pax_global_header00006660000000000000000000000064137576775030014536gustar00rootroot0000000000000052 comment=6bff567e84b01c1b3502985ec936b9e74ea252b4 math-comp-mathcomp-1.12.0/000077500000000000000000000000001375767750300153125ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/.dockerignore000066400000000000000000000012451375767750300177700ustar00rootroot00000000000000* # Begin files referenced by symlinks !README.md !AUTHORS !INSTALL.md !CeCILL-B # End files referenced by symlinks !*.opam !plugin !mathcomp !etc/utils/hierarchy.ml **/*.d **/*.vo **/*.vio **/*.cm* **/*~ **/*.glob **/*.aux **/*.a **/*.o **/*# **/Make*.coq **/Make*.coq.bak **/Make*.coq.conf mathcomp/ssreflect/ssreflect.ml4 mathcomp/ssreflect/ssrmatching.ml4 mathcomp/ssreflect/ssrmatching.mli # mathcomp/ssreflect/ssrmatching.v mathcomp/ssreflect/ssreflect_plugin.mllib mathcomp/ssreflect/ssreflect_plugin.mlpack mathcomp/ssreflect.ml4 mathcomp/ssrmatching.ml4 mathcomp/ssrmatching.mli mathcomp/ssrmatching.v mathcomp/ssreflect_plugin.mllib mathcomp/ssreflect_plugin.mlpack math-comp-mathcomp-1.12.0/AUTHORS000066400000000000000000000017761375767750300163750ustar00rootroot00000000000000Andrea Asperti University of Bologna - Microsoft Inria Joint Centre Jeremy Avigad Carnegie Mellon University - Microsoft Inria Joint Centre Yves Bertot Inria Sophia Antipolis - Microsoft Inria Joint Centre Cyril Cohen LIX École Polytechnique - Microsoft Inria Joint Centre François Garillot Microsoft Inria Joint Centre Georges Gonthier Microsoft Research Cambridge - Microsoft Inria Joint Centre Stéphane Le Roux Microsoft Inria Joint Centre Assia Mahboubi Inria Saclay - Microsoft Inria Joint Centre Sidi Ould Biha Inria Sophia Antipolis - Microsoft Inria Joint Centre Ioana Pasca Inria Sophia Antipolis - Microsoft Inria Joint Centre Laurence Rideau Inria Sophia Antipolis - Microsoft Inria Joint Centre Alexey Solovyev University of Pittsburgh Enrico Tassi Inria Saclay - Microsoft Inria Joint Centre Laurent Théry Inria Sophia Antipolis - Microsoft Inria Joint Centre Russell O'Connor Mc Master University - Microsoft Inria Joint Centre math-comp-mathcomp-1.12.0/CHANGELOG.md000066400000000000000000001741711375767750300171360ustar00rootroot00000000000000# Changelog All notable changes to this project will be documented in this file. Last releases: [[1.12.0] - 2020-11-26](#1120---2020-11-26), [[1.11.0] - 2020-06-09](#1110---2020-06-09), and [[1.10.0] - 2019-11-29](#1100---2019-11-29). The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). ## [1.12.0] - 2020-11-26 This release is compatible with Coq versions 8.10, 8.11, and 8.12. ### Added - Contraposition lemmas involving propositions: + in `ssrbool.v`: `contra_not`, `contraPnot`, `contraTnot`, `contraNnot`, `contraPT`, `contra_notT`, `contra_notN`, `contraPN`, `contraFnot`, `contraPF` and `contra_notF`. + in `eqtype.v`: `contraPeq`, `contra_not_eq`, `contraPneq`, and `contra_neq_not`, `contra_not_neq`, `contra_eq_not`. - Contraposition lemmas involving inequalities: + in `ssrnat.v`: `contraTleq`, `contraTltn`, `contraNleq`, `contraNltn`, `contraFleq`, `contraFltn`, `contra_leqT`, `contra_ltnT`, `contra_leqN`, `contra_ltnN`, `contra_leqF`, `contra_ltnF`, `contra_leq`, `contra_ltn`, `contra_leq_ltn`, `contra_ltn_leq`, `contraPleq`, `contraPltn`, `contra_not_leq`, `contra_not_ltn`, `contra_leq_not`, `contra_ltn_not` + in `order.v`: `comparable_contraTle`, `comparable_contraTlt`, `comparable_contraNle`, `comparable_contraNlt`, `comparable_contraFle`, `comparable_contraFlt`, `contra_leT`, `contra_ltT`, `contra_leN`, `contra_ltN`, `contra_leF`, `contra_ltF`, `comparable_contra_leq_le`, `comparable_contra_leq_lt`, `comparable_contra_ltn_le`, `comparable_contra_ltn_lt`, `contra_le_leq`, `contra_le_ltn`, `contra_lt_leq`, `contra_lt_ltn`, `comparable_contra_le`, `comparable_contra_le_lt`, `comparable_contra_lt_le`, `comparable_contra_lt`, `contraTle`, `contraTlt`, `contraNle`, `contraNlt`, `contraFle`, `contraFlt`, `contra_leq_le`, `contra_leq_lt`, `contra_ltn_le`, `contra_ltn_lt`, `contra_le`, `contra_le_lt`, `contra_lt_le`, `contra_lt`, `contra_le_not`, `contra_lt_not`, `comparable_contraPle`, `comparable_contraPlt`, `comparable_contra_not_le`, `comparable_contra_not_lt`, `contraPle`, `contraPlt`, `contra_not_le`, `contra_not_lt` - in `ssreflect.v`, added intro pattern ltac views for dup, swap, apply: `/[apply]`, `/[swap]` and `/[dup]`. - in `ssrbool.v` (waiting to be integrated in Coq) + generic lemmas about interaction between `{in _, _}` and `{on _, _}`: `in_on1P`, `in_on1lP`, `in_on2P`, `on1W_in`, `on1lW_in`, `on2W_in`, `in_on1W`, `in_on1lW`, `in_on2W`, `on1S`, `on1lS`, `on2S`, `on1S_in`, `on1lS_in`, `on2S_in`, `in_on1S`, `in_on1lS`, `in_on2S`. + lemmas about interaction between `{in _, _}` and `sig`: `in1_sig`, `in2_sig`, and `in3_sig`. - in `ssrnat.v`, new lemmas: `subn_minl`, `subn_maxl`, `oddS`, `subnA`, `addnBn`, `addnCAC`, `addnACl`, `iterM`, `iterX` - in `seq.v`, + new lemmas `take_uniq`, `drop_uniq` + new lemma `mkseqP` to abstract a sequence `s` with `mkseq f n`, where `f` and `n` are fresh variables. + new high-order relation `allrel r xs ys` which asserts that `r x y` holds whenever `x` is in `xs` and `y` is in `ys`, new notation `all2rel r xs (:= allrel r xs xs)` which asserts that `r` holds on all pairs of elements of `xs`, and * lemmas `allrel0(l|r)`, `allrel_cons(l|r|2)`, `allrel1(l|r)`, `allrel_cat(l|r)`, `allrel_allpairsE`, `eq_in_allrel`, `eq_allrel`, `allrelC`, `allrel_map(l|r)`, `allrelP`, * new lemmas `all2rel1`, `all2rel2`, and `all2rel_cons` under assumptions of symmetry of `r`. + new lemmas `allss`, `all_mask`, and `all_sigP`. `allss` has also been declared as a hint. + new lemmas `index_pivot`, `take_pivot`, `rev_pivot`, `eqseq_pivot2l`, `eqseq_pivot2r`, `eqseq_pivotl`, `eqseq_pivotr` `uniq_eqseq_pivotl`, `uniq_eqseq_pivotr`, `mask_rcons`, `rev_mask`, `subseq_rev`, `subseq_cat2l`, `subseq_cat2r`, `subseq_rot`, and `uniq_subseq_pivot`. + new lemmas `find_ltn`, `has_take`, `has_take_leq`, `index_ltn`, `in_take`, `in_take_leq`, `split_find_nth`, `split_find` and `nth_rcons_cat_find`. + added `drop_index`, `in_mask`, `mask0s`, `cons_subseq`, `undup_subseq`, `leq_count_mask`, `leq_count_subseq`, `count_maskP`, `count_subseqP`, `count_rem`, `count_mem_rem`, `rem_cons`, `remE`, `subseq_rem`, `leq_uniq_countP`, and `leq_uniq_count`. + new definition `rot_add` and new lemmas `rot_minn`, `leq_rot_add`, `rot_addC`, `rot_rot_add`. + new lemmas `perm_catACA`, `allpairs0l`, `allpairs0r`, `allpairs1l`, `allpairs1r`, `allpairs_cons`, `eq_allpairsr`, `allpairs_rcons`, `perm_allpairs_catr`, `perm_allpairs_consr`, `mem_allpairs_rconsr`, and `allpairs_rconsr` (with the alias `perm_allpairs_rconsr` for the sake of uniformity, but which is already deprecated in favor of `allpairs_rconsr`, cf renamed section). - in `path.v`, + new lemmas `sub_cycle(_in)`, `eq_cycle_in`, `(path|sorted)_(mask|filter)_in`, `rev_cycle`, `cycle_map`, `(homo|mono)_cycle(_in)`. + new lemma `sort_iota_stable`. + new lemmas `order_path_min_in`, `path_sorted_inE`, `sorted_(leq|ltn)_nth_in`, `subseq_path_in`, `subseq_sorted_in`, `sorted_(leq|ltn)_index_in`, `sorted_uniq_in`, `sorted_eq_in`, `irr_sorted_eq_in`, `sort_sorted_in`, `sorted_sort_in`, `perm_sort_inP`, `all_sort`, `sort_stable_in`, `filter_sort_in`, `(sorted_)mask_sort_in`, `(sorted_)subseq_sort_in`, and `mem2_sort_in`. + added `size_merge_sort_push`, which documents an invariant of `merge_sort_push`. - in `fintype.v`, + new lemmas `card_geqP`, `card_gt1P`, `card_gt2P`, `card_le1_eqP` (generalizes `fintype_le1P`), + adds lemma `split_ordP`, a variant of `splitP` which introduces ordinal equalities between the index and `lshift`/`rshift`, rather than equalities in `nat`, which in some proofs makes the reasoning easier (cf `matrix.v`), especially together with the new lemma `eq_shift` (which is a multi-rule for new lemmas `eq_lshift`, `eq_rshift`, `eq_lrshift` and `eq_rlshift`). + new lemmas `eq_liftF` and `lift_eqF`. + new lemmas `disjointFr`, `disjointFl`, `disjointWr`, `disjointW` + new (pigeonhole) lemmas `leq_card_in`, `leq_card`, + added `mask_enum_ord`. - in `finset.v` + new lemmas `set_enum`, `cards_eqP`, `cards2P` + new lemmas `properC`, `properCr`, `properCl` + new lemmas `mem_imset_eq`, `mem_imset2_eq`. These lemmas will lose the `_eq` suffix in the next release, when the shortende names will become available (cf. Renamed section) + new lemma `disjoints1` - in `order.v` + new lemmas `comparable_bigl` and `comparable_bigr`. + added a factory `distrLatticePOrderMixin` to build a `distrLatticeType` from a `porderType`. + new notations `0^d` and `1^d` for bottom and top elements of dual lattices. + new definition `lteif` and notations ` v = 0` for all `v`. + new notation `stablemx V f` asserting that `f` stabilizes `V`, with new theorems: `eigenvectorP`, `eqmx_stable`, `stablemx_row_base`, `stablemx_full`, `stablemxM`, `stablemxD`, `stablemxN`, `stablemxC`, `stablemx0`, `stableDmx`, `stableNmx`, `stable0mx`, `stableCmx`, `stablemx_sums`, and `stablemx_unit`. + added `comm_mx_stable`, `comm_mx_stable_ker`, and `comm_mx_stable_eigenspace`. + new definitions `maxrankfun`, `fullrankfun` which are "subset function" to be plugged in `rowsub`, with lemmas: `maxrowsub_free`, `eq_maxrowsub`, `maxrankfun_inj`, `maxrowsub_full`, `fullrowsub_full`, `fullrowsub_unit`, `fullrowsub_free`, `mxrank_fullrowsub`, `eq_fullrowsub`, and `fullrankfun_inj`. - in `mxpoly.v`, + new lemmas `mxminpoly_minP` and `dvd_mxminpoly`. + new lemmas `horner_mx_diag` and `char_poly_trig`, `root_mxminpoly`, and `mxminpoly_diag` + new definitions `kermxpoly g p` (the kernel of polynomial $p(g)$). * new elementary theorems: `kermxpolyC`, `kermxpoly1`, `kermxpolyX`, `kermxpoly_min` * kernel lemmas: `mxdirect_kermxpoly`, `kermxpolyM`, `kermxpoly_prod`, and `mxdirect_sum_kermx` * correspondance between `eigenspace` and `kermxpoly`: `eigenspace_poly` + generalized eigenspace `geigenspace` and a generalization of eigenvalues called `eigenpoly g` (i.e. polynomials such that `kermxpoly g p` is nonzero, e.g. eigen polynomials of degree 1 are of the form `'X - a%:P` where `a` are eigenvalues), and * correspondance with `kermx`: `geigenspaceE`, * application of kernel lemmas `mxdirect_sum_geigenspace`, * new lemmas: `eigenpolyP`, `eigenvalue_poly`, `eigenspace_sub_geigen`, + new `map_mx` lemmas: `map_kermxpoly`, `map_geigenspace`, `eigenpoly_map`. + new lemma `horner_mx_stable`. + added `comm_mx_horner`, `comm_horner_mx`, `comm_horner_mx2`, `horner_mx_stable`, `comm_mx_stable_kermxpoly`, and `comm_mx_stable_geigenspace`. - in `ssrnum.v`, + new lemma `ler_sum_nat` + new lemmas `big_real`, `sum_real`, `prod_real`, `max_real`, `min_real`, `bigmax_real`, and `bigmin_real`. + new lemma `real_lteif_distl`. - in `interval.v`, + intervals and their bounds of `T` now have canonical ordered type instances whose ordering relations are the subset relation and the left to right ordering respectively. They form partially ordered types if `T` is a `porderType`. If `T` is a `latticeType`, they also form `tbLatticeType` where the join and meet are intersection and convex hull respectively. If `T` is an `orderType`, they are distributive, and the interval bounds are totally ordered. (cf Changed section) + new lemmas `bound_ltxx`, `subitvE`, `in_itv`, `itv_ge`, `in_itvI`, `itv_total_meet3E`, and `itv_total_join3E`. ### Changed - in `ssrbool.v`, use `Reserved Notation` for `[rel _ _ : _ | _]` to avoid warnings with coq-8.12 - in `seq.v`, `mask` will only expand if both arguments are constructors, the case `mask [::] s` can be dealt with using `mask0s` or explicit conversion. - in `path.v`, + generalized lemmas `sub_path_in`, `sub_sorted_in`, and `eq_path_in` for non-`eqType`s. + generalized lemmas `sorted_ltn_nth` and `sorted_leq_nth` (formerly `sorted_lt_nth` and `sorted_le_nth`, cf Renamed section) for non-`eqType`s. - in `fintype.v`, + added lemma `ord1`, it is the same as `zmodp.ord1`, except `fintype.ord1` does not rely on `'I_n` zmodType structure. + rename `disjoint_trans` to `disjointWl` + lemmas `inj_card_onto` and `inj_card_bij` take a weaker hypothesis (i.e. `#|T| >= #|T'|` instead of `#|T| = #|T'|` thanks to `leq_card` under injectivity assumption). - in `finset.v`, fixed printing of notation `[set E | x in A , y in B & P ]` - in `bigop.v`, lemma `big_rmcond` is deprecated and has been renamed `big_rmcomd_in` (and aliased `big_uncond_in`, see Added). The variant which does not require an `eqType` is currently named `big_uncond` (cf Added) but it will be renamed `big_mkcond` in the next release. - in `ssrAC.v`, fix `non-reversible-notation` warnings - in `order.v`, + in the definition of structures, displays are removed from parameters of mixins and fields of classes internally and now only appear in parameters of structures. Consequently, each mixin is now parameterized by a class rather than a structure, and the corresponding factory parameterized by a structure is provided to replace the use of the mixin. These factories have the same names as in the mixins before this change except that `bLatticeMixin` and `tbLatticeMixin` have been renamed to `bottomMixin` and `topMixin` respectively. + the `dual_*` notations such as `dual_le` are now qualified with the `Order` module. + `\join^d_` and `\meet^d_` notations are now properly specialized for `dual_display`. + rephrased `comparable_(min|max)[rl]` in terms of `{in _, forall x y, _}`, hence reordering the arguments. Made them hints for smoother combination with `comparable_big[lr]`. + `>=< y` now stands for `[pred x | x >=< y]` + `>< y` now stands for `[pred x | x >< y]` + and the same holds for the dual `>=<^d`, `><^d`, the product `>=<^p`, `><^p`, and lexicographic `>=<^l`, `><^l`. The previous meanings can be obtained through `>=<%O x` and `><%O x`. + generalized `sort_le_id` for any `porderType`. + the names of lemmas `join_idPl` and `join_idPr` are transposed to follow the naming convention. - In `ssrnum.v`, + `>=< y` now stands for `[pred x | x >=< y]` + fixed notations `@minr` and `@maxr` to point `Order.min` and `Order.max` respectively. - in `ssrint.v`, generalized `mulpz` for any `ringType`. - in `interval.v`: + `x <= y ?< if c` (`lersif`) has been generalized to `porderType`, relocated to `order.v`, and replaced with `x < y ?<= if c'` (`lteif`) where `c'` is negation of `c`. + Many definitions and lemmas on intervals such as the membership test are generalized from numeric domains to ordered types. + Interval bounds `itv_bound : Type -> Type` are redefined with two constructors `BSide : bool -> T -> itv_bound T` and `BInfty : bool -> itv_bound T`. New notations `BLeft` and `BRight` are aliases for `BSide true` and `BSide false` respectively. `BInfty false` and `BInfty true` respectively means positive and negative infinity. `BLeft x` and `BRight x` respectively mean close and open bounds as left bounds, and they respectively mean open and close bounds as right bounds. This change gives us the canonical "left to right" ordering of interval bounds. + Lemmas `mid_in_itv(|oo|cc)` have been generalized from `realFieldType` to `numFieldType`. - In `matrix.v`, generalized `diag_mx_comm` and `scalar_mx_comm` to all `n`, instead of `n'.+1`, thanks to `commmmx`. ### Renamed - in `ssrnat.v` + `iter_add` -> `iterD` + `maxn_mul(l|r)` -> `maxnM(l|r)` + `minn_mul(l|r)` -> `minnM(l|r)` + `odd_(opp|mul|exp)` -> `odd(N|M|X)` + `sqrn_sub` -> `sqrnB` - in `div.v` + `coprime_mul(l|r)` -> `coprimeM(l|r)` + `coprime_exp(l|r)` -> `coprimeX(l|r)` - in `prime.v` + `primes_(mul|exp)` -> `primes(M|X)` + `pnat_(mul|exp)` -> `pnat(M|X)` - in `seq.v`, + `iota_add(|l)` -> `iotaD(|l)` + `allpairs_(cons|cat)r` -> `mem_allpairs_(cons|cat)r` (`allpairs_consr` and `allpairs_catr` are now deprecated alias, and will be attributed to the new `perm_allpairs_catr`). - in `path.v`, + `eq_sorted(_irr)` -> `(irr_)sorted_eq` + `sorted_(lt|le)_nth` -> `sorted_(ltn|leq)_nth` + `(ltn|leq)_index` -> `sorted_(ltn|leq)_index` + `subseq_order_path` -> `subseq_path` - in `fintype.v` + `bump_addl` -> `bumpDl` + `unbump_addl` -> `unbumpDl` - in `finset.v`, + `mem_imset` -> `imset_f` (with deprecation alias, cf. Added section) + `mem_imset2` -> `imset2_f` (with deprecation alias, cf. Added section) - in `bigop.v` + `big_rmcond` -> `big_rmcond_in` (cf Changed section) + `mulm_add(l|r)` -> `mulmD(l|r)` - in `order.v`, `eq_sorted_(le|lt)` -> `(le|lt)_sorted_eq` - in `interval.v`, we deprecate, rename, and relocate to `order.v` the following: + `lersif_(trans|anti)` -> `lteif_(trans|anti)` + `lersif(xx|NF|S|T|F|W)` -> `lteif(xx|NF|S|T|F|W)` + `lersif_(andb|orb|imply)` -> `lteif_(andb|orb|imply)` + `ltrW_lersif` -> `ltrW_lteif` + `lersifN` -> `lteifNE` + `lersif_(min|max)(l|r)` -> ` lteif_(min|max)(l|r)` - in `interval.v`, we deprecate, rename, and relocate to `ssrnum.v` the following: + `subr_lersif(r0|0r|0)` -> `subr_lteif(r0|0r|0)` + `lersif01` -> `lteif01` + `lersif_(oppl|oppr|0oppr|oppr0|opp2|oppE)` -> `lteif_(oppl|oppr|0oppr|oppr0|opp2|oppE)` + `lersif_add2(|l|r)` -> `lteif_add2(|l|r)` + `lersif_sub(l|r)_add(l|r)` -> `lteif_sub(l|r)_add(l|r)` + `lersif_sub_add(l|r)` -> `lteif_sub_add(l|r)` + `lersif_(p|n)mul2(l|r)` -> `lteif_(p|n)mul2(l|r)` + `real_lersifN` -> `real_lteifNE` + `real_lersif_norm(l|r)` -> `real_lteif_norm(l|r)` + `lersif_nnormr` -> `lteif_nnormr` + `lersif_norm(l|r)` -> `lteif_norm(l|r)` + `lersif_distl` -> `lteif_distl` + `lersif_(p|n)div(l|r)_mul(l|r)` -> `lteif_(p|n)div(l|r)_mul(l|r)` - in `interval.v`, we deprecate and replace the following: + `lersif_in_itv` -> `lteif_in_itv` + `itv_gte` -> `itv_ge` + `l(t|e)r_in_itv` -> `lt_in_itv` - in `ssralg.v`, `prodrMn`-> `prodrMn_const` (with deprecation alias, cf. Added section) - in `ssrint.v`, `polyC_mulrz` -> `polyCMz` - in `poly.v` + `polyC_(add|opp|sub|muln|mul|inv)` -> `polyC(D|N|B|Mn|M|V)` + `lead_coef_opp` -> `lead_coefN` + `derivn_sub` -> `derivnB` - in `polydiv.v` + `rdivp_add(l|r)` -> `rdivpD(l|r)` + `rmodp_add` -> `rmodpD` + `dvdp_scale(l|r)` -> `dvdpZ(l|r)` + `dvdp_opp` -> `dvdpNl` + `coprimep_scale(l|r)` -> `coprimepZ(l|r)` + `coprimep_mul(l|r)` -> `coprimepM(l|r)` + `modp_scale(l|r)` -> `modpZ(l|r)` + `modp_(opp|add|scalel|scaler)` -> `modp(N|D|Zl|Zr)` + `divp_(opp|add|scalel|scaler)` -> `divp(N|D|Zl|Zr)` - in `matrix.v`, `map_mx_sub` -> `map_mxB` - in `mxalgebra.v`, `mulsmx_add(l|r)` -> `mulsmxD(l|r)` - in `vector.v`, `limg_add` -> `limgD` - in `intdiv.v` + `coprimez_mul(l|r)` -> `coprimezM(l|r)` + `coprimez_exp(l|r)` -> `coprimezX(l|r)` ### Removed - in `ssrnat.v`, we remove the compatibility module `mc_1_9`. - in `interval.v`, we remove the following: + `le_bound(l|r)` (use `Order.le` instead) + `le_bound(l|r)_refl` (use `lexx` instead) + `le_bound(l|r)_anti` (use `eq_le` instead) + `le_bound(l|r)_trans` (use `le_trans` instead) + `le_bound(l|r)_bb` (use `bound_lexx` instead) + `le_bound(l|r)_total` (use `le_total` instead) - in `interval.v`, we deprecate the following: + `itv_intersection` (use `Order.meet` instead) + `itv_intersection1i` (use `meet1x` instead) + `itv_intersectioni1` (use `meetx1` instead) + `itv_intersectionii` (use `meetxx` instead) + `itv_intersectionC` (use `meetC` instead) + `itv_intersectionA` (use `meetA` instead) - in `mxpoly.v`, we deprecate `scalar_mx_comm`, and advise to use `comm_mxC` instead (with maximal implicit arguments `R` and `n`). ### Infrastructure - in all the hierarchies (in `eqtype.v`, `choice.v`, `order.v`, `ssralg.v`,...), the `class_of` records of structures are turned into primitive records to prevent prevent potential issues of ambiguous paths and convertibility of structure instances. - across the library, the following constants have been tuned to only reduce when they do not expose a match: `subn_rec`, `decode_rec`, `nth` (thus avoiding a notorious problem of ``p`_0`` expanding too eagerly), `set_nth`, `take`, `drop`, `eqseq`, `incr_nth`, `elogn2`, `binomial_rec`, `sumpT`. ## [1.11.0] - 2020-06-09 This release is compatible with Coq versions 8.7, 8.8, 8.9, 8.10, and 8.11. - Added lemmas about monotony of functions `nat -> T` where `T` is an ordered type: `homo_ltn_lt_in`, `incn_inP`, `nondecn_inP`, `nhomo_ltn_lt_in`, `decn_inP`, `nonincn_inP`, `homo_ltn_lt`, `incnP`, `nondecnP`, `nhomo_ltn_lt`, `decnP`, `nonincnP` in file `order.v`. - Added lemmas for swaping arguments of homomorphisms and monomorphisms: `homo_sym`, `mono_sym`, `homo_sym_in`, `mono_sym_in`, `homo_sym_in11`, `mono_sym_in11` in `ssrbool.v` ### Added - in `ssrnum.v`, new lemmas: + `(real_)ltr_normlW`, `(real_)ltrNnormlW`, `(real_)ler_normlW`, `(real_)lerNnormlW` + `(real_)ltr_distl_addr`, `(real_)ler_distl_addr`, `(real_)ltr_distlC_addr`, `(real_)ler_distlC_addr`, `(real_)ltr_distl_subl`, `(real_)ler_distl_subl`, `(real_)ltr_distlC_subl`, `(real_)ler_distlC_subl` - in `order.v`, defining `min` and `max` independently from `meet` and `join`, and providing a theory about for min and max, hence generalizing the theory of `Num.min` and `Num.max` from versions <= `1.10`, instead of specializing to total order as in `1.11+beta1`: ``` Definition min (T : porderType) (x y : T) := if x < y then x else y. Definition max (T : porderType) (x y : T) := if x < y then y else x. ``` + Lemmas: `min_l`, `min_r`, `max_l`, `max_r`, `minxx`, `maxxx`, `eq_minl`, `eq_maxr`, `min_idPl`, `max_idPr`, `min_minxK`, `min_minKx`, `max_maxxK`, `max_maxKx`, `comparable_minl`, `comparable_minr`, `comparable_maxl`, and `comparable_maxr` + Lemmas about interaction with lattice operations: `meetEtotal`, `joinEtotal`, + Lemmas under condition of pairwise comparability of a (sub)set of their arguments: `comparable_minC`, `comparable_maxC`, `comparable_eq_minr`, `comparable_eq_maxl`, `comparable_le_minr`, `comparable_le_minl`, `comparable_min_idPr`, `comparable_max_idPl`, `comparableP`, `comparable_lt_minr`, `comparable_lt_minl`, `comparable_le_maxr`, `comparable_le_maxl`, `comparable_lt_maxr`, `comparable_lt_maxl`, `comparable_minxK`, `comparable_minKx`, `comparable_maxxK`, `comparable_maxKx`, `comparable_minA`, `comparable_maxA`, `comparable_max_minl`, `comparable_min_maxl`, `comparable_minAC`, `comparable_maxAC`, `comparable_minCA`, `comparable_maxCA`, `comparable_minACA`, `comparable_maxACA`, `comparable_max_minr`, `comparable_min_maxr` + and the same but in a total order: `minC`, `maxC`, `minA`, `maxA`, `minAC`, `maxAC`, `minCA`, `maxCA`, `minACA`, `maxACA`, `eq_minr`, `eq_maxl`, `min_idPr`, `max_idPl`, `le_minr`, `le_minl`, `lt_minr`, `lt_minl`, `le_maxr`,`le_maxl`, `lt_maxr`, `lt_maxl`, `minxK`, `minKx`, `maxxK`, `maxKx`, `max_minl`, `min_maxl`, `max_minr`, `min_maxr` - in `ssrnum.v`, theory about `min` and `max` extended to `numDomainType`: + Lemmas: `real_oppr_max`, `real_oppr_min`, `real_addr_minl`, `real_addr_minr`, `real_addr_maxl`, `real_addr_maxr`, `minr_pmulr`, `maxr_pmulr`, `real_maxr_nmulr`, `real_minr_nmulr`, `minr_pmull`, `maxr_pmull`, `real_minr_nmull`, `real_maxr_nmull`, `real_maxrN`, `real_maxNr`, `real_minrN`, `real_minNr` - the compatibility module `ssrnum.mc_1_10` was extended to support definitional compatibility with `min` and `max` which had been lost in `1.11+beta1` for most instances. - in `fintype.v`, new lemmas: `seq_sub_default`, `seq_subE` - in `order.v`, new "unfolding" lemmas: `minEnat` and `maxEnat` - in `ssrbool.v` + lemmas about the `cancel` predicate and `{in _, _}`/`{on _, _}` notations: * `onW_can`, `onW_can_in`, `in_onW_can`, `onS_can`, `onS_can_in`, `in_onS_can` + lemmas about the `cancel` predicate and injective functions: * `inj_can_sym_in_on`, `inj_can_sym_on`, `inj_can_sym_in` ### Changed - in `order.v`, `le_xor_gt`, `lt_xor_ge`, `compare`, `incompare`, `lel_xor_gt`, `ltl_xor_ge`, `comparel`, `incomparel` have more parameters, so that the the following now deal with `min` and `max` + `comparable_ltgtP`, `comparable_leP`, `comparable_ltP`, `comparableP` + `lcomparableP`, `lcomparable_ltgtP`, `lcomparable_leP`, `lcomparable_ltP`, `ltgtP` - in `order.v`: + `[arg min_(i < i0 | P) M]` now for `porderType` (was for `orderType`) + `[arg max_(i < i0 | P) M]` now for `porderType` (was for `orderType`) + added `comparable_arg_minP`, `comparable_arg_maxP`, `real_arg_minP`, `real_arg_maxP`, in order to take advantage of the former generalizations. - in `ssrnum.v`, `maxr` is a notation for `(@Order.max ring_display _)` (was `Order.join`) (resp. `minr` is a notation for `(@Order.min ring_display _)`) - in `ssrnum.v`, `ler_xor_gt`, `ltr_xor_ge`, `comparer`, `ger0_xor_lt0`, `ler0_xor_gt0`, `comparer0` have now more parameters, so that the following now deal with min and max: + `real_leP`, `real_ltP x y`, `real_ltgtP`, `real_ge0P`, `real_le0P`, `real_ltgt0P` + `lerP`, `ltrP`, `ltrgtP`, `ger0P`, `ler0P`, `ltrgt0P` - in `ssrnum.v`, the following have been restated (which were formerly derived from `order.v` and stated with specializations of the `meet` and `join` operators): + `minrC`, `minrr`, `minr_l`, `minr_r`, `maxrC`, `maxrr`, `maxr_l`, `maxr_r`, `minrA`, `minrCA`, `minrAC`, `maxrA`, `maxrCA`, `maxrAC` + `eqr_minl`, `eqr_minr`, `eqr_maxl`, `eqr_maxr`, `ler_minr`, `ler_minl`, `ler_maxr`, `ler_maxl`, `ltr_minr`, `ltr_minl`, `ltr_maxr`, `ltr_maxl` + `minrK`, `minKr`, `maxr_minl`, `maxr_minr`, `minr_maxl`, `minr_maxr` - The new definitions of `min` and `max` may require the following rewrite rules changes when dealing with `max` and `min` instead of `meet` and `join`: + `ltexI` -> `(le_minr,lt_minr)` + `lteIx` -> `(le_minl,lt_minl)` + `ltexU` -> `(le_maxr,lt_maxr)` + `lteUx` -> `(le_maxl,lt_maxl)` + `lexU` -> `le_maxr` + `ltxU` -> `lt_maxr` + `lexU` -> `le_maxr` - in `ssrbool.v` + lemmas about monotone functions and the `{in _, _}` notation: * `homoRL_in`, `homoLR_in`, `homo_mono_in`, `monoLR_in`, `monoRL_in`, `can_mono_in` ### Renamed - in `fintype` we deprecate and rename the following: + `arg_minP` -> `arg_minnP` + `arg_maxP` -> `arg_maxnP` - in `order.v`, in module `NatOrder`, renamings: + `meetEnat` -> `minEnat`, `joinEnat` -> `maxEnat`, `meetEnat` -> `minEnat`, `joinEnat` -> `maxEnat` ### Removed - in `order.v`, removed `total_display` (was used to provide the notation `max` for `join` and `min` for `meet`). - in `order.v`, removed `minnE` and `maxnE` - in `order.v`, + removed `meetEnat` (in favor of `meetEtotal` followed by `minEnat`) + removed `joinEnat` (in favor of `joinEtotal` followed by `maxEnat`) ## [1.11+beta1] - 2020-04-15 This release is compatible with Coq versions 8.7, 8.8, 8.9 and 8.10. ### Added - Arithmetic theorems in ssrnat, div and prime about `logn`, `coprime`, `gcd`, `lcm` and `partn`: `logn_coprime`, `logn_gcd`, `logn_lcm`, `eq_partn_from_log` and `eqn_from_log`. - Lemmas `ltnNleqif`, `eq_leqif`, `eqTleqif` in `ssrnat` - Lemmas `eqEtupe`, `tnthS` and `tnth_nseq` in `tuple` - Ported `order.v` from the finmap library, which provides structures of ordered sets (`porderType`, `latticeType`, `distrLatticeType`, `orderType`, etc.) and its theory. - Lemmas `path_map`, `eq_path_in`, `sub_path_in`, `path_sortedE`, `sub_sorted` and `sub_sorted_in` in `path` (and refactored related proofs) - Added lemmas `hasNfind`, `memNindex` and `findP` in `seq` - Added lemmas `foldr_rcons`, `foldl_rcons`, `scanl_rcons` and `nth_cons_scanl` in `seq` - ssrAC tactics, see header of `ssreflect/ssrAC.v` for documentation of `(AC patternshape reordering)`, `(ACl reordering)` `(ACof reordering reordering)`, `op.[AC patternshape reordering]`, `op.[ACl reordering]` and `op.[ACof reordering reordering]`. - Added definition `cast_perm` with a group morphism canonical structure, and lemmas `permX_fix`, `imset_perm1`, `permS0`, `permS1`, `cast_perm_id`, `cast_ord_permE`, `cast_permE`, `cast_perm_comp`, `cast_permK`, `cast_permKV`, `cast_perm_inj`, `cast_perm_sym`,`cast_perm_morphM`, and `isom_cast_perm` in `perm` and `restr_perm_commute` in `action`. - Added `card_porbit_neq0`, `porbitP`, and `porbitPmin` in `perm` - Added definition `Sym` with a group set canonical structure and lemmas `card_Sn` and `card_Sym` in `perm` and `SymE` in `action` ### Changed - Reorganized the algebraic hierarchy and the theory of `ssrnum.v`. + `numDomainType` and `realDomainType` get inheritances respectively from `porderType` and `orderType`. + `normedZmodType` is a new structure for `numDomainType` indexed normed additive abelian groups. + `[arg minr_( i < n | P ) F]` and `[arg maxr_( i < n | P ) F]` notations are removed. Now `[arg min_( i < n | P ) F]` and `[arg max_( i < n | P ) F]` notations are defined in `nat_scope` (specialized for `nat`), `order_scope` (general one), and `ring_scope` (specialized for `ring_display`). Lemma `fintype.arg_minP` is aliased to `arg_minnP` and the same for `arg_maxnP`. + The following lemmas are generalized, renamed, and relocated to `order.v`: * `ltr_def` -> `lt_def` * `(ger|gtr)E` -> `(ge|gt)E` * `(le|lt|lte)rr` -> `(le|lt|lte)xx` * `ltrW` -> `ltW` * `ltr_neqAle` -> `lt_neqAle` * `ler_eqVlt` -> `le_eqVlt` * `(gtr|ltr)_eqF` -> `(gt|lt)_eqF` * `ler_anti`, `ler_asym` -> `le_anti` * `eqr_le` -> `eq_le` * `(ltr|ler_lt|ltr_le|ler)_trans` -> `(lt|le_lt|lt_le|le)_trans` * `lerifP` -> `leifP` * `(ltr|ltr_le|ler_lt)_asym` -> `(lt|lt_le|le_lt)_asym` * `lter_anti` -> `lte_anti` * `ltr_geF` -> `lt_geF` * `ler_gtF` -> `le_gtF` * `ltr_gtF` -> `lt_gtF` * `lt(r|nr|rn)W_(n)homo(_in)` -> `ltW_(n)homo(_in)` * `inj_(n)homo_lt(r|nr|rn)(_in)` -> `inj_(n)homo_lt(_in)` * `(inc|dec)(r|nr|rn)_inj(_in)` -> `(inc_dec)_inj(_in)` * `le(r|nr|rn)W_(n)mono(_in)` -> `leW_(n)mono(_in)` * `lenr_(n)mono(_in)` -> `le_(n)mono(_in)` * `lerif_(refl|trans|le|eq)` -> `leif_(refl|trans|le|eq)` * `(ger|ltr)_lerif` -> `(ge|lt)_leif` * `(n)mono(_in)_lerif` -> `(n)mono(_in)_leif` * `(ler|ltr)_total` -> `(le|lt)_total` * `wlog_(ler|ltr)` -> `wlog_(le|lt)` * `ltrNge` -> `ltNge` * `lerNgt` -> `leNgt` * `neqr_lt` -> `neq_lt` * `eqr_(le|lt)(LR|RL)` -> `eq_(le|lt)(LR|RL)` * `eqr_(min|max)(l|r)` -> `eq_(meet|join)(l|r)` * `ler_minr` -> `lexI` * `ler_minl` -> `leIx` * `ler_maxr` -> `lexU` * `ler_maxl` -> `leUx` * `lt(e)r_min(r|l)` -> `lt(e)(xI|Ix)` * `lt(e)r_max(r|l)` -> `lt(e)(xU|Ux)` * `minrK` -> `meetUKC` * `minKr` -> `joinKIC` * `maxr_min(l|r)` -> `joinI(l|r)` * `minr_max(l|r)` -> `meetU(l|r)` * `minrP`, `maxrP` -> `leP`, `ltP` Replacing `minrP` and `maxrP` with `leP` and `ltP` may require to provide some arguments explicitly. The former ones respectively try to match with `minr` and `maxr` first but the latter ones try that in the order of `<`, `<=`, `maxr`, and `minr`. * `(minr|maxr)(r|C|A|CA|AC)` -> `(meet|join)(xx|C|A|CA|AC)` * `minr_(l|r)` -> `meet_(l|r)` * `maxr_(l|r)` -> `join_(l|r)` * `arg_minrP` -> `arg_minP` * `arg_maxrP` -> `arg_maxP` + Generalized the following lemmas as properties of `normedDomainType`: `normr0`, `normr0P`, `normr_eq0`, `distrC`, `normr_id`, `normr_ge0`, `normr_le0`, `normr_lt0`, `normr_gt0`, `normrE`, `normr_real`, `ler_norm_sum`, `ler_norm_sub`, `ler_dist_add`, `ler_sub_norm_add`, `ler_sub_dist`, `ler_dist_dist`, `ler_dist_norm_add`, `ler_nnorml`, `ltr_nnorml`, `lter_nnormr`. + The compatibility layer for the version 1.10 is provided as the `ssrnum.mc_1_10` module. One may compile proofs compatible with the version 1.10 in newer versions by using the `mc_1_10.Num` module instead of the `Num` module. However, instances of the number structures may require changes. - Extended comparison predicates `leqP`, `ltnP`, and `ltngtP` in ssrnat to allow case analysis on `minn` and `maxn`. + The compatibility layer for the version 1.10 is provided as the `ssrnat.mc_1_10` module. One may compile proofs compatible with the version 1.10 in newer versions by using this module. - The definition of `all2` was slightly altered for a better interaction with the guard condition (#469) ### Renamed - `real_lerP` -> `real_leP` - `real_ltrP` -> `real_ltP` - `real_ltrNge` -> `real_ltNge` - `real_lerNgt` -> `real_leNgt` - `real_ltrgtP` -> `real_ltgtP` - `real_ger0P` -> `real_ge0P` - `real_ltrgt0P` -> `real_ltgt0P` - `lerif_nat` -> `leif_nat_r` - Replaced `lerif` with `leif` in the following names of lemmas: + `lerif_subLR`, `lerif_subRL`, `lerif_add`, `lerif_sum`, `lerif_0_sum`, `real_lerif_norm`, `lerif_pmul`, `lerif_nmul`, `lerif_pprod`, `real_lerif_mean_square_scaled`, `real_lerif_AGM2_scaled`, `lerif_AGM_scaled`, `real_lerif_mean_square`, `real_lerif_AGM2`, `lerif_AGM`, `relif_mean_square_scaled`, `lerif_AGM2_scaled`, `lerif_mean_square`, `lerif_AGM2`, `lerif_normC_Re_Creal`, `lerif_Re_Creal`, `lerif_rootC_AGM`. - The following naming inconsistencies have been fixed in `ssrnat.v`: + `homo_inj_lt(_in)` -> `inj_homo_ltn(_in)` + `(inc|dec)r_inj(_in)` -> `(inc|dec)n_inj(_in)` - switching long suffixes to short suffixes + `odd_add` -> `oddD` + `odd_sub` -> `oddB` + `take_addn` -> `takeD` + `rot_addn` -> `rotD` + `nseq_addn` -> `nseqD` - Replaced `cycle` by `orbit` in `perm/action`: + `pcycle` -> `porbit` + `pcycles` -> `porbits` + `pcycleE` -> `porbitE` + `pcycle_actperm` -> `porbit_actperm` + `mem_pcycle` -> `mem_porbit` + `pcycle_id` -> `porbit_id` + `uniq_traject_pcycle` -> `uniq_traject_porbit` + `pcycle_traject` -> `porbit_traject` + `iter_pcycle` -> `iter_porbit` + `eq_pcycle_mem` -> `eq_porbit_mem` + `pcycle_sym` -> `porbit_sym` + `pcycle_perm` -> `porbit_perm` + `ncycles_mul_tperm` -> `porbits_mul_tperm` ### Removed The following were deprecated since release 1.9.0 - `tuple_perm_eqP` (use `tuple_permP` instead, from `perm.v`) - `eq_big_perm` (use `perm_big` instead, from `bigop.v`) - `perm_eqP` (use `permP` instead, from seq.v) - `perm_eqlP` (use `permPl` instead) - `perm_eqrP` (use `permPr` instead) - `perm_eqlE` (use `permEl` instead) - `perm_eq_refl` (use `perm_refl` instead) - `perm_eq_sym` (use `perm_sym` instead) - `perm_eq_trans` (use `perm_trans` instead) - `perm_eq_size` (use `perm_size` instead) - `perm_eq_mem` (use `perm_mem` instead) - `perm_eq_uniq` (use `perm_uniq` instead) ## [1.10.0] - 2019-11-29 This release is compatible with Coq versions 8.9 and 8.10. ### Added - Added a `void` notation for the `Empty_set` type of the standard library, the canonical injection `of_void` and its cancellation lemma `of_voidK`, and `eq`, `choice`, `count` and `fin` instances. - Added `ltn_ind` general induction principle for `nat` variables, helper lemmas `ubnP`, `ltnSE`, ubnPleq, ubnPgeq and ubnPeq, in support of a generalized induction idiom for `nat` measures that does not rely on the `{-2}` numerical occurrence selector, and purged this idiom from the `mathcomp` library (see below). - Added fixpoint and cofixpoint constructions to `finset`: `fixset`, `cofixset` and `fix_order`, with a few theorems about them - Added functions `tuple_of_finfun`, `finfun_of_tuple`, and their "cancellation" lemmas. - Added theorems `totient_prime` and `Euclid_dvd_prod` in `prime.v` - Added theorems `ffact_prod`, `prime_modn_expSn` and `fermat_little` in `binomial.v` - Added theorems `flatten_map1`, `allpairs_consr`, `mask_filter`, `all_filter`, `all_pmap`, and `all_allpairsP` in `seq.v`. - Added theorems `nth_rcons_default`, `undup_rcons`, `undup_cat` and `undup_flatten_nseq` in `seq.v` - Fintype theorems: `fintype0`, `card_le1P`, `mem_card1`, `card1P`, `fintype_le1P`, `fintype1`, `fintype1P`, `existsPn`, `exists_inPn`, `forallPn`, `forall_inPn`, `eq_enum_rank_in`, `enum_rank_in_inj`, `lshift_inj`, and `rshift_inj`. - Bigop theorems: `index_enum_uniq`, `big_rmcond`, `bigD1_seq`, `big_enum_val_cond`, `big_enum_rank_cond`, `big_enum_val`, `big_enum_rank`, `big_set`, `big_enumP`, `big_enum_cond`, `big_enum` - Arithmetic theorems in ssrnat and div: - some trivial results in ssrnat: `ltn_predL`, `ltn_predRL`, `ltn_subrR`, `leq_subrR`, `ltn_subrL` and `predn_sub`, - theorems about `n <=/< p +/- m` and `m +/- n <=/< p`: `leq_psubRL`, `ltn_psubLR`, `leq_subRL`, `ltn_subLR`, `leq_subCl`, `leq_psubCr`, `leq_subCr`, `ltn_subCr`, `ltn_psubCl` and `ltn_subCl`, - some commutations between modulo and division: `modn_divl` and `divn_modl`, - theorems about the euclidean division of additions and subtraction, + without preconditions of divisibility: `edivnD`, `edivnB`, `divnD`, `divnB`, `modnD`, `modnB`, + with divisibility of one argument: `divnDMl`, `divnMBl`, `divnBMl`, `divnBl` and `divnBr`, + specialization of the former theorems for .+1 and .-1: `edivnS`, `divnS`, `modnS`, `edivn_pred`, `divn_pred` and `modn_pred`. - Added `sort_rec1` and `sortE` to help inductive reasoning on `sort`. - Added map/parametricity theorems about `path`, `sort`, and `sorted`: `homo_path`, `mono_path`, `homo_path_in`, `mono_path_in`, `homo_sorted`, `mono_sorted`, `map_merge`, `merge_map`, `map_sort`, `sort_map`, `sorted_map`, `homo_sorted_in`, `mono_sorted_in`. - Extracting lemma `fpathE` from `fpathP`, and shortening the proof of the latter. - Added the theorem `perm_iota_sort` to express that the sorting of any sequence `s` is equal to a mapping of `iota 0 (size s)` to the nth elements of `s`, so that one can still reason on `nat`, even though the elements of `s` are not in an `eqType`. - Added stability theorems about `merge` and `sort`: `sorted_merge`, `merge_stable_path`, `merge_stable_sorted`, `sorted_sort`, `sort_stable`, `filter_sort`, `mask_sort`, `sorted_mask_sort`, `subseq_sort`, `sorted_subseq_sort`, and `mem2_sort`. - New algebraic interfaces in `ssralg.v`: comAlgebra and comUnitAlgebra for commutative and commutative-unitary algebras. - Initial property for polynomials in algebras: New canonical lrMoprphism `horner_alg` evaluating a polynomial in an element of an algebra. The theory include the lemmas `in_alg_comm`, `horner_algC`, `horner_algX`, `poly_alg_initial`. - Added lemmas on commutation with difference, big sum and prod: `commrB`, `commr_sum`, `commr_prod`. - Added a few basic seq lemmas about `nseq`, `take` and `drop`: `nseq_addn`, `take_take`, `take_drop`, `take_addn`, `takeC`, `take_nseq`, `drop_nseq`, `rev_nseq`, `take_iota`, `drop_iota`. - Added ssrfun theorem `inj_compr`. - Added theorems `mem2E`, `nextE`, `mem_fcycle`, `inj_cycle`, `take_traject`, `trajectD` and `cycle_catC` in `path.v` - Added lemmas about `cycle`, `connect`, `fconnect`, `order` and `orbit` in `fingraph.v`: - lemma `connect_cycle`, - lemmas `in_orbit`, `order_gt0`, `findex_eq0`, `mem_orbit`, `image_orbit`, - lemmas `fcycle_rconsE`, `fcycle_consE`, `fcycle_consEflatten` and `undup_cycle_cons` which operate under the precondition that the sequence `x :: p` is a cycle for f (i.e. `fcycle f (x :: p)`). - lemmas which operate under the precondition there is a sequence `p` which is a cycle for `f` (i.e. `fcycle f p`): `order_le_cycle`, `finv_cycle`, `f_finv_cycle`, `finv_f_cycle`, `finv_inj_cycle`, `iter_finv_cycle`, `cycle_orbit_cycle`, `fpath_finv_cycle`, `fpath_finv_f_cycle`, `fpath_f_finv_cycle`, `prevE`, `fcycleEflatten`, `fcycle_undup`, `in_orbit_cycle`, `eq_order_cycle`, `iter_order_cycle`, - lemmas `injectivePcycle`, `orbitPcycle`, `fconnect_eqVf`, `order_id_cycle`, `orderPcycle`, `fconnect_f`, `fconnect_findex`. - Added lemma `rot_index` which explicits the index given by `rot_to`. - Added tactic `tfae` to split an equivalence between n+1 propositions into n+1 goals, and referenced orbitPcycle as a reference of use. ### Changed - Replaced the legacy generalised induction idiom with a more robust one that does not rely on the `{-2}` numerical occurrence selector, using new `ssrnat` helper lemmas `ltn_ind`, `ubnP`, `ubnPleq`, ...., (see above). The new idiom is documented in `ssrnat`. This change anticipates an expected evolution of `fintype` to integrate `finmap`. It is likely that the new definition of the `#|A|` notation will hide multiple occurrences of `A`, which will break the `{-2}` induction idiom. Client libraries should update before the 1.11 release (see [PR #434](https://github.com/math-comp/math-comp/pull/434) for examples). - Replaced the use of the accidental convertibility between `enum A` and `filter A (index_enum T)` with more explicit lemmas `big_enumP`, `big_enum`, `big_enum_cond`, `big_image` added to the `bigop` library, and deprecated the `filter_index_enum` lemma that states the corresponding equality. Both convertibility and equality may no longer hold in future `mathcomp` releases when sets over `finType`s are generalised to finite sets over `choiceType`s, so client libraries should stop relying on this identity. File `bigop.v` has some boilerplate to help with the port; also see [PR #441](https://github.com/math-comp/math-comp/pull/441) for examples. - Restricted `big_image`, `big_image_cond`, `big_image_id` and `big_image_cond_id` to `bigop`s over _abelian_ monoids, anticipating the change in the definition of `enum`. This may introduce some incompatibilities - non-abelian instances should be dealt with a combination of `big_map` and `big_enumP`. - `eqVneq` lemma is changed from `{x = y} + {x != y}` to `eq_xor_neq x y (y == x) (x == y)`, on which a case analysis performs simultaneous replacement of expressions of the form `x == y` and `y == x` by `true` or `false`, while keeping the ability to use it in the way it was used before. - Generalized the `allpairs_catr` lemma to the case where the types of `s`, `t1`, and `t2` are non-`eqType`s in `[seq E | i <- s, j <- t1 ++ t2]`. - Generalized `muln_modr` and `muln_modl` removing hypothesis `0 < p`. - Generalized `sort` to non-`eqType`s (as well as `merge`, `merge_sort_push`, `merge_sort_pop`), together with all the lemmas that did not really rely on an `eqType`: `size_merge`, `size_sort`, `merge_path`, `merge_sorted`, `sort_sorted`, `path_min_sorted` (which statement was modified to remove the dependency in `eqType`), and `order_path_min`. - `compare_nat` type family and `ltngtP` comparison predicate are changed from `compare_nat m n (m <= n) (n <= m) (m < n) (n < m) (n == m) (m == n)` to `compare_nat m n (n == m) (m == n) (n <= m) (m <= n) (n < m) (m < n)`, to make it tries to match subterms with `m < n` first, `m <= n`, then `m == n`. + The compatibility layer for the version 1.9 is provided as the `ssrnat.mc_1_9` module. One may compile proofs compatible with the version 1.9 in newer versions by using this module. - Moved `iter_in` to ssrnat and reordered its arguments. - Notation `[<-> P0 ; .. ; Pn]` now forces `Pi` to be of type `Prop`. ### Removed - `fin_inj_bij` lemma is removed as a duplicate of `injF_bij` lemma from `fintype` library. ### Infrastructure - `Makefile` now supports the `test-suite` and `only` targets. Currently, `make test-suite` will verify the implementation of mathematical structures and their inheritances of MathComp automatically, by using the `hierarchy.ml` utility. One can use the `only` target to build the sub-libraries of MathComp specified by the `TGTS` variable, e.g., `make only TGTS="ssreflect/all_ssreflect.vo fingroup/all_fingroup.vo"`. - `Makefile`now supports a `doc` target to build the documentation as made available on https://mathcomp.github.io/htmldoc/index.html ## [1.9.0] - 2019-05-22 MathComp 1.9.0 is compatible with Coq 8.7, 8.8, 8.9 and 8.10beta1. Minor releases will remain compatible with Coq 8.9 and 8.10; compatibility with earlier versions may be dropped. ### Added - `nonPropType`, an interface for non-`Prop` types, and `{pred T}` and `relpre f r`, all of which will be in the Coq 8.10 core SSreflect library. - `deprecate old_id new_id`, notation for `new_id` that prints a deprecation warning for `old_id`; `Import Deprecation.Silent` turns off those warnings, `Import Deprecation.Reject` raises errors instead of only warning. - `filter_nseq`, `count_nseq`, `mem_nseq`, `rcons_inj`, `rcons_injl`, `rcons_injr`, `nthK`, `sumn_rot`. - some `perm_eq` lemmas: `perm_cat[lr]`, `perm_nilP`, `perm_consP`, `perm_has`, `perm_flatten`, `perm_sumn`. - computing (efficiently) (item, multiplicity) tallies of sequences over an `eqType`: `tally s`, `incr_tally bs x`, `bs \is a wf_tally`, `tally_seq bs`. ### Changed - definition of `PredType` which now takes only a `P -> pred T` function; definition of `simpl_rel` to improve simplification by `inE`. Both these changes will be in the Coq 8.10 SSReflect core library. - definition of `permutations s` now uses an optimal algorithm (in space _and_ time) to generate all permutations of s back-to-front, using `tally s`. ### Renamed - `perm_eqP` -> `permP` (`seq.permP` if `perm.v` is also imported) - `perm_eqlP` -> `permPl` - `perm_eqrP` -> `permPr` - `perm_eqlE` -> `permEl` - `perm_eq_refl` -> `perm_refl` - `perm_eq_sym` -> `perm_sym` - `perm_eq_trans` -> `perm_trans` - `perm_eq_size` -> `perm_size` - `perm_eq_mem` -> `perm_mem` - `perm_eq_uniq` -> `perm_uniq` - `perm_eq_rev` -> `perm_rev` - `perm_eq_flatten` -> `perm_flatten` - `perm_eq_all` -> `perm_all` - `perm_eq_small` -> `perm_small_eq` - `perm_eq_nilP` -> `perm_nilP` - `perm_eq_consP` -> `perm_consP` - `leq_size_perm` -> `uniq_min_size` (permuting conclusions) - `perm_uniq` -> `eq_uniq` (permuting assumptions) --> beware `perm_uniq` now means `perm_eq_uniq` - `uniq_perm_eq` -> `uniq_perm` - `perm_eq_iotaP` -> `perm_iotaP` - `perm_undup_count` -> `perm_count_undup` - `tuple_perm_eqP` -> `tuple_permP` - `eq_big_perm` -> `perm_big` - `perm_eq_abelian_type` -> `abelian_type_pgroup` ### Misc - removed Coq prelude hints `plus_n_O` `plus_n_Sm` `mult_n_O` `mult_n_Sm`, to improve robustness of `by ...`; scripts may need to invoke `addn0`, `addnS`, `muln0` or `mulnS` explicitly where these hints were used accidentally. ## [1.8.0] - 2019-04-08 Drop compatibility with Coq 8.6 (OCaml plugin removed). MathComp 1.8.0 is compatible with Coq 8.7, 8.8 and 8.9. ### Added - Companion matrix of a polynomial `companionmx p` and the theorems: `companionmxK`, `map_mx_companion` and `companion_map_poly` - `homoW_in`, `inj_homo_in`, `mono_inj_in`, `anti_mono_in`, `total_homo_mono_in`, `homoW`, `inj_homo`, `monoj`, `anti_mono`, `total_homo_mono` - `sorted_lt_nth`, `ltn_index`, `sorted_le_nth`, `leq_index`. - `[arg minr_( i < n | P ) F]` and `[arg maxr_( i < n | P ) F]` with all their variants, following the same convention as for `nat` - `contra_neqN`, `contra_neqF`, `contra_neqT`, `contra_neq_eq`, `contra_eq_neq` - `take_subseq`, `drop_subseq` - `big_imset_cond`,`big_map_id`, `big_image_cond` `big_image`, `big_image_cond_id` and `big_image_id` - `foldrE`, `foldlE`, `foldl_idx` and `sumnE` to turn "seq statements" into "bigop statements" - `all_iff` with notation `[<-> P0; P1; ..; Pn]` to talk about circular implication `P0 -> P1 -> ... -> Pn -> P0`. Related theorems are `all_iffLR` and `all_iffP` - support for casts in map comprehension notations, e.g., `[seq E : T | s <- s]`. - a predicate `all2`, a parallel double `seq` version of `all`. - some `perm_eq` lemmas: `perm_cat[lr]`, `perm_eq_nilP`, `perm_eq_consP`, `perm_eq_flatten`. - a function `permutations` that computes a duplicate-free list of all permutations of a given sequence `s` over an `eqType`, along with its theory: `mem_permutations`, `size_permutations`, `permutations_uniq`, `permutations_all_uniq`, `perm_permutations`. - `eq_mktuple`, `eq_ffun`, `eq_finset`, `eq_poly`, `ex_mx` that can be used with the `under` tactic from the Coq 8.10 SSReflect plugin (cf. [coq/coq#9651](https://github.com/coq/coq/pull/9651)) ### Changed - Theory of `lersif` and intervals: + Many `lersif` related lemmas are ported from `ssrnum` + Changed: `prev_of_itv`, `itv_decompose`, and `itv_rewrite` + New theory of intersections of intervals - Generalized `extremum_spec` and its theory, added `extremum` and `extremumP`, generalizing `arg_min` for an arbitrary `eqType` with an order relation on it (rather than `nat`). Redefined `arg_min` and `arg_max` with it. - Reshuffled theorems inside files and packages: + `countalg` goes from the field to the algebra package + `finalg` inherits from countalg + `closed_field` contains the construction of algebraic closure for countable fields that used to be in the file `countalg`. - Maximal implicits applied to reflection, injectivity and cancellation lemmas so that they are easier to pass to combinator lemmas such as `sameP`, `inj_eq` or `canLR`. - Added `reindex_inj s` shorthand for reindexing a bigop with a permutation `s`. - Added lemma `eqmxMunitP`: two matrices with the same shape represent the same subspace iff they differ only by a change of basis. - Corrected implicits and documentation of `MatrixGenField`. - Rewritten proof of quantifier elimination for closed field in a monadic style. - Specialized `bool_irrelevance` so that the statement reflects the name. - Changed the shape of the type of `FieldMixin` to allow one-line in-proof definition of bespoke `fieldType` structure. - Refactored and extended Arguments directives to provide more comprehensive signature information. - Generalized the notation `[seq E | i <- s, j <- t]` to the case where `t` may depend on `i`. The notation is now primitive and expressed using `flatten` and `map` (see documentation of seq). `allpairs` now expands to this notation when fully applied. + Added `allpairs_dep` and made it self-expanding as well. + Generalized some lemmas in a backward compatible way. + Some strictly more general lemmas now have suffix `_dep`. + Replaced `allpairs_comp` with its converse `map_allpairs`. + Added `allpairs` extensionality lemmas for the following cases: non-localised (`eq_allpairs`), dependent localised (`eq_in_allpairs_dep`) and non-dependent localised (`eq_in_allpairs`); as per `eq_in_map`, the latter two are equivalences. - Generalized `{ffun A -> R}` to handle dependent functions, and to be structurally positive so it can be used in recursive inductive type definitions. Minor backward incompatibilities: `fgraph f` is no longer a field accessor, and no longer equal to `val f` as `{ffun A -> R}` is no longer a `subType`; some instances of `finfun`, `ffunE`, `ffunK` may not unify with a generic non-dependent function type `A -> ?R` due to a bug in Coq version 8.9 or below. - Renamed double `seq` induction lemma from `seq2_ind` to `seq_ind2`, and weakened its induction hypothesis. - Replaced the `nosimpl` in `rev` with a `Arguments simpl never` directive. - Many corrections in implicits declarations. - fixed missing joins in `ssralg`, `ssrnum`, `finalg` and `countalg` ### Renamed Renamings also involve the `_in` suffix counterpart when applicable - `mono_inj` -> `incr_inj` - `nmono_inj` -> `decr_inj` - `leq_mono_inj` -> `incnr_inj` - `leq_nmono_inj` -> `decnr_inj` - `homo_inj_ltn_lt` -> `incnr_inj` - `nhomo_inj_ltn_lt` -> `decnr_inj` - `homo_inj_in_lt` -> `inj_homo_ltr_in` - `nhomo_inj_in_lt` -> `inj_nhomo_ltr_in` - `ltn_ltrW_homo` -> `ltnrW_homo` - `ltn_ltrW_nhomo` -> `ltnrW_nhomo` - `leq_lerW_mono` -> `lenrW_mono` - `leq_lerW_nmono` -> `lenrW_nmono` - `homo_leq_mono` -> `lenr_mono` - `nhomo_leq_mono` -> `lenr_nmono` - `homo_inj_lt` -> `inj_homo_ltr` - `nhomo_inj_lt` -> `inj_nhomo_ltr` - `homo_inj_ltn_lt` -> `inj_homo_ltnr` - `nhomo_inj_ltn_lt` -> `inj_nhomo_ltnr` - `homo_mono` -> `ler_mono` - `nhomo_mono` -> `ler_nmono` - `big_setIDdep` -> `big_setIDcond` - `sum_nat_dep_const` -> `sum_nat_cond_const` ### Misc - Removed trailing `_ : Type` field from packed classes. This performance optimization is not strictly necessary with modern Coq versions. - Removed duplicated definitions of `tag`, `tagged` and `Tagged` from `eqtype.v`. They are already in `ssrfun.v`. - Miscellaneous improvements to proof scripts and file organisation. ## [1.7.0] - 2018-04-24 Compatibility with Coq 8.8 and lost compatibility with Coq <= 8.5. This release is compatible with Coq 8.6, 8.7 and 8.8. - Integration in Coq startng from version 8.7 of: + OCaml plugin (plugin for 8.6 still in the archive for backward compatibility) + `ssreflect.v`, `ssrbool.v`, `ssrfun.v` and `ssrtest/` - Cleaning up the github repository: the math-comp repository is now dedicated to the released material (as in the present release). For instance, directories `real-closed/` and `odd-order/` now have their own repository. ### Changed - Library refactoring: `algC` and `ssrnum`. Library `ssrnum.v` provides an interface `numClosedFieldType`, which abstracts the theory of algebraic numbers. In particular, `Re`, `Im`, `'i`, `conjC`, `n.-root` and `sqrtC`, previously defined in library `algC.v`, are now part of this generic interface. In case of ambiguity, a cast to type `algC`, of complex algebraic numbers, can be used to disambiguate via typing constraints. Some theory was thus made more generic, and the corresponding lemmas, previously defined in library `algC.v` (e.g. `conjCK`) now feature an extra, non maximal implicit, parameter of type `numClosedFieldType`. This could break some proofs. Every theorem from `ssrnum` that used to be in `algC` changed statement. - `ltngtP`, `contra_eq`, `contra_neq`, `odd_opp`, `nth_iota` ### Added - `iter_in`, `finv_in`, `inv_f_in`, `finv_inj_in`, `fconnect_sym_in`, `iter_order_in`, `iter_finv_in`, `cycle_orbit_in`, `fpath_finv_in`, `fpath_finv_f_in`, `fpath_f_finv_in` - `big_allpairs` - `uniqP, uniqPn` - `dec_factor_theorem`, `mul_bin_down`, `mul_bin_left` - `abstract_context` (`in ssreflect.v`, now merged in Coq proper) ### Renamed - Lemma `dvdn_fact` was moved from library `prime.v` to library `div.v` - `mul_Sm_binm -> mul_bin_diag - `divn1` -> `divz1` (in intdiv) - `rootC` -> `nthroot` - `algRe` -> `Re` - `algIm` -> `Im` - `algCi` -> `imaginaryC` - `reshape_index_leq` -> `reshape_leq` ## [1.6.0] - 2015-11-24 (ssreflect + mathcomp) Major reorganization of the archive. - Files split into sub-directories: `ssreflect/`, `algebra/`, `fingroup/`, `solvable/`, `field/` and `character/`. In this way the user can decide to compile only the subset of the Mathematical Components library that is relevant to her. Note that this introduces a possible incompatibility for users of the previous version. A replacement scheme is suggested in the installation notes. - The archive is now open and based on git. Public mirror at: https://github.com/math-comp/math-comp - Sources of the reference manual of the Ssreflect tactic language are also open and available at: https://github.com/math-comp/ssr-manual Pull requests improving the documentation are welcome. ### Renamed - `conjC_closed` -> `cfConjC_closed` - `class_transr` -> `class_eqP` - `cfclass_transl` -> `cfclass_transr` - `nontrivial_ideal` -> `proper_ideal` - `zchar_orthonormalP` -> `vchar_orthonormalP` ### Changed - `seq_sub` - `orbit_in_transl`, `orbit_sym`, `orbit_trans`, `orbit_transl`, `orbit_transr`, `cfAut_char`, `cfConjC_char`, `invg_lcosets`, `lcoset_transl`, `lcoset_transr`, `rcoset_transl`, `rcoset_transr`, `mem2_last`, `bind_unless`, `unless_contra`, `all_and2`, `all_and3`, `all_and4`, `all_and5`, `ltr0_neq0`, `ltr_prod`, `Zisometry_of_iso` ### Added - `adhoc_seq_sub_choiceMixin`, `adhoc_seq_sub_[choice|fin]Type` - `orbit_in_eqP`, `cards_draws`, `cfAut_lin_char`, `cfConjC_lin_char`, `extend_cfConjC_subset`, `isometry_of_free`, `cfAutK`, `cfAutVK`, `lcoset_eqP`, `rcoset_eqP`, `class_eqP`, `gFsub_trans`, `gFnorms`, `gFchar_trans`, `gFnormal_trans`, `gFnorm_trans`, `mem2_seq1`, `dvdn_fact`, `prime_above`, `subKr`, `subrI`, `subIr`, `subr0_eq`, `divrI`, `divIr`, `divKr`, `divfI`, `divIf`, `divKf`, `impliesP`, `impliesPn`, `unlessL`, `unlessR`, `unless_sym`, `unlessP` (coercion), `classicW`, `ltr_prod_nat` - Notation `\unless C, P` ## [1.5.0] - 2014-03-12 (ssreflect + mathcomp) Split the archive in SSReflect and MathComp - With this release "ssreflect" has been split into two packages. The Ssreflect one contains the proof language (plugin for Coq) and a small set of core theory libraries about boolean, natural numbers, sequences, decidable equality and finite types. The Mathematical Components one contains advanced theory files covering a wider spectrum of mathematics. - With respect to version 1.4 the proof language got a few new features related to forward reasoning and some bug fixes. The Mathematical Components library features 16 new theory files and in particular: some field and Galois theory, advanced character theory and a construction of algebraic numbers. ## [1.4.0] - 2012-09-05 (ssreflect) - With this release the plugin code received many bug fixes and the existing libraries relevant updates. This release also includes some new libraries on the following topics: rational numbers, divisibility of integers, F-algebras, finite dimensional field extensions and Euclidean division for polynomials over a ring. - The release includes a major code refactoring of the plugin for Coq 8.4. In particular a documented ML API to access the pattern matching facilities of Ssreflect from third party plugins has been introduced. ## [1.3.0] - 2011-03-14 (ssreflect) - The tactic language has been extended with several new features, inspired by the five years of intensive use in our project. However we have kept the core of the language unchanged; the new library compiles with Ssreflect 1.2. Users of a Coq 8.2 toplevel statically linked with Ssreflect 1.2 need to comment the Declare ML Module "ssreflect" line in ssreflect.v to properly compile the 1.3 library. We will continue supporting new releases of Coq in due course. - The new library adds general linear algebra (matrix rank, subspaces) and all of the advanced finite group that was developed in the course of completing the Local Analysis part of the Odd Order Theorem, starting from the Sylow and Hall theorems and including full structure theorems for abelian, extremal and extraspecial groups, and general (modular) linear representation theory. ## [1.2.0] - 2009-08-14 (ssreflect) No change log ## [1.1.0] - 2008-03-18 (ssreflect) First public release math-comp-mathcomp-1.12.0/CHANGELOG_UNRELEASED.md000066400000000000000000000007261375767750300206370ustar00rootroot00000000000000# Changelog (unreleased) To avoid having old PRs put changes into the wrong section of the CHANGELOG, new entries now go to the present file as discussed [here](https://github.com/math-comp/math-comp/wiki/Agenda-of-the-April-23rd-2019-meeting-9h30-to-12h30#avoiding-issues-with-changelog). The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). ## [Unreleased] ### Added ### Changed ### Renamed ### Removed ### Infrastructure ### Misc math-comp-mathcomp-1.12.0/CONTRIBUTING.md000066400000000000000000000246501375767750300175520ustar00rootroot00000000000000# Contribution Guide for the Mathematical Components library We describe here best practices for contributing to the library. In particular we explain what conventions are used in the library. When contributing, you should comply to these conventions to get your code integrated to the library. This file is not comprehensive yet and might still contain mistakes or unclear indications, please consider contributing. ## Proof style ### General guidelines - One important guideline is to structure proofs in blocks, i.e., forward steps, to limit the scope of errors. + See [G. Gonthier, A. Mahboubi, "An introduction to small scale reflection in Coq", p.103](https://doi.org/10.6092/issn.1972-5787/1979) for an illustration - **A line should have no more than 80 characters**. If a line is longer than that, it should be cut semantically. If there is no way to make a semantic cut (e.g. the user provides an explicit term that is too long to fit on one line), then just cut it over several lines to make it readable. - Lines end with a point `.` and only have `;` inside them. - Lines that close a goal must start with a terminator (`by` or `exact`). You should consider using an editor that highlight those terminators in a specific color (e.g. red). - Chaining too many optional rewrites makes error detection hard. The idiom is ``` rewrite conditional_rule ?simplify_side_condition // next_rule. ``` ### Spaces We write - `move=>` and `move:` (no space between `move` and `=>` or `:`) - `apply/` and `apply:` (no space between `apply` and `/` or `:`) - `rewrite /definition` (there is a space between `rewrite` and an unfold) ### Indentation in proof scripts - When two subgoals are created, the first subgoal is indented by 2 spaces, the second is not. Use `last first` to bring the smallest/less meaningful goal first, and keep the main flow of the proof unindented. - When more than two subgoals are created, bullets are used `-` for the first level, `+` for the second and `*` for the third as in: ``` tactic. - tactic. + tactic. * tactic. * tactic. * tactic. + tactic. + tactic. - tactic - tactic ``` If all the subgoals have the same importance, use bullets for all of them, however, if one goal is more important than the others (i.e. is main flow of the proof). Then you might remove the bullet for this last one and unindent it as in: ``` tactic. - tactic. (* secondary subgoal 1 *) - tactic. (* secondary subgoal 2 *) tactic. (* third subgoal is the main one *) ``` ## Statements of lemmas, theorems and definitions - Universal quantifications with dependent variable should appear on the left hand side of the colon, until we reach the first non dependent variables. e.g. `Lemma example x y : x < y -> x >= y = false` ### Term style - Operators are surrounded by space, for example `n*m` should be written `n * m`. This particular example can be problematic if matrix.v is imported because then, `M *m N` is matrix product. ### Statement-macros - There is a number of "macros" that are available to state lemmas, like `commutative`, `associative`,... (see [`ssrfun.v`](https://github.com/coq/coq/blob/master/theories/ssr/ssrfun.v)) - There are also macros that are available to to localize a statement, like `{in A, P}`,... (see [`ssrbool.v`](https://github.com/coq/coq/blob/master/theories/ssr/ssrbool.v)) ### Naming of variables - Variable names follow the following conventions. + Hypothesis should not be named `H`, `H'`,... (these collide with subgroup variable conventions) but have meaningful names. For example, an hypothesis `n > 0` should be named `n_gt0`. + Induction Hypotheses are prefixed by `IH` or `ih` (e.g. induction hypothesis on `n` is called `IHn`). + Natural numbers and integers should be named `m`, `n`, `p`, `d`, ... + Elements of another ring should be named `x`, `y`, `z`, `u`, `v`, `w`, ... + Polynomials should be named by lower case letter `p`, `q`, `r` ... (to avoid collision with properties named `P`, `Q`, ...) + Matrices should be named `A`, `B`, ..., `M`, `N`, ... + Polymorphic variables should be named `x`, ... ### Naming conventions for lemmas (non exhaustive) #### Names in the library usually obey one of the following conventions - `(condition_)?mainSymbol_suffixes` - `mainSymbol_suffixes(_condition)?` Or in the presence of a property denoted by an n-ary or unary predicate: - `naryPredicate_mainSymbol+` - `mainSymbol_unaryPredicate` #### Where: - `mainSymbol` is the most meaningful part of the lemma. It generally is the head symbol of the right-hand side of an equation or the head symbol of a theorem. It can also simply be the main object of study, head symbol or not. It is usually either + one of the main symbols of the theory at hand. For example, it will be `opp`, `add`, `mul`, etc., or + a special "canonical" operation, such as a ring morphism or a subtype predicate. e.g. `linear`, `raddf`, `rmorph`, `rpred`, etc. - "condition" is used when the lemma applies under some hypothesis. - "suffixes" are there to refine what shape and/or what other symbols the lemma has. It can either be the name of a symbol ("add", "mul", etc.), or the (short) name of a predicate ("`inj`" for "`injectivity`", "`id`" for "identity", etc.) or an abbreviation. Abbreviations are in the header of the file which introduces them. We list here the main abbreviations. - `A` -- associativity, as in `andbA : associative andb.` - `AC` -- right commutativity. - `ACA` -- self-interchange (inner commutativity), e.g., `orbACA : (a || b) || (c || d) = (a || c) || (b || d).` - `b` -- a boolean argument, as in `andbb : idempotent andb.` - `C` -- commutativity, as in `andbC : commutative andb.` -- alternatively, predicate or set complement, as in `predC.` -- alternatively, constant. - `CA` -- left commutativity. - `D` -- predicate or set difference, as in `predD.` - `E` -- elimination lemma, as in `negbFE : ~~ b = false -> b.` - `F` or `f` -- boolean false, as in `andbF : b && false = false.` - `F` -- alternatively, about a finite type. - `g` -- a group argument. - `I` -- left/right injectivity, as in `addbI : right_injective addb.` -- alternatively predicate or set intersection, as in `predI.` - `l` -- the left-hand of an operation, as in + `andb_orl : left_distributive andb orb.` + ``ltr_norml x y : (`|x| < y) = (- y < x < y).`` - `L` -- the left-hand of a relation, as in `ltn_subrL : n - m < n = (0 < m) && (0 < n).` - `LR` -- moving an operator from the left-hand to the right-hand of an relation, as in `leq_subLR : (m - n <= p) = (m <= n + p).` - `N` or `n` -- boolean negation, as in `andbN : a && (~~ a) = false.` - `n` -- alternatively, it is a natural number argument. - `N` -- alternatively ring negation, as in `mulNr : (- x) * y = - (x * y).` - `P` -- a characteristic property, often a reflection lemma, as in `andP : reflect (a /\ b) (a && b)`. - `r` -- a right-hand operation, as in + `orb_andr : right_distributive orb andb.` + ``ler_normr x y : (x <= `|y|) = (x <= y) || (x <= - y).`` + alternatively, it is a ring argument. - `R` -- the right-hand of a relation, as in `ltn_subrR : n < n - m = false`. - `RL` -- moving an operator from the right-hand to the left-hand of an relation, as in `ltn_subRL : (n < p - m) = (m + n < p).` - `T` or `t` -- boolean truth, as in `andbT: right_id true andb.` - `T` -- alternatively, total set. - `U` -- predicate or set union, as in `predU`. - `W` -- weakening, as in `in1W : {in D, forall x, P} -> forall x, P.` - `0` -- ring or nat 0, or empty set, as in `addr0 : x + 0 = x.` - `1` -- ring; nat or group 1, as in `mulr1 : x * 1 = x.` - `D` -- addition, as in `linearD : f (u + v) = f u + f v.` - `B` -- subtraction, as in `opprB : - (x - y) = y - x.` - `M` -- multiplication, as in `invfM : (x * y)^-1 = x^-1 * y^-1.` - `Mn` -- ring nat multiplication, as in `raddfMn : f (x *+ n) = f x *+ n.` - `V` -- multiplicative inverse, as in `mulVr : x^-1 * x = 1.` - `X` -- exponentiation, as in `rmorphX : f (x ^+ n) = f x ^+ n.` - `Z` -- (left) module scaling, as in `linearZ : f (a *: v) = s *: f v.` - `z` -- an int argument. #### Special naming conventions (non exhaustive) - For the infix membership predicate `_ \in _`, the prefix `in_` is used for lemmas that unfold specific predicates, possibly propagating the infix membership (e.g, `in_cons` or `in_set0`). These lemmas are generally part of the `inE` multirule. Other lemmas involving the infix membership predicated use the generic prefix `mem_` (e.g., `mem_head` or `mem_map`). #### Typical search pattern - `Search _ "prefix" "suffix"* (symbol|pattern)* in library.` (for coq < 8.12) - `Search "prefix" "suffix"* (symbol|pattern)* inside library.` (for coq >= 8.12) ### Naming conventions for definitions (non exhaustive) - Structure for types - Mixed case, the first letter lowercase and the first letter of each internal word capitalized, end with `Type` - e.g., `unitRingType` - Packed classes - Mixed case, the first letter of each internal word capitalized, end with `Type` - e.g., `UnitRingType` - Mixins - Mixed case, the first letter of each internal word capitalised, end with `Mixin` - e.g., `UnitRingMixin` - Coq Modules: - Mixed case, the first letter of each internal word capitalized - e.g., `NumDomain` in `ssrnum.v` #### Abbreviations - The following are considered as single words and are abbreviated when used as prefixes - Z-module becomes `zmod`/`Zmod`, e.g., `ZmodType` in `ssralg.v`, `normedZmodType` in `ssrnum.v` - L-module becomes `lmod`/`Lmod` - L-algebra becomes `lalg`/`Lalg` - Partial order is abbreviated to `porder` or `POrder`, e.g., `porderType`, `CanPOrderMixin` in `order.v` ## Doc style ### Header documentary comments We try to document types, definitions and notations precisely, but only describe the lemmas and theorems in general terms, because we don't want to discourage users from actually reading the documentation. There are some exceptions for some particularly important theorems. ### Commenting source code The MathComp library uses exclusively block comments, with 80-character lines enclosed in the `(*` / `*)` delimiters, e.g. ``` (* Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Donec hendrerit *) (* tempor tellus. Donec pretium posuere tellus. Proin quam nisl, tincidunt *) (* et, mattis eget, convallis nec, purus. *) ``` Multiline comments are strictly limited to out-commented code. math-comp-mathcomp-1.12.0/CeCILL-B000066400000000000000000000526231375767750300164170ustar00rootroot00000000000000CeCILL-B FREE SOFTWARE LICENSE AGREEMENT Notice This Agreement is a Free Software license agreement that is the result of discussions between its authors in order to ensure compliance with the two main principles guiding its drafting: * firstly, compliance with the principles governing the distribution of Free Software: access to source code, broad rights granted to users, * secondly, the election of a governing law, French law, with which it is conformant, both as regards the law of torts and intellectual property law, and the protection that it offers to both authors and holders of the economic rights over software. The authors of the CeCILL-B (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre]) license are: Commissariat à l'Energie Atomique - CEA, a public scientific, technical and industrial research establishment, having its principal place of business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France. Centre National de la Recherche Scientifique - CNRS, a public scientific and technological establishment, having its principal place of business at 3 rue Michel-Ange, 75794 Paris cedex 16, France. Institut National de Recherche en Informatique et en Automatique - INRIA, a public scientific and technological establishment, having its principal place of business at Domaine de Voluceau, Rocquencourt, BP 105, 78153 Le Chesnay cedex, France. Preamble This Agreement is an open source software license intended to give users significant freedom to modify and redistribute the software licensed hereunder. The exercising of this freedom is conditional upon a strong obligation of giving credits for everybody that distributes a software incorporating a software ruled by the current license so as all contributions to be properly identified and acknowledged. In consideration of access to the source code and the rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors only have limited liability. In this respect, the risks associated with loading, using, modifying and/or developing or reproducing the software by the user are brought to the user's attention, given its Free Software status, which may make it complicated to use, with the result that its use is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the suitability of the software as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions of security. This Agreement may be freely reproduced and published, provided it is not altered, and that no provisions are either added or removed herefrom. This Agreement may apply to any or all software for which the holder of the economic rights decides to submit the use thereof to its provisions. Article 1 - DEFINITIONS For the purpose of this Agreement, when the following expressions commence with a capital letter, they shall have the following meaning: Agreement: means this license agreement, and its possible subsequent versions and annexes. Software: means the software in its Object Code and/or Source Code form and, where applicable, its documentation, "as is" when the Licensee accepts the Agreement. Initial Software: means the Software in its Source Code and possibly its Object Code form and, where applicable, its documentation, "as is" when it is first distributed under the terms and conditions of the Agreement. Modified Software: means the Software modified by at least one Contribution. Source Code: means all the Software's instructions and program lines to which access is required so as to modify the Software. Object Code: means the binary files originating from the compilation of the Source Code. Holder: means the holder(s) of the economic rights over the Initial Software. Licensee: means the Software user(s) having accepted the Agreement. Contributor: means a Licensee having made at least one Contribution. Licensor: means the Holder, or any other individual or legal entity, who distributes the Software under the Agreement. Contribution: means any or all modifications, corrections, translations, adaptations and/or new functions integrated into the Software by any or all Contributors, as well as any or all Internal Modules. Module: means a set of sources files including their documentation that enables supplementary functions or services in addition to those offered by the Software. External Module: means any or all Modules, not derived from the Software, so that this Module and the Software run in separate address spaces, with one calling the other when they are run. Internal Module: means any or all Module, connected to the Software so that they both execute in the same address space. Parties: mean both the Licensee and the Licensor. These expressions may be used both in singular and plural form. Article 2 - PURPOSE The purpose of the Agreement is the grant by the Licensor to the Licensee of a non-exclusive, transferable and worldwide license for the Software as set forth in Article 5 hereinafter for the whole term of the protection granted by the rights over said Software. Article 3 - ACCEPTANCE 3.1 The Licensee shall be deemed as having accepted the terms and conditions of this Agreement upon the occurrence of the first of the following events: * (i) loading the Software by any or all means, notably, by downloading from a remote server, or by loading from a physical medium; * (ii) the first time the Licensee exercises any of the rights granted hereunder. 3.2 One copy of the Agreement, containing a notice relating to the characteristics of the Software, to the limited warranty, and to the fact that its use is restricted to experienced users has been provided to the Licensee prior to its acceptance as set forth in Article 3.1 hereinabove, and the Licensee hereby acknowledges that it has read and understood it. Article 4 - EFFECTIVE DATE AND TERM 4.1 EFFECTIVE DATE The Agreement shall become effective on the date when it is accepted by the Licensee as set forth in Article 3.1. 4.2 TERM The Agreement shall remain in force for the entire legal term of protection of the economic rights over the Software. Article 5 - SCOPE OF RIGHTS GRANTED The Licensor hereby grants to the Licensee, who accepts, the following rights over the Software for any or all use, and for the term of the Agreement, on the basis of the terms and conditions set forth hereinafter. Besides, if the Licensor owns or comes to own one or more patents protecting all or part of the functions of the Software or of its components, the Licensor undertakes not to enforce the rights granted by these patents against successive Licensees using, exploiting or modifying the Software. If these patents are transferred, the Licensor undertakes to have the transferees subscribe to the obligations set forth in this paragraph. 5.1 RIGHT OF USE The Licensee is authorized to use the Software, without any limitation as to its fields of application, with it being hereinafter specified that this comprises: 1. permanent or temporary reproduction of all or part of the Software by any or all means and in any or all form. 2. loading, displaying, running, or storing the Software on any or all medium. 3. entitlement to observe, study or test its operation so as to determine the ideas and principles behind any or all constituent elements of said Software. This shall apply when the Licensee carries out any or all loading, displaying, running, transmission or storage operation as regards the Software, that it is entitled to carry out hereunder. 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS The right to make Contributions includes the right to translate, adapt, arrange, or make any or all modifications to the Software, and the right to reproduce the resulting software. The Licensee is authorized to make any or all Contributions to the Software provided that it includes an explicit notice that it is the author of said Contribution and indicates the date of the creation thereof. 5.3 RIGHT OF DISTRIBUTION In particular, the right of distribution includes the right to publish, transmit and communicate the Software to the general public on any or all medium, and by any or all means, and the right to market, either in consideration of a fee, or free of charge, one or more copies of the Software by any means. The Licensee is further authorized to distribute copies of the modified or unmodified Software to third parties according to the terms and conditions set forth hereinafter. 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION The Licensee is authorized to distribute true copies of the Software in Source Code or Object Code form, provided that said distribution complies with all the provisions of the Agreement and is accompanied by: 1. a copy of the Agreement, 2. a notice relating to the limitation of both the Licensor's warranty and liability as set forth in Articles 8 and 9, and that, in the event that only the Object Code of the Software is redistributed, the Licensee allows effective access to the full Source Code of the Software at a minimum during the entire period of its distribution of the Software, it being understood that the additional cost of acquiring the Source Code shall not exceed the cost of transferring the data. 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE If the Licensee makes any Contribution to the Software, the resulting Modified Software may be distributed under a license agreement other than this Agreement subject to compliance with the provisions of Article 5.3.4. 5.3.3 DISTRIBUTION OF EXTERNAL MODULES When the Licensee has developed an External Module, the terms and conditions of this Agreement do not apply to said External Module, that may be distributed under a separate license agreement. 5.3.4 CREDITS Any Licensee who may distribute a Modified Software hereby expressly agrees to: 1. indicate in the related documentation that it is based on the Software licensed hereunder, and reproduce the intellectual property notice for the Software, 2. ensure that written indications of the Software intended use, intellectual property notice and license hereunder are included in easily accessible format from the Modified Software interface, 3. mention, on a freely accessible website describing the Modified Software, at least throughout the distribution term thereof, that it is based on the Software licensed hereunder, and reproduce the Software intellectual property notice, 4. where it is distributed to a third party that may distribute a Modified Software without having to make its source code available, make its best efforts to ensure that said third party agrees to comply with the obligations set forth in this Article . If the Software, whether or not modified, is distributed with an External Module designed for use in connection with the Software, the Licensee shall submit said External Module to the foregoing obligations. 5.3.5 COMPATIBILITY WITH THE CeCILL AND CeCILL-C LICENSES Where a Modified Software contains a Contribution subject to the CeCILL license, the provisions set forth in Article 5.3.4 shall be optional. A Modified Software may be distributed under the CeCILL-C license. In such a case the provisions set forth in Article 5.3.4 shall be optional. Article 6 - INTELLECTUAL PROPERTY 6.1 OVER THE INITIAL SOFTWARE The Holder owns the economic rights over the Initial Software. Any or all use of the Initial Software is subject to compliance with the terms and conditions under which the Holder has elected to distribute its work and no one shall be entitled to modify the terms and conditions for the distribution of said Initial Software. The Holder undertakes that the Initial Software will remain ruled at least by this Agreement, for the duration set forth in Article 4.2. 6.2 OVER THE CONTRIBUTIONS The Licensee who develops a Contribution is the owner of the intellectual property rights over this Contribution as defined by applicable law. 6.3 OVER THE EXTERNAL MODULES The Licensee who develops an External Module is the owner of the intellectual property rights over this External Module as defined by applicable law and is free to choose the type of agreement that shall govern its distribution. 6.4 JOINT PROVISIONS The Licensee expressly undertakes: 1. not to remove, or modify, in any manner, the intellectual property notices attached to the Software; 2. to reproduce said notices, in an identical manner, in the copies of the Software modified or not. The Licensee undertakes not to directly or indirectly infringe the intellectual property rights of the Holder and/or Contributors on the Software and to take, where applicable, vis-à-vis its staff, any and all measures required to ensure respect of said intellectual property rights of the Holder and/or Contributors. Article 7 - RELATED SERVICES 7.1 Under no circumstances shall the Agreement oblige the Licensor to provide technical assistance or maintenance services for the Software. However, the Licensor is entitled to offer this type of services. The terms and conditions of such technical assistance, and/or such maintenance, shall be set forth in a separate instrument. Only the Licensor offering said maintenance and/or technical assistance services shall incur liability therefor. 7.2 Similarly, any Licensor is entitled to offer to its licensees, under its sole responsibility, a warranty, that shall only be binding upon itself, for the redistribution of the Software and/or the Modified Software, under terms and conditions that it is free to decide. Said warranty, and the financial terms and conditions of its application, shall be subject of a separate instrument executed between the Licensor and the Licensee. Article 8 - LIABILITY 8.1 Subject to the provisions of Article 8.2, the Licensee shall be entitled to claim compensation for any direct loss it may have suffered from the Software as a result of a fault on the part of the relevant Licensor, subject to providing evidence thereof. 8.2 The Licensor's liability is limited to the commitments made under this Agreement and shall not be incurred as a result of in particular: (i) loss due the Licensee's total or partial failure to fulfill its obligations, (ii) direct or consequential loss that is suffered by the Licensee due to the use or performance of the Software, and (iii) more generally, any consequential loss. In particular the Parties expressly agree that any or all pecuniary or business loss (i.e. loss of data, loss of profits, operating loss, loss of customers or orders, opportunity cost, any disturbance to business activities) or any or all legal proceedings instituted against the Licensee by a third party, shall constitute consequential loss and shall not provide entitlement to any or all compensation from the Licensor. Article 9 - WARRANTY 9.1 The Licensee acknowledges that the scientific and technical state-of-the-art when the Software was distributed did not enable all possible uses to be tested and verified, nor for the presence of possible defects to be detected. In this respect, the Licensee's attention has been drawn to the risks associated with loading, using, modifying and/or developing and reproducing the Software which are reserved for experienced users. The Licensee shall be responsible for verifying, by any or all means, the suitability of the product for its requirements, its good working order, and for ensuring that it shall not cause damage to either persons or properties. 9.2 The Licensor hereby represents, in good faith, that it is entitled to grant all the rights over the Software (including in particular the rights set forth in Article 5). 9.3 The Licensee acknowledges that the Software is supplied "as is" by the Licensor without any other express or tacit warranty, other than that provided for in Article 9.2 and, in particular, without any warranty as to its commercial value, its secured, safe, innovative or relevant nature. Specifically, the Licensor does not warrant that the Software is free from any error, that it will operate without interruption, that it will be compatible with the Licensee's own equipment and software configuration, nor that it will meet the Licensee's requirements. 9.4 The Licensor does not either expressly or tacitly warrant that the Software does not infringe any third party intellectual property right relating to a patent, software or any other property right. Therefore, the Licensor disclaims any and all liability towards the Licensee arising out of any or all proceedings for infringement that may be instituted in respect of the use, modification and redistribution of the Software. Nevertheless, should such proceedings be instituted against the Licensee, the Licensor shall provide it with technical and legal assistance for its defense. Such technical and legal assistance shall be decided on a case-by-case basis between the relevant Licensor and the Licensee pursuant to a memorandum of understanding. The Licensor disclaims any and all liability as regards the Licensee's use of the name of the Software. No warranty is given as regards the existence of prior rights over the name of the Software or as regards the existence of a trademark. Article 10 - TERMINATION 10.1 In the event of a breach by the Licensee of its obligations hereunder, the Licensor may automatically terminate this Agreement thirty (30) days after notice has been sent to the Licensee and has remained ineffective. 10.2 A Licensee whose Agreement is terminated shall no longer be authorized to use, modify or distribute the Software. However, any licenses that it may have granted prior to termination of the Agreement shall remain valid subject to their having been granted in compliance with the terms and conditions hereof. Article 11 - MISCELLANEOUS 11.1 EXCUSABLE EVENTS Neither Party shall be liable for any or all delay, or failure to perform the Agreement, that may be attributable to an event of force majeure, an act of God or an outside cause, such as defective functioning or interruptions of the electricity or telecommunications networks, network paralysis following a virus attack, intervention by government authorities, natural disasters, water damage, earthquakes, fire, explosions, strikes and labor unrest, war, etc. 11.2 Any failure by either Party, on one or more occasions, to invoke one or more of the provisions hereof, shall under no circumstances be interpreted as being a waiver by the interested Party of its right to invoke said provision(s) subsequently. 11.3 The Agreement cancels and replaces any or all previous agreements, whether written or oral, between the Parties and having the same purpose, and constitutes the entirety of the agreement between said Parties concerning said purpose. No supplement or modification to the terms and conditions hereof shall be effective as between the Parties unless it is made in writing and signed by their duly authorized representatives. 11.4 In the event that one or more of the provisions hereof were to conflict with a current or future applicable act or legislative text, said act or legislative text shall prevail, and the Parties shall make the necessary amendments so as to comply with said act or legislative text. All other provisions shall remain effective. Similarly, invalidity of a provision of the Agreement, for any reason whatsoever, shall not cause the Agreement as a whole to be invalid. 11.5 LANGUAGE The Agreement is drafted in both French and English and both versions are deemed authentic. Article 12 - NEW VERSIONS OF THE AGREEMENT 12.1 Any person is authorized to duplicate and distribute copies of this Agreement. 12.2 So as to ensure coherence, the wording of this Agreement is protected and may only be modified by the authors of the License, who reserve the right to periodically publish updates or new versions of the Agreement, each with a separate number. These subsequent versions may address new issues encountered by Free Software. 12.3 Any Software distributed under a given version of the Agreement may only be subsequently distributed under the same version of the Agreement or a subsequent version. Article 13 - GOVERNING LAW AND JURISDICTION 13.1 The Agreement is governed by French law. The Parties agree to endeavor to seek an amicable solution to any disagreements or disputes that may arise during the performance of the Agreement. 13.2 Failing an amicable solution within two (2) months as from their occurrence, and unless emergency proceedings are necessary, the disagreements or disputes shall be referred to the Paris Courts having jurisdiction, by the more diligent Party. Version 1.0 dated 2006-09-05. math-comp-mathcomp-1.12.0/Dockerfile000066400000000000000000000025121375767750300173040ustar00rootroot00000000000000ARG coq_image="coqorg/coq:dev" FROM ${coq_image} as builder WORKDIR /home/coq/mathcomp COPY . . RUN ["/bin/bash", "--login", "-c", "set -x \ && [ -n \"${COMPILER_EDGE}\" ] \ && opam switch set \"${COMPILER_EDGE}\" \ && eval $(opam env) \ && [ -n \"${COMPILER}\" ] \ && opam switch remove -y \"${COMPILER}\" \ && opam repository add --all-switches --set-default coq-extra-dev https://coq.inria.fr/opam/extra-dev \ && opam repository add --all-switches --set-default coq-core-dev https://coq.inria.fr/opam/core-dev \ && opam update -y \ && opam config list && opam repo list && opam list && coqc --version \ && sudo chown -R coq:coq /home/coq/mathcomp \ && opam pin add -n -k path coq-mathcomp-ssreflect . \ && opam pin add -n -k path coq-mathcomp-fingroup . \ && opam pin add -n -k path coq-mathcomp-algebra . \ && opam pin add -n -k path coq-mathcomp-solvable . \ && opam pin add -n -k path coq-mathcomp-field . \ && opam pin add -n -k path coq-mathcomp-character . \ && opam install -y -v -j ${NJOBS} coq-mathcomp-character \ && opam clean -a -c -s --logs"] FROM coqorg/base:bare ENV COMPILER="" ENV MATHCOMP_VERSION="dev" ENV MATHCOMP_PACKAGE="coq-mathcomp-character" COPY --from=builder --chown=coq:coq /home/coq/.opam /home/coq/.opam COPY --from=builder --chown=coq:coq /home/coq/.profile /home/coq/.profile math-comp-mathcomp-1.12.0/Dockerfile.make000066400000000000000000000015151375767750300202220ustar00rootroot00000000000000ARG coq_image="coqorg/coq:dev" FROM ${coq_image} WORKDIR /home/coq/mathcomp COPY . . RUN ["/bin/bash", "--login", "-c", "set -x \ && [ -n \"${COMPILER_EDGE}\" ] \ && opam switch set \"${COMPILER_EDGE}\" \ && eval $(opam env) \ && [ -n \"${COMPILER}\" ] \ && opam switch remove -y \"${COMPILER}\" \ && opam repository add --all-switches --set-default coq-extra-dev https://coq.inria.fr/opam/extra-dev \ && opam repository add --all-switches --set-default coq-core-dev https://coq.inria.fr/opam/core-dev \ && opam update -y \ && opam config list && opam repo list && opam list && coqc --version \ && opam clean -a -c -s --logs \ && sudo chown -R coq:coq /home/coq/mathcomp \ && cd mathcomp \ && make Makefile.coq \ && make -f Makefile.coq -j ${NJOBS} all \ && make -f Makefile.coq install \ && make test-suite"] math-comp-mathcomp-1.12.0/INSTALL.md000066400000000000000000000066541375767750300167550ustar00rootroot00000000000000# Layout and compilation of the library The library is divided into packages which group together related files. Each package defines a distribution and compilation unit. Packages can be compiled using the traditional make utility or the more recent OPAM one (version 2). The released and current dev versions are also available as OPAM packages. ## Compilation and installation of released and current dev version with OPAM If you just installed OPAM version 2 you should proceed as follows: ``` opam --version # should print 2.x.y opam init -n --comp=ocaml-base-compiler.4.05.0 eval $(opam config env) ``` Once your OPAM environment is configured you can install any math-comp package via ``` opam repo add coq-released https://coq.inria.fr/opam/released opam pin add -n coq -k version 8.12.0 opam install coq -j3 opam install coq-mathcomp-ssreflect -j3 ``` Replace `ssreflect` here by the package you want, the dependencies will be installed automatically. We recommend pinning a particular version of Coq (we give `8.12.0` as an example, see `CHANGELOG.md` for the supported versions). To get the latest development version you need to execute the following: ``` opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev opam install coq-mathcomp-ssreflect.dev -j3 ``` You can learn more about OPAM by reading its [user manual](https://opam.ocaml.org/doc/Usage.html). ## Compilation and installation in a dedicated OPAM root If you want to install the library in a dedicated environment (let's name it `MC`) which will remain independent from your current OPAM setup you can run the following commands: ``` opam init --root=$PWD/MC eval $(opam config env --root=$PWD/MC`) ``` After that the installations instructions above apply. Coq and the library are installed in the `$PWD/MC` directory (called an OPAM root). To discard the OPAM root, simply delete the directory. ## Compilation and installation with make The instructions assume you are in the `mathcomp` directory and that you have a supported version of Coq (listed in `CHANGLOG.md`). If `coqc` is in your `PATH`, then you are good to go. Alternatively, you can export the `COQBIN` variable to tell `make` where the `coqc` binary is: ``` export COQBIN=/home/gares/COQ/coq/bin/ ``` To compile the entire library just type `make`. If you have parallel hardware then `make -j 3` is probably a faster option. The files can be edited using CoqIDE or Proof General, or any other editor that understands the `_CoqProject` file, with no further configuration from the `mathcomp` directory. ``` coqide ssreflect/div.v ``` Note that you may need to enable `_CoqProject` processing in your editor (e.g. the default for CoqIDE is to ignore it). To install the compiled library, just execute `make install`. ## Compilation and installation of a custom version using OPAM The instructions assume you are in the parent directory (that contains this file `INSTALL.md`) and that you have OPAM installed and configured with the standard Coq repositories. First, we recommend pinning a particular version of Coq (e.g. `8.12.0`): ``` opam pin add -n coq -k version 8.12.0 ``` Then for each math-comp package, pin the `opam` file: ``` opam pin add -n -k path coq-mathcomp-ssreflect . ``` This can be achieved in one go as follows: ``` for P in *.opam; do opam pin add -n -k path ${P%.opam} .; done ``` Then you can use `opam install` to compile and install any package. For example: ``` opam install coq-mathcomp-character -j3 ``` math-comp-mathcomp-1.12.0/README.md000066400000000000000000000052471375767750300166010ustar00rootroot00000000000000[![pipeline status](https://gitlab.com/math-comp/math-comp/badges/master/pipeline.svg)](https://gitlab.com/math-comp/math-comp/commits/master) [![Join the chat at https://gitter.im/math-comp/](https://badges.gitter.im/math-comp.svg)](https://gitter.im/math-comp?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) # The Mathematical Components repository The Mathematical Components Library is an extensive and coherent repository of formalized mathematical theories. It is based on the [Coq](http://coq.inria.fr) proof assistant, powered with the [Coq/SSReflect](https://coq.inria.fr/distrib/current/refman/proof-engine/ssreflect-proof-language.html) language. These formal theories cover a wide spectrum of topics, ranging from the formal theory of general purpose data structures like [lists](mathcomp/ssreflect/seq.v), [prime numbers](mathcomp/ssreflect/prime.v) or [finite graphs](mathcomp/ssreflect/fingraph.v), to advanced topics in algebra. The repository includes the foundation of formal theories used in a [formal proof](https://www.ams.org/notices/200811/tx081101382p.pdf) of the [Four Colour Theorem](https://en.wikipedia.org/wiki/Four_color_theorem) (Appel - Haken, 1976) and a [mechanization](https://hal.archives-ouvertes.fr/hal-00816699/) of the [Odd Order Theorem](https://en.wikipedia.org/wiki/Feit%E2%80%93Thompson_theorem) (Feit - Thompson, 1963), a landmark result of finite group theory, which utilizes the library extensively. ## Installation If you already have OPAM installed (a fresh or up to date version of opam 2 is required): ``` opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-mathcomp-ssreflect ``` Additional packages go by the name of `coq-mathcomp-algebra`, `coq-mathcomp-field`, etc... See [INSTALL](INSTALL.md) for detailed installation instructions in other scenarios. ## How to get help - The [website](http://math-comp.github.io/math-comp/) of the MathComp library contains: + links to the [HTML documentation of each file](https://math-comp.github.io/htmldoc/index.html) + a list of [tutorials](https://math-comp.github.io/documentation.html) - The [ssreflect mailing list](https://sympa.inria.fr/sympa/info/ssreflect) is the primary venue for help and questions about the library. - The [Mathematical Components Book](https://math-comp.github.io/mcb/) provides a comprehensive introduction to the library. - Experienced users hang around at [StackOverflow](https://stackoverflow.com/questions/tagged/ssreflect) listening to the `ssreflect` and `coq` tags. ## Publications and Tools using MathComp [A collection of papers using the Mathematical Components library](https://math-comp.github.io/papers.html) math-comp-mathcomp-1.12.0/config.nix000066400000000000000000000000241375767750300172730ustar00rootroot00000000000000{ coq = "8.11"; } math-comp-mathcomp-1.12.0/coq-mathcomp-algebra.opam000066400000000000000000000023201375767750300221500ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/algebra" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/algebra" "install" ] depends: [ "coq-mathcomp-fingroup" { = version } ] tags: [ "keyword:algebra" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.algebra" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Mathematical Components Library on Algebra" description: """ This library contains definitions and theorems about discrete (i.e. with decidable equality) algebraic structures : ring, fields, ordered fields, real fields, modules, algebras, integers, rational numbers, polynomials, matrices, vector spaces... """ math-comp-mathcomp-1.12.0/coq-mathcomp-character.opam000066400000000000000000000021441375767750300225130ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/character" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/character" "install" ] depends: [ "coq-mathcomp-field" { = version } ] tags: [ "keyword:algebra" "keyword:character" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.character" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Mathematical Components Library on character theory" description:""" This library contains definitions and theorems about group representations, characters and class functions. """ math-comp-mathcomp-1.12.0/coq-mathcomp-field.opam000066400000000000000000000021441375767750300216420ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/field" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/field" "install" ] depends: [ "coq-mathcomp-solvable" { = version } ] tags: [ "keyword:algebra" "keyword:field" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.field" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Mathematical Components Library on Fields" description:""" This library contains definitions and theorems about field extensions, galois theory, algebraic numbers, cyclotomic polynomials... """ math-comp-mathcomp-1.12.0/coq-mathcomp-fingroup.opam000066400000000000000000000021631375767750300224110ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/fingroup" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/fingroup" "install" ] depends: [ "coq-mathcomp-ssreflect" { = version } ] tags: [ "keyword:finite groups" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.fingroup" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Mathematical Components Library on finite groups" description: """ This library contains definitions and theorems about finite groups, group quotients, group morphisms, group presentation, group action... """ math-comp-mathcomp-1.12.0/coq-mathcomp-solvable.opam000066400000000000000000000021261375767750300223660ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/solvable" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/solvable" "install" ] depends: [ "coq-mathcomp-algebra" { = version } ] tags: [ "keyword:finite groups" "keyword:Feit Thompson theorem" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.solvable" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Mathematical Components Library on finite groups (II)" description:""" This library contains more definitions and theorems about finite groups. """ math-comp-mathcomp-1.12.0/coq-mathcomp-ssreflect.opam000066400000000000000000000024571375767750300225600ustar00rootroot00000000000000opam-version: "2.0" version: "dev" maintainer: "Mathematical Components " homepage: "https://math-comp.github.io/" bug-reports: "https://github.com/math-comp/math-comp/issues" dev-repo: "git+https://github.com/math-comp/math-comp.git" license: "CECILL-B" build: [ make "-C" "mathcomp/ssreflect" "-j" "%{jobs}%" ] install: [ make "-C" "mathcomp/ssreflect" "install" ] depends: [ "coq" { ((>= "8.7" & < "8.13~") | (= "dev"))} ] tags: [ "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" "logpath:mathcomp.ssreflect" ] authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] synopsis: "Small Scale Reflection" description: """ This library includes the small scale reflection proof language extension and the minimal set of libraries to take advantage of it. This includes libraries on lists (seq), boolean and boolean predicates, natural numbers and types with decidable equality, finite types, finite sets, finite functions, finite graphs, basic arithmetics and prime numbers, big operators """ math-comp-mathcomp-1.12.0/default.nix000066400000000000000000000134571375767750300174700ustar00rootroot00000000000000{ nixpkgs ? (if builtins.pathExists ./nixpkgs.nix then import ./nixpkgs.nix else fetchTarball https://github.com/NixOS/nixpkgs-channels/archive/502845c3e31ef3de0e424f3fcb09217df2ce6df6.tar.gz), config ? (if builtins.pathExists ./config.nix then import ./config.nix else {}), withEmacs ? false, print-env ? false, do-nothing ? false, package ? (if builtins.pathExists ./package.nix then import ./package.nix else "mathcomp-fast"), src ? (if builtins.pathExists ./package.nix then ./. else false) }: with builtins; let cfg-fun = if isFunction config then config else (pkgs: config); pkg-src = if src == false then {} else { ${if package == "mathcomp.single" then "mathcomp" else package} = src; }; pkgs = if isAttrs nixpkgs then nixpkgs else import nixpkgs { overlays = [ (pkgs: super-pkgs: with pkgs.lib; let coqPackages = with pkgs; { "8.7" = coqPackages_8_7; "8.8" = coqPackages_8_8; "8.9" = coqPackages_8_9; "8.10" = coqPackages_8_10; "8.11" = coqPackages_8_11; "8.12" = coqPackages_8_12; "default" = coqPackages_8_10; }.${(cfg-fun pkgs).coq or "default"}.overrideScope' (coqPackages: super-coqPackages: let all-pkgs = pkgs // { inherit coqPackages; }; cfg = pkg-src // { mathcomp-fast = { src = ./.; propagatedBuildInputs = with coqPackages; ([ mathcomp ] ++ mathcomp-extra-fast); }; mathcomp-full = { src = ./.; propagatedBuildInputs = with coqPackages; ([ mathcomp ] ++ mathcomp-extra-all); }; } // (cfg-fun all-pkgs); in { mathcomp-extra-config = let mec = super-coqPackages.mathcomp-extra-config; in lib.recursiveUpdate mec { initial = { # fixing mathcomp analysis to depend on real-closed mathcomp-analysis = {version, coqPackages} @ args: let mca = mec.initial.mathcomp-analysis args; in mca // { propagatedBuildInputs = mca.propagatedBuildInputs ++ (if builtins.elem coq.version ["8.10" "8.11" "8.12"] then (with coqPackages; [ coq-elpi hierarchy-builder ]) else []); }; }; for-coq-and-mc.${coqPackages.coq.coq-version}.${coqPackages.mathcomp.version} = (super-coqPackages.mathcomp-extra-config.${coqPackages.coq.coq-version}.${coqPackages.mathcomp.version} or {}) // (removeAttrs cfg [ "mathcomp" "coq" "mathcomp-fast" "mathcomp-full" ]); }; mathcomp = if cfg?mathcomp then coqPackages.mathcomp_ cfg.mathcomp else super-coqPackages.mathcomp; } // mapAttrs (package: version: coqPackages.mathcomp-extra package version) (removeAttrs cfg ["mathcomp" "coq"]) ); in { coqPackages = coqPackages.filterPackages coqPackages.coq coqPackages; coq = coqPackages.coq; mc-clean = src: { version = baseNameOf src; src = cleanSourceWith { src = cleanSource src; filter = path: type: let baseName = baseNameOf (toString path); in ! ( hasSuffix ".aux" baseName || hasSuffix ".d" baseName || hasSuffix ".vo" baseName || hasSuffix ".glob" baseName || elem baseName ["Makefile.coq" "Makefile.coq.conf" ".mailmap" ".git"] ); }; }; })]; }; mathcompnix = ./.; shellHook = '' nixEnv () { echo "Here is your work environement" echo "buildInputs:" for x in $buildInputs; do printf " "; echo $x | cut -d "-" -f "2-"; done echo "propagatedBuildInputs:" for x in $propagatedBuildInputs; do printf " "; echo $x | cut -d "-" -f "2-"; done echo "you can pass option --arg config '{coq = \"x.y\"; math-comp = \"x.y.z\";}' to nix-shell to change coq and/or math-comp versions" } printEnv () { for x in $buildInputs; do echo $x; done for x in $propagatedBuildInputs; do echo $x; done } cachixEnv () { echo "Pushing environement to cachix" printEnv | cachix push math-comp } nixDefault () { cat $mathcompnix/default.nix } > default.nix updateNixPkgs (){ HASH=$(git ls-remote https://github.com/NixOS/nixpkgs-channels refs/heads/nixpkgs-unstable | cut -f1); URL=https://github.com/NixOS/nixpkgs-channels/archive/$HASH.tar.gz SHA256=$(nix-prefetch-url --unpack $URL) echo "fetchTarball { url = $URL; sha256 = \"$SHA256\"; }" > nixpkgs.nix } updateNixPkgsMaster (){ HASH=$(git ls-remote https://github.com/NixOS/nixpkgs refs/heads/master | cut -f1); URL=https://github.com/NixOS/nixpkgs/archive/$HASH.tar.gz SHA256=$(nix-prefetch-url --unpack $URL) echo "fetchTarball { url = $URL; sha256 = \"$SHA256\"; }" > nixpkgs.nix } '' + pkgs.lib.optionalString print-env "nixEnv"; emacs = with pkgs; emacsWithPackages (epkgs: with epkgs.melpaStablePackages; [proof-general]); pkg = with pkgs; if package == "mathcomp.single" then coqPackages.mathcomp.single else coqPackages.${package} or (coqPackages.current-mathcomp-extra package); in if pkgs.lib.trivial.inNixShell then pkg.overrideAttrs (old: { inherit shellHook mathcompnix; buildInputs = if do-nothing then [] else (old.buildInputs ++ (if pkgs.lib.trivial.inNixShell then pkgs.lib.optional withEmacs pkgs.emacs else [])) ++ [ pkgs.lua pkgs.sedutil ]; propagatedBuildInputs = if do-nothing then [] else old.propagatedBuildInputs; }) else pkg math-comp-mathcomp-1.12.0/docs/000077500000000000000000000000001375767750300162425ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/docs/index.html000066400000000000000000000001651375767750300202410ustar00rootroot00000000000000 math-comp-mathcomp-1.12.0/etc/000077500000000000000000000000001375767750300160655ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/etc/ANNOUNCE-1.6.md000066400000000000000000000051431375767750300201220ustar00rootroot00000000000000# Ssreflect/MathComp 1.6 released We are proud to announce the immediate availability of the Ssreflect proof language and the Mathematical Components library version 1.6 for Coq 8.4pl6 and 8.5beta3. This release adds no new theory files. The proof language received minor fixes while the libraries received minor additions. A detailed ChangeLog is available at: https://github.com/math-comp/math-comp/blob/master/etc/ChangeLog This document contains in particular the list of new theorems as well as the list of theorems that were renamed or replaced by more general variants. Our development repository is now public, and mirrored on github: https://github.com/math-comp/math-comp An announcement specific to this new setting will follow shortly. One major change for users is that the library has been split into several components, by order of dependency: 1. ssreflect: Ssreflect proof language, lists, boolean predicates, natural numbers, types with a decidable equality, finite types, finite sets and finite functions (over finite types), finite graphs, basic arithmetics and prime numbers, big (iterated) operators 2. fingroup: finite groups, their quotients, morphisms, presentations, and actions 3. algebra: discrete algebraic structures (rings, fields, modules, ordered fields, vector spaces...) and some of their instances like integers, rational numbers, polynomials, matrices 4. solvable: more finite group theory: Sylow and Hall groups, composition series, A-series, maximal subgroups, nilpotent, abelian and solvable groups 5. field: field extensions, Galois theory, algebraic numbers, cyclotomic polynomials 6. character: group representations, class functions and characters As a consequence users may select and download or compile only the components they are interested in. Each component comes with a summary file to be Require(d) and Import(ed) in order to load, at once, the entire component. For example the command Require Import all_ssreflect. loads all the theory files contained in the 'ssreflect' component. Note that this modularity comes at the price of a possible incompatibility for users of previous version of the Mathematical Components library, due to the change of logical/physical paths implied by the reorganization of the library. See the installation notes for more on this issue and a migration scheme. The tarball can be download at http://ssr.msr-inria.inria.fr/FTP/mathcomp-1.6.tar.gz The html documentation of the theory files can be browsed at http://ssr.msr-inria.inria.fr/doc/mathcomp-1.6/ -- The Mathematical Components team math-comp-mathcomp-1.12.0/etc/ANNOUNCE-github.md000066400000000000000000000031171375767750300210770ustar00rootroot00000000000000# The Mathematical Components github organization We are plase to announce that the development of the Mathematical Components now happens in the public and takes advantage of github's organization system. The purpose of such organization is to create a synergy between the Mathematical Components library and its ecosystem of related projects. The [homepage](http://math-comp.github.io/math-comp/) is now hosted by the github.io service, and the [main archive](https://github.com/math-comp/math-comp) is available as a git repository in the [organization space](https://github.com/math-comp/). We accept bug reports and pull requests via the standard github interface. Users of the library are encouraged to join the organization and place (or mirror) their projects in the organization name space. The immediate gain is discoverability. The more long term deal we propose is that the impact of non backward compatible changes in the Mathematical Components library will be carefully assessed on all the mature projects part of the organization. In exchange we expect members of the organization to actively maintain their code when a breaking change is applied or a patch is proposed. The organization hosts a [wiki](https://github.com/math-comp/wiki/wiki) for exchanging tips and tricks, gotchas, good practices, etc. The ssreflect [mailing list](https://sympa.inria.fr/sympa/info/ssreflect) shall serve as the privileged communication channel between the organization members. Contact us on this channel to join the organization or to get write access to the wiki. -- The Mathematical Components team math-comp-mathcomp-1.12.0/etc/NOTICE000066400000000000000000000002261375767750300167710ustar00rootroot00000000000000(* (c) Copyright Microsoft Corporation and Inria. *) (* You may distribute this file under the terms of the CeCILL-B license *) math-comp-mathcomp-1.12.0/etc/artwork/000077500000000000000000000000001375767750300175565ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/etc/artwork/coqdoc.css000066400000000000000000000143631375767750300215470ustar00rootroot00000000000000body { padding: 0px 0px; margin: 0px 0px; background-color: white } #page { display: block; padding: 0px; margin: 0px; padding-bottom: 10px; } #header { display: block; position: relative; padding: 0; margin: 0; vertical-align: middle; border-bottom-style: solid; border-width: thin } #header h1 { padding: 0; margin: 0;} /* Contents */ #main{ display: block; padding: 10px; font-family: sans-serif; font-size: 100%; line-height: 100% } #main h1 { line-height: 95% } /* allow for multi-line headers */ #main a.idref:visited {color : #416DFF; text-decoration : none; } #main a.idref:link {color : #416DFF; text-decoration : none; } #main a.idref:hover {text-decoration : none; } #main a.idref:active {text-decoration : none; } #main a.modref:visited {color : #416DFF; text-decoration : none; } #main a.modref:link {color : #416DFF; text-decoration : none; } #main a.modref:hover {text-decoration : none; } #main a.modref:active {text-decoration : none; } #main .keyword { color : #cf1d1d } #main { color: black } .section { background-color: rgb(60%,60%,100%); padding-top: 13px; padding-bottom: 13px; padding-left: 3px; margin-top: 5px; margin-bottom: 5px; font-size : 110% } h2.section { background-color: rgb(80%,80%,100%); padding-left: 3px; padding-top: 12px; padding-bottom: 10px; font-size : 110% } h3.section { background-color: rgb(90%,90%,100%); padding-left: 3px; padding-top: 7px; padding-bottom: 7px; font-size : 110% } h4.section { /* background-color: rgb(80%,80%,80%); max-width: 20em; padding-left: 5px; padding-top: 5px; padding-bottom: 5px; */ background-color: white; padding-left: 0px; padding-top: 0px; padding-bottom: 0px; font-size : 100%; font-style : bold; text-decoration : underline; } #main .doc { margin: 0px; font-family: courier; font-size: 100%; line-height: 125%; max-width: 50em; color: black; padding: 10px; background-color: #90bdff; border-style: plain; white-space: pre; } .inlinecode { display: inline; /* font-size: 125%; */ color: #666666; font-family: monospace } .doc .inlinecode { display: inline; font-size: 120%; color: rgb(30%,30%,70%); font-family: monospace } .doc .inlinecode .id { color: rgb(30%,30%,70%); } .inlinecodenm { display: inline; color: #444444; } .doc .code { display: inline; font-size: 120%; color: rgb(30%,30%,70%); font-family: monospace } .comment { display: inline; font-family: monospace; color: #cf1d1d } .code { display: block; /* padding-left: 15px; */ font-size: 110%; font-family: monospace; } table.infrule { border: 0px; margin-left: 50px; margin-top: 10px; margin-bottom: 10px; } td.infrule { font-family: monospace; text-align: center; /* color: rgb(35%,35%,70%); */ padding: 0px; line-height: 100%; } tr.infrulemiddle hr { margin: 1px 0 1px 0; } .infrulenamecol { color: rgb(60%,60%,60%); font-size: 80%; padding-left: 1em; padding-bottom: 0.1em } /* Pied de page */ #footer { font-size: 65%; font-family: sans-serif; } /* Identifiers: ) */ .id { display: inline; } .id[title="constructor"] { color: rgb(60%,0%,0%); } .id[title="var"] { color: rgb(40%,0%,40%); } .id[title="variable"] { color: rgb(40%,0%,40%); } .id[title="definition"] { color: rgb(0%,40%,0%); } .id[title="abbreviation"] { color: rgb(0%,40%,0%); } .id[title="lemma"] { color: rgb(0%,40%,0%); } .id[title="instance"] { color: rgb(0%,40%,0%); } .id[title="projection"] { color: rgb(0%,40%,0%); } .id[title="method"] { color: rgb(0%,40%,0%); } .id[title="inductive"] { color: rgb(0%,0%,80%); } .id[title="record"] { color: rgb(0%,0%,80%); } .id[title="class"] { color: rgb(0%,0%,80%); } .id[title="keyword"] { color : #cf1d1d; /* color: black; */ } /* Deprecated rules using the 'type' attribute of (not xhtml valid) */ .id[type="constructor"] { color: rgb(60%,0%,0%); } .id[type="var"] { color: rgb(40%,0%,40%); } .id[type="variable"] { color: rgb(40%,0%,40%); } .id[type="definition"] { color: rgb(0%,40%,0%); } .id[type="abbreviation"] { color: rgb(0%,40%,0%); } .id[type="lemma"] { color: rgb(0%,40%,0%); } .id[type="instance"] { color: rgb(0%,40%,0%); } .id[type="projection"] { color: rgb(0%,40%,0%); } .id[type="method"] { color: rgb(0%,40%,0%); } .id[type="inductive"] { color: rgb(0%,0%,80%); } .id[type="record"] { color: rgb(0%,0%,80%); } .id[type="class"] { color: rgb(0%,0%,80%); } .id[type="keyword"] { color : #cf1d1d; /* color: black; */ } .inlinecode .id { color: rgb(0%,0%,0%); } /* TOC */ #toc h2 { padding: 10px; background-color: rgb(60%,60%,100%); } #toc li { padding-bottom: 8px; } /* Index */ #index { margin: 0; padding: 0; width: 100%; } #index #frontispiece { margin: 1em auto; padding: 1em; width: 60%; } .booktitle { font-size : 140% } .authors { font-size : 90%; line-height: 115%; } .moreauthors { font-size : 60% } #index #entrance { text-align: center; } #index #entrance .spacer { margin: 0 30px 0 30px; } #index #footer { position: absolute; bottom: 0; } .paragraph { height: 0.75em; } ul.doclist { margin-top: 0em; margin-bottom: 0em; } math-comp-mathcomp-1.12.0/etc/artwork/jc.png000066400000000000000000000036701375767750300206660ustar00rootroot00000000000000‰PNG  IHDR&&¨=é®bKGDÿÿÿ ½§“ pHYs  šœtIME×/éÅZtEXtCommentCreated with The GIMPïd%nIDATXÃí˜{ŒWÇ?gfß»°+Ky,lW$¼¶-V(6@[RM£6ÀbZ©ÚC¥6«IùC±VH|”jM*¡‚%¥¶"ÒÚ@%(l‘fXXvÙǽ{ï÷Üyœã3[VÜâ®.ð‡þ’ùãLÎL>ó{~ÏÀÿmø¬ø°hI¯5ÀÈë õAà¸.P·ÓԚɚZZƒ*œîºPÀÅ15B½°²\å,WÆB]]œ†ÚUšžÀYÀâ« ¡ pï±1ÕbÂîÕ,©ˆž˜(/ñ]háû@Ôß½–`#€»žWÂÌH¢]ˆQ1®©ð(†P ¬JöÞ,ºZ`%—­«É3¤Bo‘™· p,p]ðÀ—>j5Çûj‡ºcŠmfVaæÁ6ÁÁdºe|c5e•ÚCÀà-`-Pÿ¾ï¢éxð󩞀cã‚'Á¢tS+P\5‘uûæ1v–F¨Âѹsá=2â«ÀÂÔ{-$…2,`>ÐüNÀì%hx*¹Ùå?«ÔY¶åCTŒUÔ6)ïÓhZ£ pr4øÝ,Æy #}|4ðåÔ»ÏË›v «?ˆ¶8?F®&öûì^à)`îf²ðáq¸ÒÆ‘V\ÀŠ ôä|:Û õuè~ ‚€AœvKJ+*o×4›‰ó—ÐÝÚJç±7(æ/úÀvà 8Çú¼ö¦ÿ=TMãò—‘uìœÖDÚGé9÷‹!Ð|<é`m ÓÃ0…Øx7@4(GC2 Ÿ•5µõŸyr+ý·¨j˜OÕŒ¥ÔÌZN\¬(q.nå§9; @ðL 2 &=þ1kãfæ­ø"£oj&Ó^É‘]/kE^Y—¥äh¶Ã‰=A9¸ØPnZçSKð¥ìfüœ…¶Ä°[Qtª(y~æAþo³Ó;Wª <°8Ùyæ ²|¶«°]EãÇîCë¸ ÿWUùù½<¿~û8}ŽcÑŸ*0~Ò!é-$Á™\ûaª§4“3%y+ómAhi„Ž`Dãã½fl_oTi¡Âr–«p<É_÷îáŽy’­O}!}„*"TÀŒ Ϭ©aEPçûU P×0‡ž|L&/É Ó?¯X‘£ƒ6½¼ž¡€½túÀ^lWb» \ÇkÛøÜŠ©”á¢I!=D \‰ð$[î-§ä-ÀL“â$¨ª1ôä$ÙB’‡^N§XÐ MÐш}ñO½¥d`½kS0bQJYlpû,Iýè-¶±¹/@˜1‘ÔD°¬L'x9¦ l©z›ê[ ô4B[š:©˜‘#ŒH¿ àwƒõØÎгi=üG,GÒÛÞƬ)z”G‹ ôÈ@ó]D>S",‰p%£ÊàTÍš¾LÇþ]x]:~¦¿W§˜/!´4â@à¶mBI¿ 8ÈPƇWT8–ÀÒfóü«=ìEsh®È†ˆlœÀY\ÅÉ¿ÇÔö{þ ¯o¢çгxÝÑ{P¡“Á:½–bïKO…+µ‹þf÷¨¸üÆš†eDžF…ߊ–=ÌÍ“$¢7FdbD.Fä$Â<ûvHÝ9ɤË^òbhsñâ~ì³ÛŒ¼Î_â´~ƒÈú³ l¾××Ï“c#/ 4ud$ðÇo`ÓŽãÌ,?Åíã5D!Fä%q!f煮­‡B6ô×À“Iûw§eXýîí3S™uØFRÇWIÙ7õÊQOLÿì»ÈHGE‚Àì&lŸµ›õ¦©xµ%↌äÓ$JàX åÁ `]_rU½Ÿec/Ghi(©!#Rõ”ÖÝISÛ¯ÑZ Êƒ¯÷“Eû€Ÿ&3îD*Å{þ;=ö¯vÀi?JhkDŽFì ‚Ž]

"%s";',edge.from,edge.to)) end print[[ } ]] end function cytoscape() print[[ var depends = [ ]] for c,nodes in pairs(clusters) do print(string.format('{ data: { id: "cluster_%s", name: "%s" } },', c, c)) print(string.format('{ data: { id: "cluster_%s_plus", name: "+", parent: "cluster_%s" } },', c, c)) for node,_ in pairs(nodes) do local released = "no" if args[node] then released = "yes" end print(string.format('{ data: { id: "%s", name: "%s", parent: "cluster_%s", released: "%s" } },', node, node, c, released)) end end local i = 0 for _,edge in ipairs(edges) do print(string.format('{ data: { id: "edge%d", source: "%s", target: "%s" } },', i, edge.from,edge.to)) i=i+1 end for _,edge in ipairs(meta_edges) do print(string.format('{ data: { id: "edge%d", source: "cluster_%s", target: "cluster_%s" } },', i, edge.from,edge.to)) i=i+1 end print[[ ]; ]] end for i=1,#arg do args[arg[i]] = true end cytoscape() -- $COQBIN/coqdep -R . mathcomp */*.v | grep -v vio: > depend -- cat depend | ./graph.lua dot | tee depend.dot | dot -T png -o depend.png -- cat depend | ./graph.lua cytoscape `git show release/1.6:mathcomp/Make | grep 'v *$' | cut -d / -f 2 | cut -d . -f 1` > depend.js math-comp-mathcomp-1.12.0/etc/utils/000077500000000000000000000000001375767750300172255ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/etc/utils/builddoc_lib.sh000066400000000000000000000072031375767750300221760ustar00rootroot00000000000000 mangle_sources() { # pre processing, mainly comments for f in $@; do sed -r -e ' # We remove comments inside proofs /^Proof.$/,/^Qed./s/\(\*[^*](([^(]|\([^*]){1,}?[^^])\*+\)//g; ' $f | sed -r -e ' # read the whole file into the pattern space # :a is the label, N glues the current line; b branches # to a if not EOF :a; N; $!ba; # remove all starred lines s/\(\*{5,}?\)//g; # remove *)\n(* s/\*+\)\n\(\*+/\n/g; # double star not too short comments, that are left # as singly starred comments, like (*a.3*) s/\n\(\*+(([^(]|\([^*]){5,}?[^^])\*+\)/\n(**\ \1\ **)/g; # restore hide s/\(\*+[ ]*begin hide[ ]*\*+\)/\(\* begin hide \*\)/g; s/\(\*+[ ]*end hide[ ]*\*+\)/\(\* end hide \*\)/g; ' | sed -r -e ' # since ranges apply to lines only we create lines s/\(\*\*/\n(**\n/g; s/\*\*\)/\n**)\n/g; ' | sed -r -e ' # quote sharp, percent and dollar on comment blocks # hiding underscore /\(\*\*/,/\*\*\)/s/#/##/g; /\(\*\*/,/\*\*\)/s/%/%%/g; /\(\*\*/,/\*\*\)/s/\$/$$/g; /\(\*\*/,/\*\*\)/s/\[/#[#/g; /\(\*\*/,/\*\*\)/s/]/#]#/g; # only in 8.4 # /\(\*\*/,/\*\*\)/s/\_/#\_#/g; # the lexer glues sharp with other symbols /\(\*\*/,/\*\*\)/s/([^A-Za-z0-9 ])#\[#/\1 #[#/g; /\(\*\*/,/\*\*\)/s/([^A-Za-z0-9 ])#]#/\1 #]#/g; ' | sed -r -e ' # we glue comment lines back together :a; N; $!ba; s/\n\(\*\*\n/(**/g; s/\n\*\*\)\n/**)/g; ' > $f.tmp mv $f.tmp $f done } # example invocation: # MAKEDOT=../etc/utils/ PATH=$COQBIN:$PATH MANGLEDOT=touch COQDOCOPTS="-R . mathcomp" \ # build_doc */*.v build_doc() { rm -rf html mkdir html coqdoc -t "$TITLE" -g --utf8 $COQDOCOPTS \ --parse-comments \ --multi-index $@ -d html # graph coqdep -noglob $COQOPTS $@ > depend sed -i -e 's/ [^ ]*\.cmxs//g' -e 's/ [^ ]*\.cm.//g' depend ocamlc -o $MAKEDOT/makedot -pp camlp5o $MAKEDOT/dependtodot.ml $MAKEDOT/makedot depend mv *.dot theories.dot || true $MANGLEDOT theories.dot dot -Tpng -o html/depend.png -Tcmapx -o html/depend.map theories.dot dot -Tsvg -o html/depend.svg theories.dot # post processing for f in html/*.html; do sed -r -i -e ' # read the whole file into the pattern space # :a is the label, N glues the current line; b branches # to a if not EOF :a; N; $!ba; #Add the favicon s/^<\/head>/\n<\/head>/mg; # add the Joint Center logo s/]*?)>/(Joint Center)/g; # extra blank line s/\n/

/g; # weird underscore s/ /_/g; # putting back underscore s/#\_#/\_/g; # abundance of
s/\n //g; ' $f done mv html/index.html html/index_lib.html cat >html/index.html < $TITLE

(Joint Center) $TITLE Documentation

EOT cat html/depend.map >> html/index.html cat >>html/index.html <
Library index
EOT } math-comp-mathcomp-1.12.0/etc/utils/dependtodot.ml000066400000000000000000000230461375767750300220750ustar00rootroot00000000000000(* Loic Pottier, projet CROAP, INRIA Sophia Antipolis, April 1998. *) (* Laurent Théry , INRIA Sophia Antipolis, April 2007 *) (* Convert a dependencies file, in makefile form, into a graph in a file readable by dot. The function dependtodot takes as input the dependencies file, and create a file with the same name suffixed by ".dot", readable by dot. *) let nodecol="#dbc3b6";; (* #add8ff *) let edgecol="#676767";; (* #ff0000 *) (* parameters to draw edges and nodes *) let vnode x = "l(\"" ^ x ^ "\",n(\"\",[a(\"COLOR\",\""^ nodecol ^"\"),a(\"OBJECT\",\"" ^ x ^ "\")]," ;; let wstring x = "\""^x^"\"" ;; let vnoder x = "r(\"" ^ x ^ "\")" ;; let vedge = "e(\"\",[a(\"_DIR\",\"inverse\"),a(\"EDGEPATTERN\",\"solid\"),a(\"EDGECOLOR\",\"" ^ edgecol ^ "\")]," ;; let listdv l = match l with [] -> "[]" |x::l -> let rec listdvr l = match l with [] -> "" |y::l -> "," ^ y ^ (listdvr l) in "[" ^ x ^ (listdvr l) ^ "]" ;; let rec visit ht hte x s = Hashtbl.add ht x x; try let le=Hashtbl.find hte x in let rec visit_edge ls le = match le with [] -> ls |b::l -> try let _ =Hashtbl.find ht b in (visit_edge (ls@[vedge ^ (vnoder b) ^ ")"]) l) with Not_found -> (visit_edge (ls@[vedge ^ (visit ht hte b s) ^ ")"]) l) in s ^ (vnode x) ^ (listdv (visit_edge [] le)) ^ "))" with Not_found -> s ^ (vnode x) ^ "[]))" ;; (* cloture transitive *) let rec merge_list a b = match a with [] -> b |x::a -> if (List.mem x b) then (merge_list a b) else x::(merge_list a b) ;; let ht_graph g = let ht =Hashtbl.create 50 in let rec fill g = match g with [] -> () |(a,lb)::g -> Hashtbl.add ht a lb; fill g in fill g; ht ;; let trans_clos1 g = let ht =ht_graph g in List.map (fun (a,lb) -> (a,(let l = ref lb in let rec addlb lb = match lb with [] -> () |b::lb -> (try l:=(merge_list (Hashtbl.find ht b) !l) with Not_found -> ()); addlb lb in addlb lb; !l))) g ;; let rec transitive_closure g = let g1=trans_clos1 g in if g1=g then g else (transitive_closure g1) ;; (* let g=["A",["B"]; "B",["C"]; "C",["D"]; "D",["E"]; "E",["A"]];; transitive_closure g;; *) (* enlever les arcs de transitivite *) let remove_trans g = let ht = ht_graph (transitive_closure g) in List.map (fun (a,lb) -> (a,(let l=ref [] in (let rec sel l2 = match l2 with [] -> () |b::l2 -> (let r=ref false in (let rec testlb l3 = match l3 with [] -> () |c::l3 -> if (not (b=a)) &&(not(b=c)) && (not (a=c)) && (try (List.mem b (Hashtbl.find ht c)) with Not_found -> false) then r:=true else (); testlb l3 in testlb lb); if (!r=false) then l:=b::!l else ()); sel l2 in sel lb); !l))) g ;; (* let g1=["Le", ["C";"Lt";"B"; "Plus"]; "Lt", ["A";"Plus"]];; let g=["A",["B";"C";"D";"E"]; "B",["C"]; "C",["D"]; "D",["E"]];; remove_trans g;; *) let dot g name file= let chan_out = open_out (file^".dot") in output_string chan_out "digraph "; output_string chan_out name; output_string chan_out " {\n"; output_string chan_out " bgcolor=transparent;\n"; output_string chan_out " splines=true;\n"; output_string chan_out " nodesep=1;\n"; output_string chan_out " node [fontsize=18, shape=rect, color=\"#dbc3b6\", style=filled];\n"; List.iter (fun (x,y) -> output_string chan_out " "; output_string chan_out (wstring x); output_string chan_out " [URL=\"./"; output_string chan_out x; output_string chan_out ".html\"]\n"; List.iter (fun y -> output_string chan_out " "; output_string chan_out (wstring x); output_string chan_out " -> "; output_string chan_out (wstring y); output_string chan_out ";\n") y) g; flush chan_out; output_string chan_out "}"; close_out chan_out ;; (* example: a complete 5-graph, let g=["A",["B";"C";"D";"E"]; "B",["A";"C";"D";"E"]; "C",["A";"B";"D";"E"]; "D",["A";"B";"C";"E"]; "E",["A";"B";"C";"D"]];; daVinci g "g2";; the file is then g2.daVinci *) (***********************************************************************) open Genlex;; (* change OP april 28 *) (* this parsing produce a pair where the first member is a paire (file,Directory) and the second is a list of pairs (file,Directory). from this we can compute the files graph dependency and also the directory graph dependency *) let lexer = make_lexer [":";".";"/";"-"];; let rec parse_dep = parser [< a=parse_name; 'Kwd ".";'Ident b; _=parse_until_colon; _=parse_name ;'Kwd "."; 'Ident d;n=parse_rem >] -> (a,n) and parse_rem = parser [< a=parse_name;'Kwd ".";'Ident b;n=parse_rem >] -> a::n | [<>]->[] and parse_until_colon = parser [< 'Kwd ":" >] -> () | [< 'Kwd _; _=parse_until_colon >] -> () | [< 'Int _; _=parse_until_colon >] -> () | [< 'Ident _; _=parse_until_colon >] -> () and parse_name = parser [<'Kwd "/";a=parse_ident; b=parse_name_rem a "" >]-> a::b |[]-> a::b and parse_name2 k = parser []-> d::b and parse_name_rem a b= parser [<'Kwd "/";c=parse_name2 a >]-> c | [<>]->[] and parse_ident = parser [<'Ident a; b=parse_ident_rem a "" >]-> a ^ b |[<'Int a; b=parse_ident_rem (string_of_int a) "" >]-> (string_of_int a) ^ b and parse_ident2 k = parser [<'Ident d; b=parse_ident_rem d k >]-> d ^ b |[<'Int d; b=parse_ident_rem (string_of_int d) k >]-> (string_of_int d) ^ b and parse_ident_rem a b= parser [<'Kwd "-";c=parse_ident2 a >]-> "-" ^ c | [<>]-> "" ;; (* parse_name(lexer(Stream.of_string "u/sanglier/0/croap/pottier/Coq/Dist/contrib/Rocq/ALGEBRA/CATEGORY_THEORY/NT/YONEDA_LEMMA/NatFun.vo: "));; parse_ident(lexer(Stream.of_string "ARITH-OMEGA-ggg-2.vo:"));; PROBLEME *) (* reads the depend file *) let read_depend file= let st =open_in file in let lr =ref [] in let rec other() = (try let d=parse_dep(lexer(Stream.of_string (input_line st))) in lr:=d::(!lr); other() with _ ->[]) in (let _ = other() in ()); !lr;; (* graph of a directory (given by a path) *) let rec is_prefix p q = match p with [] -> true |a::p -> match q with [] -> false |b::q -> if a=b then (is_prefix p q) else false ;; let rec after_prefix p q = match p with [] ->(match q with [] -> "unknown" |a::_ -> a) |a::p -> match q with [] -> "unknown" |b::q -> (after_prefix p q) ;; let rec proj_graph p g = match g with [] -> [] |(q,l)::g -> if (is_prefix p q) then let rec proj_edges l = match l with [] -> [] |r::l -> if (is_prefix p r) then (after_prefix p r)::(proj_edges l) else (proj_edges l) in ((after_prefix p q),(proj_edges l)) ::(proj_graph p g) else (proj_graph p g) ;; let rec start_path p = match p with [] ->[] |a::p -> match p with [] ->[] |b::q -> a::(start_path p) ;; (* the list of all the paths and subpaths in g *) let all_path g = let ht =Hashtbl.create 50 in let add_path p = Hashtbl.remove ht p;Hashtbl.add ht p true in let rec add_subpath p = match p with [] ->() |_ -> add_path p; add_subpath (start_path p) in let rec all_path g = match g with [] -> () |(q,l)::g -> add_subpath (start_path q); let rec all_pathl l = match l with [] -> () |a::l -> add_subpath (start_path a); all_pathl l in all_pathl l; all_path g in all_path g; let lp=ref [] in Hashtbl.iter (fun x y -> lp:=x::!lp) ht; !lp ;; (* let g=read_depend "depend";; proj_graph ["theories"] g;; *) let rec endpath p = match p with [] ->"" |a::p -> match p with [] ->a |_ -> endpath p ;; let rec fpath p = match p with [] ->"" |a::p -> a ^ "/" ^ (fpath p) ;; let rec spath p = match p with [] -> "" |a::p -> match p with [] ->a |b::q -> a ^ "/" ^ (spath p) ;; (* creates graphs for all paths *) let dependtodot file= let g =(read_depend file) in let lp1 = all_path g in let lp = (if lp1=[] then [[]] else lp1) in let rec ddv lp = match lp with [] -> () |p::lp -> let name = (let f = (endpath p) in if f="" then file else f) in let filep = (let f = (spath p) in if f="" then file else f) in dot (remove_trans (proj_graph p g)) name filep; ddv lp in ddv lp ;; let _ = if (Array.length Sys.argv) == 2 then dependtodot Sys.argv.(1) else print_string "makedot depend"; print_newline() math-comp-mathcomp-1.12.0/etc/utils/hierarchy.ml000066400000000000000000000221441375767750300215400ustar00rootroot00000000000000#load "unix.cma";; #load "str.cma";; module MapS = Map.Make(String) let usage () = print_endline {|Usage : ocaml hierarchy.ml [OPTIONS] Description: hierarchy.ml is a small utility to draw a diagram of and verify the hierarchy of mathematical structures. This utility uses the coercion paths and the canonical projections between .type types (typically in the MathComp library) to draw the diagram. Indirect edges which can be composed of other edges by transitivity are eliminated automatically for each kind of edges. A diagram appears on the standard output in the DOT format which can be converted to several image formats by Graphviz. Options: -h, -help: Output a usage message and exit. -verify: Output a proof script to verify the join canonical projections. The options "-canonicals" and "-coercions" are ignored if "-verify" is given. -canonicals (off|on|color): Configure output of edges of canonical projections. The default value is "on". -coercions (off|on|color): Configure output of edges of coercions. The default value is "off". The value given by this option must be different from that by -canonical soption. -R dir coqdir: This option is given to coqtop: "recursively map physical dir to logical coqdir". -lib library: Specify a Coq library used to draw a diagram. This option can appear repetitively. If not specified, all.all will be used.|} ;; let coqtop = match Sys.getenv "COQBIN" with | exception Not_found -> "coqtop" | coqbin -> if coqbin.[String.length coqbin - 1] = '/' then coqbin ^ "coqtop" else coqbin ^ "/coqtop" ;; let parse_canonicals file = let lines = ref [] in let ic = open_in file in let re = Str.regexp "^\\([^ ]+\\)\\.sort <- \\([^ ]+\\)\\.sort ( \\([^ ]+\\)\\.\\([^\\. ]+\\) )$" in begin try while true do let line = input_line ic in if Str.string_match re line 0 then let to_module = Str.matched_group 1 line in let from_module = Str.matched_group 2 line in let proj_module = Str.matched_group 3 line in if from_module = proj_module || to_module = proj_module then lines := (from_module, to_module, proj_module ^ "." ^ Str.matched_group 4 line) :: !lines done with End_of_file -> close_in ic end; List.rev !lines ;; let parse_coercions file = let lines = ref [] in let ic = open_in file in let re = Str.regexp "^\\[\\([^]]+\\)\\] : \\([^ ]+\\)\\.type >-> \\([^ ]+\\)\\.type$" in begin try while true do let line = input_line ic in if Str.string_match re line 0 then lines := (Str.matched_group 3 line, Str.matched_group 2 line, Str.matched_group 1 line) :: !lines done with End_of_file -> close_in ic end; List.rev !lines ;; let map_of_inheritances (inhs : (string * string * string) list) = let rec recur m = function | [] -> m | (from_module, to_module, inh) :: inhs -> recur (MapS.update to_module (function None -> Some MapS.empty | m' -> m') (MapS.update from_module (function | None -> Some (MapS.singleton to_module inh) | Some m' -> Some (MapS.add to_module inh m')) m)) inhs in recur MapS.empty inhs ;; (* Computes transitive closure by the Floyd-Warshall algorithm *) let transitive_closure inhs = MapS.fold (fun j _ inhs' -> let mj = match MapS.find_opt j inhs' with None -> MapS.empty | Some mj -> mj in MapS.map (fun mi -> match MapS.find_opt j mi with | None -> mi | Some i_j -> MapS.merge (fun _ i_k j_k -> match i_k, j_k with | Some i_k, _ -> Some i_k | None, Some j_k -> Some (i_j ^ "; " ^ j_k) | None, None -> None) mi mj) inhs') inhs inhs ;; let minimalize inhs m = let rec recur m k = match MapS.find_first_opt (fun k' -> String.compare k k' < 0) m with | None -> m | Some (k', _) -> try recur (MapS.merge (fun _ v v' -> match v, v' with Some _, None -> v | _, _ -> None) m (MapS.find k' inhs)) k' with Not_found -> recur m k' in recur m "" ;; let print_verifier libs inhs = Printf.printf {|(** Generated by etc/utils/hierarchy.ml *) From mathcomp Require Import %s. (* `check_join t1 t2 tjoin` assert that the join of `t1` and `t2` is `tjoin`. *) Tactic Notation "check_join" open_constr(t1) open_constr(t2) open_constr(tjoin) := let rec fillargs t := lazymatch type of t with | forall _, _ => let t' := open_constr:(t _) in fillargs t' | _ => t end in let t1 := fillargs t1 in let t2 := fillargs t2 in let tjoin := fillargs tjoin in let T1 := open_constr:(_ : t1) in let T2 := open_constr:(_ : t2) in match tt with | _ => unify ((fun x : t1 => x : Type) T1) ((fun x : t2 => x : Type) T2) | _ => fail "There is no join of" t1 "and" t2 "but is expected to be" tjoin end; let Tjoin := lazymatch T1 with _ (_ ?Tjoin) => Tjoin | _ ?Tjoin => Tjoin | ?Tjoin => Tjoin end in match tt with | _ => is_evar Tjoin | _ => let Tjoin := eval simpl in (Tjoin : Type) in fail "The join of" t1 "and" t2 "is a concrete type" Tjoin "but is expected to be" tjoin end; let tjoin' := type of Tjoin in lazymatch tjoin' with | tjoin => idtac | _ => fail "The join of" t1 "and" t2 "is" tjoin' "but is expected to be" tjoin end. Goal False. |} (String.concat " " libs); MapS.iter (fun kl ml -> MapS.iter (fun kr mr -> let m = minimalize inhs (MapS.merge (fun _ v v' -> match v, v' with Some _, Some _ -> Some () | _, _ -> None) (MapS.add kl "" ml) (MapS.add kr "" mr)) in match MapS.bindings m with | [] -> () | [kj, ()] -> Printf.printf "check_join %s.type %s.type %s.type.\n" kl kr kj | joins -> failwith (Printf.sprintf "%s and %s have more than two least common children: %s." kl kr (String.concat ", " (List.map fst joins))) ) inhs) inhs; Printf.printf "Abort.\n" ;; let () = let opt_verify = ref false in let opt_canonicals = ref "on" in let opt_coercions = ref "off" in let opt_libmaps = ref [] in let opt_imports = ref [] in let tmp_coercions = Filename.temp_file "" ".out" in let tmp_canonicals = Filename.temp_file "" ".out" in let rec parse = function | [] -> () | "-verify" :: rem -> opt_verify := true; parse rem | "-canonicals" :: col :: rem -> opt_canonicals := col; parse rem | "-coercions" :: col :: rem -> opt_coercions := col; parse rem | "-R" :: path :: log :: rem -> opt_libmaps := (path, log) :: !opt_libmaps; parse rem | "-lib" :: lib :: rem -> opt_imports := lib :: !opt_imports; parse rem | "-h" :: _ | "-help" :: _ -> usage (); exit 0 | _ -> usage (); exit 1 in parse (List.tl (Array.to_list Sys.argv)); opt_libmaps := List.rev !opt_libmaps; opt_imports := if !opt_imports = [] then ["all.all"] else List.rev !opt_imports; (* Interact with coqtop *) begin let (coqtop_out, coqtop_in, _) as coqtop_ch = Unix.open_process_full (Printf.sprintf "%S -w none " coqtop ^ String.concat " " (List.map (fun (path, log) -> Printf.sprintf "-R %S %S" path log) !opt_libmaps)) (Unix.environment ()) in Printf.fprintf coqtop_in {| Set Printing Width 4611686018427387903. From mathcomp Require Import %s. Redirect %S Print Canonical Projections. Redirect %S Print Graph. |} (String.concat " " !opt_imports) (List.hd (String.split_on_char '.' tmp_canonicals)) (List.hd (String.split_on_char '.' tmp_coercions)); close_out coqtop_in; try while true do ignore (input_line coqtop_out) done with End_of_file -> if Unix.close_process_full coqtop_ch <> WEXITED 0 then failwith "Failed to invoke coqtop." end; (* Parsing *) let canonicals = parse_canonicals tmp_canonicals in let coercions = parse_coercions tmp_coercions in (* Output *) if !opt_verify then print_verifier !opt_imports (transitive_closure (map_of_inheritances canonicals)) else begin let print_graph opt inhs = if opt <> "off" then let attr = if opt = "on" then "" else "color=" ^ opt in MapS.iter (fun k m -> MapS.iter (fun k' _ -> Printf.printf "%S -> %S[%s];\n" k k' attr) (minimalize inhs m)) inhs in print_endline "digraph structures {"; print_graph !opt_canonicals (transitive_closure (map_of_inheritances canonicals)); print_graph !opt_coercions (transitive_closure (map_of_inheritances coercions)); print_endline "}" end; Sys.remove tmp_canonicals; Sys.remove tmp_coercions; ;; math-comp-mathcomp-1.12.0/etc/utils/packager000077500000000000000000000055371375767750300207420ustar00rootroot00000000000000#!/bin/bash set -e set -x if [ -z $1 ] || [ $1 == "--help" ] || [ $1 == "-h" ] then cat < $pkgdir/opam sed -r "/^version/d" -i $pkgdir/opam fi echo "" >> $pkgdir/opam echo "url {" >> $pkgdir/opam echo $URLLINE >> $pkgdir/opam if [ $VERSION != "dev" ] then echo $CHECKSUMLINE >> $pkgdir/opam fi echo "}" >> $pkgdir/opam done # finally test the existence of the archive wget --spider $ARCHIVEURL math-comp-mathcomp-1.12.0/etc/win-installer.nsi000077500000000000000000000045421375767750300214000ustar00rootroot00000000000000SetCompressor lzma ; VERSION and BITS should be passed as an argument at compile time using: ; makensis -DVERSION=1.6 -DBITS=32 win-installer.nsi !define MY_PRODUCT "Coq" ;Define your own software name here !define SRC "C:\coq${BITS}\lib\user-contrib\mathcomp\" !define OUTFILE "ssreflect-mathcomp-installer-${VERSION}-win${BITS}.exe" !include "MUI2.nsh" ;-------------------------------- ;Configuration Name "Ssreflect and the Mathematical Components library" ;General OutFile "${OUTFILE}" ;Folder selection page InstallDir "C:\Coq" ;Remember install folder InstallDirRegKey HKCU "Software\Coq" "" ;-------------------------------- ;Modern UI Configuration !insertmacro MUI_PAGE_WELCOME !insertmacro MUI_PAGE_LICENSE ".\CeCILL-B" !insertmacro MUI_PAGE_COMPONENTS !define MUI_DIRECTORYPAGE_TEXT_TOP "Select where Coq is installed." !insertmacro MUI_PAGE_DIRECTORY !insertmacro MUI_PAGE_INSTFILES !insertmacro MUI_PAGE_FINISH !insertmacro MUI_UNPAGE_WELCOME !insertmacro MUI_UNPAGE_CONFIRM !insertmacro MUI_UNPAGE_INSTFILES !insertmacro MUI_UNPAGE_FINISH ;-------------------------------- ;Languages !insertmacro MUI_LANGUAGE "English" ;-------------------------------- ;Language Strings ;Description LangString DESC ${LANG_ENGLISH} "The Ssreflect proof language and the Mathematical Components library." ;-------------------------------- ;Installer Sections Section "Ssreflect and MathComp" Sec SetOutPath "$INSTDIR\lib\user-contrib\mathcomp\" File /r ${SRC}\*.vo File /r ${SRC}\*.v File /r ${SRC}\*.glob CreateDirectory "$SMPROGRAMS\Coq" WriteINIStr "$SMPROGRAMS\Coq\The Mathematical Components Library.url" "InternetShortcut" "URL" "http://math-comp.github.io/math-comp/" WriteINIStr "$SMPROGRAMS\Coq\The Ssreflect User Manaul.url" "InternetShortcut" "URL" "http://hal.inria.fr/inria-00258384/en" SetOutPath "$INSTDIR" writeUninstaller "Uninstall Ssreflect and MathComp.exe" SectionEnd !insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN !insertmacro MUI_DESCRIPTION_TEXT ${Sec} $(DESC) !insertmacro MUI_FUNCTION_DESCRIPTION_END Section "Uninstall" RMDir /r "$INSTDIR\lib\user-contrib\mathcomp\" Delete "$SMPROGRAMS\Coq\The Mathematical Components Library.url" Delete "$SMPROGRAMS\Coq\The Ssreflect User Manaul.url" Delete "$INSTDIR\Uninstall Ssreflect and MathComp.exe" SectionEnd math-comp-mathcomp-1.12.0/mathcomp/000077500000000000000000000000001375767750300171225ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/Make000066400000000000000000000040161375767750300177230ustar00rootroot00000000000000algebra/all_algebra.v algebra/finalg.v algebra/countalg.v algebra/fraction.v algebra/intdiv.v algebra/interval.v algebra/matrix.v algebra/mxalgebra.v algebra/mxpoly.v algebra/polydiv.v algebra/poly.v algebra/polyXY.v algebra/rat.v algebra/ring_quotient.v algebra/ssralg.v algebra/ssrint.v algebra/ssrnum.v algebra/vector.v algebra/zmodp.v all/all.v character/all_character.v character/character.v character/classfun.v character/inertia.v character/integral_char.v character/mxabelem.v character/mxrepresentation.v character/vcharacter.v field/algC.v field/algebraics_fundamentals.v field/algnum.v field/all_field.v field/closed_field.v field/cyclotomic.v field/falgebra.v field/fieldext.v field/finfield.v field/galois.v field/separable.v fingroup/action.v fingroup/all_fingroup.v fingroup/automorphism.v fingroup/fingroup.v fingroup/gproduct.v fingroup/morphism.v fingroup/perm.v fingroup/presentation.v fingroup/quotient.v solvable/abelian.v solvable/all_solvable.v solvable/alt.v solvable/burnside_app.v solvable/center.v solvable/commutator.v solvable/cyclic.v solvable/extraspecial.v solvable/extremal.v solvable/finmodule.v solvable/frobenius.v solvable/gfunctor.v solvable/gseries.v solvable/hall.v solvable/jordanholder.v solvable/maximal.v solvable/nilpotent.v solvable/pgroup.v solvable/primitive_action.v solvable/sylow.v ssreflect/all_ssreflect.v ssreflect/bigop.v ssreflect/binomial.v ssreflect/choice.v ssreflect/div.v ssreflect/eqtype.v ssreflect/finfun.v ssreflect/fingraph.v ssreflect/finset.v ssreflect/fintype.v ssreflect/generic_quotient.v ssreflect/order.v ssreflect/path.v ssreflect/prime.v ssreflect/seq.v ssreflect/ssrAC.v ssreflect/ssrbool.v ssreflect/ssreflect.v ssreflect/ssrfun.v ssreflect/ssrnat.v ssreflect/ssrnotations.v ssreflect/ssrmatching.v ssreflect/tuple.v -I . -R . mathcomp -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +non-primitive-record -arg -w -arg +undeclared-scope math-comp-mathcomp-1.12.0/mathcomp/Make.test-suite000066400000000000000000000002661375767750300220330ustar00rootroot00000000000000test_suite/test_hierarchy_all.v test_suite/test_ssrAC.v test_suite/test_guard.v test_suite/test_regular_conv.v -I . -arg -w -arg -notation-overridden -arg -w -arg -ambiguous-paths math-comp-mathcomp-1.12.0/mathcomp/Makefile000066400000000000000000000002061375767750300205600ustar00rootroot00000000000000# -*- Makefile -*- # setting variables COQPROJECT?=Make COQMAKEOPTIONS=--no-print-directory # Main Makefile include Makefile.common math-comp-mathcomp-1.12.0/mathcomp/Makefile.common000066400000000000000000000125601375767750300220550ustar00rootroot00000000000000# -*- Makefile -*- ###################################################################### # USAGE: # # # # make all: Build the MathComp library entirely, # # make test-suite: Run the test suite, # # make only TGTS="...vo": Build the selected libraries of MathComp. # # # # The rules this-config::, this-build::, this-only::, # # this-test-suite::, this-distclean::, pre-makefile::, this-clean:: # # and __always__:: may be extended. # # # # Additionally, the following variables may be customized: # SUBDIRS?= COQBIN?=$(dir $(shell which coqtop)) COQMAKEFILE?=$(COQBIN)coq_makefile COQDEP?=$(COQBIN)coqdep COQPROJECT?=_CoqProject COQMAKEOPTIONS?= COQMAKEFILEOPTIONS?= V?= VERBOSE?=V TGTS?= ###################################################################### # local context: ----------------------------------------------------- .PHONY: all config build only test-suite clean distclean doc doc-clean __always__ .SUFFIXES: H:= $(if $(VERBOSE),,@) # not used yet TOP = $(dir $(lastword $(MAKEFILE_LIST))) COQMAKE = $(MAKE) -f Makefile.coq $(COQMAKEOPTIONS) COQMAKE_TESTSUITE = $(MAKE) -f Makefile.test-suite.coq VDFILE=".coqdeps.test-suite" $(COQMAKEOPTIONS) BRANCH_coq:= $(shell $(COQBIN)coqtop -v | head -1 | grep -E '(trunk|master)' \ | wc -l | sed 's/ *//g') # coq version: ifneq "$(BRANCH_coq)" "0" COQVVV:= dev else COQVVV:=$(shell $(COQBIN)coqtop --print-version | cut -d" " -f1) endif COQV:= $(shell echo $(COQVVV) | cut -d"." -f1) COQVV:= $(shell echo $(COQVVV) | cut -d"." -f1-2) # all: --------------------------------------------------------------- all: config build # Makefile.coq: ------------------------------------------------------ .PHONY: pre-makefile Makefile.coq: pre-makefile $(COQPROJECT) Makefile $(COQMAKEFILE) $(COQMAKEFILEOPTIONS) -f $(COQPROJECT) -o Makefile.coq # Test suite --------------------------------------------------------- ifneq "$(TEST_SKIP_BUILD)" "" TEST_DEP := MATHCOMP_PATH := -R test_suite mathcomp.test_suite else TEST_DEP := build MATHCOMP_PATH := -R . mathcomp endif test_suite/test_hierarchy_all.v: $(TEST_DEP) COQBIN=$(COQBIN) ocaml ../etc/utils/hierarchy.ml -verify $(MATHCOMP_PATH) \ -lib all_ssreflect \ -lib all_algebra \ -lib all_field \ -lib all_character \ -lib all_fingroup \ -lib all_solvable \ > test_suite/test_hierarchy_all.v Makefile.test-suite.coq: test_suite/test_hierarchy_all.v $(COQMAKEFILE) $(COQMAKEFILEOPTIONS) -f Make.test-suite $(MATHCOMP_PATH) -o Makefile.test-suite.coq # Global config, build, clean and distclean -------------------------- config: sub-config this-config build: sub-build this-build only: sub-only this-only test-suite: sub-test-suite this-test-suite clean: sub-clean this-clean doc-clean distclean: sub-distclean this-distclean # Local config, build, clean and distclean --------------------------- .PHONY: this-config this-build this-only this-test-suite this-distclean this-clean this-config:: __always__ this-build:: this-config Makefile.coq +$(COQMAKE) this-only:: this-config Makefile.coq +$(COQMAKE) only "TGTS=$(TGTS)" this-test-suite:: Makefile.test-suite.coq +$(COQMAKE_TESTSUITE) this-distclean:: this-clean rm -f Makefile.coq Makefile.coq.conf rm -f Makefile.test-suite.coq Makefile.test-suite.coq.conf this-clean:: __always__ @if [ -f Makefile.coq ]; then $(COQMAKE) cleanall; fi @if [ -f Makefile.test-suite.coq ]; then $(COQMAKE_TESTSUITE) cleanall; fi # Install target ----------------------------------------------------- .PHONY: install install: __always__ Makefile.coq $(COQMAKE) install # counting lines of Coq code ----------------------------------------- .PHONY: count COQFILES = $(shell grep '.v$$' $(COQPROJECT)) count: @coqwc $(COQFILES) | tail -1 | \ awk '{printf ("%d (spec=%d+proof=%d)\n", $$1+$$2, $$1, $$2)}' # Additionally cleaning backup (*~) files ---------------------------- this-distclean:: rm -f $(shell find . -name '*~') # Make in SUBDIRS ---------------------------------------------------- ifdef SUBDIRS sub-%: __always__ @set -e; for d in $(SUBDIRS); do +$(MAKE) -C $$d $(@:sub-%=%); done else sub-%: __always__ @true endif # Make of individual .vo --------------------------------------------- %.vo: __always__ Makefile.coq +$(COQMAKE) $@ test_suite/%.vo: __always__ Makefile.test-suite.coq +$(COQMAKE_TESTSUITE) $@ doc: __always__ Makefile.coq mkdir -p _build_doc/ cp -r $(COQFILES) -t _build_doc/ --parents cp Make Makefile* _build_doc mkdir -p _build_doc/htmldoc . ../etc/utils/builddoc_lib.sh; \ cd _build_doc && mangle_sources $(COQFILES) +cd _build_doc && $(COQMAKE) cd _build_doc && if [ ! -f .Makefile.coq.d ] ; then cp .coqdeps.d .Makefile.coq.d ; fi #can be removed when coq-8.10 compatibility is dropped cd _build_doc && grep -v vio: .Makefile.coq.d > depend cd _build_doc && cat depend | ../../etc/buildlibgraph $(COQFILES) > htmldoc/depend.js cd _build_doc && $(COQBIN)coqdoc -t "Mathematical Components" \ -g --utf8 -R . mathcomp \ --parse-comments \ --multi-index $(COQFILES) -d htmldoc cp ../etc/artwork/coqdoc.css _build_doc/htmldoc doc-clean: rm -rf _build_doc/ math-comp-mathcomp-1.12.0/mathcomp/Makefile.test-suite.coq.local000066400000000000000000000014021375767750300245360ustar00rootroot00000000000000OUTPUT_TESTS=test_suite/output.v test_suite/imset2_finset.v test_suite/imset2_gproduct.v OUTPUT_ARTIFACTS=$(OUTPUT_TESTS:%.v=%.v.out.new) COQ_VERSION_MINOR=$(shell $(COQC) -print-version | cut -d ' ' -f 1 | cut -d '.' -f 1-2) # Given a file f we compare its compilation output f.out.new with # f.out.COQ_VERSION_MINOR (or f.out if f.out.COQ_VERSION_MINOR does not exist) post-all:: $(OUTPUT_ARTIFACTS) @for f in $(OUTPUT_TESTS); do\ if [ -e "$$f.out.$(COQ_VERSION_MINOR)" ]; then REFERENCE="$$f.out.$(COQ_VERSION_MINOR)";\ else REFERENCE=$$f.out; fi;\ if ! diff -q "$$REFERENCE" "$$f.out.new"; \ then diff -u "$$REFERENCE" "$$f.out.new"; \ exit 1;\ fi;\ done $(OUTPUT_ARTIFACTS): %.v.out.new: %.v $(COQC) $(COQFLAGS) $(COQLIBS) $< > $<.out.new math-comp-mathcomp-1.12.0/mathcomp/_CoqProject000066400000000000000000000003551375767750300212600ustar00rootroot00000000000000-I . -R . mathcomp -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg +non-primitive-record -arg -w -arg +undeclared-scope math-comp-mathcomp-1.12.0/mathcomp/algebra/000077500000000000000000000000001375767750300205175ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/algebra/AUTHORS000077700000000000000000000000001375767750300232602../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/algebra/CeCILL-B000077700000000000000000000000001375767750300233322../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/algebra/INSTALL.md000077700000000000000000000000001375767750300242202../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/algebra/Make000066400000000000000000000006471375767750300213260ustar00rootroot00000000000000all_algebra.v countalg.v finalg.v fraction.v intdiv.v interval.v matrix.v mxalgebra.v mxpoly.v polydiv.v poly.v polyXY.v rat.v ring_quotient.v ssralg.v ssrint.v ssrnum.v vector.v zmodp.v -R . mathcomp.algebra -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scope math-comp-mathcomp-1.12.0/mathcomp/algebra/Makefile000066400000000000000000000001441375767750300221560ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/algebra/README.md000077700000000000000000000000001375767750300236762../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/algebra/all_algebra.v000066400000000000000000000006511375767750300231350ustar00rootroot00000000000000Require Export ssralg. Require Export ssrnum. Require Export finalg. Require Export countalg. Require Export poly. Require Export polydiv. Require Export polyXY. Require Export ssrint. Require Export rat. Require Export intdiv. Require Export interval. Require Export matrix. Require Export mxpoly. Require Export mxalgebra. Require Export vector. Require Export ring_quotient. Require Export fraction. Require Export zmodp. math-comp-mathcomp-1.12.0/mathcomp/algebra/countalg.v000066400000000000000000000744551375767750300225410ustar00rootroot00000000000000(* (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. From mathcomp Require Import generic_quotient ring_quotient. (*****************************************************************************) (* This file clones part of ssralg hierachy for countable types; it does not *) (* cover the left module / algebra interfaces, providing only *) (* countZmodType == countable zmodType interface. *) (* countRingType == countable ringType interface. *) (* countComRingType == countable comRingType interface. *) (* countUnitRingType == countable unitRingType interface. *) (* countComUnitRingType == countable comUnitRingType interface. *) (* countIdomainType == countable idomainType interface. *) (* countFieldType == countable fieldType interface. *) (* countDecFieldType == countable decFieldType interface. *) (* countClosedFieldType == countable closedFieldType interface. *) (* The interface cloning syntax is extended to these structures *) (* [countZmodType of M] == countZmodType structure for an M that has both *) (* zmodType and countType structures. *) (* ... etc *) (* This file provides constructions for both simple extension and algebraic *) (* closure of countable fields. *) (*****************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GRing.Theory CodeSeq. Module CountRing. Local Notation mixin_of T := (Countable.mixin_of T). Section Generic. (* Implicits *) Variables (type base_type : Type) (class_of base_of : Type -> Type). Variable base_sort : base_type -> Type. (* Explicits *) Variable Pack : forall T, class_of T -> type. Variable Class : forall T, base_of T -> mixin_of T -> class_of T. Variable base_class : forall bT, base_of (base_sort bT). Definition gen_pack T := fun bT b & phant_id (base_class bT) b => fun fT c m & phant_id (Countable.class fT) (Countable.Class c m) => Pack (@Class T b m). End Generic. Arguments gen_pack [type base_type class_of base_of base_sort]. Local Notation cnt_ c := (@Countable.Class _ c c). Local Notation do_pack pack T := (pack T _ _ id _ _ _ id). Import GRing.Theory. Module Zmodule. Section ClassDef. Set Primitive Projections. Record class_of M := Class { base : GRing.Zmodule.class_of M; mixin : mixin_of M }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Zmodule.class_of. Local Coercion mixin : class_of >-> mixin_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Zmodule.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition join_countType := @Countable.Pack zmodType (cnt_ class). End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Zmodule.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Canonical join_countType. Notation countZmodType := type. Notation "[ 'countZmodType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countZmodType' 'of' T ]") : form_scope. End Exports. End Zmodule. Import Zmodule.Exports. Module Ring. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.Ring.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := Zmodule.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.Ring.class_of. Local Coercion base2 : class_of >-> Zmodule.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Ring.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition join_countType := @Countable.Pack ringType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack ringType class. End ClassDef. Module Import Exports. Coercion base : class_of >-> GRing.Ring.class_of. Coercion base2 : class_of >-> Zmodule.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Canonical join_countType. Canonical join_countZmodType. Notation countRingType := type. Notation "[ 'countRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countRingType' 'of' T ]") : form_scope. End Exports. End Ring. Import Ring.Exports. Module ComRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.ComRing.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := Ring.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.ComRing.class_of. Local Coercion base2 : class_of >-> Ring.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.ComRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition join_countType := @Countable.Pack comRingType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack comRingType class. Definition join_countRingType := @Ring.Pack comRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.ComRing.class_of. Coercion base2 : class_of >-> Ring.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Notation countComRingType := CountRing.ComRing.type. Notation "[ 'countComRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countComRingType' 'of' T ]") : form_scope. End Exports. End ComRing. Import ComRing.Exports. Module UnitRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.UnitRing.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := Ring.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.UnitRing.class_of. Local Coercion base2 : class_of >-> Ring.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.UnitRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition join_countType := @Countable.Pack unitRingType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack unitRingType class. Definition join_countRingType := @Ring.Pack unitRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.UnitRing.class_of. Coercion base2 : class_of >-> Ring.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Notation countUnitRingType := CountRing.UnitRing.type. Notation "[ 'countUnitRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countUnitRingType' 'of' T ]") : form_scope. End Exports. End UnitRing. Import UnitRing.Exports. Module ComUnitRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.ComUnitRing.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := ComRing.Class (base c) (mixin c). Definition base3 R (c : class_of R) := @UnitRing.Class R (base c) (mixin c). Local Coercion base : class_of >-> GRing.ComUnitRing.class_of. Local Coercion base2 : class_of >-> ComRing.class_of. Local Coercion base3 : class_of >-> UnitRing.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.ComUnitRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition join_countType := @Countable.Pack comUnitRingType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack comUnitRingType class. Definition join_countRingType := @Ring.Pack comUnitRingType class. Definition join_countComRingType := @ComRing.Pack comUnitRingType class. Definition join_countUnitRingType := @UnitRing.Pack comUnitRingType class. Definition ujoin_countComRingType := @ComRing.Pack unitRingType class. Definition cjoin_countUnitRingType := @UnitRing.Pack comRingType class. Definition ccjoin_countUnitRingType := @UnitRing.Pack countComRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.ComUnitRing.class_of. Coercion base2 : class_of >-> ComRing.class_of. Coercion base3 : class_of >-> UnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> ComRing.type. Canonical countComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> UnitRing.type. Canonical countUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Canonical join_countComRingType. Canonical join_countUnitRingType. Canonical ujoin_countComRingType. Canonical cjoin_countUnitRingType. Canonical ccjoin_countUnitRingType. Notation countComUnitRingType := CountRing.ComUnitRing.type. Notation "[ 'countComUnitRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countComUnitRingType' 'of' T ]") : form_scope. End Exports. End ComUnitRing. Import ComUnitRing.Exports. Module IntegralDomain. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.IntegralDomain.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := ComUnitRing.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.IntegralDomain.class_of. Local Coercion base2 : class_of >-> ComUnitRing.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.IntegralDomain.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition join_countType := @Countable.Pack idomainType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack idomainType class. Definition join_countRingType := @Ring.Pack idomainType class. Definition join_countUnitRingType := @UnitRing.Pack idomainType class. Definition join_countComRingType := @ComRing.Pack idomainType class. Definition join_countComUnitRingType := @ComUnitRing.Pack idomainType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.IntegralDomain.class_of. Coercion base2 : class_of >-> ComUnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> ComRing.type. Canonical countComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> UnitRing.type. Canonical countUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> ComUnitRing.type. Canonical countComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Canonical join_countComRingType. Canonical join_countUnitRingType. Canonical join_countComUnitRingType. Notation countIdomainType := CountRing.IntegralDomain.type. Notation "[ 'countIdomainType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countIdomainType' 'of' T ]") : form_scope. End Exports. End IntegralDomain. Import IntegralDomain.Exports. Module Field. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.Field.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := IntegralDomain.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.Field.class_of. Local Coercion base2 : class_of >-> IntegralDomain.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Field.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition countIdomainType := @IntegralDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition join_countType := @Countable.Pack fieldType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack fieldType class. Definition join_countRingType := @Ring.Pack fieldType class. Definition join_countUnitRingType := @UnitRing.Pack fieldType class. Definition join_countComRingType := @ComRing.Pack fieldType class. Definition join_countComUnitRingType := @ComUnitRing.Pack fieldType class. Definition join_countIdomainType := @IntegralDomain.Pack fieldType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Field.class_of. Coercion base2 : class_of >-> IntegralDomain.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> ComRing.type. Canonical countComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> UnitRing.type. Canonical countUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> ComUnitRing.type. Canonical countComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion countIdomainType : type >-> IntegralDomain.type. Canonical countIdomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Canonical join_countComRingType. Canonical join_countUnitRingType. Canonical join_countComUnitRingType. Canonical join_countIdomainType. Notation countFieldType := CountRing.Field.type. Notation "[ 'countFieldType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countFieldType' 'of' T ]") : form_scope. End Exports. End Field. Import Field.Exports. Module DecidableField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.DecidableField.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := Field.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.DecidableField.class_of. Local Coercion base2 : class_of >-> Field.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.DecidableField.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition countIdomainType := @IntegralDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition countFieldType := @Field.Pack cT class. Definition decFieldType := @GRing.DecidableField.Pack cT class. Definition join_countType := @Countable.Pack decFieldType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack decFieldType class. Definition join_countRingType := @Ring.Pack decFieldType class. Definition join_countUnitRingType := @UnitRing.Pack decFieldType class. Definition join_countComRingType := @ComRing.Pack decFieldType class. Definition join_countComUnitRingType := @ComUnitRing.Pack decFieldType class. Definition join_countIdomainType := @IntegralDomain.Pack decFieldType class. Definition join_countFieldType := @Field.Pack decFieldType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.DecidableField.class_of. Coercion base2 : class_of >-> Field.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> ComRing.type. Canonical countComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> UnitRing.type. Canonical countUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> ComUnitRing.type. Canonical countComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion countIdomainType : type >-> IntegralDomain.type. Canonical countIdomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion countFieldType : type >-> Field.type. Canonical countFieldType. Coercion decFieldType : type >-> GRing.DecidableField.type. Canonical decFieldType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Canonical join_countComRingType. Canonical join_countUnitRingType. Canonical join_countComUnitRingType. Canonical join_countIdomainType. Canonical join_countFieldType. Notation countDecFieldType := CountRing.DecidableField.type. Notation "[ 'countDecFieldType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countDecFieldType' 'of' T ]") : form_scope. End Exports. End DecidableField. Import DecidableField.Exports. Module ClosedField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.ClosedField.class_of R; mixin : mixin_of R }. Unset Primitive Projections. Definition base2 R (c : class_of R) := DecidableField.Class (base c) (mixin c). Local Coercion base : class_of >-> GRing.ClosedField.class_of. Local Coercion base2 : class_of >-> DecidableField.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.ClosedField.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (cnt_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition countIdomainType := @IntegralDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition countFieldType := @Field.Pack cT class. Definition decFieldType := @GRing.DecidableField.Pack cT class. Definition countDecFieldType := @DecidableField.Pack cT class. Definition closedFieldType := @GRing.ClosedField.Pack cT class. Definition join_countType := @Countable.Pack closedFieldType (cnt_ class). Definition join_countZmodType := @Zmodule.Pack closedFieldType class. Definition join_countRingType := @Ring.Pack closedFieldType class. Definition join_countUnitRingType := @UnitRing.Pack closedFieldType class. Definition join_countComRingType := @ComRing.Pack closedFieldType class. Definition join_countComUnitRingType := @ComUnitRing.Pack closedFieldType class. Definition join_countIdomainType := @IntegralDomain.Pack closedFieldType class. Definition join_countFieldType := @Field.Pack closedFieldType class. Definition join_countDecFieldType := @DecidableField.Pack closedFieldType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.ClosedField.class_of. Coercion base2 : class_of >-> DecidableField.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> Zmodule.type. Canonical countZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> Ring.type. Canonical countRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> ComRing.type. Canonical countComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> UnitRing.type. Canonical countUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> ComUnitRing.type. Canonical countComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion countIdomainType : type >-> IntegralDomain.type. Canonical countIdomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion countFieldType : type >-> Field.type. Canonical countFieldType. Coercion decFieldType : type >-> GRing.DecidableField.type. Canonical decFieldType. Coercion countDecFieldType : type >-> DecidableField.type. Canonical countDecFieldType. Coercion closedFieldType : type >-> GRing.ClosedField.type. Canonical closedFieldType. Canonical join_countType. Canonical join_countZmodType. Canonical join_countRingType. Canonical join_countComRingType. Canonical join_countUnitRingType. Canonical join_countComUnitRingType. Canonical join_countIdomainType. Canonical join_countFieldType. Canonical join_countDecFieldType. Notation countClosedFieldType := CountRing.ClosedField.type. Notation "[ 'countClosedFieldType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'countClosedFieldType' 'of' T ]") : form_scope. End Exports. End ClosedField. Import ClosedField.Exports. End CountRing. Import CountRing. Export Zmodule.Exports Ring.Exports ComRing.Exports UnitRing.Exports. Export ComUnitRing.Exports IntegralDomain.Exports. Export Field.Exports DecidableField.Exports ClosedField.Exports. math-comp-mathcomp-1.12.0/mathcomp/algebra/finalg.v000066400000000000000000001752171375767750300221630ustar00rootroot00000000000000(* (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 finset fingroup morphism perm action. From mathcomp Require Import ssralg countalg. (*****************************************************************************) (* This file clones the entire ssralg hierachy for finite types; this allows *) (* type inference to function properly on expressions that mix combinatorial *) (* and algebraic operators (e.g., [set x + y | x in A, y in A]). *) (* finZmodType, finRingType, finComRingType, finUnitRingType, *) (* finComUnitRingType, finIdomType, finFieldType finLmodType, *) (* finLalgType finAlgType finUnitAlgType *) (* == the finite counterparts of zmodType, etc. *) (* Note that a finFieldType is canonically decidable. All these structures *) (* can be derived using [xxxType of T] forms, e.g., if R has both canonical *) (* finType and ringType structures, then *) (* Canonical R_finRingType := Eval hnf in [finRingType of R]. *) (* declares the derived finRingType structure for R. As the implementation *) (* of the derivation is somewhat involved, the Eval hnf normalization is *) (* strongly recommended. *) (* This file also provides direct tie-ins with finite group theory: *) (* [baseFinGroupType of R for +%R] == the (canonical) additive group *) (* [finGroupType of R for +%R] structures for R *) (* {unit R} == the type of units of R, which has a *) (* canonical group structure. *) (* FinRing.unit R Ux == the element of {unit R} corresponding *) (* to x, where Ux : x \in GRing.unit. *) (* 'U%act == the action by right multiplication of *) (* {unit R} on R, via FinRing.unit_act. *) (* (This is also a group action.) *) (*****************************************************************************) Local Open Scope ring_scope. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Module FinRing. Local Notation mixin_of T b := (Finite.mixin_of (EqType T b)). Section Generic. (* Implicits *) Variables (type base_type : Type) (class_of base_of : Type -> Type). Variable to_choice : forall T, base_of T -> Choice.class_of T. Variable base_sort : base_type -> Type. (* Explicits *) Variable Pack : forall T, class_of T -> type. Variable Class : forall T b, mixin_of T (to_choice b) -> class_of T. Variable base_class : forall bT, base_of (base_sort bT). Definition gen_pack T := fun bT b & phant_id (base_class bT) b => fun fT m & phant_id (Finite.class fT) (Finite.Class m) => Pack (@Class T b m). End Generic. Arguments gen_pack [type base_type class_of base_of to_choice base_sort]. Local Notation fin_ c := (@Finite.Class _ c c). Local Notation do_pack pack T := (pack T _ _ id _ _ id). Import GRing.Theory. Definition groupMixin V := FinGroup.Mixin (@addrA V) (@add0r V) (@addNr V). Local Notation base_group T vT fT := (@FinGroup.PackBase T (groupMixin vT) (Finite.class fT)). Local Notation fin_group B V := (@FinGroup.Pack B (@addNr V)). Module Zmodule. Section ClassDef. Set Primitive Projections. Record class_of M := Class { base : GRing.Zmodule.class_of M; mixin : mixin_of M base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Zmodule.class_of. Local Coercion base2 R (c : class_of R) : CountRing.Zmodule.class_of R := CountRing.Zmodule.Class c (mixin c). Local Coercion mixin : class_of >-> mixin_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Zmodule.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition zmod_finType := @Finite.Pack zmodType (fin_ class). Definition zmod_baseFinGroupType := base_group zmodType zmodType finType. Definition zmod_finGroupType := fin_group zmod_baseFinGroupType zmodType. Definition countZmod_finType := @Finite.Pack countZmodType (fin_ class). Definition countZmod_baseFinGroupType := base_group countZmodType zmodType finType. Definition countZmod_finGroupType := fin_group countZmod_baseFinGroupType zmodType. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Zmodule.class_of. Coercion base2 : class_of >-> CountRing.Zmodule.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Canonical zmod_finType. Canonical zmod_baseFinGroupType. Canonical zmod_finGroupType. Canonical countZmod_finType. Canonical countZmod_baseFinGroupType. Canonical countZmod_finGroupType. Notation finZmodType := type. Notation "[ 'finZmodType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finZmodType' 'of' T ]") : form_scope. Notation "[ 'baseFinGroupType' 'of' R 'for' +%R ]" := (BaseFinGroupType R (groupMixin _)) (at level 0, format "[ 'baseFinGroupType' 'of' R 'for' +%R ]") : form_scope. Notation "[ 'finGroupType' 'of' R 'for' +%R ]" := (@FinGroup.clone R _ (finGroupType _) id _ id) (at level 0, format "[ 'finGroupType' 'of' R 'for' +%R ]") : form_scope. End Exports. End Zmodule. Import Zmodule.Exports. Section AdditiveGroup. Variable U : finZmodType. Implicit Types x y : U. Lemma zmod1gE : 1%g = 0 :> U. Proof. by []. Qed. Lemma zmodVgE x : x^-1%g = - x. Proof. by []. Qed. Lemma zmodMgE x y : (x * y)%g = x + y. Proof. by []. Qed. Lemma zmodXgE n x : (x ^+ n)%g = x *+ n. Proof. by []. Qed. Lemma zmod_mulgC x y : commute x y. Proof. exact: addrC. Qed. Lemma zmod_abelian (A : {set U}) : abelian A. Proof. by apply/centsP=> x _ y _; apply: zmod_mulgC. Qed. End AdditiveGroup. Module Ring. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.Ring.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Ring.class_of. Local Coercion base2 R (c : class_of R) : CountRing.Ring.class_of R := CountRing.Ring.Class c (mixin c). Local Coercion base3 R (c : class_of R) : Zmodule.class_of R := Zmodule.Class (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Ring.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition ring_finType := @Finite.Pack ringType (fin_ class). Definition ring_baseFinGroupType := base_group ringType zmodType finType. Definition ring_finGroupType := fin_group ring_baseFinGroupType zmodType. Definition ring_finZmodType := @Zmodule.Pack ringType class. Definition countRing_finType := @Finite.Pack countRingType (fin_ class). Definition countRing_baseFinGroupType := base_group countRingType zmodType finType. Definition countRing_finGroupType := fin_group countRing_baseFinGroupType zmodType. Definition countRing_finZmodType := @Zmodule.Pack countRingType class. End ClassDef. Module Import Exports. Coercion base : class_of >-> GRing.Ring.class_of. Coercion base2 : class_of >-> CountRing.Ring.class_of. Coercion base3 : class_of >-> Zmodule.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Canonical ring_finType. Canonical ring_baseFinGroupType. Canonical ring_finGroupType. Canonical ring_finZmodType. Canonical countRing_finType. Canonical countRing_baseFinGroupType. Canonical countRing_finGroupType. Canonical countRing_finZmodType. Notation finRingType := type. Notation "[ 'finRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finRingType' 'of' T ]") : form_scope. End Exports. Section Unit. Variable R : finRingType. Definition is_inv (x y : R) := (x * y == 1) && (y * x == 1). Definition unit := [qualify a x : R | [exists y, is_inv x y]]. Definition inv x := odflt x (pick (is_inv x)). Lemma mulVr : {in unit, left_inverse 1 inv *%R}. Proof. rewrite /inv => x Ux; case: pickP => [y | no_y]; last by case/pred0P: Ux. by case/andP=> _; move/eqP. Qed. Lemma mulrV : {in unit, right_inverse 1 inv *%R}. Proof. rewrite /inv => x Ux; case: pickP => [y | no_y]; last by case/pred0P: Ux. by case/andP; move/eqP. Qed. Lemma intro_unit x y : y * x = 1 /\ x * y = 1 -> x \is a unit. Proof. by case=> yx1 xy1; apply/existsP; exists y; rewrite /is_inv xy1 yx1 !eqxx. Qed. Lemma invr_out : {in [predC unit], inv =1 id}. Proof. rewrite /inv => x nUx; case: pickP => // y invxy. by case/existsP: nUx; exists y. Qed. Definition UnitMixin := GRing.UnitRing.Mixin mulVr mulrV intro_unit invr_out. End Unit. End Ring. Import Ring.Exports. Module ComRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.ComRing.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.ComRing.class_of. Local Coercion base2 R (c : class_of R) : CountRing.ComRing.class_of R := CountRing.ComRing.Class c (mixin c). Local Coercion base3 R (c : class_of R) : Ring.class_of R := Ring.Class (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.ComRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @CountRing.ComRing.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition comRing_finType := @Finite.Pack comRingType (fin_ class). Definition comRing_baseFinGroupType := base_group comRingType zmodType finType. Definition comRing_finGroupType := fin_group comRing_baseFinGroupType zmodType. Definition comRing_finZmodType := @Zmodule.Pack comRingType class. Definition comRing_finRingType := @Ring.Pack comRingType class. Definition countComRing_finType := @Finite.Pack countComRingType (fin_ class). Definition countComRing_baseFinGroupType := base_group countComRingType zmodType finType. Definition countComRing_finGroupType := fin_group countComRing_baseFinGroupType zmodType. Definition countComRing_finZmodType := @Zmodule.Pack countComRingType class. Definition countComRing_finRingType := @Ring.Pack countComRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.ComRing.class_of. Coercion base2 : class_of >-> CountRing.ComRing.class_of. Coercion base3 : class_of >-> Ring.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> CountRing.ComRing.type. Canonical countComRingType. Canonical comRing_finType. Canonical comRing_baseFinGroupType. Canonical comRing_finGroupType. Canonical comRing_finZmodType. Canonical comRing_finRingType. Canonical countComRing_finType. Canonical countComRing_baseFinGroupType. Canonical countComRing_finGroupType. Canonical countComRing_finZmodType. Canonical countComRing_finRingType. Notation finComRingType := FinRing.ComRing.type. Notation "[ 'finComRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finComRingType' 'of' T ]") : form_scope. End Exports. End ComRing. Import ComRing.Exports. Module UnitRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.UnitRing.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.UnitRing.class_of. Local Coercion base2 R (c : class_of R) : CountRing.UnitRing.class_of R := CountRing.UnitRing.Class c (mixin c). Local Coercion base3 R (c : class_of R) : Ring.class_of R := Ring.Class (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.UnitRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @CountRing.UnitRing.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition unitRing_finType := @Finite.Pack unitRingType (fin_ class). Definition unitRing_baseFinGroupType := base_group unitRingType zmodType finType. Definition unitRing_finGroupType := fin_group unitRing_baseFinGroupType zmodType. Definition unitRing_finZmodType := @Zmodule.Pack unitRingType class. Definition unitRing_finRingType := @Ring.Pack unitRingType class. Definition countUnitRing_finType := @Finite.Pack countUnitRingType (fin_ class). Definition countUnitRing_baseFinGroupType := base_group countUnitRingType zmodType finType. Definition countUnitRing_finGroupType := fin_group countUnitRing_baseFinGroupType zmodType. Definition countUnitRing_finZmodType := @Zmodule.Pack countUnitRingType class. Definition countUnitRing_finRingType := @Ring.Pack countUnitRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.UnitRing.class_of. Coercion base2 : class_of >-> CountRing.UnitRing.class_of. Coercion base3 : class_of >-> Ring.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> CountRing.UnitRing.type. Canonical countUnitRingType. Canonical unitRing_finType. Canonical unitRing_baseFinGroupType. Canonical unitRing_finGroupType. Canonical unitRing_finZmodType. Canonical unitRing_finRingType. Canonical countUnitRing_finType. Canonical countUnitRing_baseFinGroupType. Canonical countUnitRing_finGroupType. Canonical countUnitRing_finZmodType. Canonical countUnitRing_finRingType. Notation finUnitRingType := FinRing.UnitRing.type. Notation "[ 'finUnitRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finUnitRingType' 'of' T ]") : form_scope. End Exports. End UnitRing. Import UnitRing.Exports. Section UnitsGroup. Variable R : finUnitRingType. Inductive unit_of (phR : phant R) := Unit (x : R) of x \is a GRing.unit. Bind Scope group_scope with unit_of. Let phR := Phant R. Local Notation uT := (unit_of phR). Implicit Types u v : uT. Definition uval u := let: Unit x _ := u in x. Canonical unit_subType := [subType for uval]. Definition unit_eqMixin := Eval hnf in [eqMixin of uT by <:]. Canonical unit_eqType := Eval hnf in EqType uT unit_eqMixin. Definition unit_choiceMixin := [choiceMixin of uT by <:]. Canonical unit_choiceType := Eval hnf in ChoiceType uT unit_choiceMixin. Definition unit_countMixin := [countMixin of uT by <:]. Canonical unit_countType := Eval hnf in CountType uT unit_countMixin. Canonical unit_subCountType := Eval hnf in [subCountType of uT]. Definition unit_finMixin := [finMixin of uT by <:]. Canonical unit_finType := Eval hnf in FinType uT unit_finMixin. Canonical unit_subFinType := Eval hnf in [subFinType of uT]. Definition unit1 := Unit phR (@GRing.unitr1 _). Lemma unit_inv_proof u : (val u)^-1 \is a GRing.unit. Proof. by rewrite unitrV ?(valP u). Qed. Definition unit_inv u := Unit phR (unit_inv_proof u). Lemma unit_mul_proof u v : val u * val v \is a GRing.unit. Proof. by rewrite (unitrMr _ (valP u)) ?(valP v). Qed. Definition unit_mul u v := Unit phR (unit_mul_proof u v). Lemma unit_muluA : associative unit_mul. Proof. by move=> u v w; apply/val_inj/mulrA. Qed. Lemma unit_mul1u : left_id unit1 unit_mul. Proof. by move=> u; apply/val_inj/mul1r. Qed. Lemma unit_mulVu : left_inverse unit1 unit_inv unit_mul. Proof. by move=> u; apply/val_inj/(mulVr (valP u)). Qed. Definition unit_GroupMixin := FinGroup.Mixin unit_muluA unit_mul1u unit_mulVu. Canonical unit_baseFinGroupType := Eval hnf in BaseFinGroupType uT unit_GroupMixin. Canonical unit_finGroupType := Eval hnf in FinGroupType unit_mulVu. Lemma val_unit1 : val (1%g : uT) = 1. Proof. by []. Qed. Lemma val_unitM x y : val (x * y : uT)%g = val x * val y. Proof. by []. Qed. Lemma val_unitV x : val (x^-1 : uT)%g = (val x)^-1. Proof. by []. Qed. Lemma val_unitX n x : val (x ^+ n : uT)%g = val x ^+ n. Proof. by case: n; last by elim=> //= n ->. Qed. Definition unit_act x u := x * val u. Lemma unit_actE x u : unit_act x u = x * val u. Proof. by []. Qed. Canonical unit_action := @TotalAction _ _ unit_act (@mulr1 _) (fun _ _ _ => mulrA _ _ _). Lemma unit_is_groupAction : @is_groupAction _ R setT setT unit_action. Proof. move=> u _ /=; rewrite inE; apply/andP; split. by apply/subsetP=> x _; rewrite inE. by apply/morphicP=> x y _ _; rewrite !actpermE /= [_ u]mulrDl. Qed. Canonical unit_groupAction := GroupAction unit_is_groupAction. End UnitsGroup. Module Import UnitsGroupExports. Bind Scope group_scope with unit_of. Canonical unit_subType. Canonical unit_eqType. Canonical unit_choiceType. Canonical unit_countType. Canonical unit_subCountType. Canonical unit_finType. Canonical unit_subFinType. Canonical unit_baseFinGroupType. Canonical unit_finGroupType. Canonical unit_action. Canonical unit_groupAction. End UnitsGroupExports. Notation unit R Ux := (Unit (Phant R) Ux). Module ComUnitRing. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.ComUnitRing.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.ComUnitRing.class_of. Local Coercion base2 R (c : class_of R) : CountRing.ComUnitRing.class_of R := CountRing.ComUnitRing.Class c (mixin c). Local Coercion base3 R (c : class_of R) : ComRing.class_of R := ComRing.Class (mixin c). Local Coercion base4 R (c : class_of R) : UnitRing.class_of R := @UnitRing.Class R (base c) (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.ComUnitRing.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @CountRing.ComRing.Pack cT class. Definition finComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @CountRing.UnitRing.Pack cT class. Definition finUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @CountRing.ComUnitRing.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition comUnitRing_finType := @Finite.Pack comUnitRingType (fin_ class). Definition comUnitRing_baseFinGroupType := base_group comUnitRingType zmodType finType. Definition comUnitRing_finGroupType := fin_group comUnitRing_baseFinGroupType zmodType. Definition comUnitRing_finZmodType := @Zmodule.Pack comUnitRingType class. Definition comUnitRing_finRingType := @Ring.Pack comUnitRingType class. Definition comUnitRing_finComRingType := @ComRing.Pack comUnitRingType class. Definition comUnitRing_finUnitRingType := @UnitRing.Pack comUnitRingType class. Definition countComUnitRing_finType := @Finite.Pack countComUnitRingType (fin_ class). Definition countComUnitRing_baseFinGroupType := base_group countComUnitRingType zmodType finType. Definition countComUnitRing_finGroupType := fin_group countComUnitRing_baseFinGroupType zmodType. Definition countComUnitRing_finZmodType := @Zmodule.Pack countComUnitRingType class. Definition countComUnitRing_finRingType := @Ring.Pack countComUnitRingType class. Definition countComUnitRing_finComRingType := @ComRing.Pack countComUnitRingType class. Definition countComUnitRing_finUnitRingType := @UnitRing.Pack countComUnitRingType class. Definition unitRing_finComRingType := @ComRing.Pack unitRingType class. Definition countUnitRing_finComRingType := @ComRing.Pack countUnitRingType class. Definition comRing_finUnitRingType := @UnitRing.Pack comRingType class. Definition countComRing_finUnitRingType := @UnitRing.Pack countComRingType class. Definition finComRing_finUnitRingType := @UnitRing.Pack finComRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.ComUnitRing.class_of. Coercion base2 : class_of >-> CountRing.ComUnitRing.class_of. Coercion base3 : class_of >-> ComRing.class_of. Coercion base4 : class_of >-> UnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> CountRing.ComRing.type. Canonical countComRingType. Coercion finComRingType : type >-> ComRing.type. Canonical finComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> CountRing.UnitRing.type. Canonical countUnitRingType. Coercion finUnitRingType : type >-> UnitRing.type. Canonical finUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> CountRing.ComUnitRing.type. Canonical countComUnitRingType. Canonical comUnitRing_finType. Canonical comUnitRing_baseFinGroupType. Canonical comUnitRing_finGroupType. Canonical comUnitRing_finZmodType. Canonical comUnitRing_finRingType. Canonical comUnitRing_finComRingType. Canonical comUnitRing_finUnitRingType. Canonical countComUnitRing_finType. Canonical countComUnitRing_baseFinGroupType. Canonical countComUnitRing_finGroupType. Canonical countComUnitRing_finZmodType. Canonical countComUnitRing_finRingType. Canonical countComUnitRing_finComRingType. Canonical countComUnitRing_finUnitRingType. Canonical unitRing_finComRingType. Canonical countUnitRing_finComRingType. Canonical comRing_finUnitRingType. Canonical countComRing_finUnitRingType. Canonical finComRing_finUnitRingType. Notation finComUnitRingType := FinRing.ComUnitRing.type. Notation "[ 'finComUnitRingType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finComUnitRingType' 'of' T ]") : form_scope. End Exports. End ComUnitRing. Import ComUnitRing.Exports. Module IntegralDomain. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.IntegralDomain.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.IntegralDomain.class_of. Local Coercion base2 R (c : class_of R) : CountRing.IntegralDomain.class_of R := CountRing.IntegralDomain.Class c (mixin c). Local Coercion base3 R (c : class_of R) : ComUnitRing.class_of R := ComUnitRing.Class (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.IntegralDomain.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @CountRing.ComRing.Pack cT class. Definition finComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @CountRing.UnitRing.Pack cT class. Definition finUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @CountRing.ComUnitRing.Pack cT class. Definition finComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition countIdomainType := @CountRing.IntegralDomain.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition idomain_finType := @Finite.Pack idomainType (fin_ class). Definition idomain_baseFinGroupType := base_group idomainType zmodType finType. Definition idomain_finGroupType := fin_group idomain_baseFinGroupType zmodType. Definition idomain_finZmodType := @Zmodule.Pack idomainType class. Definition idomain_finRingType := @Ring.Pack idomainType class. Definition idomain_finUnitRingType := @UnitRing.Pack idomainType class. Definition idomain_finComRingType := @ComRing.Pack idomainType class. Definition idomain_finComUnitRingType := @ComUnitRing.Pack idomainType class. Definition countIdomain_finType := @Finite.Pack countIdomainType (fin_ class). Definition countIdomain_baseFinGroupType := base_group countIdomainType zmodType finType. Definition countIdomain_finGroupType := fin_group countIdomain_baseFinGroupType zmodType. Definition countIdomain_finZmodType := @Zmodule.Pack countIdomainType class. Definition countIdomain_finRingType := @Ring.Pack countIdomainType class. Definition countIdomain_finUnitRingType := @UnitRing.Pack countIdomainType class. Definition countIdomain_finComRingType := @ComRing.Pack countIdomainType class. Definition countIdomain_finComUnitRingType := @ComUnitRing.Pack countIdomainType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.IntegralDomain.class_of. Coercion base2 : class_of >-> CountRing.IntegralDomain.class_of. Coercion base3 : class_of >-> ComUnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> CountRing.ComRing.type. Canonical countComRingType. Coercion finComRingType : type >-> ComRing.type. Canonical finComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> CountRing.UnitRing.type. Canonical countUnitRingType. Coercion finUnitRingType : type >-> UnitRing.type. Canonical finUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> CountRing.ComUnitRing.type. Canonical countComUnitRingType. Coercion finComUnitRingType : type >-> ComUnitRing.type. Canonical finComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion countIdomainType : type >-> CountRing.IntegralDomain.type. Canonical countIdomainType. Canonical idomain_finType. Canonical idomain_baseFinGroupType. Canonical idomain_finGroupType. Canonical idomain_finZmodType. Canonical idomain_finRingType. Canonical idomain_finUnitRingType. Canonical idomain_finComRingType. Canonical idomain_finComUnitRingType. Canonical countIdomain_finType. Canonical countIdomain_baseFinGroupType. Canonical countIdomain_finGroupType. Canonical countIdomain_finZmodType. Canonical countIdomain_finRingType. Canonical countIdomain_finUnitRingType. Canonical countIdomain_finComRingType. Canonical countIdomain_finComUnitRingType. Notation finIdomainType := FinRing.IntegralDomain.type. Notation "[ 'finIdomainType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finIdomainType' 'of' T ]") : form_scope. End Exports. End IntegralDomain. Import IntegralDomain.Exports. Module Field. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : GRing.Field.class_of R; mixin : mixin_of R base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Field.class_of. Local Coercion base2 R (c : class_of R) : CountRing.Field.class_of R := CountRing.Field.Class c (mixin c). Local Coercion base3 R (c : class_of R) : IntegralDomain.class_of R := IntegralDomain.Class (mixin c). Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Definition pack := gen_pack Pack Class GRing.Field.class. Variable cT : type. Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition countComRingType := @CountRing.ComRing.Pack cT class. Definition finComRingType := @ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @CountRing.UnitRing.Pack cT class. Definition finUnitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition countComUnitRingType := @CountRing.ComUnitRing.Pack cT class. Definition finComUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition countIdomainType := @CountRing.IntegralDomain.Pack cT class. Definition finIdomainType := @IntegralDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition countFieldType := @CountRing.Field.Pack cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition field_finType := @Finite.Pack fieldType (fin_ class). Definition field_baseFinGroupType := base_group fieldType zmodType finType. Definition field_finGroupType := fin_group field_baseFinGroupType zmodType. Definition field_finZmodType := @Zmodule.Pack fieldType class. Definition field_finRingType := @Ring.Pack fieldType class. Definition field_finUnitRingType := @UnitRing.Pack fieldType class. Definition field_finComRingType := @ComRing.Pack fieldType class. Definition field_finComUnitRingType := @ComUnitRing.Pack fieldType class. Definition field_finIdomainType := @IntegralDomain.Pack fieldType class. Definition countField_finType := @Finite.Pack countFieldType (fin_ class). Definition countField_baseFinGroupType := base_group countFieldType zmodType finType. Definition countField_finGroupType := fin_group countField_baseFinGroupType zmodType. Definition countField_finZmodType := @Zmodule.Pack countFieldType class. Definition countField_finRingType := @Ring.Pack countFieldType class. Definition countField_finUnitRingType := @UnitRing.Pack countFieldType class. Definition countField_finComRingType := @ComRing.Pack countFieldType class. Definition countField_finComUnitRingType := @ComUnitRing.Pack countFieldType class. Definition countField_finIdomainType := @IntegralDomain.Pack countFieldType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Field.class_of. Coercion base2 : class_of >-> CountRing.Field.class_of. Coercion base3 : class_of >-> IntegralDomain.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion comRingType : type >-> GRing.ComRing.type. Canonical comRingType. Coercion countComRingType : type >-> CountRing.ComRing.type. Canonical countComRingType. Coercion finComRingType : type >-> ComRing.type. Canonical finComRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> CountRing.UnitRing.type. Canonical countUnitRingType. Coercion finUnitRingType : type >-> UnitRing.type. Canonical finUnitRingType. Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. Canonical comUnitRingType. Coercion countComUnitRingType : type >-> CountRing.ComUnitRing.type. Canonical countComUnitRingType. Coercion finComUnitRingType : type >-> ComUnitRing.type. Canonical finComUnitRingType. Coercion idomainType : type >-> GRing.IntegralDomain.type. Canonical idomainType. Coercion countIdomainType : type >-> CountRing.IntegralDomain.type. Canonical countIdomainType. Coercion finIdomainType : type >-> IntegralDomain.type. Canonical finIdomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion countFieldType : type >-> CountRing.Field.type. Canonical countFieldType. Canonical field_finType. Canonical field_baseFinGroupType. Canonical field_finGroupType. Canonical field_finZmodType. Canonical field_finRingType. Canonical field_finUnitRingType. Canonical field_finComRingType. Canonical field_finComUnitRingType. Canonical field_finIdomainType. Canonical countField_finType. Canonical countField_baseFinGroupType. Canonical countField_finGroupType. Canonical countField_finZmodType. Canonical countField_finRingType. Canonical countField_finUnitRingType. Canonical countField_finComRingType. Canonical countField_finComUnitRingType. Canonical countField_finIdomainType. Notation finFieldType := FinRing.Field.type. Notation "[ 'finFieldType' 'of' T ]" := (do_pack pack T) (at level 0, format "[ 'finFieldType' 'of' T ]") : form_scope. End Exports. End Field. Import Field.Exports. Section DecideField. Variable F : Field.type. Fixpoint sat e f := match f with | GRing.Bool b => b | t1 == t2 => (GRing.eval e t1 == GRing.eval e t2)%bool | GRing.Unit t => GRing.eval e t \is a GRing.unit | f1 /\ f2 => sat e f1 && sat e f2 | f1 \/ f2 => sat e f1 || sat e f2 | f1 ==> f2 => (sat e f1 ==> sat e f2)%bool | ~ f1 => ~~ sat e f1 | ('exists 'X_k, f1) => [exists x : F, sat (set_nth 0%R e k x) f1] | ('forall 'X_k, f1) => [forall x : F, sat (set_nth 0%R e k x) f1] end%T. Lemma decidable : GRing.DecidableField.axiom sat. Proof. move=> e f; elim: f e; try by move=> f1 IH1 f2 IH2 e /=; case IH1; case IH2; constructor; tauto. - by move=> b e; apply: idP. - by move=> t1 t2 e; apply: eqP. - by move=> t e; apply: idP. - by move=> f IH e /=; case: IH; constructor. - by move=> i f IH e; apply: (iffP existsP) => [] [x fx]; exists x; apply/IH. by move=> i f IH e; apply: (iffP forallP) => f_ x; apply/IH. Qed. Definition DecidableFieldMixin := DecFieldMixin decidable. End DecideField. Module DecField. Section Joins. Variable cT : Field.type. Let class : Field.class_of cT := Field.class cT. Definition type := Eval hnf in DecFieldType cT (DecidableFieldMixin cT). Definition finType := @Finite.Pack type (fin_ class). Definition finZmodType := @Zmodule.Pack type class. Definition finRingType := @Ring.Pack type class. Definition finUnitRingType := @UnitRing.Pack type class. Definition finComRingType := @ComRing.Pack type class. Definition finComUnitRingType := @ComUnitRing.Pack type class. Definition finIdomainType := @IntegralDomain.Pack type class. Definition baseFinGroupType := base_group type finZmodType finZmodType. Definition finGroupType := fin_group baseFinGroupType cT. End Joins. Module Exports. Coercion type : Field.type >-> GRing.DecidableField.type. Canonical type. Canonical finType. Canonical finZmodType. Canonical finRingType. Canonical finUnitRingType. Canonical finComRingType. Canonical finComUnitRingType. Canonical finIdomainType. Canonical baseFinGroupType. Canonical finGroupType. End Exports. End DecField. Module Lmodule. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of M := Class { base : GRing.Lmodule.class_of R M; mixin : mixin_of M base }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Lmodule.class_of. Local Coercion base2 R (c : class_of R) : Zmodule.class_of R := Zmodule.Class (mixin c). Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (phR : phant R) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition pack := gen_pack (Pack phR) Class (@GRing.Lmodule.class R phR). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition lmod_countType := @Countable.Pack lmodType (fin_ class). Definition lmod_finType := @Finite.Pack lmodType (fin_ class). Definition lmod_baseFinGroupType := base_group lmodType zmodType finType. Definition lmod_finGroupType := fin_group lmod_baseFinGroupType zmodType. Definition lmod_countZmodType := @CountRing.Zmodule.Pack lmodType class. Definition lmod_finZmodType := @Zmodule.Pack lmodType class. End ClassDef. Module Import Exports. Coercion base : class_of >-> GRing.Lmodule.class_of. Coercion base2 : class_of >-> Zmodule.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion lmodType : type >-> GRing.Lmodule.type. Canonical lmodType. Canonical lmod_countType. Canonical lmod_finType. Canonical lmod_baseFinGroupType. Canonical lmod_finGroupType. Canonical lmod_countZmodType. Canonical lmod_finZmodType. Notation finLmodType R := (FinRing.Lmodule.type (Phant R)). Notation "[ 'finLmodType' R 'of' T ]" := (do_pack (@pack _ (Phant R)) T) (at level 0, format "[ 'finLmodType' R 'of' T ]") : form_scope. End Exports. End Lmodule. Import Lmodule.Exports. Module Lalgebra. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of M := Class { base : GRing.Lalgebra.class_of R M; mixin : mixin_of M base }. Unset Primitive Projections. Definition base2 M (c : class_of M) := Ring.Class (mixin c). Definition base3 M (c : class_of M) := @Lmodule.Class _ _ (base c) (mixin c). Local Coercion base : class_of >-> GRing.Lalgebra.class_of. Local Coercion base2 : class_of >-> Ring.class_of. Local Coercion base3 : class_of >-> Lmodule.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (phR : phant R) (cT : type phR). Definition pack := gen_pack (Pack phR) Class (@GRing.Lalgebra.class R phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. Definition finLmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @GRing.Lalgebra.Pack R phR cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition lalg_countType := @Countable.Pack lalgType (fin_ class). Definition lalg_finType := @Finite.Pack lalgType (fin_ class). Definition lalg_baseFinGroupType := base_group lalgType zmodType finType. Definition lalg_finGroupType := fin_group lalg_baseFinGroupType zmodType. Definition lalg_countZmodType := @CountRing.Zmodule.Pack lalgType class. Definition lalg_finZmodType := @Zmodule.Pack lalgType class. Definition lalg_finLmodType := @Lmodule.Pack R phR lalgType class. Definition lalg_countRingType := @CountRing.Ring.Pack lalgType class. Definition lalg_finRingType := @Ring.Pack lalgType class. Definition lmod_countRingType := @CountRing.Ring.Pack lmodType class. Definition lmod_finRingType := @Ring.Pack lmodType class. Definition finLmod_ringType := @GRing.Ring.Pack finLmodType class. Definition finLmod_countRingType := @CountRing.Ring.Pack finLmodType class. Definition finLmod_finRingType := @Ring.Pack finLmodType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Lalgebra.class_of. Coercion base2 : class_of >-> Ring.class_of. Coercion base3 : class_of >-> Lmodule.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion lmodType : type >-> GRing.Lmodule.type. Canonical lmodType. Coercion finLmodType : type >-> Lmodule.type. Canonical finLmodType. Coercion lalgType : type >-> GRing.Lalgebra.type. Canonical lalgType. Canonical lalg_countType. Canonical lalg_finType. Canonical lalg_baseFinGroupType. Canonical lalg_finGroupType. Canonical lalg_countZmodType. Canonical lalg_finZmodType. Canonical lalg_finLmodType. Canonical lalg_countRingType. Canonical lalg_finRingType. Canonical lmod_countRingType. Canonical lmod_finRingType. Canonical finLmod_ringType. Canonical finLmod_countRingType. Canonical finLmod_finRingType. Notation finLalgType R := (FinRing.Lalgebra.type (Phant R)). Notation "[ 'finLalgType' R 'of' T ]" := (do_pack (@pack _ (Phant R)) T) (at level 0, format "[ 'finLalgType' R 'of' T ]") : form_scope. End Exports. End Lalgebra. Import Lalgebra.Exports. Module Algebra. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of M := Class { base : GRing.Algebra.class_of R M; mixin : mixin_of M base }. Unset Primitive Projections. Definition base2 M (c : class_of M) := Lalgebra.Class (mixin c). Local Coercion base : class_of >-> GRing.Algebra.class_of. Local Coercion base2 : class_of >->Lalgebra.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (phR : phant R) (cT : type phR). Definition pack := gen_pack (Pack phR) Class (@GRing.Algebra.class R phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. Definition finLmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @GRing.Lalgebra.Pack R phR cT class. Definition finLalgType := @Lalgebra.Pack R phR cT class. Definition algType := @GRing.Algebra.Pack R phR cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition alg_countType := @Countable.Pack algType (fin_ class). Definition alg_finType := @Finite.Pack algType (fin_ class). Definition alg_baseFinGroupType := base_group algType zmodType finType. Definition alg_finGroupType := fin_group alg_baseFinGroupType zmodType. Definition alg_countZmodType := @CountRing.Zmodule.Pack algType class. Definition alg_finZmodType := @Zmodule.Pack algType class. Definition alg_countRingType := @CountRing.Ring.Pack algType class. Definition alg_finRingType := @Ring.Pack algType class. Definition alg_finLmodType := @Lmodule.Pack R phR algType class. Definition alg_finLalgType := @Lalgebra.Pack R phR algType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.Algebra.class_of. Coercion base2 : class_of >-> Lalgebra.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion lmodType : type >-> GRing.Lmodule.type. Canonical lmodType. Coercion finLmodType : type >-> Lmodule.type. Canonical finLmodType. Coercion lalgType : type >-> GRing.Lalgebra.type. Canonical lalgType. Coercion finLalgType : type >-> Lalgebra.type. Canonical finLalgType. Coercion algType : type >-> GRing.Algebra.type. Canonical algType. Canonical alg_countType. Canonical alg_finType. Canonical alg_baseFinGroupType. Canonical alg_finGroupType. Canonical alg_countZmodType. Canonical alg_finZmodType. Canonical alg_countRingType. Canonical alg_finRingType. Canonical alg_finLmodType. Canonical alg_finLalgType. Notation finAlgType R := (type (Phant R)). Notation "[ 'finAlgType' R 'of' T ]" := (do_pack (@pack _ (Phant R)) T) (at level 0, format "[ 'finAlgType' R 'of' T ]") : form_scope. End Exports. End Algebra. Import Algebra.Exports. Module UnitAlgebra. Section ClassDef. Variable R : unitRingType. Set Primitive Projections. Record class_of M := Class { base : GRing.UnitAlgebra.class_of R M; mixin : mixin_of M base }. Unset Primitive Projections. Definition base2 M (c : class_of M) := Algebra.Class (mixin c). Definition base3 M (c : class_of M) := @UnitRing.Class _ (base c) (mixin c). Local Coercion base : class_of >-> GRing.UnitAlgebra.class_of. Local Coercion base2 : class_of >-> Algebra.class_of. Local Coercion base3 : class_of >-> UnitRing.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (phR : phant R) (cT : type phR). Definition pack := gen_pack (Pack phR) Class (@GRing.UnitAlgebra.class R phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (fin_ class). Definition finType := @Finite.Pack cT (fin_ class). Definition zmodType := @GRing.Zmodule.Pack cT class. Definition countZmodType := @CountRing.Zmodule.Pack cT class. Definition finZmodType := @Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition countRingType := @CountRing.Ring.Pack cT class. Definition finRingType := @Ring.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition countUnitRingType := @CountRing.UnitRing.Pack cT class. Definition finUnitRingType := @UnitRing.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. Definition finLmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @GRing.Lalgebra.Pack R phR cT class. Definition finLalgType := @Lalgebra.Pack R phR cT class. Definition algType := @GRing.Algebra.Pack R phR cT class. Definition finAlgType := @Algebra.Pack R phR cT class. Definition unitAlgType := @GRing.UnitAlgebra.Pack R phR cT class. Definition baseFinGroupType := base_group cT zmodType finType. Definition finGroupType := fin_group baseFinGroupType zmodType. Definition unitAlg_countType := @Countable.Pack unitAlgType (fin_ class). Definition unitAlg_finType := @Finite.Pack unitAlgType (fin_ class). Definition unitAlg_baseFinGroupType := base_group unitAlgType zmodType finType. Definition unitAlg_finGroupType := fin_group unitAlg_baseFinGroupType zmodType. Definition unitAlg_countZmodType := @CountRing.Zmodule.Pack unitAlgType class. Definition unitAlg_finZmodType := @Zmodule.Pack unitAlgType class. Definition unitAlg_countRingType := @CountRing.Ring.Pack unitAlgType class. Definition unitAlg_finRingType := @Ring.Pack unitAlgType class. Definition unitAlg_countUnitRingType := @CountRing.UnitRing.Pack unitAlgType class. Definition unitAlg_finUnitRingType := @UnitRing.Pack unitAlgType class. Definition unitAlg_finLmodType := @Lmodule.Pack R phR unitAlgType class. Definition unitAlg_finLalgType := @Lalgebra.Pack R phR unitAlgType class. Definition unitAlg_finAlgType := @Algebra.Pack R phR unitAlgType class. Definition unitRing_finLmodType := @Lmodule.Pack R phR unitRingType class. Definition unitRing_finLalgType := @Lalgebra.Pack R phR unitRingType class. Definition unitRing_finAlgType := @Algebra.Pack R phR unitRingType class. Definition countUnitRing_lmodType := @GRing.Lmodule.Pack R phR countUnitRingType class. Definition countUnitRing_finLmodType := @Lmodule.Pack R phR countUnitRingType class. Definition countUnitRing_lalgType := @GRing.Lalgebra.Pack R phR countUnitRingType class. Definition countUnitRing_finLalgType := @Lalgebra.Pack R phR countUnitRingType class. Definition countUnitRing_algType := @GRing.Algebra.Pack R phR countUnitRingType class. Definition countUnitRing_finAlgType := @Algebra.Pack R phR countUnitRingType class. Definition finUnitRing_lmodType := @GRing.Lmodule.Pack R phR finUnitRingType class. Definition finUnitRing_finLmodType := @Lmodule.Pack R phR finUnitRingType class. Definition finUnitRing_lalgType := @GRing.Lalgebra.Pack R phR finUnitRingType class. Definition finUnitRing_finLalgType := @Lalgebra.Pack R phR finUnitRingType class. Definition finUnitRing_algType := @GRing.Algebra.Pack R phR finUnitRingType class. Definition finUnitRing_finAlgType := @Algebra.Pack R phR finUnitRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> GRing.UnitAlgebra.class_of. Coercion base2 : class_of >-> Algebra.class_of. Coercion base3 : class_of >-> UnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Coercion finType : type >-> Finite.type. Canonical finType. Coercion baseFinGroupType : type >-> FinGroup.base_type. Canonical baseFinGroupType. Coercion finGroupType : type >-> FinGroup.type. Canonical finGroupType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion countZmodType : type >-> CountRing.Zmodule.type. Canonical countZmodType. Coercion finZmodType : type >-> Zmodule.type. Canonical finZmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion countRingType : type >-> CountRing.Ring.type. Canonical countRingType. Coercion finRingType : type >-> Ring.type. Canonical finRingType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion countUnitRingType : type >-> CountRing.UnitRing.type. Canonical countUnitRingType. Coercion finUnitRingType : type >-> UnitRing.type. Canonical finUnitRingType. Coercion lmodType : type >-> GRing.Lmodule.type. Canonical lmodType. Coercion finLmodType : type >-> Lmodule.type. Canonical finLmodType. Coercion lalgType : type >-> GRing.Lalgebra.type. Canonical lalgType. Coercion finLalgType : type >-> Lalgebra.type. Canonical finLalgType. Coercion algType : type >-> GRing.Algebra.type. Canonical algType. Coercion finAlgType : type >-> Algebra.type. Canonical finAlgType. Coercion unitAlgType : type >-> GRing.UnitAlgebra.type. Canonical unitAlgType. Canonical unitAlg_countType. Canonical unitAlg_finType. Canonical unitAlg_baseFinGroupType. Canonical unitAlg_finGroupType. Canonical unitAlg_countZmodType. Canonical unitAlg_finZmodType. Canonical unitAlg_countRingType. Canonical unitAlg_finRingType. Canonical unitAlg_countUnitRingType. Canonical unitAlg_finUnitRingType. Canonical unitAlg_finLmodType. Canonical unitAlg_finLalgType. Canonical unitAlg_finAlgType. Canonical unitRing_finLmodType. Canonical unitRing_finLalgType. Canonical unitRing_finAlgType. Canonical countUnitRing_lmodType. Canonical countUnitRing_finLmodType. Canonical countUnitRing_lalgType. Canonical countUnitRing_finLalgType. Canonical countUnitRing_algType. Canonical countUnitRing_finAlgType. Canonical finUnitRing_lmodType. Canonical finUnitRing_finLmodType. Canonical finUnitRing_lalgType. Canonical finUnitRing_finLalgType. Canonical finUnitRing_algType. Canonical finUnitRing_finAlgType. Notation finUnitAlgType R := (type (Phant R)). Notation "[ 'finUnitAlgType' R 'of' T ]" := (do_pack (@pack _ (Phant R)) T) (at level 0, format "[ 'finUnitAlgType' R 'of' T ]") : form_scope. End Exports. End UnitAlgebra. Import UnitAlgebra.Exports. Module Theory. Definition zmod1gE := zmod1gE. Definition zmodVgE := zmodVgE. Definition zmodMgE := zmodMgE. Definition zmodXgE := zmodXgE. Definition zmod_mulgC := zmod_mulgC. Definition zmod_abelian := zmod_abelian. Definition val_unit1 := val_unit1. Definition val_unitM := val_unitM. Definition val_unitX := val_unitX. Definition val_unitV := val_unitV. Definition unit_actE := unit_actE. End Theory. End FinRing. Import FinRing. Export Zmodule.Exports Ring.Exports ComRing.Exports. Export UnitRing.Exports UnitsGroupExports ComUnitRing.Exports. Export IntegralDomain.Exports Field.Exports DecField.Exports. Export Lmodule.Exports Lalgebra.Exports Algebra.Exports UnitAlgebra.Exports. Notation "{ 'unit' R }" := (unit_of (Phant R)) (at level 0, format "{ 'unit' R }") : type_scope. Prenex Implicits FinRing.uval. Notation "''U'" := (unit_action _) (at level 8) : action_scope. Notation "''U'" := (unit_groupAction _) (at level 8) : groupAction_scope. math-comp-mathcomp-1.12.0/mathcomp/algebra/fraction.v000066400000000000000000000323101375767750300225120ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq. From mathcomp Require Import ssrAC choice tuple bigop ssralg poly polydiv. From mathcomp Require Import generic_quotient. (* This file builds the field of fraction of any integral domain. *) (* The main result of this file is the existence of the field *) (* and of the tofrac function which is a injective ring morphism from R *) (* to its fraction field {fraction R} *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. Local Open Scope quotient_scope. Reserved Notation "{ 'ratio' T }" (at level 0, format "{ 'ratio' T }"). Reserved Notation "{ 'fraction' T }" (at level 0, format "{ 'fraction' T }"). Reserved Notation "x %:F" (at level 2, format "x %:F"). Section FracDomain. Variable R : ringType. (* ratios are pairs of R, such that the second member is nonzero *) Inductive ratio := mkRatio { frac :> R * R; _ : frac.2 != 0 }. Definition ratio_of of phant R := ratio. Local Notation "{ 'ratio' T }" := (ratio_of (Phant T)). Canonical ratio_subType := Eval hnf in [subType for frac]. Canonical ratio_of_subType := Eval hnf in [subType of {ratio R}]. Definition ratio_EqMixin := [eqMixin of ratio by <:]. Canonical ratio_eqType := EqType ratio ratio_EqMixin. Canonical ratio_of_eqType := Eval hnf in [eqType of {ratio R}]. Definition ratio_ChoiceMixin := [choiceMixin of ratio by <:]. Canonical ratio_choiceType := ChoiceType ratio ratio_ChoiceMixin. Canonical ratio_of_choiceType := Eval hnf in [choiceType of {ratio R}]. Lemma denom_ratioP : forall f : ratio, f.2 != 0. Proof. by case. Qed. Definition ratio0 := (@mkRatio (0, 1) (oner_neq0 _)). Definition Ratio x y : {ratio R} := insubd ratio0 (x, y). Lemma numer_Ratio x y : y != 0 -> (Ratio x y).1 = x. Proof. by move=> ny0; rewrite /Ratio /insubd insubT. Qed. Lemma denom_Ratio x y : y != 0 -> (Ratio x y).2 = y. Proof. by move=> ny0; rewrite /Ratio /insubd insubT. Qed. Definition numden_Ratio := (numer_Ratio, denom_Ratio). Variant Ratio_spec (n d : R) : {ratio R} -> R -> R -> Type := | RatioNull of d = 0 : Ratio_spec n d ratio0 n 0 | RatioNonNull (d_neq0 : d != 0) : Ratio_spec n d (@mkRatio (n, d) d_neq0) n d. Lemma RatioP n d : Ratio_spec n d (Ratio n d) n d. Proof. rewrite /Ratio /insubd; case: insubP=> /= [x /= d_neq0 hx|]. have ->: x = @mkRatio (n, d) d_neq0 by apply: val_inj. by constructor. by rewrite negbK=> /eqP hx; rewrite {2}hx; constructor. Qed. Lemma Ratio0 x : Ratio x 0 = ratio0. Proof. by rewrite /Ratio /insubd; case: insubP; rewrite //= eqxx. Qed. End FracDomain. Notation "{ 'ratio' T }" := (ratio_of (Phant T)). Identity Coercion type_fracdomain_of : ratio_of >-> ratio. Notation "'\n_' x" := (frac x).1 (at level 8, x at level 2, format "'\n_' x"). Notation "'\d_' x" := (frac x).2 (at level 8, x at level 2, format "'\d_' x"). Module FracField. Section FracField. Variable R : idomainType. Local Notation frac := (R * R). Local Notation dom := (ratio R). Local Notation domP := denom_ratioP. Implicit Types x y z : dom. (* We define a relation in ratios *) Local Notation equivf_notation x y := (\n_x * \d_y == \d_x * \n_y). Definition equivf x y := equivf_notation x y. Lemma equivfE x y : equivf x y = equivf_notation x y. Proof. by []. Qed. Lemma equivf_refl : reflexive equivf. Proof. by move=> x; rewrite /equivf mulrC. Qed. Lemma equivf_sym : symmetric equivf. Proof. by move=> x y; rewrite /equivf eq_sym; congr (_==_); rewrite mulrC. Qed. Lemma equivf_trans : transitive equivf. Proof. move=> [x Px] [y Py] [z Pz]; rewrite /equivf /= mulrC => /eqP xy /eqP yz. by rewrite -(inj_eq (mulfI Px)) mulrA xy -mulrA yz mulrCA. Qed. (* we show that equivf is an equivalence *) Canonical equivf_equiv := EquivRel equivf equivf_refl equivf_sym equivf_trans. Definition type := {eq_quot equivf}. Definition type_of of phant R := type. Notation "{ 'fraction' T }" := (type_of (Phant T)). (* we recover some structure for the quotient *) Canonical frac_quotType := [quotType of type]. Canonical frac_eqType := [eqType of type]. Canonical frac_choiceType := [choiceType of type]. Canonical frac_eqQuotType := [eqQuotType equivf of type]. Canonical frac_of_quotType := [quotType of {fraction R}]. Canonical frac_of_eqType := [eqType of {fraction R}]. Canonical frac_of_choiceType := [choiceType of {fraction R}]. Canonical frac_of_eqQuotType := [eqQuotType equivf of {fraction R}]. (* we explain what was the equivalence on the quotient *) Lemma equivf_def (x y : ratio R) : x == y %[mod type] = (\n_x * \d_y == \d_x * \n_y). Proof. by rewrite eqmodE. Qed. Lemma equivf_r x : \n_x * \d_(repr (\pi_type x)) = \d_x * \n_(repr (\pi_type x)). Proof. by apply/eqP; rewrite -equivf_def reprK. Qed. Lemma equivf_l x : \n_(repr (\pi_type x)) * \d_x = \d_(repr (\pi_type x)) * \n_x. Proof. by apply/eqP; rewrite -equivf_def reprK. Qed. Lemma numer0 x : (\n_x == 0) = (x == (ratio0 R) %[mod_eq equivf]). Proof. by rewrite eqmodE /= !equivfE // mulr1 mulr0. Qed. Lemma Ratio_numden : forall x, Ratio \n_x \d_x = x. Proof. case=> [[n d] /= nd]; rewrite /Ratio /insubd; apply: val_inj=> /=. by case: insubP=> //=; rewrite nd. Qed. Definition tofrac := lift_embed {fraction R} (fun x : R => Ratio x 1). Canonical tofrac_pi_morph := PiEmbed tofrac. Notation "x %:F" := (@tofrac x). Implicit Types a b c : type. Definition addf x y : dom := Ratio (\n_x * \d_y + \n_y * \d_x) (\d_x * \d_y). Definition add := lift_op2 {fraction R} addf. Lemma pi_add : {morph \pi : x y / addf x y >-> add x y}. Proof. move=> x y; unlock add; apply/eqmodP; rewrite /= equivfE /addf /=. rewrite !numden_Ratio ?mulf_neq0 ?domP // mulrDr mulrDl; apply/eqP. symmetry; rewrite (AC (2*2)%AC (3*1*2*4)%AC) (AC (2*2)%AC (3*2*1*4)%AC)/=. by rewrite !equivf_l (ACl ((2*3)*(1*4))%AC) (ACl ((2*3)*(4*1))%AC)/=. Qed. Canonical pi_add_morph := PiMorph2 pi_add. Definition oppf x : dom := Ratio (- \n_x) \d_x. Definition opp := lift_op1 {fraction R} oppf. Lemma pi_opp : {morph \pi : x / oppf x >-> opp x}. Proof. move=> x; unlock opp; apply/eqmodP; rewrite /= /equivf /oppf /=. by rewrite !numden_Ratio ?(domP,mulf_neq0) // mulNr mulrN -equivf_r. Qed. Canonical pi_opp_morph := PiMorph1 pi_opp. Definition mulf x y : dom := Ratio (\n_x * \n_y) (\d_x * \d_y). Definition mul := lift_op2 {fraction R} mulf. Lemma pi_mul : {morph \pi : x y / mulf x y >-> mul x y}. Proof. move=> x y; unlock mul; apply/eqmodP=> /=. rewrite equivfE /= /addf /= !numden_Ratio ?mulf_neq0 ?domP //. by rewrite mulrACA !equivf_r mulrACA. Qed. Canonical pi_mul_morph := PiMorph2 pi_mul. Definition invf x : dom := Ratio \d_x \n_x. Definition inv := lift_op1 {fraction R} invf. Lemma pi_inv : {morph \pi : x / invf x >-> inv x}. Proof. move=> x; unlock inv; apply/eqmodP=> /=; rewrite equivfE /invf eq_sym. do 2?case: RatioP=> /= [/eqP|]; rewrite ?mul0r ?mul1r -?equivf_def ?numer0 ?reprK //. by move=> hx /eqP hx'; rewrite hx' eqxx in hx. by move=> /eqP ->; rewrite eqxx. Qed. Canonical pi_inv_morph := PiMorph1 pi_inv. Lemma addA : associative add. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; rewrite !piE. rewrite /addf /= !numden_Ratio ?mulf_neq0 ?domP // !mulrDl. by rewrite !mulrA !addrA ![_ * _ * \d_x]mulrAC. Qed. Lemma addC : commutative add. Proof. by elim/quotW=> x; elim/quotW=> y; rewrite !piE /addf addrC [\d__ * _]mulrC. Qed. Lemma add0_l : left_id 0%:F add. Proof. elim/quotW=> x; rewrite !piE /addf !numden_Ratio ?oner_eq0 //. by rewrite mul0r mul1r mulr1 add0r Ratio_numden. Qed. Lemma addN_l : left_inverse 0%:F opp add. Proof. elim/quotW=> x; apply/eqP; rewrite piE /equivf. rewrite /addf /oppf !numden_Ratio ?(oner_eq0, mulf_neq0, domP) //. by rewrite mulr1 mulr0 mulNr addNr. Qed. (* fracions form an abelian group *) Definition frac_zmodMixin := ZmodMixin addA addC add0_l addN_l. Canonical frac_zmodType := Eval hnf in ZmodType type frac_zmodMixin. Lemma mulA : associative mul. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; rewrite !piE. by rewrite /mulf !numden_Ratio ?mulf_neq0 ?domP // !mulrA. Qed. Lemma mulC : commutative mul. Proof. elim/quotW=> x; elim/quotW=> y; rewrite !piE /mulf. by rewrite [_ * (\d_x)]mulrC [_ * (\n_x)]mulrC. Qed. Lemma mul1_l : left_id 1%:F mul. Proof. elim/quotW=> x; rewrite !piE /mulf. by rewrite !numden_Ratio ?oner_eq0 // !mul1r Ratio_numden. Qed. Lemma mul_addl : left_distributive mul add. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; apply/eqP. rewrite !piE /equivf /mulf /addf !numden_Ratio ?mulf_neq0 ?domP //; apply/eqP. rewrite !(mulrDr, mulrDl) (AC (3*(2*2))%AC (4*2*7*((1*3)*(6*5)))%AC)/=. by rewrite [X in _ + X](AC (3*(2*2))%AC (4*6*7*((1*3)*(2*5)))%AC)/=. Qed. Lemma nonzero1 : 1%:F != 0%:F :> type. Proof. by rewrite piE equivfE !numden_Ratio ?mul1r ?oner_eq0. Qed. (* fracions form a commutative ring *) Definition frac_comRingMixin := ComRingMixin mulA mulC mul1_l mul_addl nonzero1. Canonical frac_ringType := Eval hnf in RingType type frac_comRingMixin. Canonical frac_comRingType := Eval hnf in ComRingType type mulC. Lemma mulV_l : forall a, a != 0%:F -> mul (inv a) a = 1%:F. Proof. elim/quotW=> x /=; rewrite !piE. rewrite /equivf !numden_Ratio ?oner_eq0 // mulr1 mulr0=> nx0. apply/eqmodP; rewrite /= equivfE. by rewrite !numden_Ratio ?(oner_eq0, mulf_neq0, domP) // !mulr1 mulrC. Qed. Lemma inv0 : inv 0%:F = 0%:F. Proof. rewrite !piE /invf !numden_Ratio ?oner_eq0 // /Ratio /insubd. do 2?case: insubP; rewrite //= ?eqxx ?oner_eq0 // => u _ hu _. by congr \pi; apply: val_inj; rewrite /= hu. Qed. (* fractions form a ring with explicit unit *) Definition RatFieldUnitMixin := FieldUnitMixin mulV_l inv0. Canonical frac_unitRingType := Eval hnf in UnitRingType type RatFieldUnitMixin. Canonical frac_comUnitRingType := [comUnitRingType of type]. Lemma field_axiom : GRing.Field.mixin_of frac_unitRingType. Proof. exact. Qed. (* fractions form a field *) Definition RatFieldIdomainMixin := (FieldIdomainMixin field_axiom). Canonical frac_idomainType := Eval hnf in IdomainType type (FieldIdomainMixin field_axiom). Canonical frac_fieldType := FieldType type field_axiom. End FracField. End FracField. Notation "{ 'fraction' T }" := (FracField.type_of (Phant T)). Notation equivf := (@FracField.equivf _). Hint Resolve denom_ratioP : core. Section Canonicals. Variable R : idomainType. (* reexporting the structures *) Canonical FracField.frac_quotType. Canonical FracField.frac_eqType. Canonical FracField.frac_choiceType. Canonical FracField.frac_zmodType. Canonical FracField.frac_ringType. Canonical FracField.frac_comRingType. Canonical FracField.frac_unitRingType. Canonical FracField.frac_comUnitRingType. Canonical FracField.frac_idomainType. Canonical FracField.frac_fieldType. Canonical FracField.tofrac_pi_morph. Canonical frac_of_quotType := Eval hnf in [quotType of {fraction R}]. Canonical frac_of_eqType := Eval hnf in [eqType of {fraction R}]. Canonical frac_of_choiceType := Eval hnf in [choiceType of {fraction R}]. Canonical frac_of_zmodType := Eval hnf in [zmodType of {fraction R}]. Canonical frac_of_ringType := Eval hnf in [ringType of {fraction R}]. Canonical frac_of_comRingType := Eval hnf in [comRingType of {fraction R}]. Canonical frac_of_unitRingType := Eval hnf in [unitRingType of {fraction R}]. Canonical frac_of_comUnitRingType := Eval hnf in [comUnitRingType of {fraction R}]. Canonical frac_of_idomainType := Eval hnf in [idomainType of {fraction R}]. Canonical frac_of_fieldType := Eval hnf in [fieldType of {fraction R}]. End Canonicals. Section FracFieldTheory. Import FracField. Variable R : idomainType. Lemma Ratio_numden (x : {ratio R}) : Ratio \n_x \d_x = x. Proof. exact: FracField.Ratio_numden. Qed. (* exporting the embeding from R to {fraction R} *) Local Notation tofrac := (@FracField.tofrac R). Local Notation "x %:F" := (tofrac x). Lemma tofrac_is_additive: additive tofrac. Proof. move=> p q /=; unlock tofrac. rewrite -[X in _ = _ + X]pi_opp -[X in _ = X]pi_add. by rewrite /addf /oppf /= !numden_Ratio ?(oner_neq0, mul1r, mulr1). Qed. Canonical tofrac_additive := Additive tofrac_is_additive. Lemma tofrac_is_multiplicative: multiplicative tofrac. Proof. split=> [p q|//]; unlock tofrac; rewrite -[X in _ = X]pi_mul. by rewrite /mulf /= !numden_Ratio ?(oner_neq0, mul1r, mulr1). Qed. Canonical tofrac_rmorphism := AddRMorphism tofrac_is_multiplicative. (* tests *) Lemma tofrac0 : 0%:F = 0. Proof. exact: rmorph0. Qed. Lemma tofracN : {morph tofrac: x / - x}. Proof. exact: rmorphN. Qed. Lemma tofracD : {morph tofrac: x y / x + y}. Proof. exact: rmorphD. Qed. Lemma tofracB : {morph tofrac: x y / x - y}. Proof. exact: rmorphB. Qed. Lemma tofracMn n : {morph tofrac: x / x *+ n}. Proof. exact: rmorphMn. Qed. Lemma tofracMNn n : {morph tofrac: x / x *- n}. Proof. exact: rmorphMNn. Qed. Lemma tofrac1 : 1%:F = 1. Proof. exact: rmorph1. Qed. Lemma tofracM : {morph tofrac: x y / x * y}. Proof. exact: rmorphM. Qed. Lemma tofracX n : {morph tofrac: x / x ^+ n}. Proof. exact: rmorphX. Qed. Lemma tofrac_eq (p q : R): (p%:F == q%:F) = (p == q). Proof. apply/eqP/eqP=> [|->//]; unlock tofrac=> /eqmodP /eqP /=. by rewrite !numden_Ratio ?(oner_eq0, mul1r, mulr1). Qed. Lemma tofrac_eq0 (p : R): (p%:F == 0) = (p == 0). Proof. by rewrite tofrac_eq. Qed. End FracFieldTheory. math-comp-mathcomp-1.12.0/mathcomp/algebra/intdiv.v000066400000000000000000001332221375767750300222060ustar00rootroot00000000000000(* (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 order. From mathcomp Require Import ssralg poly ssrnum ssrint rat matrix. From mathcomp Require Import polydiv finalg perm zmodp mxalgebra vector. (******************************************************************************) (* This file provides various results on divisibility of integers. *) (* It defines, for m, n, d : int, *) (* (m %% d)%Z == the remainder of the Euclidean division of m by d; this is *) (* the least non-negative element of the coset m + dZ when *) (* d != 0, and m if d = 0. *) (* (m %/ d)%Z == the quotient of the Euclidean division of m by d, such *) (* that m = (m %/ d)%Z * d + (m %% d)%Z. Since for d != 0 the *) (* remainder is non-negative, (m %/ d)%Z is non-zero for *) (* (d %| m)%Z <=> m is divisible by d; dvdz d is the (collective) predicate *) (* for integers divisible by d, and (d %| m)%Z is actually *) (* (transposing) notation for m \in dvdz d. *) (* (m = n %[mod d])%Z, (m == n %[mod d])%Z, (m != n %[mod d])%Z *) (* m and n are (resp. compare, don't compare) equal mod d. *) (* gcdz m n == the (non-negative) greatest common divisor of m and n, *) (* with gcdz 0 0 = 0. *) (* coprimez m n <=> m and n are coprime. *) (* egcdz m n == the Bezout coefficients of the gcd of m and n: a pair *) (* (u, v) of coprime integers such that u*m + v*n = gcdz m n. *) (* Alternatively, a Bezoutz lemma states such u and v exist. *) (* zchinese m1 m2 n1 n2 == for coprime m1 and m2, a solution to the Chinese *) (* remainder problem for n1 and n2, i.e., and integer n such *) (* that n = n1 %[mod m1] and n = n2 %[mod m2]. *) (* zcontents p == the contents of p : {poly int}, that is, the gcd of the *) (* coefficients of p, with the lead coefficient of p, *) (* zprimitive p == the primitive part of p : {poly int}, i.e., p divided by *) (* its contents. *) (* inIntSpan X v <-> v is an integral linear combination of elements of *) (* X : seq V, where V is a zmodType. We prove that this is a *) (* decidable property for Q-vector spaces. *) (* int_Smith_normal_form :: a theorem asserting the existence of the Smith *) (* normal form for integer matrices. *) (* Note that many of the concepts and results in this file could and perhaps *) (* sould be generalized to the more general setting of integral, unique *) (* factorization, principal ideal, or Euclidean domains. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Theory. Local Open Scope ring_scope. Definition divz (m d : int) := let: (K, n) := match m with Posz n => (Posz, n) | Negz n => (Negz, n) end in sgz d * K (n %/ `|d|)%N. Definition modz (m d : int) : int := m - divz m d * d. Definition dvdz d m := (`|d| %| `|m|)%N. Definition gcdz m n := (gcdn `|m| `|n|)%:Z. Definition egcdz m n : int * int := if m == 0 then (0, (-1) ^+ (n < 0)%R) else let: (u, v) := egcdn `|m| `|n| in (sgz m * u, - (-1) ^+ (n < 0)%R * v%:Z). Definition coprimez m n := (gcdz m n == 1). Infix "%/" := divz : int_scope. Infix "%%" := modz : int_scope. Notation "d %| m" := (m \in dvdz d) : int_scope. Notation "m = n %[mod d ]" := (modz m d = modz n d) : int_scope. Notation "m == n %[mod d ]" := (modz m d == modz n d) : int_scope. Notation "m <> n %[mod d ]" := (modz m d <> modz n d) : int_scope. Notation "m != n %[mod d ]" := (modz m d != modz n d) : int_scope. Lemma divz_nat (n d : nat) : (n %/ d)%Z = (n %/ d)%N. 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 : 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. Lemma div0z d : (0 %/ d)%Z = 0. Proof. by rewrite -(canLR (signrMK _) (divz_abs _ _)) (divz_nat 0) div0n mulr0. Qed. Lemma divNz_nat m d : (d > 0)%N -> (Negz m %/ d)%Z = - (m %/ d).+1%:Z. Proof. by case: d => // d _; apply: mul1r. Qed. Lemma divz_eq m d : m = (m %/ d)%Z * d + (m %% d)%Z. Proof. by rewrite addrC subrK. Qed. Lemma modzN m d : (m %% - d)%Z = (m %% d)%Z. Proof. by rewrite /modz divzN mulrNN. Qed. Lemma modz_abs m d : (m %% `|d|%N)%Z = (m %% d)%Z. Proof. by rewrite {2}[d]intEsign mulr_sign; case: ifP; rewrite ?modzN. Qed. Lemma modz_nat (m d : nat) : (m %% d)%Z = (m %% d)%N. Proof. by apply: (canLR (addrK _)); rewrite addrC divz_nat {1}(divn_eq m d). Qed. Lemma modNz_nat m d : (d > 0)%N -> (Negz m %% d)%Z = d%:Z - 1 - (m %% d)%:Z. Proof. rewrite /modz => /divNz_nat->; apply: (canLR (addrK _)). rewrite -!addrA -!opprD -!PoszD -opprB mulnSr !addnA PoszD addrK. by rewrite addnAC -addnA mulnC -divn_eq. Qed. Lemma modz_ge0 m d : d != 0 -> 0 <= (m %% d)%Z. Proof. rewrite -absz_gt0 -modz_abs => d_gt0. case: m => n; rewrite ?modNz_nat ?modz_nat // -addrA -opprD subr_ge0. by rewrite lez_nat ltn_mod. Qed. Lemma divz0 m : (m %/ 0)%Z = 0. Proof. by case: m. Qed. Lemma mod0z d : (0 %% d)%Z = 0. Proof. by rewrite /modz div0z mul0r subrr. Qed. Lemma modz0 m : (m %% 0)%Z = m. Proof. by rewrite /modz mulr0 subr0. Qed. Lemma divz_small m d : 0 <= m < `|d|%:Z -> (m %/ d)%Z = 0. Proof. rewrite -(canLR (signrMK _) (divz_abs _ _)); case: m => // n /divn_small. by rewrite divz_nat => ->; rewrite mulr0. Qed. Lemma divzMDl q m d : d != 0 -> ((q * d + m) %/ d)%Z = q + (m %/ d)%Z. Proof. 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. wlog q_gt0: q m / q >= 0; last case: q q_gt0 => // q _. move=> IH; case: q => n; first exact: IH; rewrite NegzE mulNr. by apply: canRL (addKr _) _; rewrite -IH ?addNKr. case: m => n; first by rewrite !divz_nat divnMDl. have [le_qd_n | lt_qd_n] := leqP (q * d) n. rewrite divNz_nat // NegzE -(subnKC le_qd_n) divnMDl //. by rewrite -!addnS !PoszD !opprD !addNKr divNz_nat. rewrite divNz_nat // NegzE -PoszM subzn // divz_nat. apply: canRL (addrK _) _; congr _%:Z; rewrite addnC -divnMDl // mulSnr. rewrite -{3}(subnKC (ltn_pmod n d_gt0)) addnA addnS -divn_eq addnAC. by rewrite subnKC // divnMDl // divn_small ?addn0 // subnSK ?ltn_mod ?leq_subr. Qed. Lemma mulzK m d : d != 0 -> (m * d %/ d)%Z = m. Proof. by move=> d_nz; rewrite -[m * d]addr0 divzMDl // div0z addr0. Qed. Lemma mulKz m d : d != 0 -> (d * m %/ d)%Z = m. Proof. by move=> d_nz; rewrite mulrC mulzK. Qed. Lemma expzB p m n : p != 0 -> (m >= n)%N -> p ^+ (m - n) = (p ^+ m %/ p ^+ n)%Z. Proof. by move=> p_nz /subnK{2}<-; rewrite exprD mulzK // expf_neq0. Qed. Lemma modz1 m : (m %% 1)%Z = 0. Proof. by case: m => n; rewrite (modNz_nat, modz_nat) ?modn1. Qed. Lemma divz1 m : (m %/ 1)%Z = m. Proof. by rewrite -{1}[m]mulr1 mulzK. Qed. Lemma divzz d : (d %/ d)%Z = (d != 0). Proof. by have [-> // | d_nz] := eqVneq; rewrite -{1}[d]mul1r mulzK. Qed. Lemma ltz_pmod m d : d > 0 -> (m %% d)%Z < d. Proof. case: m d => n [] // d d_gt0; first by rewrite modz_nat ltz_nat ltn_pmod. by rewrite modNz_nat // -lez_addr1 addrAC subrK ger_addl oppr_le0. Qed. Lemma ltz_mod m d : d != 0 -> (m %% d)%Z < `|d|. Proof. by rewrite -absz_gt0 -modz_abs => d_gt0; apply: ltz_pmod. Qed. 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 ?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]. Lemma divzMpr p m d : p > 0 -> (m * p %/ (d * p) = m %/ d)%Z. Proof. by move=> p_gt0; rewrite -!(mulrC p) divzMpl. Qed. Arguments divzMpr [p m d]. Lemma lez_floor m d : d != 0 -> (m %/ d)%Z * d <= m. Proof. by rewrite -subr_ge0; apply: modz_ge0. Qed. (* leq_mod does not extend to negative m. *) Lemma lez_div m d : (`|(m %/ d)%Z| <= `|m|)%N. Proof. wlog d_gt0: d / d > 0; last case: d d_gt0 => // d d_gt0. by move=> IH; case/intP: d => [|n|n]; rewrite ?divz0 ?divzN ?abszN // IH. case: m => n; first by rewrite divz_nat leq_div. by rewrite divNz_nat // NegzE !abszN ltnS leq_div. 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 ?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 -[_ < 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 !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. Lemma divzMA_ge0 m n p : n >= 0 -> (m %/ (n * p) = (m %/ n)%Z %/ p)%Z. 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 // ?gt_eqF //. rewrite [rhs in _ + rhs]divz_small ?addr0 // ltz_divLR // divz_ge0 //. by rewrite mulrC ltz_pmod ?modz_ge0 ?gt_eqF ?pmulr_lgt0. Qed. Lemma modz_small m d : 0 <= m < d -> (m %% d)%Z = m. Proof. by case: m d => //= m [] // d; rewrite modz_nat => /modn_small->. Qed. Lemma modz_mod m d : ((m %% d)%Z = m %[mod d])%Z. Proof. rewrite -!(modz_abs _ d); case: {d}`|d|%N => [|d]; first by rewrite !modz0. by rewrite modz_small ?modz_ge0 ?ltz_mod. Qed. Lemma modzMDl p m d : (p * d + m = m %[mod d])%Z. Proof. have [-> | d_nz] := eqVneq d 0; first by rewrite mulr0 add0r. by rewrite /modz divzMDl // mulrDl opprD addrACA subrr add0r. Qed. Lemma mulz_modr {p m d} : 0 < p -> p * (m %% d)%Z = ((p * m) %% (p * d))%Z. Proof. case: p => // p p_gt0; rewrite mulrBr; apply: canLR (addrK _) _. by rewrite mulrCA -(divzMpl p_gt0) subrK. Qed. Lemma mulz_modl {p m d} : 0 < p -> (m %% d)%Z * p = ((m * p) %% (d * p))%Z. Proof. by rewrite -!(mulrC p); apply: mulz_modr. Qed. Lemma modzDl m d : (d + m = m %[mod d])%Z. Proof. by rewrite -{1}[d]mul1r modzMDl. Qed. Lemma modzDr m d : (m + d = m %[mod d])%Z. Proof. by rewrite addrC modzDl. Qed. Lemma modzz d : (d %% d)%Z = 0. Proof. by rewrite -{1}[d]addr0 modzDl mod0z. Qed. Lemma modzMl p d : (p * d %% d)%Z = 0. Proof. by rewrite -[p * d]addr0 modzMDl mod0z. Qed. Lemma modzMr p d : (d * p %% d)%Z = 0. Proof. by rewrite mulrC modzMl. Qed. Lemma modzDml m n d : ((m %% d)%Z + n = m + n %[mod d])%Z. Proof. by rewrite {2}(divz_eq m d) -[_ * d + _ + n]addrA modzMDl. Qed. Lemma modzDmr m n d : (m + (n %% d)%Z = m + n %[mod d])%Z. Proof. by rewrite !(addrC m) modzDml. Qed. Lemma modzDm m n d : ((m %% d)%Z + (n %% d)%Z = m + n %[mod d])%Z. Proof. by rewrite modzDml modzDmr. Qed. Lemma eqz_modDl p m n d : (p + m == p + n %[mod d])%Z = (m == n %[mod d])%Z. Proof. have [-> | d_nz] := eqVneq d 0; first by rewrite !modz0 (inj_eq (addrI p)). apply/eqP/eqP=> eq_mn; last by rewrite -modzDmr eq_mn modzDmr. by rewrite -(addKr p m) -modzDmr eq_mn modzDmr addKr. Qed. Lemma eqz_modDr p m n d : (m + p == n + p %[mod d])%Z = (m == n %[mod d])%Z. Proof. by rewrite -!(addrC p) eqz_modDl. Qed. Lemma modzMml m n d : ((m %% d)%Z * n = m * n %[mod d])%Z. Proof. by rewrite {2}(divz_eq m d) mulrDl mulrAC modzMDl. Qed. Lemma modzMmr m n d : (m * (n %% d)%Z = m * n %[mod d])%Z. Proof. by rewrite !(mulrC m) modzMml. Qed. Lemma modzMm m n d : ((m %% d)%Z * (n %% d)%Z = m * n %[mod d])%Z. Proof. by rewrite modzMml modzMmr. Qed. Lemma modzXm k m d : ((m %% d)%Z ^+ k = m ^+ k %[mod d])%Z. Proof. by elim: k => // k IHk; rewrite !exprS -modzMmr IHk modzMm. Qed. Lemma modzNm m d : (- (m %% d)%Z = - m %[mod d])%Z. Proof. by rewrite -mulN1r modzMmr mulN1r. Qed. Lemma modz_absm m d : ((-1) ^+ (m < 0)%R * (m %% d)%Z = `|m|%:Z %[mod d])%Z. Proof. by rewrite modzMmr -abszEsign. Qed. (** Divisibility **) Fact dvdz_key d : pred_key (dvdz d). Proof. by []. Qed. Canonical dvdz_keyed d := KeyedPred (dvdz_key d). Lemma dvdzE d m : (d %| m)%Z = (`|d| %| `|m|)%N. Proof. by []. Qed. Lemma dvdz0 d : (d %| 0)%Z. Proof. exact: dvdn0. Qed. Lemma dvd0z n : (0 %| n)%Z = (n == 0). Proof. by rewrite -absz_eq0 -dvd0n. Qed. Lemma dvdz1 d : (d %| 1)%Z = (`|d|%N == 1%N). Proof. exact: dvdn1. Qed. Lemma dvd1z m : (1 %| m)%Z. Proof. exact: dvd1n. Qed. Lemma dvdzz m : (m %| m)%Z. Proof. exact: dvdnn. Qed. Lemma dvdz_mull d m n : (d %| n)%Z -> (d %| m * n)%Z. Proof. by rewrite !dvdzE abszM; apply: dvdn_mull. Qed. Lemma dvdz_mulr d m n : (d %| m)%Z -> (d %| m * n)%Z. Proof. by move=> d_m; rewrite mulrC dvdz_mull. Qed. Hint Resolve dvdz0 dvd1z dvdzz dvdz_mull dvdz_mulr : core. Lemma dvdz_mul d1 d2 m1 m2 : (d1 %| m1 -> d2 %| m2 -> d1 * d2 %| m1 * m2)%Z. Proof. by rewrite !dvdzE !abszM; apply: dvdn_mul. Qed. Lemma dvdz_trans n d m : (d %| n -> n %| m -> d %| m)%Z. Proof. by rewrite !dvdzE; apply: dvdn_trans. Qed. Lemma dvdzP d m : reflect (exists q, m = q * d) (d %| m)%Z. Proof. apply: (iffP dvdnP) => [] [q Dm]; last by exists `|q|%N; rewrite Dm abszM. exists ((-1) ^+ (m < 0)%R * q%:Z * (-1) ^+ (d < 0)%R). by rewrite -!mulrA -abszEsign -PoszM -Dm -intEsign. Qed. Arguments dvdzP {d m}. Lemma dvdz_mod0P d m : reflect (m %% d = 0)%Z (d %| m)%Z. Proof. apply: (iffP dvdzP) => [[q ->] | md0]; first by rewrite modzMl. by rewrite (divz_eq m d) md0 addr0; exists (m %/ d)%Z. Qed. Arguments dvdz_mod0P {d m}. Lemma dvdz_eq d m : (d %| m)%Z = ((m %/ d)%Z * d == m). Proof. by rewrite (sameP dvdz_mod0P eqP) subr_eq0 eq_sym. Qed. Lemma divzK d m : (d %| m)%Z -> (m %/ d)%Z * d = m. Proof. by rewrite dvdz_eq => /eqP. Qed. Lemma lez_divLR d m n : 0 < d -> (d %| m)%Z -> ((m %/ d)%Z <= n) = (m <= n * d). Proof. by move=> /ler_pmul2r <- /divzK->. Qed. Lemma ltz_divRL d m n : 0 < d -> (d %| m)%Z -> (n < m %/ d)%Z = (n * d < m). Proof. by move=> /ltr_pmul2r <- /divzK->. Qed. Lemma eqz_div d m n : d != 0 -> (d %| m)%Z -> (n == m %/ d)%Z = (n * d == m). Proof. by move=> /mulIf/inj_eq <- /divzK->. Qed. Lemma eqz_mul d m n : d != 0 -> (d %| m)%Z -> (m == n * d) = (m %/ d == n)%Z. Proof. by move=> d_gt0 dv_d_m; rewrite eq_sym -eqz_div // eq_sym. Qed. Lemma divz_mulAC d m n : (d %| m)%Z -> (m %/ d)%Z * n = (m * n %/ d)%Z. Proof. have [-> | d_nz] := eqVneq d 0; first by rewrite !divz0 mul0r. by move/divzK=> {2} <-; rewrite mulrAC mulzK. Qed. Lemma mulz_divA d m n : (d %| n)%Z -> m * (n %/ d)%Z = (m * n %/ d)%Z. Proof. by move=> dv_d_m; rewrite !(mulrC m) divz_mulAC. Qed. Lemma mulz_divCA d m n : (d %| m)%Z -> (d %| n)%Z -> m * (n %/ d)%Z = n * (m %/ d)%Z. Proof. by move=> dv_d_m dv_d_n; rewrite mulrC divz_mulAC ?mulz_divA. Qed. Lemma divzA m n p : (p %| n -> n %| m * p -> m %/ (n %/ p)%Z = m * p %/ n)%Z. Proof. move/divzK=> p_dv_n; have [->|] := eqVneq n 0; first by rewrite div0z !divz0. rewrite -{1 2}p_dv_n mulf_eq0 => /norP[pn_nz p_nz] /divzK; rewrite mulrA p_dv_n. by move/mulIf=> {1} <- //; rewrite mulzK. Qed. Lemma divzMA m n p : (n * p %| m -> m %/ (n * p) = (m %/ n)%Z %/ p)%Z. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite mulr0 !divz0. have [-> | nz_n] := eqVneq n 0; first by rewrite mul0r !divz0 div0z. by move/divzK=> {2} <-; rewrite mulrA mulrAC !mulzK. Qed. Lemma divzAC m n p : (n * p %| m -> (m %/ n)%Z %/ p = (m %/ p)%Z %/ n)%Z. Proof. by move=> np_dv_mn; rewrite -!divzMA // mulrC. Qed. Lemma divzMl p m d : p != 0 -> (d %| m -> p * m %/ (p * d) = m %/ d)%Z. Proof. have [-> | nz_d nz_p] := eqVneq d 0; first by rewrite mulr0 !divz0. by move/divzK=> {1}<-; rewrite mulrCA mulzK ?mulf_neq0. Qed. Lemma divzMr p m d : p != 0 -> (d %| m -> m * p %/ (d * p) = m %/ d)%Z. Proof. by rewrite -!(mulrC p); apply: divzMl. Qed. Lemma dvdz_mul2l p d m : p != 0 -> (p * d %| p * m)%Z = (d %| m)%Z. Proof. by rewrite !dvdzE -absz_gt0 !abszM; apply: dvdn_pmul2l. Qed. Arguments dvdz_mul2l [p d m]. Lemma dvdz_mul2r p d m : p != 0 -> (d * p %| m * p)%Z = (d %| m)%Z. Proof. by rewrite !dvdzE -absz_gt0 !abszM; apply: dvdn_pmul2r. Qed. Arguments dvdz_mul2r [p d m]. Lemma dvdz_exp2l p m n : (m <= n)%N -> (p ^+ m %| p ^+ n)%Z. Proof. by rewrite dvdzE !abszX; apply: dvdn_exp2l. Qed. Lemma dvdz_Pexp2l p m n : `|p| > 1 -> (p ^+ m %| p ^+ n)%Z = (m <= n)%N. Proof. by rewrite dvdzE !abszX ltz_nat; apply: dvdn_Pexp2l. Qed. Lemma dvdz_exp2r m n k : (m %| n -> m ^+ k %| n ^+ k)%Z. Proof. by rewrite !dvdzE !abszX; apply: dvdn_exp2r. Qed. Fact dvdz_zmod_closed d : zmod_closed (dvdz d). Proof. split=> [|_ _ /dvdzP[p ->] /dvdzP[q ->]]; first exact: dvdz0. by rewrite -mulrBl dvdz_mull. Qed. Canonical dvdz_addPred d := AddrPred (dvdz_zmod_closed d). Canonical dvdz_oppPred d := OpprPred (dvdz_zmod_closed d). Canonical dvdz_zmodPred d := ZmodPred (dvdz_zmod_closed d). Lemma dvdz_exp k d m : (0 < k)%N -> (d %| m -> d %| m ^+ k)%Z. Proof. by case: k => // k _ d_dv_m; rewrite exprS dvdz_mulr. Qed. Lemma eqz_mod_dvd d m n : (m == n %[mod d])%Z = (d %| m - n)%Z. Proof. apply/eqP/dvdz_mod0P=> eq_mn. by rewrite -modzDml eq_mn modzDml subrr mod0z. by rewrite -(subrK n m) -modzDml eq_mn add0r. Qed. Lemma divzDl m n d : (d %| m)%Z -> ((m + n) %/ d)%Z = (m %/ d)%Z + (n %/ d)%Z. Proof. have [-> | d_nz] := eqVneq d 0; first by rewrite !divz0. by move/divzK=> {1}<-; rewrite divzMDl. Qed. Lemma divzDr m n d : (d %| n)%Z -> ((m + n) %/ d)%Z = (m %/ d)%Z + (n %/ d)%Z. Proof. by move=> dv_n; rewrite addrC divzDl // addrC. Qed. Lemma Qint_dvdz (m d : int) : (d %| m)%Z -> ((m%:~R / d%:~R : rat) \is a Qint). Proof. case/dvdzP=> z ->; rewrite rmorphM /=; have [->|dn0] := eqVneq d 0. by rewrite mulr0 mul0r. by rewrite mulfK ?intr_eq0 // rpred_int. Qed. Lemma Qnat_dvd (m d : nat) : (d %| m)%N -> ((m%:R / d%:R : rat) \is a Qnat). Proof. move=> h; rewrite Qnat_def divr_ge0 ?ler0n // -[m%:R]/(m%:~R) -[d%:R]/(d%:~R). by rewrite Qint_dvdz. Qed. (* Greatest common divisor *) Lemma gcdzz m : gcdz m m = `|m|%:Z. Proof. by rewrite /gcdz gcdnn. Qed. Lemma gcdzC : commutative gcdz. Proof. by move=> m n; rewrite /gcdz gcdnC. Qed. Lemma gcd0z m : gcdz 0 m = `|m|%:Z. Proof. by rewrite /gcdz gcd0n. Qed. Lemma gcdz0 m : gcdz m 0 = `|m|%:Z. Proof. by rewrite /gcdz gcdn0. Qed. Lemma gcd1z : left_zero 1 gcdz. Proof. by move=> m; rewrite /gcdz gcd1n. Qed. Lemma gcdz1 : right_zero 1 gcdz. Proof. by move=> m; rewrite /gcdz gcdn1. Qed. Lemma dvdz_gcdr m n : (gcdz m n %| n)%Z. Proof. exact: dvdn_gcdr. Qed. Lemma dvdz_gcdl m n : (gcdz m n %| m)%Z. Proof. exact: dvdn_gcdl. Qed. Lemma gcdz_eq0 m n : (gcdz m n == 0) = (m == 0) && (n == 0). Proof. by rewrite -absz_eq0 eqn0Ngt gcdn_gt0 !negb_or -!eqn0Ngt !absz_eq0. Qed. Lemma gcdNz m n : gcdz (- m) n = gcdz m n. Proof. by rewrite /gcdz abszN. Qed. Lemma gcdzN m n : gcdz m (- n) = gcdz m n. Proof. by rewrite /gcdz abszN. Qed. Lemma gcdz_modr m n : gcdz m (n %% m)%Z = gcdz m n. Proof. rewrite -modz_abs /gcdz; move/absz: m => m. have [-> | m_gt0] := posnP m; first by rewrite modz0. case: n => n; first by rewrite modz_nat gcdn_modr. rewrite modNz_nat // NegzE abszN {2}(divn_eq n m) -addnS gcdnMDl. rewrite -addrA -opprD -intS /=; set m1 := _.+1. have le_m1m: (m1 <= m)%N by apply: ltn_pmod. by rewrite subzn // !(gcdnC m) -{2 3}(subnK le_m1m) gcdnDl gcdnDr gcdnC. Qed. Lemma gcdz_modl m n : gcdz (m %% n)%Z n = gcdz m n. Proof. by rewrite -!(gcdzC n) gcdz_modr. Qed. Lemma gcdzMDl q m n : gcdz m (q * m + n) = gcdz m n. Proof. by rewrite -gcdz_modr modzMDl gcdz_modr. Qed. Lemma gcdzDl m n : gcdz m (m + n) = gcdz m n. Proof. by rewrite -{2}(mul1r m) gcdzMDl. Qed. Lemma gcdzDr m n : gcdz m (n + m) = gcdz m n. Proof. by rewrite addrC gcdzDl. Qed. Lemma gcdzMl n m : gcdz n (m * n) = `|n|%:Z. Proof. by rewrite -[m * n]addr0 gcdzMDl gcdz0. Qed. Lemma gcdzMr n m : gcdz n (n * m) = `|n|%:Z. Proof. by rewrite mulrC gcdzMl. Qed. Lemma gcdz_idPl {m n} : reflect (gcdz m n = `|m|%:Z) (m %| n)%Z. Proof. by apply: (iffP gcdn_idPl) => [<- | []]. Qed. Lemma gcdz_idPr {m n} : reflect (gcdz m n = `|n|%:Z) (n %| m)%Z. Proof. by rewrite gcdzC; apply: gcdz_idPl. Qed. Lemma expz_min e m n : e >= 0 -> e ^+ minn m n = gcdz (e ^+ m) (e ^+ n). Proof. by case: e => // e _; rewrite /gcdz !abszX -expn_min -natz -natrX !natz. Qed. Lemma dvdz_gcd p m n : (p %| gcdz m n)%Z = (p %| m)%Z && (p %| n)%Z. Proof. exact: dvdn_gcd. Qed. Lemma gcdzAC : right_commutative gcdz. Proof. by move=> m n p; rewrite /gcdz gcdnAC. Qed. Lemma gcdzA : associative gcdz. Proof. by move=> m n p; rewrite /gcdz gcdnA. Qed. Lemma gcdzCA : left_commutative gcdz. Proof. by move=> m n p; rewrite /gcdz gcdnCA. Qed. Lemma gcdzACA : interchange gcdz gcdz. Proof. by move=> m n p q; rewrite /gcdz gcdnACA. Qed. Lemma mulz_gcdr m n p : `|m|%:Z * gcdz n p = gcdz (m * n) (m * p). Proof. by rewrite -PoszM muln_gcdr -!abszM. Qed. Lemma mulz_gcdl m n p : gcdz m n * `|p|%:Z = gcdz (m * p) (n * p). Proof. by rewrite -PoszM muln_gcdl -!abszM. Qed. Lemma mulz_divCA_gcd n m : n * (m %/ gcdz n m)%Z = m * (n %/ gcdz n m)%Z. Proof. by rewrite mulz_divCA ?dvdz_gcdl ?dvdz_gcdr. Qed. (* Not including lcm theory, for now. *) (* Coprime factors *) Lemma coprimezE m n : coprimez m n = coprime `|m| `|n|. Proof. by []. Qed. Lemma coprimez_sym : symmetric coprimez. Proof. by move=> m n; apply: coprime_sym. Qed. Lemma coprimeNz m n : coprimez (- m) n = coprimez m n. Proof. by rewrite coprimezE abszN. Qed. Lemma coprimezN m n : coprimez m (- n) = coprimez m n. Proof. by rewrite coprimezE abszN. Qed. Variant egcdz_spec m n : int * int -> Type := EgcdzSpec u v of u * m + v * n = gcdz m n & coprimez u v : egcdz_spec m n (u, v). Lemma egcdzP m n : egcdz_spec m n (egcdz m n). Proof. rewrite /egcdz; have [-> | m_nz] := eqVneq. by split; [rewrite -abszEsign gcd0z | rewrite coprimezE absz_sign]. have m_gt0 : (`|m| > 0)%N by rewrite absz_gt0. case: egcdnP (coprime_egcdn `|n| m_gt0) => //= u v Duv _ co_uv; split. rewrite !mulNr -!mulrA mulrCA -abszEsg mulrCA -abszEsign. by rewrite -!PoszM Duv addnC PoszD addrK. by rewrite coprimezE abszM absz_sg m_nz mul1n mulNr abszN abszMsign. Qed. Lemma Bezoutz m n : {u : int & {v : int | u * m + v * n = gcdz m n}}. Proof. by exists (egcdz m n).1, (egcdz m n).2; case: egcdzP. Qed. Lemma coprimezP m n : reflect (exists uv, uv.1 * m + uv.2 * n = 1) (coprimez m n). Proof. apply: (iffP eqP) => [<-| [[u v] /= Duv]]. by exists (egcdz m n); case: egcdzP. congr _%:Z; apply: gcdn_def; rewrite ?dvd1n // => d dv_d_n dv_d_m. by rewrite -(dvdzE d 1) -Duv [m]intEsg [n]intEsg rpredD ?dvdz_mull. Qed. Lemma Gauss_dvdz m n p : coprimez m n -> (m * n %| p)%Z = (m %| p)%Z && (n %| p)%Z. Proof. by move/Gauss_dvd <-; rewrite -abszM. Qed. Lemma Gauss_dvdzr m n p : coprimez m n -> (m %| n * p)%Z = (m %| p)%Z. Proof. by rewrite dvdzE abszM => /Gauss_dvdr->. Qed. Lemma Gauss_dvdzl m n p : coprimez m p -> (m %| n * p)%Z = (m %| n)%Z. Proof. by rewrite mulrC; apply: Gauss_dvdzr. Qed. Lemma Gauss_gcdzr p m n : coprimez p m -> gcdz p (m * n) = gcdz p n. Proof. by rewrite /gcdz abszM => /Gauss_gcdr->. Qed. Lemma Gauss_gcdzl p m n : coprimez p n -> gcdz p (m * n) = gcdz p m. Proof. by move=> co_pn; rewrite mulrC Gauss_gcdzr. Qed. Lemma coprimezMr p m n : coprimez p (m * n) = coprimez p m && coprimez p n. Proof. by rewrite -coprimeMr -abszM. Qed. Lemma coprimezMl p m n : coprimez (m * n) p = coprimez m p && coprimez n p. Proof. by rewrite -coprimeMl -abszM. Qed. Lemma coprimez_pexpl k m n : (0 < k)%N -> coprimez (m ^+ k) n = coprimez m n. Proof. by rewrite /coprimez /gcdz abszX; apply: coprime_pexpl. Qed. Lemma coprimez_pexpr k m n : (0 < k)%N -> coprimez m (n ^+ k) = coprimez m n. Proof. by move=> k_gt0; rewrite !(coprimez_sym m) coprimez_pexpl. Qed. Lemma coprimezXl k m n : coprimez m n -> coprimez (m ^+ k) n. Proof. by rewrite /coprimez /gcdz abszX; apply: coprimeXl. Qed. Lemma coprimezXr k m n : coprimez m n -> coprimez m (n ^+ k). Proof. by rewrite !(coprimez_sym m); apply: coprimezXl. Qed. Lemma coprimez_dvdl m n p : (m %| n)%N -> coprimez n p -> coprimez m p. Proof. exact: coprime_dvdl. Qed. Lemma coprimez_dvdr m n p : (m %| n)%N -> coprimez p n -> coprimez p m. Proof. exact: coprime_dvdr. Qed. Lemma dvdz_pexp2r m n k : (k > 0)%N -> (m ^+ k %| n ^+ k)%Z = (m %| n)%Z. Proof. by rewrite dvdzE !abszX; apply: dvdn_pexp2r. Qed. Section Chinese. (***********************************************************************) (* The chinese remainder theorem *) (***********************************************************************) Variables m1 m2 : int. Hypothesis co_m12 : coprimez m1 m2. Lemma zchinese_remainder x y : (x == y %[mod m1 * m2])%Z = (x == y %[mod m1])%Z && (x == y %[mod m2])%Z. Proof. by rewrite !eqz_mod_dvd Gauss_dvdz. Qed. (***********************************************************************) (* A function that solves the chinese remainder problem *) (***********************************************************************) Definition zchinese r1 r2 := r1 * m2 * (egcdz m1 m2).2 + r2 * m1 * (egcdz m1 m2).1. Lemma zchinese_modl r1 r2 : (zchinese r1 r2 = r1 %[mod m1])%Z. Proof. rewrite /zchinese; have [u v /= Duv _] := egcdzP m1 m2. rewrite -{2}[r1]mulr1 -((gcdz _ _ =P 1) co_m12) -Duv. by rewrite mulrDr mulrAC addrC (mulrAC r2) !mulrA !modzMDl. Qed. Lemma zchinese_modr r1 r2 : (zchinese r1 r2 = r2 %[mod m2])%Z. Proof. rewrite /zchinese; have [u v /= Duv _] := egcdzP m1 m2. rewrite -{2}[r2]mulr1 -((gcdz _ _ =P 1) co_m12) -Duv. by rewrite mulrAC modzMDl mulrAC addrC mulrDr !mulrA modzMDl. Qed. Lemma zchinese_mod x : (x = zchinese (x %% m1)%Z (x %% m2)%Z %[mod m1 * m2])%Z. Proof. apply/eqP; rewrite zchinese_remainder //. by rewrite zchinese_modl zchinese_modr !modz_mod !eqxx. Qed. End Chinese. Section ZpolyScale. Definition zcontents p := sgz (lead_coef p) * \big[gcdn/0%N]_(i < size p) `|(p`_i)%R|%N. Lemma sgz_contents p : sgz (zcontents p) = sgz (lead_coef p). Proof. rewrite /zcontents mulrC sgzM sgz_id; set d := _%:Z. have [-> | nz_p] := eqVneq p 0; first by rewrite lead_coef0 mulr0. rewrite gtr0_sgz ?mul1r // ltz_nat polySpred ?big_ord_recr //= -lead_coefE. by rewrite gcdn_gt0 orbC absz_gt0 lead_coef_eq0 nz_p. Qed. Lemma zcontents_eq0 p : (zcontents p == 0) = (p == 0). Proof. by rewrite -sgz_eq0 sgz_contents sgz_eq0 lead_coef_eq0. Qed. Lemma zcontents0 : zcontents 0 = 0. Proof. by apply/eqP; rewrite zcontents_eq0. Qed. Lemma zcontentsZ a p : zcontents (a *: p) = a * zcontents p. Proof. have [-> | nz_a] := eqVneq a 0; first by rewrite scale0r mul0r zcontents0. rewrite {2}[a]intEsg mulrCA -mulrA -PoszM big_distrr /= mulrCA mulrA -sgzM. rewrite -lead_coefZ; congr (_ * _%:Z); rewrite size_scale //. by apply: eq_bigr => i _; rewrite coefZ abszM. Qed. Lemma zcontents_monic p : p \is monic -> zcontents p = 1. Proof. move=> mon_p; rewrite /zcontents polySpred ?monic_neq0 //. by rewrite big_ord_recr /= -lead_coefE (monicP mon_p) gcdn1. Qed. Lemma dvdz_contents a p : (a %| zcontents p)%Z = (p \is a polyOver (dvdz a)). Proof. rewrite dvdzE abszM absz_sg lead_coef_eq0. have [-> | nz_p] := eqVneq; first by rewrite mul0n dvdn0 rpred0. rewrite mul1n; apply/dvdn_biggcdP/(all_nthP 0)=> a_dv_p i ltip /=. exact: (a_dv_p (Ordinal ltip)). exact: a_dv_p. Qed. Lemma map_poly_divzK {a} p : p \is a polyOver (dvdz a) -> a *: map_poly (divz^~ a) p = p. Proof. move/polyOverP=> a_dv_p; apply/polyP=> i. by rewrite coefZ coef_map_id0 ?div0z // mulrC divzK. Qed. Lemma polyOver_dvdzP a p : reflect (exists q, p = a *: q) (p \is a polyOver (dvdz a)). Proof. apply: (iffP idP) => [/map_poly_divzK | [q ->]]. by exists (map_poly (divz^~ a) p). by apply/polyOverP=> i; rewrite coefZ dvdz_mulr. Qed. Definition zprimitive p := map_poly (divz^~ (zcontents p)) p. Lemma zpolyEprim p : p = zcontents p *: zprimitive p. Proof. by rewrite map_poly_divzK // -dvdz_contents. Qed. Lemma zprimitive0 : zprimitive 0 = 0. Proof. by apply/polyP=> i; rewrite coef0 coef_map_id0 ?div0z // zcontents0 divz0. Qed. Lemma zprimitive_eq0 p : (zprimitive p == 0) = (p == 0). Proof. apply/idP/idP=> /eqP p0; first by rewrite [p]zpolyEprim p0 scaler0. by rewrite p0 zprimitive0. Qed. Lemma size_zprimitive p : size (zprimitive p) = size p. Proof. have [-> | ] := eqVneq p 0; first by rewrite zprimitive0. by rewrite {1 3}[p]zpolyEprim scale_poly_eq0 => /norP[/size_scale-> _]. Qed. Lemma sgz_lead_primitive p : sgz (lead_coef (zprimitive p)) = (p != 0). Proof. have [-> | nz_p] := eqVneq; first by rewrite zprimitive0 lead_coef0. apply: (@mulfI _ (sgz (zcontents p))); first by rewrite sgz_eq0 zcontents_eq0. by rewrite -sgzM mulr1 -lead_coefZ -zpolyEprim sgz_contents. Qed. Lemma zcontents_primitive p : zcontents (zprimitive p) = (p != 0). Proof. have [-> | nz_p] := eqVneq; first by rewrite zprimitive0 zcontents0. apply: (@mulfI _ (zcontents p)); first by rewrite zcontents_eq0. by rewrite mulr1 -zcontentsZ -zpolyEprim. Qed. Lemma zprimitive_id p : zprimitive (zprimitive p) = zprimitive p. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite !zprimitive0. by rewrite {2}[zprimitive p]zpolyEprim zcontents_primitive nz_p scale1r. Qed. Lemma zprimitive_monic p : p \in monic -> zprimitive p = p. Proof. by move=> mon_p; rewrite {2}[p]zpolyEprim zcontents_monic ?scale1r. Qed. Lemma zprimitiveZ a p : a != 0 -> zprimitive (a *: p) = zprimitive p. Proof. have [-> | nz_p nz_a] := eqVneq p 0; first by rewrite scaler0. apply: (@mulfI _ (a * zcontents p)%:P). by rewrite polyC_eq0 mulf_neq0 ?zcontents_eq0. by rewrite -{1}zcontentsZ !mul_polyC -zpolyEprim -scalerA -zpolyEprim. Qed. Lemma zprimitive_min p a q : p != 0 -> p = a *: q -> {b | sgz b = sgz (lead_coef q) & q = b *: zprimitive p}. Proof. move=> nz_p Dp; have /dvdzP/sig_eqW[b Db]: (a %| zcontents p)%Z. by rewrite dvdz_contents; apply/polyOver_dvdzP; exists q. suffices ->: q = b *: zprimitive p. by rewrite lead_coefZ sgzM sgz_lead_primitive nz_p mulr1; exists b. apply: (@mulfI _ a%:P). by apply: contraNneq nz_p; rewrite Dp -mul_polyC => ->; rewrite mul0r. by rewrite !mul_polyC -Dp scalerA mulrC -Db -zpolyEprim. Qed. Lemma zprimitive_irr p a q : p != 0 -> zprimitive p = a *: q -> a = sgz (lead_coef q). Proof. move=> nz_p Dp; have: p = (a * zcontents p) *: q. by rewrite mulrC -scalerA -Dp -zpolyEprim. case/zprimitive_min=> // b <- /eqP. rewrite Dp -{1}[q]scale1r scalerA -subr_eq0 -scalerBl scale_poly_eq0 subr_eq0. have{Dp} /negPf->: q != 0. by apply: contraNneq nz_p; rewrite -zprimitive_eq0 Dp => ->; rewrite scaler0. by case: b a => [[|[|b]] | [|b]] [[|[|a]] | [|a]] //; rewrite mulr0. Qed. Lemma zcontentsM p q : zcontents (p * q) = zcontents p * zcontents q. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite !(mul0r, zcontents0). have [-> | nz_q] := eqVneq q 0; first by rewrite !(mulr0, zcontents0). rewrite -[zcontents q]mulr1 {1}[p]zpolyEprim {1}[q]zpolyEprim. rewrite -scalerAl -scalerAr !zcontentsZ; congr (_ * (_ * _)). rewrite [zcontents _]intEsg sgz_contents lead_coefM sgzM !sgz_lead_primitive. apply/eqP; rewrite nz_p nz_q !mul1r [_ == _]eqn_leq absz_gt0 zcontents_eq0. rewrite mulf_neq0 ?zprimitive_eq0 // andbT leqNgt. apply/negP=> /pdivP[r r_pr r_dv_d]; pose to_r : int -> 'F_r := intr. have nz_prim_r q1: q1 != 0 -> map_poly to_r (zprimitive q1) != 0. move=> nz_q1; apply: contraTneq (prime_gt1 r_pr) => r_dv_q1. rewrite -leqNgt dvdn_leq // -(dvdzE r true) -nz_q1 -zcontents_primitive. rewrite dvdz_contents; apply/polyOverP=> i /=; rewrite dvdzE /=. have /polyP/(_ i)/eqP := r_dv_q1; rewrite coef_map coef0 /=. rewrite {1}[_`_i]intEsign rmorphM rmorph_sign /= mulf_eq0 signr_eq0 /=. by rewrite -val_eqE /= val_Fp_nat. suffices{nz_prim_r} /idPn[]: map_poly to_r (zprimitive p * zprimitive q) == 0. by rewrite rmorphM mulf_neq0 ?nz_prim_r. rewrite [_ * _]zpolyEprim [zcontents _]intEsign mulrC -scalerA map_polyZ /=. by rewrite scale_poly_eq0 -val_eqE /= val_Fp_nat ?(eqnP r_dv_d). Qed. Lemma zprimitiveM p q : zprimitive (p * q) = zprimitive p * zprimitive q. Proof. have [pq_0|] := eqVneq (p * q) 0. rewrite pq_0; move/eqP: pq_0; rewrite mulf_eq0. by case/pred2P=> ->; rewrite !zprimitive0 (mul0r, mulr0). rewrite -zcontents_eq0 -polyC_eq0 => /mulfI; apply; rewrite !mul_polyC. by rewrite -zpolyEprim zcontentsM -scalerA scalerAr scalerAl -!zpolyEprim. Qed. Lemma dvdpP_int p q : p %| q -> {r | q = zprimitive p * r}. Proof. case/Pdiv.Idomain.dvdpP/sig2_eqW=> [[c r] /= nz_c Dpr]. exists (zcontents q *: zprimitive r); rewrite -scalerAr. by rewrite -zprimitiveM mulrC -Dpr zprimitiveZ // -zpolyEprim. Qed. Local Notation pZtoQ := (map_poly (intr : int -> rat)). Lemma size_rat_int_poly p : size (pZtoQ p) = size p. Proof. by apply: size_map_inj_poly; first apply: intr_inj. Qed. Lemma rat_poly_scale (p : {poly rat}) : {q : {poly int} & {a | a != 0 & p = a%:~R^-1 *: pZtoQ q}}. Proof. pose a := \prod_(i < size p) denq p`_i. have nz_a: a != 0 by apply/prodf_neq0=> i _; apply: denq_neq0. exists (map_poly numq (a%:~R *: p)), a => //. apply: canRL (scalerK _) _; rewrite ?intr_eq0 //. apply/polyP=> i; rewrite !(coefZ, coef_map_id0) // numqK // Qint_def mulrC. have [ltip | /(nth_default 0)->] := ltnP i (size p); last by rewrite mul0r. by rewrite [a](bigD1 (Ordinal ltip)) // rmorphM mulrA -numqE -rmorphM denq_int. Qed. Lemma dvdp_rat_int p q : (pZtoQ p %| pZtoQ q) = (p %| q). Proof. apply/dvdpP/Pdiv.Idomain.dvdpP=> [[/= r1 Dq] | [[/= a r] nz_a Dq]]; last first. exists (a%:~R^-1 *: pZtoQ r); rewrite -scalerAl -rmorphM -Dq. by rewrite -{2}[a]intz scaler_int rmorphMz -scaler_int scalerK ?intr_eq0. have [r [a nz_a Dr1]] := rat_poly_scale r1; exists (a, r) => //=. apply: (map_inj_poly _ _ : injective pZtoQ) => //; first exact: intr_inj. rewrite -[a]intz scaler_int rmorphMz -scaler_int /= Dq Dr1. by rewrite -scalerAl -rmorphM scalerKV ?intr_eq0. Qed. Lemma dvdpP_rat_int p q : p %| pZtoQ q -> {p1 : {poly int} & {a | a != 0 & p = a *: pZtoQ p1} & {r | q = p1 * r}}. Proof. have{p} [p [a nz_a ->]] := rat_poly_scale p. rewrite dvdpZl ?invr_eq0 ?intr_eq0 // dvdp_rat_int => dv_p_q. exists (zprimitive p); last exact: dvdpP_int. have [-> | nz_p] := eqVneq p 0. by exists 1; rewrite ?oner_eq0 // zprimitive0 map_poly0 !scaler0. exists ((zcontents p)%:~R / a%:~R). by rewrite mulf_neq0 ?invr_eq0 ?intr_eq0 ?zcontents_eq0. by rewrite mulrC -scalerA -map_polyZ -zpolyEprim. Qed. End ZpolyScale. (* Integral spans. *) Lemma int_Smith_normal_form m n (M : 'M[int]_(m, n)) : {L : 'M[int]_m & L \in unitmx & {R : 'M[int]_n & R \in unitmx & {d : seq int | sorted dvdz d & M = L *m (\matrix_(i, j) (d`_i *+ (i == j :> nat))) *m R}}}. Proof. move: {2}_.+1 (ltnSn (m + n)) => mn. elim: mn => // mn IHmn in m n M *; rewrite ltnS => le_mn. have [[i j] nzMij | no_ij] := pickP (fun k => M k.1 k.2 != 0%N); last first. do 2![exists 1%:M; first exact: unitmx1]; exists nil => //=. apply/matrixP=> i j; apply/eqP; rewrite mulmx1 mul1mx mxE nth_nil mul0rn. exact: negbFE (no_ij (i, j)). do [case: m i => [[]//|m] i; case: n j => [[]//|n] j /=] in M nzMij le_mn *. wlog Dj: j M nzMij / j = 0; last rewrite {j}Dj in nzMij. case/(_ 0 (xcol j 0 M)); rewrite ?mxE ?tpermR // => L uL [R uR [d dvD dM]]. exists L => //; exists (xcol j 0 R); last exists d => //=. by rewrite xcolE unitmx_mul uR unitmx_perm. by rewrite xcolE !mulmxA -dM xcolE -mulmxA -perm_mxM tperm2 perm_mx1 mulmx1. move Da: (M i 0) nzMij => a nz_a. have [A leA] := ubnP `|a|; elim: A => // A IHa in a leA m n M i Da nz_a le_mn *. wlog [j a'Mij]: m n M i Da le_mn / {j | ~~ (a %| M i j)%Z}; last first. have nz_j: j != 0 by apply: contraNneq a'Mij => ->; rewrite Da. case: n => [[[]//]|n] in j le_mn nz_j M a'Mij Da *. wlog{nz_j} Dj: j M a'Mij Da / j = 1; last rewrite {j}Dj in a'Mij. case/(_ 1 (xcol j 1 M)); rewrite ?mxE ?tpermR ?tpermD //. move=> L uL [R uR [d dvD dM]]; exists L => //. exists (xcol j 1 R); first by rewrite xcolE unitmx_mul uR unitmx_perm. exists d; rewrite //= xcolE !mulmxA -dM xcolE -mulmxA -perm_mxM tperm2. by rewrite perm_mx1 mulmx1. have [u [v]] := Bezoutz a (M i 1); set b := gcdz _ _ => Db. have{leA} ltA: (`|b| < A)%N. rewrite -ltnS (leq_trans _ leA) // ltnS ltn_neqAle andbC. rewrite dvdn_leq ?absz_gt0 ? dvdn_gcdl //=. by rewrite (contraNneq _ a'Mij) ?dvdzE // => <-; apply: dvdn_gcdr. pose t2 := [fun j : 'I_2 => [tuple _; _]`_j : int]; pose a1 := M i 1. pose Uul := \matrix_(k, j) t2 (t2 u (- (a1 %/ b)%Z) j) (t2 v (a %/ b)%Z j) k. pose U : 'M_(2 + n) := block_mx Uul 0 0 1%:M; pose M1 := M *m U. have{nz_a} nz_b: b != 0 by rewrite gcdz_eq0 (negPf nz_a). have uU: U \in unitmx. rewrite unitmxE det_ublock det1 (expand_det_col _ 0) big_ord_recl big_ord1. do 2!rewrite /cofactor [row' _ _]mx11_scalar !mxE det_scalar1 /=. rewrite mulr1 mul1r mulN1r opprK -[_ + _](mulzK _ nz_b) mulrDl. by rewrite -!mulrA !divzK ?dvdz_gcdl ?dvdz_gcdr // Db divzz nz_b unitr1. have{} Db: M1 i 0 = b. rewrite /M1 -(lshift0 n 1) [U]block_mxEh mul_mx_row row_mxEl. rewrite -[M](@hsubmxK _ _ 2) (@mul_row_col _ _ 2) mulmx0 addr0 !mxE /=. rewrite big_ord_recl big_ord1 !mxE /= [lshift _ _]((_ =P 0) _) // Da. by rewrite [lshift _ _]((_ =P 1) _) // mulrC -(mulrC v). have [L uL [R uR [d dvD dM1]]] := IHa b ltA _ _ M1 i Db nz_b le_mn. exists L => //; exists (R *m invmx U); last exists d => //. by rewrite unitmx_mul uR unitmx_inv. by rewrite mulmxA -dM1 mulmxK. move=> {A leA}IHa; wlog Di: i M Da / i = 0; last rewrite {i}Di in Da. case/(_ 0 (xrow i 0 M)); rewrite ?mxE ?tpermR // => L uL [R uR [d dvD dM]]. exists (xrow i 0 L); first by rewrite xrowE unitmx_mul unitmx_perm. exists R => //; exists d; rewrite //= xrowE -!mulmxA (mulmxA L) -dM xrowE. by rewrite mulmxA -perm_mxM tperm2 perm_mx1 mul1mx. without loss /forallP a_dvM0: / [forall j, a %| M 0 j]%Z. case: (altP forallP) => [_ IH|/forallPn/sigW/IHa IH _]; exact: IH. without loss{Da a_dvM0} Da: M / forall j, M 0 j = a. pose Uur := col' 0 (\row_j (1 - (M 0 j %/ a)%Z)). pose U : 'M_(1 + n) := block_mx 1 Uur 0 1%:M; pose M1 := M *m U. have uU: U \in unitmx by rewrite unitmxE det_ublock !det1 mulr1. case/(_ (M *m U)) => [j | L uL [R uR [d dvD dM]]]. rewrite -(lshift0 m 0) -[M](@submxK _ 1 _ 1) (@mulmx_block _ 1 m 1). rewrite (@col_mxEu _ 1) !mulmx1 mulmx0 addr0 [ulsubmx _]mx11_scalar. rewrite mul_scalar_mx !mxE !lshift0 Da. case: splitP => [j0 _ | j1 Dj]; rewrite ?ord1 !mxE // lshift0 rshift1. by rewrite mulrBr mulr1 mulrC divzK ?subrK. exists L => //; exists (R * U^-1); first by rewrite unitmx_mul uR unitmx_inv. by exists d; rewrite //= mulmxA -dM mulmxK. without loss{IHa} /forallP/(_ (_, _))/= a_dvM: / [forall k, a %| M k.1 k.2]%Z. case: (altP forallP) => [_|/forallPn/sigW [[i j] /= a'Mij] _]; first exact. have [|||L uL [R uR [d dvD dM]]] := IHa _ _ M^T j; rewrite ?mxE 1?addnC //. by exists i; rewrite mxE. exists R^T; last exists L^T; rewrite ?unitmx_tr //; exists d => //. rewrite -[M]trmxK dM !trmx_mul mulmxA; congr (_ *m _ *m _). by apply/matrixP=> i1 j1; rewrite !mxE; case: eqVneq => // ->. without loss{nz_a a_dvM} a1: M a Da / a = 1. pose M1 := map_mx (divz^~ a) M; case/(_ M1 1)=> // [k|L uL [R uR [d dvD dM]]]. by rewrite !mxE Da divzz nz_a. exists L => //; exists R => //; exists [seq a * x | x <- d]. case: d dvD {dM} => //= x d; elim: d x => //= y d IHd x /andP[dv_xy /IHd]. by rewrite [dvdz _ _]dvdz_mul2l ?[_ \in _]dv_xy. have ->: M = a *: M1 by apply/matrixP=> i j; rewrite !mxE mulrC divzK ?a_dvM. rewrite dM scalemxAl scalemxAr; congr (_ *m _ *m _). apply/matrixP=> i j; rewrite !mxE mulrnAr; congr (_ *+ _). have [lt_i_d | le_d_i] := ltnP i (size d); first by rewrite (nth_map 0). by rewrite !nth_default ?size_map ?mulr0. rewrite {a}a1 -[m.+1]/(1 + m)%N -[n.+1]/(1 + n)%N in M Da *. pose Mu := ursubmx M; pose Ml := dlsubmx M. have{} Da: ulsubmx M = 1 by rewrite [_ M]mx11_scalar !mxE !lshift0 Da. pose M1 := - (Ml *m Mu) + drsubmx M. have [|L uL [R uR [d dvD dM1]]] := IHmn m n M1; first by rewrite -addnS ltnW. exists (block_mx 1 0 Ml L). by rewrite unitmxE det_lblock det_scalar1 mul1r. exists (block_mx 1 Mu 0 R). by rewrite unitmxE det_ublock det_scalar1 mul1r. exists (1 :: d); set D1 := \matrix_(i, j) _ in dM1. by rewrite /= path_min_sorted //; apply/allP => g _; apply: dvd1n. rewrite [D in _ *m D *m _](_ : _ = block_mx 1 0 0 D1); last first. by apply/matrixP=> i j; do 3?[rewrite ?mxE ?ord1 //=; case: splitP => ? ->]. rewrite !mulmx_block !(mul0mx, mulmx0, addr0) !mulmx1 add0r mul1mx -Da -dM1. by rewrite addNKr submxK. Qed. Definition inIntSpan (V : zmodType) m (s : m.-tuple V) v := exists a : int ^ m, v = \sum_(i < m) s`_i *~ a i. Lemma dec_Qint_span (vT : vectType rat) m (s : m.-tuple vT) v : decidable (inIntSpan s v). Proof. have s_s (i : 'I_m): s`_i \in <>%VS by rewrite memv_span ?memt_nth. have s_Zs a: \sum_(i < m) s`_i *~ a i \in <>%VS. by rewrite memv_suml // => i _; rewrite -scaler_int memvZ. case s_v: (v \in <>%VS); last by right=> [[a Dv]]; rewrite Dv s_Zs in s_v. pose S := \matrix_(i < m, j < _) coord (vbasis <>) j s`_i. pose r := \rank S; pose k := (m - r)%N; pose Em := erefl m; pose Ek := erefl k. have Dm: (m = k + r)%N by rewrite subnK ?rank_leq_row. have [K kerK]: {K : 'M_(k, m) | map_mx intr K == kermx S}%MS. pose B := row_base (kermx S); pose d := \prod_ij denq (B ij.1 ij.2). exists (castmx (mxrank_ker S, Em) (map_mx numq (intr d *: B))). rewrite /k; case: _ / (mxrank_ker S); set B1 := map_mx _ _. have ->: B1 = (intr d *: B). apply/matrixP=> i j; rewrite 3!mxE mulrC [d](bigD1 (i, j)) // rmorphM mulrA. by rewrite -numqE -rmorphM numq_int. suffices nz_d: d%:Q != 0 by rewrite !eqmx_scale // !eq_row_base andbb. by rewrite intr_eq0; apply/prodf_neq0 => i _; apply: denq_neq0. have [L _ [G uG [D _ defK]]] := int_Smith_normal_form K. pose Gud := castmx (Dm, Em) G; pose G'lr := castmx (Em, Dm) (invmx G). have{K L D defK kerK} kerGu: map_mx intr (usubmx Gud) *m S = 0. pose Kl : 'M[rat]_k:= map_mx intr (lsubmx (castmx (Ek, Dm) (K *m invmx G))). have{} defK: map_mx intr K = row_mx Kl 0 *m map_mx intr Gud. rewrite -[K](mulmxKV uG) -{2}[G](castmxK Dm Em) -/Gud. rewrite -[K *m _](castmxK Ek Dm) map_mxM map_castmx. rewrite -(hsubmxK (castmx _ _)) map_row_mx -/Kl map_castmx /Em. set Kr := map_mx _ _; case: _ / (esym Dm) (map_mx _ _) => /= GudQ. congr (row_mx _ _ *m _); apply/matrixP=> i j; rewrite !mxE defK mulmxK //=. rewrite castmxE mxE big1 //= => j1 _; rewrite mxE /= eqn_leq andbC. by rewrite leqNgt (leq_trans (valP j1)) ?mulr0 ?leq_addr. have /row_full_inj: row_full Kl; last apply. rewrite /row_full eqn_leq rank_leq_row /= -{1}[k](mxrank_ker S). rewrite -(eqmxP kerK) defK map_castmx mxrankMfree; last first. case: _ / (Dm); apply/row_freeP; exists (map_mx intr (invmx G)). by rewrite -map_mxM mulmxV ?map_mx1. by rewrite -mxrank_tr tr_row_mx trmx0 -addsmxE addsmx0 mxrank_tr. rewrite mulmx0 mulmxA (sub_kermxP _) // -(eqmxP kerK) defK. by rewrite -{2}[Gud]vsubmxK map_col_mx mul_row_col mul0mx addr0. pose T := map_mx intr (dsubmx Gud) *m S. have{kerGu} defS: map_mx intr (rsubmx G'lr) *m T = S. have: G'lr *m Gud = 1%:M by rewrite /G'lr /Gud; case: _ / (Dm); apply: mulVmx. rewrite -{1}[G'lr]hsubmxK -[Gud]vsubmxK mulmxA mul_row_col -map_mxM. move/(canRL (addKr _))->; rewrite -mulNmx raddfD /= map_mx1 map_mxM /=. by rewrite mulmxDl -mulmxA kerGu mulmx0 add0r mul1mx. pose vv := \row_j coord (vbasis <>) j v. have uS: row_full S. apply/row_fullP; exists (\matrix_(i, j) coord s j (vbasis <>)`_i). apply/matrixP=> j1 j2; rewrite !mxE. rewrite -(coord_free _ _ (basis_free (vbasisP _))). rewrite -!tnth_nth (coord_span (vbasis_mem (mem_tnth j1 _))) linear_sum. by apply: eq_bigr => i _; rewrite !mxE (tnth_nth 0) !linearZ. have eqST: (S :=: T)%MS by apply/eqmxP; rewrite -{1}defS !submxMl. case Zv: (map_mx denq (vv *m pinvmx T) == const_mx 1). pose a := map_mx numq (vv *m pinvmx T) *m dsubmx Gud. left; exists [ffun j => a 0 j]. transitivity (\sum_j (map_mx intr a *m S) 0 j *: (vbasis <>)`_j). rewrite {1}(coord_vbasis s_v); apply: eq_bigr => j _; congr (_ *: _). have ->: map_mx intr a = vv *m pinvmx T *m map_mx intr (dsubmx Gud). rewrite map_mxM /=; congr (_ *m _); apply/rowP=> i; rewrite 2!mxE numqE. by have /eqP/rowP/(_ i) := Zv; rewrite !mxE => ->; rewrite mulr1. by rewrite -(mulmxA _ _ S) mulmxKpV ?mxE // -eqST submx_full. rewrite (coord_vbasis (s_Zs _)); apply: eq_bigr => j _; congr (_ *: _). rewrite linear_sum mxE; apply: eq_bigr => i _. by rewrite -scaler_int linearZ [a]lock !mxE ffunE. right=> [[a Dv]]; case/eqP: Zv; apply/rowP. have ->: vv = map_mx intr (\row_i a i) *m S. apply/rowP=> j; rewrite !mxE Dv linear_sum. by apply: eq_bigr => i _; rewrite -scaler_int linearZ !mxE. rewrite -defS -2!mulmxA; have ->: T *m pinvmx T = 1%:M. have uT: row_free T by rewrite /row_free -eqST. by apply: (row_free_inj uT); rewrite mul1mx mulmxKpV. by move=> i; rewrite mulmx1 -map_mxM 2!mxE denq_int mxE. Qed. Notation "@ 'coprimez_expl'" := (deprecate coprimez_expl coprimezXl) (at level 10, only parsing) : fun_scope. Notation "@ 'coprimez_expr'" := (deprecate coprimez_expr coprimezXr) (at level 10, only parsing) : fun_scope. Notation coprimez_mull := (deprecate coprimez_mull coprimezMl) (only parsing). Notation coprimez_mulr := (deprecate coprimez_mulr coprimezMr) (only parsing). Notation coprimez_expl := (fun k => @coprimez_expl k _ _) (only parsing). Notation coprimez_expr := (fun k => @coprimez_expr k _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/interval.v000066400000000000000000001317621375767750300225440ustar00rootroot00000000000000(* (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 order ssralg finset fingroup. From mathcomp Require Import ssrnum. (******************************************************************************) (* This file provide support for intervals in ordered types. The datatype *) (* (interval T) gives a formal characterization of an interval, as the pair *) (* of its right and left bounds. *) (* interval T == the type of formal intervals on T. *) (* x \in i == when i is a formal interval on an ordered type, *) (* \in can be used to test membership. *) (* itvP x_in_i == where x_in_i has type x \in i, if i is ground, *) (* gives a set of rewrite rules that x_in_i imply. *) (* *) (* Intervals of T form an partially ordered type (porderType) whose ordering *) (* is the subset relation. If T is a lattice, intervals also form a lattice *) (* (latticeType) whose meet and join are intersection and convex hull *) (* respectively. They are distributive if T is an orderType. *) (* *) (* We provide a set of notations to write intervals (see below) *) (* `[a, b], `]a, b], ..., `]-oo, a], ..., `]-oo, +oo[ *) (* We also provide the lemma subitvP which computes the inequalities one *) (* needs to prove when trying to prove the inclusion of intervals. *) (* *) (* Remark that we cannot implement a boolean comparison test for intervals on *) (* an arbitrary ordered types, for this problem might be undecidable. Note *) (* also that type (interval R) may contain several inhabitants coding for the *) (* same interval. However, this pathological issues do nor arise when R is a *) (* real domain: we could provide a specific theory for this important case. *) (* *) (* See also ``Formal proofs in real algebraic geometry: from ordered fields *) (* to quantifier elimination'', LMCS journal, 2012 *) (* by Cyril Cohen and Assia Mahboubi *) (* *) (* And "Formalized algebraic numbers: construction and first-order theory" *) (* Cyril Cohen, PhD, 2012, section 4.3. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope order_scope. Import Order.TTheory. Variant itv_bound (T : Type) : Type := BSide of bool & T | BInfty of bool. Notation BLeft := (BSide true). Notation BRight := (BSide false). Notation "'-oo'" := (BInfty _ true) (at level 0) : order_scope. Notation "'+oo'" := (BInfty _ false) (at level 0) : order_scope. Variant interval (T : Type) := Interval of itv_bound T & itv_bound T. (* We provide the 9 following notations to help writing formal intervals *) Notation "`[ a , b ]" := (Interval (BLeft a) (BRight b)) (at level 0, a, b at level 9 , format "`[ a , b ]") : order_scope. Notation "`] a , b ]" := (Interval (BRight a) (BRight b)) (at level 0, a, b at level 9 , format "`] a , b ]") : order_scope. Notation "`[ a , b [" := (Interval (BLeft a) (BLeft b)) (at level 0, a, b at level 9 , format "`[ a , b [") : order_scope. Notation "`] a , b [" := (Interval (BRight a) (BLeft b)) (at level 0, a, b at level 9 , format "`] a , b [") : order_scope. Notation "`] '-oo' , b ]" := (Interval -oo (BRight b)) (at level 0, b at level 9 , format "`] '-oo' , b ]") : order_scope. Notation "`] '-oo' , b [" := (Interval -oo (BLeft b)) (at level 0, b at level 9 , format "`] '-oo' , b [") : order_scope. Notation "`[ a , '+oo' [" := (Interval (BLeft a) +oo) (at level 0, a at level 9 , format "`[ a , '+oo' [") : order_scope. Notation "`] a , '+oo' [" := (Interval (BRight a) +oo) (at level 0, a at level 9 , format "`] a , '+oo' [") : order_scope. Notation "`] -oo , '+oo' [" := (Interval -oo +oo) (at level 0, format "`] -oo , '+oo' [") : order_scope. Notation "`[ a , b ]" := (Interval (BLeft a) (BRight b)) (at level 0, a, b at level 9 , format "`[ a , b ]") : ring_scope. Notation "`] a , b ]" := (Interval (BRight a) (BRight b)) (at level 0, a, b at level 9 , format "`] a , b ]") : ring_scope. Notation "`[ a , b [" := (Interval (BLeft a) (BLeft b)) (at level 0, a, b at level 9 , format "`[ a , b [") : ring_scope. Notation "`] a , b [" := (Interval (BRight a) (BLeft b)) (at level 0, a, b at level 9 , format "`] a , b [") : ring_scope. Notation "`] '-oo' , b ]" := (Interval -oo (BRight b)) (at level 0, b at level 9 , format "`] '-oo' , b ]") : ring_scope. Notation "`] '-oo' , b [" := (Interval -oo (BLeft b)) (at level 0, b at level 9 , format "`] '-oo' , b [") : ring_scope. Notation "`[ a , '+oo' [" := (Interval (BLeft a) +oo) (at level 0, a at level 9 , format "`[ a , '+oo' [") : ring_scope. Notation "`] a , '+oo' [" := (Interval (BRight a) +oo) (at level 0, a at level 9 , format "`] a , '+oo' [") : ring_scope. Notation "`] -oo , '+oo' [" := (Interval -oo +oo) (at level 0, format "`] -oo , '+oo' [") : ring_scope. Fact itv_bound_display (disp : unit) : unit. Proof. exact. Qed. Fact interval_display (disp : unit) : unit. Proof. exact. Qed. Section IntervalEq. Variable T : eqType. Definition eq_itv_bound (b1 b2 : itv_bound T) : bool := match b1, b2 with | BSide a x, BSide b y => (a == b) && (x == y) | BInfty a, BInfty b => a == b | _, _ => false end. Lemma eq_itv_boundP : Equality.axiom eq_itv_bound. Proof. move=> b1 b2; apply: (iffP idP). - by move: b1 b2 => [a x|a][b y|b] => //= [/andP [/eqP -> /eqP ->]|/eqP ->]. - by move=> <-; case: b1 => //= a x; rewrite !eqxx. Qed. Canonical itv_bound_eqMixin := EqMixin eq_itv_boundP. Canonical itv_bound_eqType := EqType (itv_bound T) itv_bound_eqMixin. Definition eqitv (x y : interval T) : bool := let: Interval x x' := x in let: Interval y y' := y in (x == y) && (x' == y'). Lemma eqitvP : Equality.axiom eqitv. Proof. move=> x y; apply: (iffP idP). - by move: x y => [x x'][y y'] => //= /andP [] /eqP -> /eqP ->. - by move=> <-; case: x => /= x x'; rewrite !eqxx. Qed. Canonical interval_eqMixin := EqMixin eqitvP. Canonical interval_eqType := EqType (interval T) interval_eqMixin. End IntervalEq. Module IntervalChoice. Section IntervalChoice. Variable T : choiceType. Lemma itv_bound_can : cancel (fun b : itv_bound T => match b with BSide b x => (b, Some x) | BInfty b => (b, None) end) (fun b => match b with (b, Some x) => BSide b x | (b, None) => BInfty _ b end). Proof. by case. Qed. Lemma interval_can : @cancel _ (interval T) (fun '(Interval b1 b2) => (b1, b2)) (fun '(b1, b2) => Interval b1 b2). Proof. by case. Qed. End IntervalChoice. Module Exports. Canonical itv_bound_choiceType (T : choiceType) := ChoiceType (itv_bound T) (CanChoiceMixin (@itv_bound_can T)). Canonical interval_choiceType (T : choiceType) := ChoiceType (interval T) (CanChoiceMixin (@interval_can T)). Canonical itv_bound_countType (T : countType) := CountType (itv_bound T) (CanCountMixin (@itv_bound_can T)). Canonical interval_countType (T : countType) := CountType (interval T) (CanCountMixin (@interval_can T)). Canonical itv_bound_finType (T : finType) := FinType (itv_bound T) (CanFinMixin (@itv_bound_can T)). Canonical interval_finType (T : finType) := FinType (interval T) (CanFinMixin (@interval_can T)). End Exports. End IntervalChoice. Export IntervalChoice.Exports. Section IntervalPOrder. Variable (disp : unit) (T : porderType disp). Implicit Types (x y z : T) (b bl br : itv_bound T) (i : interval T). Definition le_bound b1 b2 := match b1, b2 with | -oo, _ | _, +oo => true | BSide b1 x1, BSide b2 x2 => x1 < x2 ?<= if b2 ==> b1 | _, _ => false end. Definition lt_bound b1 b2 := match b1, b2 with | -oo, +oo | -oo, BSide _ _ | BSide _ _, +oo => true | BSide b1 x1, BSide b2 x2 => x1 < x2 ?<= if b1 && ~~ b2 | _, _ => false end. Lemma lt_bound_def b1 b2 : lt_bound b1 b2 = (b2 != b1) && le_bound b1 b2. Proof. by case: b1 b2 => [[]?|[]][[]?|[]] //=; rewrite lt_def. Qed. Lemma le_bound_refl : reflexive le_bound. Proof. by move=> [[]?|[]] /=. Qed. Lemma le_bound_anti : antisymmetric le_bound. Proof. by case=> [[]?|[]] [[]?|[]] //=; case: comparableP => // ->. Qed. Lemma le_bound_trans : transitive le_bound. Proof. by case=> [[]?|[]] [[]?|[]] [[]?|[]] lexy leyz //; apply: (lteif_imply _ (lteif_trans lexy leyz)). Qed. Definition itv_bound_porderMixin := LePOrderMixin lt_bound_def le_bound_refl le_bound_anti le_bound_trans. Canonical itv_bound_porderType := POrderType (itv_bound_display disp) (itv_bound T) itv_bound_porderMixin. Lemma bound_lexx c1 c2 x : (BSide c1 x <= BSide c2 x) = (c2 ==> c1). Proof. by rewrite /<=%O /= lteifxx. Qed. Lemma bound_ltxx c1 c2 x : (BSide c1 x < BSide c2 x) = (c1 && ~~ c2). Proof. by rewrite /<%O /= lteifxx. Qed. Definition subitv i1 i2 := let: Interval b1l b1r := i1 in let: Interval b2l b2r := i2 in (b2l <= b1l) && (b1r <= b2r). Lemma subitv_refl : reflexive subitv. Proof. by case=> /= ? ?; rewrite !lexx. Qed. Lemma subitv_anti : antisymmetric subitv. Proof. by case=> [? ?][? ?]; rewrite andbACA => /andP[] /le_anti -> /le_anti ->. Qed. Lemma subitv_trans : transitive subitv. Proof. case=> [yl yr][xl xr][zl zr] /andP [Hl Hr] /andP [Hl' Hr'] /=. by rewrite (le_trans Hl' Hl) (le_trans Hr Hr'). Qed. Definition interval_porderMixin := LePOrderMixin (fun _ _ => erefl) subitv_refl subitv_anti subitv_trans. Canonical interval_porderType := POrderType (interval_display disp) (interval T) interval_porderMixin. Definition pred_of_itv i : pred T := [pred x | `[x, x] <= i]. Canonical Structure itvPredType := PredType pred_of_itv. Lemma subitvE b1l b1r b2l b2r : (Interval b1l b1r <= Interval b2l b2r) = (b2l <= b1l) && (b1r <= b2r). Proof. by []. Qed. Lemma in_itv x i : x \in i = let: Interval l u := i in match l with | BSide b lb => lb < x ?<= if b | BInfty b => b end && match u with | BSide b ub => x < ub ?<= if ~~ b | BInfty b => ~~ b end. Proof. by case: i => [[? ?|[]][|[]]]. Qed. Lemma itv_boundlr bl br x : (x \in Interval bl br) = (bl <= BLeft x) && (BRight x <= br). Proof. by []. Qed. Lemma itv_splitI bl br x : x \in Interval bl br = (x \in Interval bl +oo) && (x \in Interval -oo br). Proof. by rewrite !itv_boundlr andbT. Qed. Lemma subitvP i1 i2 : i1 <= i2 -> {subset i1 <= i2}. Proof. by move=> ? ? /le_trans; exact. Qed. Lemma subitvPl b1l b2l br : b2l <= b1l -> {subset Interval b1l br <= Interval b2l br}. Proof. by move=> ?; apply: subitvP; rewrite subitvE lexx andbT. Qed. Lemma subitvPr bl b1r b2r : b1r <= b2r -> {subset Interval bl b1r <= Interval bl b2r}. Proof. by move=> ?; apply: subitvP; rewrite subitvE lexx. Qed. Lemma itv_xx x cl cr y : y \in Interval (BSide cl x) (BSide cr x) = cl && ~~ cr && (y == x). Proof. by case: cl cr => [] []; rewrite [LHS]lteif_anti // eq_sym. Qed. Lemma boundl_in_itv c x b : x \in Interval (BSide c x) b = c && (BRight x <= b). Proof. by rewrite itv_boundlr bound_lexx. Qed. Lemma boundr_in_itv c x b : x \in Interval b (BSide c x) = ~~ c && (b <= BLeft x). Proof. by rewrite itv_boundlr bound_lexx implybF andbC. Qed. Definition bound_in_itv := (boundl_in_itv, boundr_in_itv). Lemma lt_in_itv bl br x : x \in Interval bl br -> bl < br. Proof. by case/andP; apply/le_lt_trans. Qed. Lemma lteif_in_itv cl cr yl yr x : x \in Interval (BSide cl yl) (BSide cr yr) -> yl < yr ?<= if cl && ~~ cr. Proof. exact: lt_in_itv. Qed. Lemma itv_ge b1 b2 : ~~ (b1 < b2) -> Interval b1 b2 =i pred0. Proof. by move=> ltb12 y; apply/contraNF: ltb12; apply/lt_in_itv. Qed. Definition itv_decompose i x : Prop := let: Interval l u := i in (match l return Prop with | BSide b lb => lb < x ?<= if b | BInfty b => b end * match u return Prop with | BSide b ub => x < ub ?<= if ~~ b | BInfty b => ~~ b end)%type. Lemma itv_dec : forall x i, reflect (itv_decompose i x) (x \in i). Proof. by move=> ? [[? ?|[]][? ?|[]]]; apply: (iffP andP); case. Qed. Arguments itv_dec {x i}. (* we compute a set of rewrite rules associated to an interval *) Definition itv_rewrite i x : Type := let: Interval l u := i in (match l with | BLeft a => (a <= x) * (x < a = false) | BRight a => (a <= x) * (a < x) * (x <= a = false) * (x < a = false) | -oo => forall x : T, x == x | +oo => forall b : bool, unkeyed b = false end * match u with | BRight b => (x <= b) * (b < x = false) | BLeft b => (x <= b) * (x < b) * (b <= x = false) * (b < x = false) | +oo => forall x : T, x == x | -oo => forall b : bool, unkeyed b = false end * match l, u with | BLeft a, BRight b => (a <= b) * (b < a = false) * (a \in `[a, b]) * (b \in `[a, b]) | BLeft a, BLeft b => (a <= b) * (a < b) * (b <= a = false) * (b < a = false) * (a \in `[a, b]) * (a \in `[a, b[) * (b \in `[a, b]) * (b \in `]a, b]) | BRight a, BRight b => (a <= b) * (a < b) * (b <= a = false) * (b < a = false) * (a \in `[a, b]) * (a \in `[a, b[) * (b \in `[a, b]) * (b \in `]a, b]) | BRight a, BLeft b => (a <= b) * (a < b) * (b <= a = false) * (b < a = false) * (a \in `[a, b]) * (a \in `[a, b[) * (b \in `[a, b]) * (b \in `]a, b]) | _, _ => forall x : T, x == x end)%type. Lemma itvP x i : x \in i -> itv_rewrite i x. Proof. case: i => [[[]a|[]][[]b|[]]] /andP [] ha hb; rewrite /= ?bound_in_itv; do ![split | apply/negbTE; rewrite (le_gtF, lt_geF)]; by [|apply: ltW | move: (lteif_trans ha hb) => //=; exact: ltW]. Qed. Arguments itvP [x i]. End IntervalPOrder. Section IntervalLattice. Variable (disp : unit) (T : latticeType disp). Implicit Types (x y z : T) (b bl br : itv_bound T) (i : interval T). Definition bound_meet bl br : itv_bound T := match bl, br with | -oo, _ | _, -oo => -oo | +oo, b | b, +oo => b | BSide xb x, BSide yb y => BSide (((x <= y) && xb) || ((y <= x) && yb)) (x `&` y) end. Definition bound_join bl br : itv_bound T := match bl, br with | -oo, b | b, -oo => b | +oo, _ | _, +oo => +oo | BSide xb x, BSide yb y => BSide ((~~ (x <= y) || yb) && (~~ (y <= x) || xb)) (x `|` y) end. Lemma bound_meetC : commutative bound_meet. Proof. case=> [? ?|[]][? ?|[]] //=; rewrite meetC; congr BSide. by case: lcomparableP; rewrite ?orbF // orbC. Qed. Lemma bound_joinC : commutative bound_join. Proof. case=> [? ?|[]][? ?|[]] //=; rewrite joinC; congr BSide. by case: lcomparableP; rewrite ?andbT // andbC. Qed. Lemma bound_meetA : associative bound_meet. Proof. case=> [? x|[]][? y|[]][? z|[]] //=; rewrite !lexI meetA; congr BSide. by case: (lcomparableP x y) => [|||->]; case: (lcomparableP y z) => [|||->]; case: (lcomparableP x z) => [|||//<-]; case: (lcomparableP x y); rewrite //= ?andbF ?orbF ?lexx ?orbA //; case: (lcomparableP y z). Qed. Lemma bound_joinA : associative bound_join. Proof. case=> [? x|[]][? y|[]][? z|[]] //=; rewrite !leUx joinA; congr BSide. by case: (lcomparableP x y) => [|||->]; case: (lcomparableP y z) => [|||->]; case: (lcomparableP x z) => [|||//<-]; case: (lcomparableP x y); rewrite //= ?orbT ?andbT ?lexx ?andbA //; case: (lcomparableP y z). Qed. Lemma bound_meetKU b2 b1 : bound_join b1 (bound_meet b1 b2) = b1. Proof. case: b1 b2 => [? ?|[]][? ?|[]] //=; rewrite ?meetKU ?joinxx ?leIl ?lexI ?lexx ?andbb //=; congr BSide. by case: lcomparableP; rewrite ?orbF /= ?andbb ?orbK. Qed. Lemma bound_joinKI b2 b1 : bound_meet b1 (bound_join b1 b2) = b1. Proof. case: b1 b2 => [? ?|[]][? ?|[]] //=; rewrite ?joinKI ?meetxx ?leUl ?leUx ?lexx ?orbb //=; congr BSide. by case: lcomparableP; rewrite ?orbF ?orbb ?andKb. Qed. Lemma bound_leEmeet b1 b2 : (b1 <= b2) = (bound_meet b1 b2 == b1). Proof. by case: b1 b2 => [[]?|[]][[]?|[]] //=; rewrite [LHS]/<=%O /eq_op /= ?eqxx //= -leEmeet; case: lcomparableP. Qed. Definition itv_bound_latticeMixin := LatticeMixin bound_meetC bound_joinC bound_meetA bound_joinA bound_joinKI bound_meetKU bound_leEmeet. Canonical itv_bound_latticeType := LatticeType (itv_bound T) itv_bound_latticeMixin. Lemma bound_le0x b : -oo <= b. Proof. by []. Qed. Lemma bound_lex1 b : b <= +oo. Proof. by case: b => [|[]]. Qed. Canonical itv_bound_bLatticeType := BLatticeType (itv_bound T) (BottomMixin bound_le0x). Canonical itv_bound_tbLatticeType := TBLatticeType (itv_bound T) (TopMixin bound_lex1). Definition itv_meet i1 i2 : interval T := let: Interval b1l b1r := i1 in let: Interval b2l b2r := i2 in Interval (b1l `|` b2l) (b1r `&` b2r). Definition itv_join i1 i2 : interval T := let: Interval b1l b1r := i1 in let: Interval b2l b2r := i2 in Interval (b1l `&` b2l) (b1r `|` b2r). Lemma itv_meetC : commutative itv_meet. Proof. by case=> [? ?][? ?] /=; rewrite meetC joinC. Qed. Lemma itv_joinC : commutative itv_join. Proof. by case=> [? ?][? ?] /=; rewrite meetC joinC. Qed. Lemma itv_meetA : associative itv_meet. Proof. by case=> [? ?][? ?][? ?] /=; rewrite meetA joinA. Qed. Lemma itv_joinA : associative itv_join. Proof. by case=> [? ?][? ?][? ?] /=; rewrite meetA joinA. Qed. Lemma itv_meetKU i2 i1 : itv_join i1 (itv_meet i1 i2) = i1. Proof. by case: i1 i2 => [? ?][? ?] /=; rewrite meetKU joinKI. Qed. Lemma itv_joinKI i2 i1 : itv_meet i1 (itv_join i1 i2) = i1. Proof. by case: i1 i2 => [? ?][? ?] /=; rewrite meetKU joinKI. Qed. Lemma itv_leEmeet i1 i2 : (i1 <= i2) = (itv_meet i1 i2 == i1). Proof. by case: i1 i2 => [? ?][? ?]; rewrite /eq_op /= eq_meetl eq_joinl. Qed. Definition interval_latticeMixin := LatticeMixin itv_meetC itv_joinC itv_meetA itv_joinA itv_joinKI itv_meetKU itv_leEmeet. Canonical interval_latticeType := LatticeType (interval T) interval_latticeMixin. Lemma itv_le0x i : Interval +oo -oo <= i. Proof. by case: i => [[|[]]]. Qed. Lemma itv_lex1 i : i <= `]-oo, +oo[. Proof. by case: i => [?[|[]]]. Qed. Canonical interval_bLatticeType := BLatticeType (interval T) (BottomMixin itv_le0x). Canonical interval_tbLatticeType := TBLatticeType (interval T) (TopMixin itv_lex1). Lemma in_itvI x i1 i2 : x \in i1 `&` i2 = (x \in i1) && (x \in i2). Proof. exact: lexI. Qed. End IntervalLattice. Section IntervalTotal. Variable (disp : unit) (T : orderType disp). Implicit Types (x y z : T) (i : interval T). Lemma itv_bound_totalMixin : totalLatticeMixin [latticeType of itv_bound T]. Proof. by move=> [[]?|[]][[]?|[]]; rewrite /<=%O //=; case: ltgtP. Qed. Canonical itv_bound_distrLatticeType := DistrLatticeType (itv_bound T) itv_bound_totalMixin. Canonical itv_bound_bDistrLatticeType := [bDistrLatticeType of itv_bound T]. Canonical itv_bound_tbDistrLatticeType := [tbDistrLatticeType of itv_bound T]. Canonical itv_bound_orderType := OrderType (itv_bound T) itv_bound_totalMixin. Lemma itv_meetUl : @left_distributive (interval T) _ Order.meet Order.join. Proof. by move=> [? ?][? ?][? ?]; rewrite /Order.meet /Order.join /= -meetUl -joinIl. Qed. Canonical interval_distrLatticeType := DistrLatticeType (interval T) (DistrLatticeMixin itv_meetUl). Canonical interval_bDistrLatticeType := [bDistrLatticeType of interval T]. Canonical interval_tbDistrLatticeType := [tbDistrLatticeType of interval T]. Lemma itv_splitU c a b : a <= c <= b -> forall y, y \in Interval a b = (y \in Interval a c) || (y \in Interval c b). Proof. case/andP => leac lecb y. rewrite !itv_boundlr !(ltNge (BLeft y) _ : (BRight y <= _) = _). case: (leP a) (leP b) (leP c) => leay [] leby [] lecy //=. - by case: leP lecy (le_trans lecb leby). - by case: leP leay (le_trans leac lecy). Qed. Lemma itv_splitUeq x a b : x \in Interval a b -> forall y, y \in Interval a b = [|| y \in Interval a (BLeft x), y == x | y \in Interval (BRight x) b]. Proof. case/andP => ax xb y; rewrite (@itv_splitU (BLeft x)) ?ax ?ltW //. by congr orb; rewrite (@itv_splitU (BRight x)) ?bound_lexx // itv_xx. Qed. Lemma itv_total_meet3E i1 i2 i3 : i1 `&` i2 `&` i3 \in [:: i1 `&` i2; i1 `&` i3; i2 `&` i3]. Proof. case: i1 i2 i3 => [b1l b1r] [b2l b2r] [b3l b3r]; rewrite !inE /eq_op /=. case: (leP b1l b2l); case: (leP b1l b3l); case: (leP b2l b3l); case: (leP b1r b2r); case: (leP b1r b3r); case: (leP b2r b3r); rewrite ?eqxx ?orbT //= => b23r b13r b12r b23l b13l b12l. - by case: leP b13r (le_trans b12r b23r). - by case: leP b13l (le_trans b12l b23l). - by case: leP b13l (le_trans b12l b23l). - by case: leP b13r (le_trans b12r b23r). - by case: leP b13r (le_trans b12r b23r). - by case: leP b13l (lt_trans b23l b12l). - by case: leP b13r (lt_trans b23r b12r). - by case: leP b13l (lt_trans b23l b12l). - by case: leP b13r (lt_trans b23r b12r). - by case: leP b13r (lt_trans b23r b12r). Qed. Lemma itv_total_join3E i1 i2 i3 : i1 `|` i2 `|` i3 \in [:: i1 `|` i2; i1 `|` i3; i2 `|` i3]. Proof. case: i1 i2 i3 => [b1l b1r] [b2l b2r] [b3l b3r]; rewrite !inE /eq_op /=. case: (leP b1l b2l); case: (leP b1l b3l); case: (leP b2l b3l); case: (leP b1r b2r); case: (leP b1r b3r); case: (leP b2r b3r); rewrite ?eqxx ?orbT //= => b23r b13r b12r b23l b13l b12l. - by case: leP b13r (le_trans b12r b23r). - by case: leP b13r (le_trans b12r b23r). - by case: leP b13l (le_trans b12l b23l). - by case: leP b13l (le_trans b12l b23l). - by case: leP b13l (le_trans b12l b23l). - by case: leP b13r (lt_trans b23r b12r). - by case: leP b13l (lt_trans b23l b12l). - by case: leP b13l (lt_trans b23l b12l). - by case: leP b13l (lt_trans b23l b12l). - by case: leP b13r (lt_trans b23r b12r). Qed. End IntervalTotal. Local Open Scope ring_scope. Import GRing.Theory Num.Theory. Section IntervalNumDomain. Variable R : numDomainType. Implicit Types x : R. Lemma mem0_itvcc_xNx x : (0 \in `[- x, x]) = (0 <= x). Proof. by rewrite itv_boundlr [in LHS]/<=%O /= oppr_le0 andbb. Qed. Lemma mem0_itvoo_xNx x : 0 \in `](- x), x[ = (0 < x). Proof. by rewrite itv_boundlr [in LHS]/<=%O /= oppr_lt0 andbb. Qed. Lemma oppr_itv ba bb (xa xb x : R) : (- x \in Interval (BSide ba xa) (BSide bb xb)) = (x \in Interval (BSide (~~ bb) (- xb)) (BSide (~~ ba) (- xa))). Proof. by rewrite !itv_boundlr /<=%O /= !implybF negbK andbC lteif_oppl lteif_oppr. Qed. Lemma oppr_itvoo (a b x : R) : (- x \in `]a, b[) = (x \in `](- b), (- a)[). Proof. exact: oppr_itv. Qed. Lemma oppr_itvco (a b x : R) : (- x \in `[a, b[) = (x \in `](- b), (- a)]). Proof. exact: oppr_itv. Qed. Lemma oppr_itvoc (a b x : R) : (- x \in `]a, b]) = (x \in `[(- b), (- a)[). Proof. exact: oppr_itv. Qed. Lemma oppr_itvcc (a b x : R) : (- x \in `[a, b]) = (x \in `[(- b), (- a)]). Proof. exact: oppr_itv. Qed. End IntervalNumDomain. Section IntervalField. Variable R : numFieldType. Local Notation mid x y := ((x + y) / 2%:R). Lemma mid_in_itv : forall ba bb (xa xb : R), xa < xb ?<= if ba && ~~ bb -> mid xa xb \in Interval (BSide ba xa) (BSide bb xb). Proof. 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[. Proof. by move=> xa xb ?; apply: mid_in_itv. Qed. Lemma mid_in_itvcc : forall (xa xb : R), xa <= xb -> mid xa xb \in `[xa, xb]. Proof. by move=> xa xb ?; apply: mid_in_itv. Qed. End IntervalField. (******************************************************************************) (* Compatibility layer *) (******************************************************************************) Module mc_1_11. Local Notation lersif x y b := (Order.lteif x y (~~ b)) (only parsing). Local Notation "x <= y ?< 'if' b" := (x < y ?<= if ~~ b) (at level 70, y at next level, only parsing) : ring_scope. Section LersifPo. Variable R : numDomainType. Implicit Types (b : bool) (x y z : R). Lemma subr_lersifr0 b (x y : R) : (y - x <= 0 ?< if b) = (y <= x ?< if b). Proof. exact: subr_lteifr0. Qed. Lemma subr_lersif0r b (x y : R) : (0 <= y - x ?< if b) = (x <= y ?< if b). Proof. exact: subr_lteif0r. Qed. Definition subr_lersif0 := (subr_lersifr0, subr_lersif0r). Lemma lersif_trans x y z b1 b2 : x <= y ?< if b1 -> y <= z ?< if b2 -> x <= z ?< if b1 || b2. Proof. by rewrite negb_or; exact: lteif_trans. Qed. Lemma lersif01 b : (0 : R) <= 1 ?< if b. Proof. exact: lteif01. 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 rewrite lteif_anti -negb_or; case: orb. Qed. Lemma lersifxx x b : (x <= x ?< if b) = ~~ b. Proof. exact: lteifxx. Qed. Lemma lersifNF x y b : y <= x ?< if ~~ b -> x <= y ?< if b = false. Proof. exact: lteifNF. Qed. Lemma lersifS x y b : x < y -> x <= y ?< if b. Proof. exact: lteifS. Qed. Lemma lersifT x y : x <= y ?< if true = (x < y). Proof. by []. Qed. Lemma lersifF x y : x <= y ?< if false = (x <= y). Proof. by []. Qed. Lemma lersif_oppl b x y : - x <= y ?< if b = (- y <= x ?< if b). Proof. exact: lteif_oppl. Qed. Lemma lersif_oppr b x y : x <= - y ?< if b = (y <= - x ?< if b). Proof. exact: lteif_oppr. Qed. Lemma lersif_0oppr b x : 0 <= - x ?< if b = (x <= 0 ?< if b). Proof. exact: lteif_0oppr. Qed. Lemma lersif_oppr0 b x : - x <= 0 ?< if b = (0 <= x ?< if b). Proof. exact: lteif_oppr0. Qed. Lemma lersif_opp2 b : {mono (-%R : R -> R) : x y /~ x <= y ?< if b}. Proof. exact: lteif_opp2. Qed. Definition lersif_oppE := (lersif_0oppr, lersif_oppr0, lersif_opp2). Lemma lersif_add2l b x : {mono +%R x : y z / y <= z ?< if b}. Proof. exact: lteif_add2l. Qed. Lemma lersif_add2r b x : {mono +%R^~ x : y z / y <= z ?< if b}. Proof. exact: lteif_add2r. Qed. Definition lersif_add2 := (lersif_add2l, lersif_add2r). Lemma lersif_subl_addr b x y z : (x - y <= z ?< if b) = (x <= z + y ?< if b). Proof. exact: lteif_subl_addr. Qed. Lemma lersif_subr_addr b x y z : (x <= y - z ?< if b) = (x + z <= y ?< if b). Proof. exact: lteif_subr_addr. Qed. Definition lersif_sub_addr := (lersif_subl_addr, lersif_subr_addr). Lemma lersif_subl_addl b x y z : (x - y <= z ?< if b) = (x <= y + z ?< if b). Proof. exact: lteif_subl_addl. Qed. Lemma lersif_subr_addl b x y z : (x <= y - z ?< if b) = (z + x <= y ?< if b). Proof. exact: lteif_subr_addl. Qed. Definition lersif_sub_addl := (lersif_subl_addl, lersif_subr_addl). Lemma lersif_andb x y : {morph (fun b => lersif x y b) : p q / p || q >-> p && q}. Proof. by move=> ? ?; rewrite negb_or lteif_andb. Qed. Lemma lersif_orb x y : {morph (fun b => lersif x y b) : p q / p && q >-> p || q}. Proof. by move=> ? ?; rewrite negb_and lteif_orb. Qed. Lemma lersif_imply b1 b2 (r1 r2 : R) : b2 ==> b1 -> r1 <= r2 ?< if b1 -> r1 <= r2 ?< if b2. Proof. by move=> ?; apply: lteif_imply; rewrite implybNN. Qed. Lemma lersifW b x y : x <= y ?< if b -> x <= y. Proof. exact: lteifW. Qed. Lemma ltrW_lersif b x y : x < y -> x <= y ?< if b. Proof. exact: ltrW_lteif. Qed. Lemma lersif_pmul2l b x : 0 < x -> {mono *%R x : y z / y <= z ?< if b}. Proof. exact: lteif_pmul2l. Qed. Lemma lersif_pmul2r b x : 0 < x -> {mono *%R^~ x : y z / y <= z ?< if b}. Proof. exact: lteif_pmul2r. Qed. Lemma lersif_nmul2l b x : x < 0 -> {mono *%R x : y z /~ y <= z ?< if b}. Proof. exact: lteif_nmul2l. Qed. Lemma lersif_nmul2r b x : x < 0 -> {mono *%R^~ x : y z /~ y <= z ?< if b}. Proof. exact: lteif_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. exact: real_lteifNE. Qed. Lemma real_lersif_norml b x y : x \is Num.real -> (`|x| <= y ?< if b) = ((- y <= x ?< if b) && (x <= y ?< if b)). Proof. exact: real_lteif_norml. Qed. Lemma real_lersif_normr b x y : y \is Num.real -> (x <= `|y| ?< if b) = ((x <= y ?< if b) || (x <= - y ?< if b)). Proof. exact: real_lteif_normr. Qed. Lemma lersif_nnormr b x y : y <= 0 ?< if ~~ b -> (`|x| <= y ?< if b) = false. Proof. exact: lteif_nnormr. Qed. End LersifPo. Section LersifOrdered. Variable (R : realDomainType) (b : bool) (x y z e : R). Lemma lersifN : (x <= y ?< if ~~ b) = ~~ (y <= x ?< if b). Proof. exact: lteifNE. Qed. Lemma lersif_norml : (`|x| <= y ?< if b) = (- y <= x ?< if b) && (x <= y ?< if b). Proof. exact: lteif_norml. Qed. Lemma lersif_normr : (x <= `|y| ?< if b) = (x <= y ?< if b) || (x <= - y ?< if b). Proof. exact: lteif_normr. Qed. Lemma lersif_distl : (`|x - y| <= e ?< if b) = (y - e <= x ?< if b) && (x <= y + e ?< if b). Proof. exact: lteif_distl. Qed. Lemma lersif_minr : (x <= Num.min y z ?< if b) = (x <= y ?< if b) && (x <= z ?< if b). Proof. exact: lteif_minr. Qed. Lemma lersif_minl : (Num.min y z <= x ?< if b) = (y <= x ?< if b) || (z <= x ?< if b). Proof. exact: lteif_minl. Qed. Lemma lersif_maxr : (x <= Num.max y z ?< if b) = (x <= y ?< if b) || (x <= z ?< if b). Proof. exact: lteif_maxr. Qed. Lemma lersif_maxl : (Num.max y z <= x ?< if b) = (y <= x ?< if b) && (z <= x ?< if b). Proof. exact: lteif_maxl. Qed. End LersifOrdered. Section LersifField. Variable (F : numFieldType) (b : bool) (z x y : F). Lemma lersif_pdivl_mulr : 0 < z -> x <= y / z ?< if b = (x * z <= y ?< if b). Proof. exact: lteif_pdivl_mulr. Qed. Lemma lersif_pdivr_mulr : 0 < z -> y / z <= x ?< if b = (y <= x * z ?< if b). Proof. exact: lteif_pdivr_mulr. Qed. Lemma lersif_pdivl_mull : 0 < z -> x <= z^-1 * y ?< if b = (z * x <= y ?< if b). Proof. exact: lteif_pdivl_mull. Qed. Lemma lersif_pdivr_mull : 0 < z -> z^-1 * y <= x ?< if b = (y <= z * x ?< if b). Proof. exact: lteif_pdivr_mull. Qed. Lemma lersif_ndivl_mulr : z < 0 -> x <= y / z ?< if b = (y <= x * z ?< if b). Proof. exact: lteif_ndivl_mulr. Qed. Lemma lersif_ndivr_mulr : z < 0 -> y / z <= x ?< if b = (x * z <= y ?< if b). Proof. exact: lteif_ndivr_mulr. Qed. Lemma lersif_ndivl_mull : z < 0 -> x <= z^-1 * y ?< if b = (y <=z * x ?< if b). Proof. exact: lteif_ndivl_mull. Qed. Lemma lersif_ndivr_mull : z < 0 -> z^-1 * y <= x ?< if b = (z * x <= y ?< if b). Proof. exact: lteif_ndivr_mull. Qed. End LersifField. Section IntervalPo. Variable R : numDomainType. Implicit Types (x xa xb : R). Lemma lersif_in_itv ba bb xa xb x : x \in Interval (BSide ba xa) (BSide bb xb) -> xa <= xb ?< if ~~ ba || bb. Proof. by move/lt_in_itv; rewrite negb_or negbK. Qed. Lemma itv_gte ba xa bb xb : xb <= xa ?< if ba && ~~ bb -> Interval (BSide ba xa) (BSide bb xb) =i pred0. Proof. by move=> ?; apply: itv_ge; rewrite /<%O /= lteifNF. Qed. Lemma ltr_in_itv ba bb xa xb x : ~~ ba || bb -> x \in Interval (BSide ba xa) (BSide bb xb) -> xa < xb. Proof. by move=> bab /lersif_in_itv; rewrite bab. Qed. Lemma ler_in_itv ba bb xa xb x : x \in Interval (BSide ba xa) (BSide bb xb) -> xa <= xb. Proof. by move/lt_in_itv/lteifW. Qed. End IntervalPo. Lemma itv_splitU2 (R : realDomainType) (x : R) a b : x \in Interval a b -> forall y, y \in Interval a b = [|| y \in Interval a (BLeft x), y == x | y \in Interval (BRight x) b]. Proof. exact: itv_splitUeq. Qed. End mc_1_11. (* Use `Order.lteif` instead of `lteif`. (`deprecate` does not accept a *) (* qualified name.) *) Local Notation lteif := Order.lteif (only parsing). Notation "@ 'lersif'" := ((fun _ (R : numDomainType) x y b => @Order.lteif _ R x y (~~ b)) (deprecate lersif lteif)) (at level 10, only parsing). Notation lersif := (@lersif _) (only parsing). Notation "x <= y ?< 'if' b" := ((fun _ => x < y ?<= if ~~ b) (deprecate lersif lteif)) (at level 70, y at next level, only parsing) : ring_scope. (* LersifPo *) Notation "@ 'subr_lersifr0'" := ((fun _ => @mc_1_11.subr_lersifr0) (deprecate subr_lersifr0 subr_lteifr0)) (at level 10, only parsing). Notation subr_lersifr0 := (@subr_lersifr0 _) (only parsing). Notation "@ 'subr_lersif0r'" := ((fun _ => @mc_1_11.subr_lersif0r) (deprecate subr_lersif0r subr_lteif0r)) (at level 10, only parsing). Notation subr_lersif0r := (@subr_lersif0r _) (only parsing). Notation subr_lersif0 := ((fun _ => @mc_1_11.subr_lersif0) (deprecate subr_lersif0 subr_lteif0)) (only parsing). Notation "@ 'lersif_trans'" := ((fun _ => @mc_1_11.lersif_trans) (deprecate lersif_trans lteif_trans)) (at level 10, only parsing). Notation lersif_trans := (@lersif_trans _ _ _ _ _ _) (only parsing). Notation lersif01 := ((fun _ => @mc_1_11.lersif01) (deprecate lersif01 lteif01)) (only parsing). Notation "@ 'lersif_anti'" := ((fun _ => @mc_1_11.lersif_anti) (deprecate lersif_anti lteif_anti)) (at level 10, only parsing). Notation lersif_anti := (@lersif_anti _) (only parsing). Notation "@ 'lersifxx'" := ((fun _ => @mc_1_11.lersifxx) (deprecate lersifxx lteifxx)) (at level 10, only parsing). Notation lersifxx := (@lersifxx _) (only parsing). Notation "@ 'lersifNF'" := ((fun _ => @mc_1_11.lersifNF) (deprecate lersifNF lteifNF)) (at level 10, only parsing). Notation lersifNF := (@lersifNF _ _ _ _) (only parsing). Notation "@ 'lersifS'" := ((fun _ => @mc_1_11.lersifS) (deprecate lersifS lteifS)) (at level 10, only parsing). Notation lersifS := (@lersifS _ _ _) (only parsing). Notation "@ 'lersifT'" := ((fun _ => @mc_1_11.lersifT) (deprecate lersifT lteifT)) (at level 10, only parsing). Notation lersifT := (@lersifT _) (only parsing). Notation "@ 'lersifF'" := ((fun _ => @mc_1_11.lersifF) (deprecate lersifF lteifF)) (at level 10, only parsing). Notation lersifF := (@lersifF _) (only parsing). Notation "@ 'lersif_oppl'" := ((fun _ => @mc_1_11.lersif_oppl) (deprecate lersif_oppl lteif_oppl)) (at level 10, only parsing). Notation lersif_oppl := (@lersif_oppl _) (only parsing). Notation "@ 'lersif_oppr'" := ((fun _ => @mc_1_11.lersif_oppr) (deprecate lersif_oppr lteif_oppr)) (at level 10, only parsing). Notation lersif_oppr := (@lersif_oppr _) (only parsing). Notation "@ 'lersif_0oppr'" := ((fun _ => @mc_1_11.lersif_0oppr) (deprecate lersif_0oppr lteif_0oppr)) (at level 10, only parsing). Notation lersif_0oppr := (@lersif_0oppr _) (only parsing). Notation "@ 'lersif_oppr0'" := ((fun _ => @mc_1_11.lersif_oppr0) (deprecate lersif_oppr0 lteif_oppr0)) (at level 10, only parsing). Notation lersif_oppr0 := (@lersif_oppr0 _) (only parsing). Notation "@ 'lersif_opp2'" := ((fun _ => @mc_1_11.lersif_opp2) (deprecate lersif_opp2 lteif_opp2)) (at level 10, only parsing). Notation lersif_opp2 := (@lersif_opp2 _) (only parsing). Notation lersif_oppE := ((fun _ => @mc_1_11.lersif_oppE) (deprecate lersif_oppE lteif_oppE)) (only parsing). Notation "@ 'lersif_add2l'" := ((fun _ => @mc_1_11.lersif_add2l) (deprecate lersif_add2l lteif_add2l)) (at level 10, only parsing). Notation lersif_add2l := (@lersif_add2l _) (only parsing). Notation "@ 'lersif_add2r'" := ((fun _ => @mc_1_11.lersif_add2r) (deprecate lersif_add2r lteif_add2r)) (at level 10, only parsing). Notation lersif_add2r := (@lersif_add2r _) (only parsing). Notation lersif_add2 := ((fun _ => @mc_1_11.lersif_add2) (deprecate lersif_add2 lteif_add2)) (only parsing). Notation "@ 'lersif_subl_addr'" := ((fun _ => @mc_1_11.lersif_subl_addr) (deprecate lersif_subl_addr lteif_subl_addr)) (at level 10, only parsing). Notation lersif_subl_addr := (@lersif_subl_addr _) (only parsing). Notation "@ 'lersif_subr_addr'" := ((fun _ => @mc_1_11.lersif_subr_addr) (deprecate lersif_subr_addr lteif_subr_addr)) (at level 10, only parsing). Notation lersif_subr_addr := (@lersif_subr_addr _) (only parsing). Notation lersif_sub_addr := ((fun _ => @mc_1_11.lersif_sub_addr) (deprecate lersif_sub_addr lteif_sub_addr)) (only parsing). Notation "@ 'lersif_subl_addl'" := ((fun _ => @mc_1_11.lersif_subl_addl) (deprecate lersif_subl_addl lteif_subl_addl)) (at level 10, only parsing). Notation lersif_subl_addl := (@lersif_subl_addl _) (only parsing). Notation "@ 'lersif_subr_addl'" := ((fun _ => @mc_1_11.lersif_subr_addl) (deprecate lersif_subr_addl lteif_subr_addl)) (at level 10, only parsing). Notation lersif_subr_addl := (@lersif_subr_addl _) (only parsing). Notation lersif_sub_addl := ((fun _ => @mc_1_11.lersif_sub_addl) (deprecate lersif_sub_addl lteif_sub_addl)) (only parsing). Notation "@ 'lersif_andb'" := ((fun _ => @mc_1_11.lersif_andb) (deprecate lersif_andb lteif_andb)) (at level 10, only parsing). Notation lersif_andb := (@lersif_andb _) (only parsing). Notation "@ 'lersif_orb'" := ((fun _ => @mc_1_11.lersif_orb) (deprecate lersif_orb lteif_orb)) (at level 10, only parsing). Notation lersif_orb := (@lersif_orb _) (only parsing). Notation "@ 'lersif_imply'" := ((fun _ => @mc_1_11.lersif_imply) (deprecate lersif_imply lteif_imply)) (at level 10, only parsing). Notation lersif_imply := (@lersif_imply _ _ _ _ _) (only parsing). Notation "@ 'lersifW'" := ((fun _ => @mc_1_11.lersifW) (deprecate lersifW lteifW)) (at level 10, only parsing). Notation lersifW := (@lersifW _ _ _ _) (only parsing). Notation "@ 'ltrW_lersif'" := ((fun _ => @mc_1_11.ltrW_lersif) (deprecate ltrW_lersif ltrW_lteif)) (at level 10, only parsing). Notation ltrW_lersif := (@ltrW_lersif _) (only parsing). Notation "@ 'lersif_pmul2l'" := ((fun _ => @mc_1_11.lersif_pmul2l) (deprecate lersif_pmul2l lteif_pmul2l)) (at level 10, only parsing). Notation lersif_pmul2l := (fun b => @lersif_pmul2l _ b _) (only parsing). Notation "@ 'lersif_pmul2r'" := ((fun _ => @mc_1_11.lersif_pmul2r) (deprecate lersif_pmul2r lteif_pmul2r)) (at level 10, only parsing). Notation lersif_pmul2r := (fun b => @lersif_pmul2r _ b _) (only parsing). Notation "@ 'lersif_nmul2l'" := ((fun _ => @mc_1_11.lersif_nmul2l) (deprecate lersif_nmul2l lteif_nmul2l)) (at level 10, only parsing). Notation lersif_nmul2l := (fun b => @lersif_nmul2l _ b _) (only parsing). Notation "@ 'lersif_nmul2r'" := ((fun _ => @mc_1_11.lersif_nmul2r) (deprecate lersif_nmul2r lteif_nmul2r)) (at level 10, only parsing). Notation lersif_nmul2r := (fun b => @lersif_nmul2r _ b _) (only parsing). Notation "@ 'real_lersifN'" := ((fun _ => @mc_1_11.real_lersifN) (deprecate real_lersifN real_lteifNE)) (at level 10, only parsing). Notation real_lersifN := (@real_lersifN _ _ _) (only parsing). Notation "@ 'real_lersif_norml'" := ((fun _ => @mc_1_11.real_lersif_norml) (deprecate real_lersif_norml real_lteif_norml)) (at level 10, only parsing). Notation real_lersif_norml := (fun b => @real_lersif_norml _ b _) (only parsing). Notation "@ 'real_lersif_normr'" := ((fun _ => @mc_1_11.real_lersif_normr) (deprecate real_lersif_normr real_lteif_normr)) (at level 10, only parsing). Notation real_lersif_normr := (fun b x => @real_lersif_normr _ b x _) (only parsing). Notation "@ 'lersif_nnormr'" := ((fun _ => @mc_1_11.lersif_nnormr) (deprecate lersif_nnormr lteif_nnormr)) (at level 10, only parsing). Notation lersif_nnormr := (fun x => @lersif_nnormr _ _ x _) (only parsing). (* LersifOrdered *) Notation "@ 'lersifN'" := ((fun _ => @mc_1_11.lersifN) (deprecate lersifN lteifNE)) (at level 10, only parsing). Notation lersifN := (@lersifN _) (only parsing). Notation "@ 'lersif_norml'" := ((fun _ => @mc_1_11.lersif_norml) (deprecate lersif_norml lteif_norml)) (at level 10, only parsing). Notation lersif_norml := (@lersif_norml _) (only parsing). Notation "@ 'lersif_normr'" := ((fun _ => @mc_1_11.lersif_normr) (deprecate lersif_normr lteif_normr)) (at level 10, only parsing). Notation lersif_normr := (@lersif_normr _) (only parsing). Notation "@ 'lersif_distl'" := ((fun _ => @mc_1_11.lersif_distl) (deprecate lersif_distl lteif_distl)) (at level 10, only parsing). Notation lersif_distl := (@lersif_distl _) (only parsing). Notation "@ 'lersif_minr'" := ((fun _ => @mc_1_11.lersif_minr) (deprecate lersif_minr lteif_minr)) (at level 10, only parsing). Notation lersif_minr := (@lersif_minr _) (only parsing). Notation "@ 'lersif_minl'" := ((fun _ => @mc_1_11.lersif_minl) (deprecate lersif_minl lteif_minl)) (at level 10, only parsing). Notation lersif_minl := (@lersif_minl _) (only parsing). Notation "@ 'lersif_maxr'" := ((fun _ => @mc_1_11.lersif_maxr) (deprecate lersif_maxr lteif_maxr)) (at level 10, only parsing). Notation lersif_maxr := (@lersif_maxr _) (only parsing). Notation "@ 'lersif_maxl'" := ((fun _ => @mc_1_11.lersif_maxl) (deprecate lersif_maxl lteif_maxl)) (at level 10, only parsing). Notation lersif_maxl := (@lersif_maxl _) (only parsing). (* LersifField *) Notation "@ 'lersif_pdivl_mulr'" := ((fun _ => @mc_1_11.lersif_pdivl_mulr) (deprecate lersif_pdivl_mulr lteif_pdivl_mulr)) (at level 10, only parsing). Notation lersif_pdivl_mulr := (fun b => @lersif_pdivl_mulr _ b _) (only parsing). Notation "@ 'lersif_pdivr_mulr'" := ((fun _ => @mc_1_11.lersif_pdivr_mulr) (deprecate lersif_pdivr_mulr lteif_pdivr_mulr)) (at level 10, only parsing). Notation lersif_pdivr_mulr := (fun b => @lersif_pdivr_mulr _ b _) (only parsing). Notation "@ 'lersif_pdivl_mull'" := ((fun _ => @mc_1_11.lersif_pdivl_mull) (deprecate lersif_pdivl_mull lteif_pdivl_mull)) (at level 10, only parsing). Notation lersif_pdivl_mull := (fun b => @lersif_pdivl_mull _ b _) (only parsing). Notation "@ 'lersif_pdivr_mull'" := ((fun _ => @mc_1_11.lersif_pdivr_mull) (deprecate lersif_pdivr_mull lteif_pdivr_mull)) (at level 10, only parsing). Notation lersif_pdivr_mull := (fun b => @lersif_pdivr_mull _ b _) (only parsing). Notation "@ 'lersif_ndivl_mulr'" := ((fun _ => @mc_1_11.lersif_ndivl_mulr) (deprecate lersif_ndivl_mulr lteif_ndivl_mulr)) (at level 10, only parsing). Notation lersif_ndivl_mulr := (fun b => @lersif_ndivl_mulr _ b _) (only parsing). Notation "@ 'lersif_ndivr_mulr'" := ((fun _ => @mc_1_11.lersif_ndivr_mulr) (deprecate lersif_ndivr_mulr lteif_ndivr_mulr)) (at level 10, only parsing). Notation lersif_ndivr_mulr := (fun b => @lersif_ndivr_mulr _ b _) (only parsing). Notation "@ 'lersif_ndivl_mull'" := ((fun _ => @mc_1_11.lersif_ndivl_mull) (deprecate lersif_ndivl_mull lteif_ndivl_mull)) (at level 10, only parsing). Notation lersif_ndivl_mull := (fun b => @lersif_ndivl_mull _ b _) (only parsing). Notation "@ 'lersif_ndivr_mull'" := ((fun _ => @mc_1_11.lersif_ndivr_mull) (deprecate lersif_ndivr_mull lteif_ndivr_mull)) (at level 10, only parsing). Notation lersif_ndivr_mull := (fun b => @lersif_ndivr_mull _ b _) (only parsing). (* IntervalPo *) Notation "@ 'lersif_in_itv'" := ((fun _ => @mc_1_11.lersif_in_itv) (deprecate lersif_in_itv lteif_in_itv)) (at level 10, only parsing). Notation lersif_in_itv := (@lersif_in_itv _ _ _ _ _ _) (only parsing). Notation "@ 'itv_gte'" := ((fun _ => @mc_1_11.itv_gte) (deprecate itv_gte itv_ge)) (at level 10, only parsing). Notation itv_gte := (@itv_gte _ _ _ _ _) (only parsing). Notation "@ 'ltr_in_itv'" := ((fun _ => @mc_1_11.ltr_in_itv) (deprecate ltr_in_itv lt_in_itv)) (at level 10, only parsing). Notation ltr_in_itv := (@ltr_in_itv _ _ _ _ _ _) (only parsing). Notation "@ 'ler_in_itv'" := ((fun _ => @mc_1_11.ler_in_itv) (deprecate ler_in_itv lt_in_itv)) (at level 10, only parsing). Notation ler_in_itv := (@ler_in_itv _ _ _ _ _ _) (only parsing). Notation "@ 'itv_splitU2'" := ((fun _ => @mc_1_11.itv_splitU2) (deprecate itv_splitU2 itv_splitUeq)) (at level 10, only parsing). Notation itv_splitU2 := (@itv_splitU2 _ _ _ _) (only parsing). (* `itv_intersection` accepts any `numDomainType` but `Order.meet` accepts *) (* only `realDomainType`. Use `Order.meet` instead of `itv_meet`. *) Notation "@ 'itv_intersection'" := ((fun _ (R : realDomainType) => @Order.meet _ [latticeType of interval R]) (deprecate itv_intersection itv_meet)) (at level 10, only parsing) : fun_scope. Notation itv_intersection := (@itv_intersection _) (only parsing). Notation "@ 'itv_intersection1i'" := ((fun _ (R : realDomainType) => @meet1x _ [tbLatticeType of interval R]) (deprecate itv_intersection1i meet1x)) (at level 10, only parsing) : fun_scope. Notation itv_intersection1i := (@itv_intersection1i _) (only parsing). Notation "@ 'itv_intersectioni1'" := ((fun _ (R : realDomainType) => @meetx1 _ [tbLatticeType of interval R]) (deprecate itv_intersectioni1 meetx1)) (at level 10, only parsing) : fun_scope. Notation itv_intersectioni1 := (@itv_intersectioni1 _) (only parsing). Notation "@ 'itv_intersectionii'" := ((fun _ (R : realDomainType) => @meetxx _ [latticeType of interval R]) (deprecate itv_intersectionii meetxx)) (at level 10, only parsing) : fun_scope. Notation itv_intersectionii := (@itv_intersectionii _) (only parsing). (* IntervalOrdered *) Notation "@ 'itv_intersectionC'" := ((fun _ (R : realDomainType) => @meetC _ [latticeType of interval R]) (deprecate itv_intersectionC meetC)) (at level 10, only parsing) : fun_scope. Notation itv_intersectionC := (@itv_intersectionC _) (only parsing). Notation "@ 'itv_intersectionA'" := ((fun _ (R : realDomainType) => @meetA _ [latticeType of interval R]) (deprecate itv_intersectionA meetA)) (at level 10, only parsing) : fun_scope. Notation itv_intersectionA := (@itv_intersectionA _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/matrix.v000066400000000000000000004264761375767750300222350ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import fintype finfun bigop finset fingroup perm. From mathcomp Require Import div prime binomial ssralg finalg zmodp countalg. (******************************************************************************) (* Basic concrete linear algebra : definition of type for matrices, and all *) (* basic matrix operations including determinant, trace and support for block *) (* decomposition. Matrices are represented by a row-major list of their *) (* coefficients but this implementation is hidden by three levels of wrappers *) (* (Matrix/Finfun/Tuple) so the matrix type should be treated as abstract and *) (* handled using only the operations described below: *) (* 'M[R]_(m, n) == the type of m rows by n columns matrices with *) (* 'M_(m, n) coefficients in R; the [R] is optional and is usually *) (* omitted. *) (* 'M[R]_n, 'M_n == the type of n x n square matrices. *) (* 'rV[R]_n, 'rV_n == the type of 1 x n row vectors. *) (* 'cV[R]_n, 'cV_n == the type of n x 1 column vectors. *) (* \matrix_(i < m, j < n) Expr(i, j) == *) (* the m x n matrix with general coefficient Expr(i, j), *) (* with i : 'I_m and j : 'I_n. the < m bound can be omitted *) (* if it is equal to n, though usually both bounds are *) (* omitted as they can be inferred from the context. *) (* \row_(j < n) Expr(j), \col_(i < m) Expr(i) *) (* the row / column vectors with general term Expr; the *) (* parentheses can be omitted along with the bound. *) (* \matrix_(i < m) RowExpr(i) == *) (* the m x n matrix with row i given by RowExpr(i) : 'rV_n. *) (* A i j == the coefficient of matrix A : 'M_(m, n) in column j of *) (* row i, where i : 'I_m, and j : 'I_n (via the coercion *) (* fun_of_matrix : matrix >-> Funclass). *) (* const_mx a == the constant matrix whose entries are all a (dimensions *) (* should be determined by context). *) (* map_mx f A == the pointwise image of A by f, i.e., the matrix Af *) (* congruent to A with Af i j = f (A i j) for all i and j. *) (* A^T == the matrix transpose of A. *) (* row i A == the i'th row of A (this is a row vector). *) (* col j A == the j'th column of A (a column vector). *) (* row' i A == A with the i'th row spliced out. *) (* col' i A == A with the j'th column spliced out. *) (* xrow i1 i2 A == A with rows i1 and i2 interchanged. *) (* xcol j1 j2 A == A with columns j1 and j2 interchanged. *) (* row_perm s A == A : 'M_(m, n) with rows permuted by s : 'S_m. *) (* col_perm s A == A : 'M_(m, n) with columns permuted by s : 'S_n. *) (* row_mx Al Ar == the row block matrix obtained by contatenating *) (* two matrices Al and Ar of the same height. *) (* col_mx Au Ad == the column block matrix / Au \ (Au and Ad must have the *) (* same width). \ Ad / *) (* block_mx Aul Aur Adl Adr == the block matrix / Aul Aur \ *) (* \ Adl Adr / *) (* [l|r]submx A == the left/right submatrices of a row block matrix A. *) (* Note that the type of A, 'M_(m, n1 + n2) indicates how A *) (* should be decomposed. *) (* [u|d]submx A == the up/down submatrices of a column block matrix A. *) (* [u|d][l|r]submx A == the upper left, etc submatrices of a block matrix A. *) (* mxsub f g A == generic reordered submatrix, given by functions f and g *) (* which specify which subset of rows and columns to take *) (* and how to reorder them, e.g. picking f and g to be *) (* increasing yields traditional submatrices. *) (* := \matrix_(i, j) A (f i) (g i) *) (* rowsub f A := mxsub f id A *) (* colsub g A := mxsub id g A *) (* castmx eq_mn A == A : 'M_(m, n) cast to 'M_(m', n') using the equation *) (* pair eq_mn : (m = m') * (n = n'). This is the usual *) (* workaround for the syntactic limitations of dependent *) (* types in Coq, and can be used to introduce a block *) (* decomposition. It simplifies to A when eq_mn is the *) (* pair (erefl m, erefl n) (using rewrite /castmx /=). *) (* conform_mx B A == A if A and B have the same dimensions, else B. *) (* mxvec A == a row vector of width m * n holding all the entries of *) (* the m x n matrix A. *) (* mxvec_index i j == the index of A i j in mxvec A. *) (* vec_mx v == the inverse of mxvec, reshaping a vector of width m * n *) (* back into into an m x n rectangular matrix. *) (* In 'M[R]_(m, n), R can be any type, but 'M[R]_(m, n) inherits the eqType, *) (* choiceType, countType, finType, zmodType structures of R; 'M[R]_(m, n) *) (* also has a natural lmodType R structure when R has a ringType structure. *) (* Because the type of matrices specifies their dimension, only non-trivial *) (* square matrices (of type 'M[R]_n.+1) can inherit the ring structure of R; *) (* indeed they then have an algebra structure (lalgType R, or algType R if R *) (* is a comRingType, or even unitAlgType if R is a comUnitRingType). *) (* We thus provide separate syntax for the general matrix multiplication, *) (* and other operations for matrices over a ringType R: *) (* A *m B == the matrix product of A and B; the width of A must be *) (* equal to the height of B. *) (* a%:M == the scalar matrix with a's on the main diagonal; in *) (* particular 1%:M denotes the identity matrix, and is is *) (* equal to 1%R when n is of the form n'.+1 (e.g., n >= 1). *) (* is_scalar_mx A <=> A is a scalar matrix (A = a%:M for some A). *) (* diag_mx d == the diagonal matrix whose main diagonal is d : 'rV_n. *) (* is_diag_mx A <=> A is a diagonal matrix: forall i j, i != j -> A i j = 0 *) (* is_trig_mx A <=> A is a triangular matrix: forall i j, i < j -> A i j = 0 *) (* delta_mx i j == the matrix with a 1 in row i, column j and 0 elsewhere. *) (* pid_mx r == the partial identity matrix with 1s only on the r first *) (* coefficients of the main diagonal; the dimensions of *) (* pid_mx r are determined by the context, and pid_mx r can *) (* be rectangular. *) (* copid_mx r == the complement to 1%:M of pid_mx r: a square diagonal *) (* matrix with 1s on all but the first r coefficients on *) (* its main diagonal. *) (* perm_mx s == the n x n permutation matrix for s : 'S_n. *) (* tperm_mx i1 i2 == the permutation matrix that exchanges i1 i2 : 'I_n. *) (* is_perm_mx A == A is a permutation matrix. *) (* lift0_mx A == the 1 + n square matrix block_mx 1 0 0 A when A : 'M_n. *) (* \tr A == the trace of a square matrix A. *) (* \det A == the determinant of A, using the Leibnitz formula. *) (* cofactor i j A == the i, j cofactor of A (the signed i, j minor of A), *) (* \adj A == the adjugate matrix of A (\adj A i j = cofactor j i A). *) (* A \in unitmx == A is invertible (R must be a comUnitRingType). *) (* invmx A == the inverse matrix of A if A \in unitmx A, otherwise A. *) (* A \is a mxOver S == the matrix A has its coefficients in S. *) (* comm_mx A B := A *m B = B *m A *) (* comm_mxb A B := A *m B == B *m A *) (* all_comm_mx As fs := all2rel comm_mxb fs *) (* The following operations provide a correspondence between linear functions *) (* and matrices: *) (* lin1_mx f == the m x n matrix that emulates via right product *) (* a (linear) function f : 'rV_m -> 'rV_n on ROW VECTORS *) (* lin_mx f == the (m1 * n1) x (m2 * n2) matrix that emulates, via the *) (* right multiplication on the mxvec encodings, a linear *) (* function f : 'M_(m1, n1) -> 'M_(m2, n2) *) (* lin_mul_row u := lin1_mx (mulmx u \o vec_mx) (applies a row-encoded *) (* function to the row-vector u). *) (* mulmx A == partially applied matrix multiplication (mulmx A B is *) (* displayed as A *m B), with, for A : 'M_(m, n), a *) (* canonical {linear 'M_(n, p) -> 'M(m, p}} structure. *) (* mulmxr A == self-simplifying right-hand matrix multiplication, i.e., *) (* mulmxr A B simplifies to B *m A, with, for A : 'M_(n, p), *) (* a canonical {linear 'M_(m, n) -> 'M(m, p}} structure. *) (* lin_mulmx A := lin_mx (mulmx A). *) (* lin_mulmxr A := lin_mx (mulmxr A). *) (* We also extend any finType structure of R to 'M[R]_(m, n), and define: *) (* {'GL_n[R]} == the finGroupType of units of 'M[R]_n.-1.+1. *) (* 'GL_n[R] == the general linear group of all matrices in {'GL_n(R)}. *) (* 'GL_n(p) == 'GL_n['F_p], the general linear group of a prime field. *) (* GLval u == the coercion of u : {'GL_n(R)} to a matrix. *) (* In addition to the lemmas relevant to these definitions, this file also *) (* proves several classic results, including : *) (* - The determinant is a multilinear alternate form. *) (* - The Laplace determinant expansion formulas: expand_det_[row|col]. *) (* - The Cramer rule : mul_mx_adj & mul_adj_mx. *) (* Finally, as an example of the use of block products, we program and prove *) (* the correctness of a classical linear algebra algorithm: *) (* cormen_lup A == the triangular decomposition (L, U, P) of a nontrivial *) (* square matrix A into a lower triagular matrix L with 1s *) (* on the main diagonal, an upper matrix U, and a *) (* permutation matrix P, such that P * A = L * U. *) (* This is example only; we use a different, more precise algorithm to *) (* develop the theory of matrix ranks and row spaces in mxalgebra.v *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Import GRing.Theory. Local Open Scope ring_scope. Reserved Notation "''M_' n" (at level 8, n at level 2, format "''M_' n"). Reserved Notation "''rV_' n" (at level 8, n at level 2, format "''rV_' n"). Reserved Notation "''cV_' n" (at level 8, n at level 2, format "''cV_' n"). Reserved Notation "''M_' ( n )" (at level 8). (* only parsing *) Reserved Notation "''M_' ( m , n )" (at level 8, format "''M_' ( m , n )"). Reserved Notation "''M[' R ]_ n" (at level 8, n at level 2). (* only parsing *) Reserved Notation "''rV[' R ]_ n" (at level 8, n at level 2). (* only parsing *) Reserved Notation "''cV[' R ]_ n" (at level 8, n at level 2). (* only parsing *) Reserved Notation "''M[' R ]_ ( n )" (at level 8). (* only parsing *) Reserved Notation "''M[' R ]_ ( m , n )" (at level 8). (* only parsing *) Reserved Notation "\matrix_ i E" (at level 36, E at level 36, i at level 2, format "\matrix_ i E"). Reserved Notation "\matrix_ ( i < n ) E" (at level 36, E at level 36, i, n at level 50). (* only parsing *) Reserved Notation "\matrix_ ( i , j ) E" (at level 36, E at level 36, i, j at level 50, format "\matrix_ ( i , j ) E"). Reserved Notation "\matrix[ k ]_ ( i , j ) E" (at level 36, E at level 36, i, j at level 50, format "\matrix[ k ]_ ( i , j ) E"). Reserved Notation "\matrix_ ( i < m , j < n ) E" (at level 36, E at level 36, i, m, j, n at level 50). (* only parsing *) Reserved Notation "\matrix_ ( i , j < n ) E" (at level 36, E at level 36, i, j, n at level 50). (* only parsing *) Reserved Notation "\row_ j E" (at level 36, E at level 36, j at level 2, format "\row_ j E"). Reserved Notation "\row_ ( j < n ) E" (at level 36, E at level 36, j, n at level 50). (* only parsing *) Reserved Notation "\col_ j E" (at level 36, E at level 36, j at level 2, format "\col_ j E"). Reserved Notation "\col_ ( j < n ) E" (at level 36, E at level 36, j, n at level 50). (* only parsing *) Reserved Notation "x %:M" (at level 8, format "x %:M"). Reserved Notation "A *m B" (at level 40, left associativity, format "A *m B"). Reserved Notation "A ^T" (at level 8, format "A ^T"). Reserved Notation "\tr A" (at level 10, A at level 8, format "\tr A"). Reserved Notation "\det A" (at level 10, A at level 8, format "\det A"). Reserved Notation "\adj A" (at level 10, A at level 8, format "\adj A"). Local Notation simp := (Monoid.Theory.simpm, oppr0). (*****************************************************************************) (****************************Type Definition**********************************) (*****************************************************************************) Section MatrixDef. Variable R : Type. Variables m n : nat. (* Basic linear algebra (matrices). *) (* We use dependent types (ordinals) for the indices so that ranges are *) (* mostly inferred automatically *) Variant matrix : predArgType := Matrix of {ffun 'I_m * 'I_n -> R}. Definition mx_val A := let: Matrix g := A in g. Canonical matrix_subType := Eval hnf in [newType for mx_val]. Fact matrix_key : unit. Proof. by []. Qed. Definition matrix_of_fun_def F := Matrix [ffun ij => F ij.1 ij.2]. Definition matrix_of_fun k := locked_with k matrix_of_fun_def. Canonical matrix_unlockable k := [unlockable fun matrix_of_fun k]. Definition fun_of_matrix A (i : 'I_m) (j : 'I_n) := mx_val A (i, j). Coercion fun_of_matrix : matrix >-> Funclass. Lemma mxE k F : matrix_of_fun k F =2 F. Proof. by move=> i j; rewrite unlock /fun_of_matrix /= ffunE. Qed. Lemma matrixP (A B : matrix) : A =2 B <-> A = B. Proof. rewrite /fun_of_matrix; split=> [/= eqAB | -> //]. by apply/val_inj/ffunP=> [[i j]]; apply: eqAB. Qed. Lemma eq_mx k F1 F2 : (F1 =2 F2) -> matrix_of_fun k F1 = matrix_of_fun k F2. Proof. by move=> eq_F; apply/matrixP => i j; rewrite !mxE eq_F. Qed. End MatrixDef. Arguments eq_mx {R m n k} [F1] F2 eq_F12. Bind Scope ring_scope with matrix. Notation "''M[' R ]_ ( m , n )" := (matrix R m n) (only parsing): type_scope. Notation "''rV[' R ]_ n" := 'M[R]_(1, n) (only parsing) : type_scope. Notation "''cV[' R ]_ n" := 'M[R]_(n, 1) (only parsing) : type_scope. Notation "''M[' R ]_ n" := 'M[R]_(n, n) (only parsing) : type_scope. Notation "''M[' R ]_ ( n )" := 'M[R]_n (only parsing) : type_scope. Notation "''M_' ( m , n )" := 'M[_]_(m, n) : type_scope. Notation "''rV_' n" := 'M_(1, n) : type_scope. Notation "''cV_' n" := 'M_(n, 1) : type_scope. Notation "''M_' n" := 'M_(n, n) : type_scope. Notation "''M_' ( n )" := 'M_n (only parsing) : type_scope. Notation "\matrix[ k ]_ ( i , j ) E" := (matrix_of_fun k (fun i j => E)) : ring_scope. Notation "\matrix_ ( i < m , j < n ) E" := (@matrix_of_fun _ m n matrix_key (fun i j => E)) (only parsing) : ring_scope. Notation "\matrix_ ( i , j < n ) E" := (\matrix_(i < n, j < n) E) (only parsing) : ring_scope. Notation "\matrix_ ( i , j ) E" := (\matrix_(i < _, j < _) E) : ring_scope. Notation "\matrix_ ( i < m ) E" := (\matrix_(i < m, j < _) @fun_of_matrix _ 1 _ E 0 j) (only parsing) : ring_scope. Notation "\matrix_ i E" := (\matrix_(i < _) E) : ring_scope. Notation "\col_ ( i < n ) E" := (@matrix_of_fun _ n 1 matrix_key (fun i _ => E)) (only parsing) : ring_scope. Notation "\col_ i E" := (\col_(i < _) E) : ring_scope. Notation "\row_ ( j < n ) E" := (@matrix_of_fun _ 1 n matrix_key (fun _ j => E)) (only parsing) : ring_scope. Notation "\row_ j E" := (\row_(j < _) E) : ring_scope. Definition matrix_eqMixin (R : eqType) m n := Eval hnf in [eqMixin of 'M[R]_(m, n) by <:]. Canonical matrix_eqType (R : eqType) m n:= Eval hnf in EqType 'M[R]_(m, n) (matrix_eqMixin R m n). Definition matrix_choiceMixin (R : choiceType) m n := [choiceMixin of 'M[R]_(m, n) by <:]. Canonical matrix_choiceType (R : choiceType) m n := Eval hnf in ChoiceType 'M[R]_(m, n) (matrix_choiceMixin R m n). Definition matrix_countMixin (R : countType) m n := [countMixin of 'M[R]_(m, n) by <:]. Canonical matrix_countType (R : countType) m n := Eval hnf in CountType 'M[R]_(m, n) (matrix_countMixin R m n). Canonical matrix_subCountType (R : countType) m n := Eval hnf in [subCountType of 'M[R]_(m, n)]. Definition matrix_finMixin (R : finType) m n := [finMixin of 'M[R]_(m, n) by <:]. Canonical matrix_finType (R : finType) m n := Eval hnf in FinType 'M[R]_(m, n) (matrix_finMixin R m n). Canonical matrix_subFinType (R : finType) m n := Eval hnf in [subFinType of 'M[R]_(m, n)]. Lemma card_matrix (F : finType) m n : (#|{: 'M[F]_(m, n)}| = #|F| ^ (m * n))%N. Proof. by rewrite card_sub card_ffun card_prod !card_ord. Qed. (*****************************************************************************) (****** Matrix structural operations (transpose, permutation, blocks) ********) (*****************************************************************************) Section MatrixStructural. Variable R : Type. (* Constant matrix *) Fact const_mx_key : unit. Proof. by []. Qed. Definition const_mx m n a : 'M[R]_(m, n) := \matrix[const_mx_key]_(i, j) a. Arguments const_mx {m n}. Section FixedDim. (* Definitions and properties for which we can work with fixed dimensions. *) Variables m n : nat. Implicit Type A : 'M[R]_(m, n). (* Reshape a matrix, to accomodate the block functions for instance. *) Definition castmx m' n' (eq_mn : (m = m') * (n = n')) A : 'M_(m', n') := let: erefl in _ = m' := eq_mn.1 return 'M_(m', n') in let: erefl in _ = n' := eq_mn.2 return 'M_(m, n') in A. Definition conform_mx m' n' B A := match m =P m', n =P n' with | ReflectT eq_m, ReflectT eq_n => castmx (eq_m, eq_n) A | _, _ => B end. (* Transpose a matrix *) Fact trmx_key : unit. Proof. by []. Qed. Definition trmx A := \matrix[trmx_key]_(i, j) A j i. (* Permute a matrix vertically (rows) or horizontally (columns) *) Fact row_perm_key : unit. Proof. by []. Qed. Definition row_perm (s : 'S_m) A := \matrix[row_perm_key]_(i, j) A (s i) j. Fact col_perm_key : unit. Proof. by []. Qed. Definition col_perm (s : 'S_n) A := \matrix[col_perm_key]_(i, j) A i (s j). (* Exchange two rows/columns of a matrix *) Definition xrow i1 i2 := row_perm (tperm i1 i2). Definition xcol j1 j2 := col_perm (tperm j1 j2). (* Row/Column sub matrices of a matrix *) Definition row i0 A := \row_j A i0 j. Definition col j0 A := \col_i A i j0. (* Removing a row/column from a matrix *) Definition row' i0 A := \matrix_(i, j) A (lift i0 i) j. Definition col' j0 A := \matrix_(i, j) A i (lift j0 j). (* reindexing/subindex a matrix *) Definition mxsub m' n' f g A := \matrix_(i < m', j < n') A (f i) (g j). Local Notation colsub g := (mxsub id g). Local Notation rowsub f := (mxsub f id). Lemma castmx_const m' n' (eq_mn : (m = m') * (n = n')) a : castmx eq_mn (const_mx a) = const_mx a. Proof. by case: eq_mn; case: m' /; case: n' /. Qed. Lemma trmx_const a : trmx (const_mx a) = const_mx a. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma row_perm_const s a : row_perm s (const_mx a) = const_mx a. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma col_perm_const s a : col_perm s (const_mx a) = const_mx a. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma xrow_const i1 i2 a : xrow i1 i2 (const_mx a) = const_mx a. Proof. exact: row_perm_const. Qed. Lemma xcol_const j1 j2 a : xcol j1 j2 (const_mx a) = const_mx a. Proof. exact: col_perm_const. Qed. Lemma rowP (u v : 'rV[R]_n) : u 0 =1 v 0 <-> u = v. Proof. by split=> [eq_uv | -> //]; apply/matrixP=> i; rewrite ord1. Qed. Lemma rowK u_ i0 : row i0 (\matrix_i u_ i) = u_ i0. Proof. by apply/rowP=> i'; rewrite !mxE. Qed. Lemma row_matrixP A B : (forall i, row i A = row i B) <-> A = B. Proof. split=> [eqAB | -> //]; apply/matrixP=> i j. by move/rowP/(_ j): (eqAB i); rewrite !mxE. Qed. Lemma colP (u v : 'cV[R]_m) : u^~ 0 =1 v^~ 0 <-> u = v. Proof. by split=> [eq_uv | -> //]; apply/matrixP=> i j; rewrite ord1. Qed. Lemma row_const i0 a : row i0 (const_mx a) = const_mx a. Proof. by apply/rowP=> j; rewrite !mxE. Qed. Lemma col_const j0 a : col j0 (const_mx a) = const_mx a. Proof. by apply/colP=> i; rewrite !mxE. Qed. Lemma row'_const i0 a : row' i0 (const_mx a) = const_mx a. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma col'_const j0 a : col' j0 (const_mx a) = const_mx a. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma col_perm1 A : col_perm 1 A = A. Proof. by apply/matrixP=> i j; rewrite mxE perm1. Qed. Lemma row_perm1 A : row_perm 1 A = A. Proof. by apply/matrixP=> i j; rewrite mxE perm1. Qed. Lemma col_permM s t A : col_perm (s * t) A = col_perm s (col_perm t A). Proof. by apply/matrixP=> i j; rewrite !mxE permM. Qed. Lemma row_permM s t A : row_perm (s * t) A = row_perm s (row_perm t A). Proof. by apply/matrixP=> i j; rewrite !mxE permM. Qed. Lemma col_row_permC s t A : col_perm s (row_perm t A) = row_perm t (col_perm s A). Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma rowEsub i : row i = rowsub (fun=> i). Proof. by []. Qed. Lemma colEsub j : col j = colsub (fun=> j). Proof. by []. Qed. Lemma row'Esub i : row' i = rowsub (lift i). Proof. by []. Qed. Lemma col'Esub j : col' j = colsub (lift j). Proof. by []. Qed. Lemma row_permEsub s : row_perm s = rowsub s. Proof. by rewrite /row_perm /mxsub !unlock. Qed. Lemma col_permEsub s : col_perm s = colsub s. Proof. by rewrite /col_perm /mxsub !unlock. Qed. Lemma xrowEsub i1 i2 : xrow i1 i2 = rowsub (tperm i1 i2). Proof. exact: row_permEsub. Qed. Lemma xcolEsub j1 j2 : xcol j1 j2 = colsub (tperm j1 j2). Proof. exact: col_permEsub. Qed. Lemma mxsub_id : mxsub id id =1 id. Proof. by move=> A; apply/matrixP => i j; rewrite !mxE. Qed. Lemma eq_mxsub m' n' f f' g g' : f =1 f' -> g =1 g' -> @mxsub m' n' f g =1 mxsub f' g'. Proof. by move=> eq_f eq_g A; apply/matrixP => i j; rewrite !mxE eq_f eq_g. Qed. Lemma eq_rowsub m' (f f' : 'I_m' -> 'I_m) : f =1 f' -> rowsub f =1 rowsub f'. Proof. by move=> /eq_mxsub; apply. Qed. Lemma eq_colsub n' (g g' : 'I_n' -> 'I_n) : g =1 g' -> colsub g =1 colsub g'. Proof. by move=> /eq_mxsub; apply. Qed. Lemma mxsub_eq_id f g : f =1 id -> g =1 id -> mxsub f g =1 id. Proof. by move=> fid gid A; rewrite (eq_mxsub fid gid) mxsub_id. Qed. Lemma mxsub_eq_colsub n' f g : f =1 id -> @mxsub _ n' f g =1 colsub g. Proof. by move=> f_id; apply: eq_mxsub. Qed. Lemma mxsub_eq_rowsub m' f g : g =1 id -> @mxsub m' _ f g =1 rowsub f. Proof. exact: eq_mxsub. Qed. Lemma mxsub_ffunl m' n' f g : @mxsub m' n' (finfun f) g =1 mxsub f g. Proof. by apply: eq_mxsub => // i; rewrite ffunE. Qed. Lemma mxsub_ffunr m' n' f g : @mxsub m' n' f (finfun g) =1 mxsub f g. Proof. by apply: eq_mxsub => // i; rewrite ffunE. Qed. Lemma mxsub_ffun m' n' f g : @mxsub m' n' (finfun f) (finfun g) =1 mxsub f g. Proof. by move=> A; rewrite mxsub_ffunl mxsub_ffunr. Qed. Lemma mxsub_const m' n' f g a : @mxsub m' n' f g (const_mx a) = const_mx a. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. End FixedDim. Local Notation colsub g := (mxsub id g). Local Notation rowsub f := (mxsub f id). Local Notation "A ^T" := (trmx A) : ring_scope. Lemma castmx_id m n erefl_mn (A : 'M_(m, n)) : castmx erefl_mn A = A. Proof. by case: erefl_mn => e_m e_n; rewrite [e_m]eq_axiomK [e_n]eq_axiomK. Qed. Lemma castmx_comp m1 n1 m2 n2 m3 n3 (eq_m1 : m1 = m2) (eq_n1 : n1 = n2) (eq_m2 : m2 = m3) (eq_n2 : n2 = n3) A : castmx (eq_m2, eq_n2) (castmx (eq_m1, eq_n1) A) = castmx (etrans eq_m1 eq_m2, etrans eq_n1 eq_n2) A. Proof. by case: m2 / eq_m1 eq_m2; case: m3 /; case: n2 / eq_n1 eq_n2; case: n3 /. Qed. Lemma castmxK m1 n1 m2 n2 (eq_m : m1 = m2) (eq_n : n1 = n2) : cancel (castmx (eq_m, eq_n)) (castmx (esym eq_m, esym eq_n)). Proof. by case: m2 / eq_m; case: n2 / eq_n. Qed. Lemma castmxKV m1 n1 m2 n2 (eq_m : m1 = m2) (eq_n : n1 = n2) : cancel (castmx (esym eq_m, esym eq_n)) (castmx (eq_m, eq_n)). Proof. by case: m2 / eq_m; case: n2 / eq_n. Qed. (* This can be use to reverse an equation that involves a cast. *) Lemma castmx_sym m1 n1 m2 n2 (eq_m : m1 = m2) (eq_n : n1 = n2) A1 A2 : A1 = castmx (eq_m, eq_n) A2 -> A2 = castmx (esym eq_m, esym eq_n) A1. Proof. by move/(canLR (castmxK _ _)). Qed. Lemma castmxE m1 n1 m2 n2 (eq_mn : (m1 = m2) * (n1 = n2)) A i j : castmx eq_mn A i j = A (cast_ord (esym eq_mn.1) i) (cast_ord (esym eq_mn.2) j). Proof. by do [case: eq_mn; case: m2 /; case: n2 /] in A i j *; rewrite !cast_ord_id. Qed. Lemma conform_mx_id m n (B A : 'M_(m, n)) : conform_mx B A = A. Proof. by rewrite /conform_mx; do 2!case: eqP => // *; rewrite castmx_id. Qed. Lemma nonconform_mx m m' n n' (B : 'M_(m', n')) (A : 'M_(m, n)) : (m != m') || (n != n') -> conform_mx B A = B. Proof. by rewrite /conform_mx; do 2!case: eqP. Qed. Lemma conform_castmx m1 n1 m2 n2 m3 n3 (e_mn : (m2 = m3) * (n2 = n3)) (B : 'M_(m1, n1)) A : conform_mx B (castmx e_mn A) = conform_mx B A. Proof. by do [case: e_mn; case: m3 /; case: n3 /] in A *. Qed. Lemma trmxK m n : cancel (@trmx m n) (@trmx n m). Proof. by move=> A; apply/matrixP=> i j; rewrite !mxE. Qed. Lemma trmx_inj m n : injective (@trmx m n). Proof. exact: can_inj (@trmxK m n). Qed. Lemma trmx_cast m1 n1 m2 n2 (eq_mn : (m1 = m2) * (n1 = n2)) A : (castmx eq_mn A)^T = castmx (eq_mn.2, eq_mn.1) A^T. Proof. by case: eq_mn => eq_m eq_n; apply/matrixP=> i j; rewrite !(mxE, castmxE). Qed. Lemma tr_row_perm m n s (A : 'M_(m, n)) : (row_perm s A)^T = col_perm s A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_col_perm m n s (A : 'M_(m, n)) : (col_perm s A)^T = row_perm s A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_xrow m n i1 i2 (A : 'M_(m, n)) : (xrow i1 i2 A)^T = xcol i1 i2 A^T. Proof. exact: tr_row_perm. Qed. Lemma tr_xcol m n j1 j2 (A : 'M_(m, n)) : (xcol j1 j2 A)^T = xrow j1 j2 A^T. Proof. exact: tr_col_perm. Qed. Lemma row_id n i (V : 'rV_n) : row i V = V. Proof. by apply/rowP=> j; rewrite mxE [i]ord1. Qed. Lemma col_id n j (V : 'cV_n) : col j V = V. Proof. by apply/colP=> i; rewrite mxE [j]ord1. Qed. Lemma row_eq m1 m2 n i1 i2 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : row i1 A1 = row i2 A2 -> A1 i1 =1 A2 i2. Proof. by move/rowP=> eqA12 j; have:= eqA12 j; rewrite !mxE. Qed. Lemma col_eq m n1 n2 j1 j2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : col j1 A1 = col j2 A2 -> A1^~ j1 =1 A2^~ j2. Proof. by move/colP=> eqA12 i; have:= eqA12 i; rewrite !mxE. Qed. Lemma row'_eq m n i0 (A B : 'M_(m, n)) : row' i0 A = row' i0 B -> {in predC1 i0, A =2 B}. Proof. move/matrixP=> eqAB' i; rewrite !inE eq_sym; case/unlift_some=> i' -> _ j. by have:= eqAB' i' j; rewrite !mxE. Qed. Lemma col'_eq m n j0 (A B : 'M_(m, n)) : col' j0 A = col' j0 B -> forall i, {in predC1 j0, A i =1 B i}. Proof. move/matrixP=> eqAB' i j; rewrite !inE eq_sym; case/unlift_some=> j' -> _. by have:= eqAB' i j'; rewrite !mxE. Qed. Lemma tr_row m n i0 (A : 'M_(m, n)) : (row i0 A)^T = col i0 A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_row' m n i0 (A : 'M_(m, n)) : (row' i0 A)^T = col' i0 A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_col m n j0 (A : 'M_(m, n)) : (col j0 A)^T = row j0 A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_col' m n j0 (A : 'M_(m, n)) : (col' j0 A)^T = row' j0 A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma mxsub_comp m1 m2 m3 n1 n2 n3 (f : 'I_m2 -> 'I_m1) (f' : 'I_m3 -> 'I_m2) (g : 'I_n2 -> 'I_n1) (g' : 'I_n3 -> 'I_n2) (A : 'M_(m1, n1)) : mxsub (f \o f') (g \o g') A = mxsub f' g' (mxsub f g A). Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma rowsub_comp m1 m2 m3 n (f : 'I_m2 -> 'I_m1) (f' : 'I_m3 -> 'I_m2) (A : 'M_(m1, n)) : rowsub (f \o f') A = rowsub f' (rowsub f A). Proof. exact: mxsub_comp. Qed. Lemma colsub_comp m n n2 n3 (g : 'I_n2 -> 'I_n) (g' : 'I_n3 -> 'I_n2) (A : 'M_(m, n)) : colsub (g \o g') A = colsub g' (colsub g A). Proof. exact: mxsub_comp. Qed. Lemma mxsubrc m1 m2 n n2 f g (A : 'M_(m1, n)) : mxsub f g A = rowsub f (colsub g A) :> 'M_(m2, n2). Proof. exact: mxsub_comp. Qed. Lemma mxsubcr m1 m2 n n2 f g (A : 'M_(m1, n)) : mxsub f g A = colsub g (rowsub f A) :> 'M_(m2, n2). Proof. exact: mxsub_comp. Qed. Lemma rowsub_cast m1 m2 n (eq_m : m1 = m2) (A : 'M_(m2, n)) : rowsub (cast_ord eq_m) A = castmx (esym eq_m, erefl) A. Proof. by case: _ / eq_m in A *; apply: (mxsub_eq_id (cast_ord_id _)). Qed. Lemma colsub_cast m n1 n2 (eq_n : n1 = n2) (A : 'M_(m, n2)) : colsub (cast_ord eq_n) A = castmx (erefl, esym eq_n) A. Proof. by case: _ / eq_n in A *; apply: (mxsub_eq_id _ (cast_ord_id _)). Qed. Lemma mxsub_cast m1 m2 n1 n2 (eq_m : m1 = m2) (eq_n : n1 = n2) A : mxsub (cast_ord eq_m) (cast_ord eq_n) A = castmx (esym eq_m, esym eq_n) A. Proof. by rewrite mxsubrc rowsub_cast colsub_cast castmx_comp/= etrans_id. Qed. Lemma castmxEsub m1 m2 n1 n2 (eq_mn : (m1 = m2) * (n1 = n2)) A : castmx eq_mn A = mxsub (cast_ord (esym eq_mn.1)) (cast_ord (esym eq_mn.2)) A. Proof. by rewrite mxsub_cast !esymK; case: eq_mn. Qed. Lemma trmx_mxsub m1 m2 n1 n2 f g (A : 'M_(m1, n1)) : (mxsub f g A)^T = mxsub g f A^T :> 'M_(n2, m2). Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma row_mxsub m1 m2 n1 n2 (f : 'I_m2 -> 'I_m1) (g : 'I_n2 -> 'I_n1) (A : 'M_(m1, n1)) i : row i (mxsub f g A) = row (f i) (colsub g A). Proof. by rewrite !rowEsub -!mxsub_comp. Qed. Lemma col_mxsub m1 m2 n1 n2 (f : 'I_m2 -> 'I_m1) (g : 'I_n2 -> 'I_n1) (A : 'M_(m1, n1)) i : col i (mxsub f g A) = col (g i) (rowsub f A). Proof. by rewrite !colEsub -!mxsub_comp. Qed. Lemma row_rowsub m1 m2 n (f : 'I_m2 -> 'I_m1) (A : 'M_(m1, n)) i : row i (rowsub f A) = row (f i) A. Proof. by rewrite row_mxsub mxsub_id. Qed. Lemma col_colsub m n1 n2 (g : 'I_n2 -> 'I_n1) (A : 'M_(m, n1)) i : col i (colsub g A) = col (g i) A. Proof. by rewrite col_mxsub mxsub_id. Qed. Ltac split_mxE := apply/matrixP=> i j; do ![rewrite mxE | case: split => ?]. Section CutPaste. Variables m m1 m2 n n1 n2 : nat. (* Concatenating two matrices, in either direction. *) Fact row_mx_key : unit. Proof. by []. Qed. Definition row_mx (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : 'M[R]_(m, n1 + n2) := \matrix[row_mx_key]_(i, j) match split j with inl j1 => A1 i j1 | inr j2 => A2 i j2 end. Fact col_mx_key : unit. Proof. by []. Qed. Definition col_mx (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : 'M[R]_(m1 + m2, n) := \matrix[col_mx_key]_(i, j) match split i with inl i1 => A1 i1 j | inr i2 => A2 i2 j end. (* Left/Right | Up/Down submatrices of a rows | columns matrix. *) (* The shape of the (dependent) width parameters of the type of A *) (* determines which submatrix is selected. *) Fact lsubmx_key : unit. Proof. by []. Qed. Definition lsubmx (A : 'M[R]_(m, n1 + n2)) := \matrix[lsubmx_key]_(i, j) A i (lshift n2 j). Fact rsubmx_key : unit. Proof. by []. Qed. Definition rsubmx (A : 'M[R]_(m, n1 + n2)) := \matrix[rsubmx_key]_(i, j) A i (rshift n1 j). Fact usubmx_key : unit. Proof. by []. Qed. Definition usubmx (A : 'M[R]_(m1 + m2, n)) := \matrix[usubmx_key]_(i, j) A (lshift m2 i) j. Fact dsubmx_key : unit. Proof. by []. Qed. Definition dsubmx (A : 'M[R]_(m1 + m2, n)) := \matrix[dsubmx_key]_(i, j) A (rshift m1 i) j. Lemma row_mxEl A1 A2 i j : row_mx A1 A2 i (lshift n2 j) = A1 i j. Proof. by rewrite mxE (unsplitK (inl _ _)). Qed. Lemma row_mxKl A1 A2 : lsubmx (row_mx A1 A2) = A1. Proof. by apply/matrixP=> i j; rewrite mxE row_mxEl. Qed. Lemma row_mxEr A1 A2 i j : row_mx A1 A2 i (rshift n1 j) = A2 i j. Proof. by rewrite mxE (unsplitK (inr _ _)). Qed. Lemma row_mxKr A1 A2 : rsubmx (row_mx A1 A2) = A2. Proof. by apply/matrixP=> i j; rewrite mxE row_mxEr. Qed. Lemma hsubmxK A : row_mx (lsubmx A) (rsubmx A) = A. Proof. by apply/matrixP=> i j; rewrite !mxE; case: split_ordP => k ->; rewrite !mxE. Qed. Lemma col_mxEu A1 A2 i j : col_mx A1 A2 (lshift m2 i) j = A1 i j. Proof. by rewrite mxE (unsplitK (inl _ _)). Qed. Lemma col_mxKu A1 A2 : usubmx (col_mx A1 A2) = A1. Proof. by apply/matrixP=> i j; rewrite mxE col_mxEu. Qed. Lemma col_mxEd A1 A2 i j : col_mx A1 A2 (rshift m1 i) j = A2 i j. Proof. by rewrite mxE (unsplitK (inr _ _)). Qed. Lemma col_mxKd A1 A2 : dsubmx (col_mx A1 A2) = A2. Proof. by apply/matrixP=> i j; rewrite mxE col_mxEd. Qed. Lemma lsubmxEsub : lsubmx = colsub (lshift _). Proof. by rewrite /lsubmx /mxsub !unlock. Qed. Lemma rsubmxEsub : rsubmx = colsub (@rshift _ _). Proof. by rewrite /rsubmx /mxsub !unlock. Qed. Lemma usubmxEsub : usubmx = rowsub (lshift _). Proof. by rewrite /usubmx /mxsub !unlock. Qed. Lemma dsubmxEsub : dsubmx = rowsub (@rshift _ _). Proof. by rewrite /dsubmx /mxsub !unlock. Qed. Lemma eq_row_mx A1 A2 B1 B2 : row_mx A1 A2 = row_mx B1 B2 -> A1 = B1 /\ A2 = B2. Proof. move=> eqAB; move: (congr1 lsubmx eqAB) (congr1 rsubmx eqAB). by rewrite !(row_mxKl, row_mxKr). Qed. Lemma eq_col_mx A1 A2 B1 B2 : col_mx A1 A2 = col_mx B1 B2 -> A1 = B1 /\ A2 = B2. Proof. move=> eqAB; move: (congr1 usubmx eqAB) (congr1 dsubmx eqAB). by rewrite !(col_mxKu, col_mxKd). Qed. Lemma row_mx_const a : row_mx (const_mx a) (const_mx a) = const_mx a. Proof. by split_mxE. Qed. Lemma col_mx_const a : col_mx (const_mx a) (const_mx a) = const_mx a. Proof. by split_mxE. Qed. Lemma row_usubmx A i : row i (usubmx A) = row (lshift m2 i) A. Proof. by apply/rowP=> j; rewrite !mxE; congr (A _ _); apply/val_inj. Qed. Lemma row_dsubmx A i : row i (dsubmx A) = row (rshift m1 i) A. Proof. by apply/rowP=> j; rewrite !mxE; congr (A _ _); apply/val_inj. Qed. Lemma col_lsubmx A i : col i (lsubmx A) = col (lshift n2 i) A. Proof. by apply/colP=> j; rewrite !mxE; congr (A _ _); apply/val_inj. Qed. Lemma col_rsubmx A i : col i (rsubmx A) = col (rshift n1 i) A. Proof. by apply/colP=> j; rewrite !mxE; congr (A _ _); apply/val_inj. Qed. End CutPaste. Lemma trmx_lsub m n1 n2 (A : 'M_(m, n1 + n2)) : (lsubmx A)^T = usubmx A^T. Proof. by split_mxE. Qed. Lemma trmx_rsub m n1 n2 (A : 'M_(m, n1 + n2)) : (rsubmx A)^T = dsubmx A^T. Proof. by split_mxE. Qed. Lemma tr_row_mx m n1 n2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : (row_mx A1 A2)^T = col_mx A1^T A2^T. Proof. by split_mxE. Qed. Lemma tr_col_mx m1 m2 n (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : (col_mx A1 A2)^T = row_mx A1^T A2^T. Proof. by split_mxE. Qed. Lemma trmx_usub m1 m2 n (A : 'M_(m1 + m2, n)) : (usubmx A)^T = lsubmx A^T. Proof. by split_mxE. Qed. Lemma trmx_dsub m1 m2 n (A : 'M_(m1 + m2, n)) : (dsubmx A)^T = rsubmx A^T. Proof. by split_mxE. Qed. Lemma vsubmxK m1 m2 n (A : 'M_(m1 + m2, n)) : col_mx (usubmx A) (dsubmx A) = A. Proof. by apply: trmx_inj; rewrite tr_col_mx trmx_usub trmx_dsub hsubmxK. Qed. Lemma cast_row_mx m m' n1 n2 (eq_m : m = m') A1 A2 : castmx (eq_m, erefl _) (row_mx A1 A2) = row_mx (castmx (eq_m, erefl n1) A1) (castmx (eq_m, erefl n2) A2). Proof. by case: m' / eq_m. Qed. Lemma cast_col_mx m1 m2 n n' (eq_n : n = n') A1 A2 : castmx (erefl _, eq_n) (col_mx A1 A2) = col_mx (castmx (erefl m1, eq_n) A1) (castmx (erefl m2, eq_n) A2). Proof. by case: n' / eq_n. Qed. (* This lemma has Prenex Implicits to help RL rewrititng with castmx_sym. *) Lemma row_mxA m n1 n2 n3 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) (A3 : 'M_(m, n3)) : let cast := (erefl m, esym (addnA n1 n2 n3)) in row_mx A1 (row_mx A2 A3) = castmx cast (row_mx (row_mx A1 A2) A3). Proof. apply: (canRL (castmxKV _ _)); apply/matrixP=> i j. rewrite castmxE !mxE cast_ord_id; case: splitP => j1 /= def_j. have: (j < n1 + n2) && (j < n1) by rewrite def_j lshift_subproof /=. by move: def_j; do 2![case: splitP => // ? ->; rewrite ?mxE] => /ord_inj->. case: splitP def_j => j2 ->{j} def_j; rewrite !mxE. have: ~~ (j2 < n1) by rewrite -leqNgt def_j leq_addr. have: j1 < n2 by rewrite -(ltn_add2l n1) -def_j. by move: def_j; do 2![case: splitP => // ? ->] => /addnI/val_inj->. have: ~~ (j1 < n2) by rewrite -leqNgt -(leq_add2l n1) -def_j leq_addr. by case: splitP def_j => // ? ->; rewrite addnA => /addnI/val_inj->. Qed. Definition row_mxAx := row_mxA. (* bypass Prenex Implicits. *) (* This lemma has Prenex Implicits to help RL rewrititng with castmx_sym. *) Lemma col_mxA m1 m2 m3 n (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) (A3 : 'M_(m3, n)) : let cast := (esym (addnA m1 m2 m3), erefl n) in col_mx A1 (col_mx A2 A3) = castmx cast (col_mx (col_mx A1 A2) A3). Proof. by apply: trmx_inj; rewrite trmx_cast !tr_col_mx -row_mxA. Qed. Definition col_mxAx := col_mxA. (* bypass Prenex Implicits. *) Lemma row_row_mx m n1 n2 i0 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : row i0 (row_mx A1 A2) = row_mx (row i0 A1) (row i0 A2). Proof. by apply/matrixP=> i j; rewrite !mxE; case: (split j) => j'; rewrite mxE. Qed. Lemma col_col_mx m1 m2 n j0 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : col j0 (col_mx A1 A2) = col_mx (col j0 A1) (col j0 A2). Proof. by apply: trmx_inj; rewrite !(tr_col, tr_col_mx, row_row_mx). Qed. Lemma row'_row_mx m n1 n2 i0 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : row' i0 (row_mx A1 A2) = row_mx (row' i0 A1) (row' i0 A2). Proof. by apply/matrixP=> i j; rewrite !mxE; case: (split j) => j'; rewrite mxE. Qed. Lemma col'_col_mx m1 m2 n j0 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : col' j0 (col_mx A1 A2) = col_mx (col' j0 A1) (col' j0 A2). Proof. by apply: trmx_inj; rewrite !(tr_col', tr_col_mx, row'_row_mx). Qed. Lemma colKl m n1 n2 j1 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : col (lshift n2 j1) (row_mx A1 A2) = col j1 A1. Proof. by apply/matrixP=> i j; rewrite !(row_mxEl, mxE). Qed. Lemma colKr m n1 n2 j2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : col (rshift n1 j2) (row_mx A1 A2) = col j2 A2. Proof. by apply/matrixP=> i j; rewrite !(row_mxEr, mxE). Qed. Lemma rowKu m1 m2 n i1 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : row (lshift m2 i1) (col_mx A1 A2) = row i1 A1. Proof. by apply/matrixP=> i j; rewrite !(col_mxEu, mxE). Qed. Lemma rowKd m1 m2 n i2 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : row (rshift m1 i2) (col_mx A1 A2) = row i2 A2. Proof. by apply/matrixP=> i j; rewrite !(col_mxEd, mxE). Qed. Lemma col'Kl m n1 n2 j1 (A1 : 'M_(m, n1.+1)) (A2 : 'M_(m, n2)) : col' (lshift n2 j1) (row_mx A1 A2) = row_mx (col' j1 A1) A2. Proof. apply/matrixP=> i /= j; symmetry; rewrite 2!mxE; case: split_ordP => j' ->. by rewrite mxE -(row_mxEl _ A2); congr (row_mx _ _ _); apply: ord_inj. rewrite -(row_mxEr A1); congr (row_mx _ _ _); apply: ord_inj => /=. by rewrite /bump -ltnS -addSn ltn_addr. Qed. Lemma row'Ku m1 m2 n i1 (A1 : 'M_(m1.+1, n)) (A2 : 'M_(m2, n)) : row' (lshift m2 i1) (@col_mx m1.+1 m2 n A1 A2) = col_mx (row' i1 A1) A2. Proof. by apply: trmx_inj; rewrite tr_col_mx !(@tr_row' _.+1) (@tr_col_mx _.+1) col'Kl. Qed. Lemma mx'_cast m n : 'I_n -> (m + n.-1)%N = (m + n).-1. Proof. by case=> j /ltn_predK <-; rewrite addnS. Qed. Lemma col'Kr m n1 n2 j2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : col' (rshift n1 j2) (@row_mx m n1 n2 A1 A2) = castmx (erefl m, mx'_cast n1 j2) (row_mx A1 (col' j2 A2)). Proof. apply/matrixP=> i j; symmetry; rewrite castmxE mxE cast_ord_id. case: splitP => j' /= def_j. rewrite mxE -(row_mxEl _ A2); congr (row_mx _ _ _); apply: ord_inj. by rewrite /= def_j /bump leqNgt ltn_addr. rewrite 2!mxE -(row_mxEr A1); congr (row_mx _ _ _ _); apply: ord_inj. by rewrite /= def_j /bump leq_add2l addnCA. Qed. Lemma row'Kd m1 m2 n i2 (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : row' (rshift m1 i2) (col_mx A1 A2) = castmx (mx'_cast m1 i2, erefl n) (col_mx A1 (row' i2 A2)). Proof. by apply: trmx_inj; rewrite trmx_cast !(tr_row', tr_col_mx) col'Kr. Qed. Section Block. Variables m1 m2 n1 n2 : nat. (* Building a block matrix from 4 matrices : *) (* up left, up right, down left and down right components *) Definition block_mx Aul Aur Adl Adr : 'M_(m1 + m2, n1 + n2) := col_mx (row_mx Aul Aur) (row_mx Adl Adr). Lemma eq_block_mx Aul Aur Adl Adr Bul Bur Bdl Bdr : block_mx Aul Aur Adl Adr = block_mx Bul Bur Bdl Bdr -> [/\ Aul = Bul, Aur = Bur, Adl = Bdl & Adr = Bdr]. Proof. by case/eq_col_mx; do 2!case/eq_row_mx=> -> ->. Qed. Lemma block_mx_const a : block_mx (const_mx a) (const_mx a) (const_mx a) (const_mx a) = const_mx a. Proof. by split_mxE. Qed. Section CutBlock. Variable A : matrix R (m1 + m2) (n1 + n2). Definition ulsubmx := lsubmx (usubmx A). Definition ursubmx := rsubmx (usubmx A). Definition dlsubmx := lsubmx (dsubmx A). Definition drsubmx := rsubmx (dsubmx A). Lemma submxK : block_mx ulsubmx ursubmx dlsubmx drsubmx = A. Proof. by rewrite /block_mx !hsubmxK vsubmxK. Qed. Lemma ulsubmxEsub : ulsubmx = mxsub (lshift _) (lshift _) A. Proof. by rewrite /ulsubmx lsubmxEsub usubmxEsub -mxsub_comp. Qed. Lemma dlsubmxEsub : dlsubmx = mxsub (@rshift _ _) (lshift _) A. Proof. by rewrite /dlsubmx lsubmxEsub dsubmxEsub -mxsub_comp. Qed. Lemma ursubmxEsub : ursubmx = mxsub (lshift _) (@rshift _ _) A. Proof. by rewrite /ursubmx rsubmxEsub usubmxEsub -mxsub_comp. Qed. Lemma drsubmxEsub : drsubmx = mxsub (@rshift _ _) (@rshift _ _) A. Proof. by rewrite /drsubmx rsubmxEsub dsubmxEsub -mxsub_comp. Qed. End CutBlock. Section CatBlock. Variables (Aul : 'M[R]_(m1, n1)) (Aur : 'M[R]_(m1, n2)). Variables (Adl : 'M[R]_(m2, n1)) (Adr : 'M[R]_(m2, n2)). Let A := block_mx Aul Aur Adl Adr. Lemma block_mxEul i j : A (lshift m2 i) (lshift n2 j) = Aul i j. Proof. by rewrite col_mxEu row_mxEl. Qed. Lemma block_mxKul : ulsubmx A = Aul. Proof. by rewrite /ulsubmx col_mxKu row_mxKl. Qed. Lemma block_mxEur i j : A (lshift m2 i) (rshift n1 j) = Aur i j. Proof. by rewrite col_mxEu row_mxEr. Qed. Lemma block_mxKur : ursubmx A = Aur. Proof. by rewrite /ursubmx col_mxKu row_mxKr. Qed. Lemma block_mxEdl i j : A (rshift m1 i) (lshift n2 j) = Adl i j. Proof. by rewrite col_mxEd row_mxEl. Qed. Lemma block_mxKdl : dlsubmx A = Adl. Proof. by rewrite /dlsubmx col_mxKd row_mxKl. Qed. Lemma block_mxEdr i j : A (rshift m1 i) (rshift n1 j) = Adr i j. Proof. by rewrite col_mxEd row_mxEr. Qed. Lemma block_mxKdr : drsubmx A = Adr. Proof. by rewrite /drsubmx col_mxKd row_mxKr. Qed. Lemma block_mxEv : A = col_mx (row_mx Aul Aur) (row_mx Adl Adr). Proof. by []. Qed. End CatBlock. End Block. Section TrCutBlock. Variables m1 m2 n1 n2 : nat. Variable A : 'M[R]_(m1 + m2, n1 + n2). Lemma trmx_ulsub : (ulsubmx A)^T = ulsubmx A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma trmx_ursub : (ursubmx A)^T = dlsubmx A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma trmx_dlsub : (dlsubmx A)^T = ursubmx A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma trmx_drsub : (drsubmx A)^T = drsubmx A^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. End TrCutBlock. Section TrBlock. Variables m1 m2 n1 n2 : nat. Variables (Aul : 'M[R]_(m1, n1)) (Aur : 'M[R]_(m1, n2)). Variables (Adl : 'M[R]_(m2, n1)) (Adr : 'M[R]_(m2, n2)). Lemma tr_block_mx : (block_mx Aul Aur Adl Adr)^T = block_mx Aul^T Adl^T Aur^T Adr^T. Proof. rewrite -[_^T]submxK -trmx_ulsub -trmx_ursub -trmx_dlsub -trmx_drsub. by rewrite block_mxKul block_mxKur block_mxKdl block_mxKdr. Qed. Lemma block_mxEh : block_mx Aul Aur Adl Adr = row_mx (col_mx Aul Adl) (col_mx Aur Adr). Proof. by apply: trmx_inj; rewrite tr_block_mx tr_row_mx 2!tr_col_mx. Qed. End TrBlock. (* This lemma has Prenex Implicits to help RL rewrititng with castmx_sym. *) Lemma block_mxA m1 m2 m3 n1 n2 n3 (A11 : 'M_(m1, n1)) (A12 : 'M_(m1, n2)) (A13 : 'M_(m1, n3)) (A21 : 'M_(m2, n1)) (A22 : 'M_(m2, n2)) (A23 : 'M_(m2, n3)) (A31 : 'M_(m3, n1)) (A32 : 'M_(m3, n2)) (A33 : 'M_(m3, n3)) : let cast := (esym (addnA m1 m2 m3), esym (addnA n1 n2 n3)) in let row1 := row_mx A12 A13 in let col1 := col_mx A21 A31 in let row3 := row_mx A31 A32 in let col3 := col_mx A13 A23 in block_mx A11 row1 col1 (block_mx A22 A23 A32 A33) = castmx cast (block_mx (block_mx A11 A12 A21 A22) col3 row3 A33). Proof. rewrite /= block_mxEh !col_mxA -cast_row_mx -block_mxEv -block_mxEh. rewrite block_mxEv block_mxEh !row_mxA -cast_col_mx -block_mxEh -block_mxEv. by rewrite castmx_comp etrans_id. Qed. Definition block_mxAx := block_mxA. (* Bypass Prenex Implicits *) Section Induction. Lemma row_ind m (P : forall n, 'M[R]_(m, n) -> Type) : (forall A, P 0%N A) -> (forall n c A, P n A -> P (1 + n)%N (row_mx c A)) -> forall n A, P n A. Proof. move=> P0 PS; elim=> [//|n IHn] A. by rewrite -[n.+1]/(1 + n)%N in A *; rewrite -[A]hsubmxK; apply: PS. Qed. Lemma col_ind n (P : forall m, 'M[R]_(m, n) -> Type) : (forall A, P 0%N A) -> (forall m r A, P m A -> P (1 + m)%N (col_mx r A)) -> forall m A, P m A. Proof. move=> P0 PS; elim=> [//|m IHm] A. by rewrite -[m.+1]/(1 + m)%N in A *; rewrite -[A]vsubmxK; apply: PS. Qed. Lemma mx_ind (P : forall m n, 'M[R]_(m, n) -> Type) : (forall m A, P m 0%N A) -> (forall n A, P 0%N n A) -> (forall m n x r c A, P m n A -> P (1 + m)%N (1 + n)%N (block_mx x r c A)) -> forall m n A, P m n A. Proof. move=> P0l P0r PS; elim=> [|m IHm] [|n] A; do ?by [apply: P0l|apply: P0r]. by rewrite -[A](@submxK 1 _ 1); apply: PS. Qed. Definition matrix_rect := mx_ind. Definition matrix_rec := mx_ind. Definition matrix_ind := mx_ind. Lemma sqmx_ind (P : forall n, 'M[R]_n -> Type) : (forall A, P 0%N A) -> (forall n x r c A, P n A -> P (1 + n)%N (block_mx x r c A)) -> forall n A, P n A. Proof. by move=> P0 PS; elim=> [//|n IHn] A; rewrite -[A](@submxK 1 _ 1); apply: PS. Qed. Lemma ringmx_ind (P : forall n, 'M[R]_n.+1 -> Type) : (forall x, P 0%N x) -> (forall n x (r : 'rV_n.+1) (c : 'cV_n.+1) A, P n A -> P (1 + n)%N (block_mx x r c A)) -> forall n A, P n A. Proof. by move=> P0 PS; elim=> [//|n IHn] A; rewrite -[A](@submxK 1 _ 1); apply: PS. Qed. Lemma mxsub_ind (weight : forall m n, 'M[R]_(m, n) -> nat) (sub : forall m n m' n', ('I_m' -> 'I_m) -> ('I_n' -> 'I_n) -> Prop) (P : forall m n, 'M[R]_(m, n) -> Type) : (forall m n (A : 'M[R]_(m, n)), (forall m' n' f g, weight m' n' (mxsub f g A) < weight m n A -> sub m n m' n' f g -> P m' n' (mxsub f g A)) -> P m n A) -> forall m n A, P m n A. Proof. move=> Psub m n A; have [k] := ubnP (weight m n A). elim: k => [//|k IHk] in m n A *. rewrite ltnS => lt_A_k; apply: Psub => m' n' f g lt_A'_A ?. by apply: IHk; apply: leq_trans lt_A_k. Qed. End Induction. (* Bijections mxvec : 'M_(m, n) <----> 'rV_(m * n) : vec_mx *) Section VecMatrix. Variables m n : nat. Lemma mxvec_cast : #|{:'I_m * 'I_n}| = (m * n)%N. Proof. by rewrite card_prod !card_ord. Qed. Definition mxvec_index (i : 'I_m) (j : 'I_n) := cast_ord mxvec_cast (enum_rank (i, j)). Variant is_mxvec_index : 'I_(m * n) -> Type := IsMxvecIndex i j : is_mxvec_index (mxvec_index i j). Lemma mxvec_indexP k : is_mxvec_index k. Proof. rewrite -[k](cast_ordK (esym mxvec_cast)) esymK. by rewrite -[_ k]enum_valK; case: (enum_val _). Qed. Coercion pair_of_mxvec_index k (i_k : is_mxvec_index k) := let: IsMxvecIndex i j := i_k in (i, j). Definition mxvec (A : 'M[R]_(m, n)) := castmx (erefl _, mxvec_cast) (\row_k A (enum_val k).1 (enum_val k).2). Fact vec_mx_key : unit. Proof. by []. Qed. Definition vec_mx (u : 'rV[R]_(m * n)) := \matrix[vec_mx_key]_(i, j) u 0 (mxvec_index i j). Lemma mxvecE A i j : mxvec A 0 (mxvec_index i j) = A i j. Proof. by rewrite castmxE mxE cast_ordK enum_rankK. Qed. Lemma mxvecK : cancel mxvec vec_mx. Proof. by move=> A; apply/matrixP=> i j; rewrite mxE mxvecE. Qed. Lemma vec_mxK : cancel vec_mx mxvec. Proof. by move=> u; apply/rowP=> k; case/mxvec_indexP: k => i j; rewrite mxvecE mxE. Qed. Lemma curry_mxvec_bij : {on 'I_(m * n), bijective (prod_curry mxvec_index)}. Proof. exists (enum_val \o cast_ord (esym mxvec_cast)) => [[i j] _ | k _] /=. by rewrite cast_ordK enum_rankK. by case/mxvec_indexP: k => i j /=; rewrite cast_ordK enum_rankK. Qed. End VecMatrix. End MatrixStructural. Arguments const_mx {R m n}. Arguments row_mxA {R m n1 n2 n3 A1 A2 A3}. Arguments col_mxA {R m1 m2 m3 n A1 A2 A3}. Arguments block_mxA {R m1 m2 m3 n1 n2 n3 A11 A12 A13 A21 A22 A23 A31 A32 A33}. Prenex Implicits castmx trmx trmxK lsubmx rsubmx usubmx dsubmx row_mx col_mx. Prenex Implicits block_mx ulsubmx ursubmx dlsubmx drsubmx. Prenex Implicits mxvec vec_mx mxvec_indexP mxvecK vec_mxK. Arguments trmx_inj {R m n} [A1 A2] eqA12t : rename. Notation "A ^T" := (trmx A) : ring_scope. Notation colsub g := (mxsub id g). Notation rowsub f := (mxsub f id). Arguments eq_mxsub [R m n m' n' f] f' [g] g' _. Arguments eq_rowsub [R m n m' f] f' _. Arguments eq_colsub [R m n n' g] g' _. (* Matrix parametricity. *) Section MapMatrix. Variables (aT rT : Type) (f : aT -> rT). Fact map_mx_key : unit. Proof. by []. Qed. Definition map_mx m n (A : 'M_(m, n)) := \matrix[map_mx_key]_(i, j) f (A i j). Notation "A ^f" := (map_mx A) : ring_scope. Section OneMatrix. Variables (m n : nat) (A : 'M[aT]_(m, n)). Lemma map_trmx : A^f^T = A^T^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_const_mx a : (const_mx a)^f = const_mx (f a) :> 'M_(m, n). Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_row i : (row i A)^f = row i A^f. Proof. by apply/rowP=> j; rewrite !mxE. Qed. Lemma map_col j : (col j A)^f = col j A^f. Proof. by apply/colP=> i; rewrite !mxE. Qed. Lemma map_row' i0 : (row' i0 A)^f = row' i0 A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_col' j0 : (col' j0 A)^f = col' j0 A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_mxsub m' n' g h : (@mxsub _ _ _ m' n' g h A)^f = mxsub g h A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_row_perm s : (row_perm s A)^f = row_perm s A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_col_perm s : (col_perm s A)^f = col_perm s A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_xrow i1 i2 : (xrow i1 i2 A)^f = xrow i1 i2 A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_xcol j1 j2 : (xcol j1 j2 A)^f = xcol j1 j2 A^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_castmx m' n' c : (castmx c A)^f = castmx c A^f :> 'M_(m', n'). Proof. by apply/matrixP=> i j; rewrite !(castmxE, mxE). Qed. Lemma map_conform_mx m' n' (B : 'M_(m', n')) : (conform_mx B A)^f = conform_mx B^f A^f. Proof. move: B; have [[<- <-] B|] := eqVneq (m, n) (m', n'). by rewrite !conform_mx_id. by rewrite negb_and => neq_mn B; rewrite !nonconform_mx. Qed. Lemma map_mxvec : (mxvec A)^f = mxvec A^f. Proof. by apply/rowP=> i; rewrite !(castmxE, mxE). Qed. Lemma map_vec_mx (v : 'rV_(m * n)) : (vec_mx v)^f = vec_mx v^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. End OneMatrix. Section Block. Variables m1 m2 n1 n2 : nat. Variables (Aul : 'M[aT]_(m1, n1)) (Aur : 'M[aT]_(m1, n2)). Variables (Adl : 'M[aT]_(m2, n1)) (Adr : 'M[aT]_(m2, n2)). Variables (Bh : 'M[aT]_(m1, n1 + n2)) (Bv : 'M[aT]_(m1 + m2, n1)). Variable B : 'M[aT]_(m1 + m2, n1 + n2). Lemma map_row_mx : (row_mx Aul Aur)^f = row_mx Aul^f Aur^f. Proof. by apply/matrixP=> i j; do 2![rewrite !mxE //; case: split => ?]. Qed. Lemma map_col_mx : (col_mx Aul Adl)^f = col_mx Aul^f Adl^f. Proof. by apply/matrixP=> i j; do 2![rewrite !mxE //; case: split => ?]. Qed. Lemma map_block_mx : (block_mx Aul Aur Adl Adr)^f = block_mx Aul^f Aur^f Adl^f Adr^f. Proof. by apply/matrixP=> i j; do 3![rewrite !mxE //; case: split => ?]. Qed. Lemma map_lsubmx : (lsubmx Bh)^f = lsubmx Bh^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_rsubmx : (rsubmx Bh)^f = rsubmx Bh^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_usubmx : (usubmx Bv)^f = usubmx Bv^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_dsubmx : (dsubmx Bv)^f = dsubmx Bv^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_ulsubmx : (ulsubmx B)^f = ulsubmx B^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_ursubmx : (ursubmx B)^f = ursubmx B^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_dlsubmx : (dlsubmx B)^f = dlsubmx B^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma map_drsubmx : (drsubmx B)^f = drsubmx B^f. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. End Block. End MapMatrix. Arguments map_mx {aT rT} f {m n} A. Section MultipleMapMatrix. Context {R S T : Type} {m n : nat}. Local Notation "M ^ phi" := (map_mx phi M). Lemma map_mx_comp (f : R -> S) (g : S -> T) (M : 'M_(m, n)) : M ^ (g \o f) = (M ^ f) ^ g. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma eq_in_map_mx (g f : R -> S) (M : 'M_(m, n)) : (forall i j, f (M i j) = g (M i j)) -> M ^ f = M ^ g. Proof. by move=> fg; apply/matrixP => i j; rewrite !mxE. Qed. Lemma eq_map_mx (g f : R -> S) : f =1 g -> forall (M : 'M_(m, n)), M ^ f = M ^ g. Proof. by move=> eq_fg M; apply/eq_in_map_mx. Qed. Lemma map_mx_id_in (f : R -> R) (M : 'M_(m, n)) : (forall i j, f (M i j) = M i j) -> M ^ f = M. Proof. by move=> fM; apply/matrixP => i j; rewrite !mxE. Qed. Lemma map_mx_id (f : R -> R) : f =1 id -> forall M : 'M_(m, n), M ^ f = M. Proof. by move=> fid M; rewrite map_mx_id_in. Qed. End MultipleMapMatrix. Arguments eq_map_mx {R S m n} g [f]. Arguments eq_in_map_mx {R S m n} g [f M]. Arguments map_mx_id_in {R m n} [f M]. Arguments map_mx_id {R m n} [f]. (*****************************************************************************) (********************* Matrix Zmodule (additive) structure *******************) (*****************************************************************************) Section MatrixZmodule. Variable V : zmodType. Section FixedDim. Variables m n : nat. Implicit Types A B : 'M[V]_(m, n). Fact oppmx_key : unit. Proof. by []. Qed. Fact addmx_key : unit. Proof. by []. Qed. Definition oppmx A := \matrix[oppmx_key]_(i, j) (- A i j). Definition addmx A B := \matrix[addmx_key]_(i, j) (A i j + B i j). (* In principle, diag_mx and scalar_mx could be defined here, but since they *) (* only make sense with the graded ring operations, we defer them to the *) (* next section. *) Lemma addmxA : associative addmx. Proof. by move=> A B C; apply/matrixP=> i j; rewrite !mxE addrA. Qed. Lemma addmxC : commutative addmx. Proof. by move=> A B; apply/matrixP=> i j; rewrite !mxE addrC. Qed. Lemma add0mx : left_id (const_mx 0) addmx. Proof. by move=> A; apply/matrixP=> i j; rewrite !mxE add0r. Qed. Lemma addNmx : left_inverse (const_mx 0) oppmx addmx. Proof. by move=> A; apply/matrixP=> i j; rewrite !mxE addNr. Qed. Definition matrix_zmodMixin := ZmodMixin addmxA addmxC add0mx addNmx. Canonical matrix_zmodType := Eval hnf in ZmodType 'M[V]_(m, n) matrix_zmodMixin. Lemma mulmxnE A d i j : (A *+ d) i j = A i j *+ d. Proof. by elim: d => [|d IHd]; rewrite ?mulrS mxE ?IHd. Qed. Lemma summxE I r (P : pred I) (E : I -> 'M_(m, n)) i j : (\sum_(k <- r | P k) E k) i j = \sum_(k <- r | P k) E k i j. Proof. by apply: (big_morph (fun A => A i j)) => [A B|]; rewrite mxE. Qed. Lemma const_mx_is_additive : additive const_mx. Proof. by move=> a b; apply/matrixP=> i j; rewrite !mxE. Qed. Canonical const_mx_additive := Additive const_mx_is_additive. End FixedDim. Section Additive. Variables (m n p q : nat) (f : 'I_p -> 'I_q -> 'I_m) (g : 'I_p -> 'I_q -> 'I_n). Definition swizzle_mx k (A : 'M[V]_(m, n)) := \matrix[k]_(i, j) A (f i j) (g i j). Lemma swizzle_mx_is_additive k : additive (swizzle_mx k). Proof. by move=> A B; apply/matrixP=> i j; rewrite !mxE. Qed. Canonical swizzle_mx_additive k := Additive (swizzle_mx_is_additive k). End Additive. Local Notation SwizzleAdd op := [additive of op as swizzle_mx _ _ _]. Canonical trmx_additive m n := SwizzleAdd (@trmx V m n). Canonical row_additive m n i := SwizzleAdd (@row V m n i). Canonical col_additive m n j := SwizzleAdd (@col V m n j). Canonical row'_additive m n i := SwizzleAdd (@row' V m n i). Canonical col'_additive m n j := SwizzleAdd (@col' V m n j). Canonical mxsub_additive m n m' n' f g := SwizzleAdd (@mxsub V m n m' n' f g). Canonical row_perm_additive m n s := SwizzleAdd (@row_perm V m n s). Canonical col_perm_additive m n s := SwizzleAdd (@col_perm V m n s). Canonical xrow_additive m n i1 i2 := SwizzleAdd (@xrow V m n i1 i2). Canonical xcol_additive m n j1 j2 := SwizzleAdd (@xcol V m n j1 j2). Canonical lsubmx_additive m n1 n2 := SwizzleAdd (@lsubmx V m n1 n2). Canonical rsubmx_additive m n1 n2 := SwizzleAdd (@rsubmx V m n1 n2). Canonical usubmx_additive m1 m2 n := SwizzleAdd (@usubmx V m1 m2 n). Canonical dsubmx_additive m1 m2 n := SwizzleAdd (@dsubmx V m1 m2 n). Canonical vec_mx_additive m n := SwizzleAdd (@vec_mx V m n). Canonical mxvec_additive m n := Additive (can2_additive (@vec_mxK V m n) mxvecK). Lemma flatmx0 n : all_equal_to (0 : 'M_(0, n)). Proof. by move=> A; apply/matrixP=> [] []. Qed. Lemma thinmx0 n : all_equal_to (0 : 'M_(n, 0)). Proof. by move=> A; apply/matrixP=> i []. Qed. Lemma trmx0 m n : (0 : 'M_(m, n))^T = 0. Proof. exact: trmx_const. Qed. Lemma row0 m n i0 : row i0 (0 : 'M_(m, n)) = 0. Proof. exact: row_const. Qed. Lemma col0 m n j0 : col j0 (0 : 'M_(m, n)) = 0. Proof. exact: col_const. Qed. Lemma mxvec_eq0 m n (A : 'M_(m, n)) : (mxvec A == 0) = (A == 0). Proof. by rewrite (can2_eq mxvecK vec_mxK) raddf0. Qed. Lemma vec_mx_eq0 m n (v : 'rV_(m * n)) : (vec_mx v == 0) = (v == 0). Proof. by rewrite (can2_eq vec_mxK mxvecK) raddf0. Qed. Lemma row_mx0 m n1 n2 : row_mx 0 0 = 0 :> 'M_(m, n1 + n2). Proof. exact: row_mx_const. Qed. Lemma col_mx0 m1 m2 n : col_mx 0 0 = 0 :> 'M_(m1 + m2, n). Proof. exact: col_mx_const. Qed. Lemma block_mx0 m1 m2 n1 n2 : block_mx 0 0 0 0 = 0 :> 'M_(m1 + m2, n1 + n2). Proof. exact: block_mx_const. Qed. Ltac split_mxE := apply/matrixP=> i j; do ![rewrite mxE | case: split => ?]. Lemma opp_row_mx m n1 n2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : - row_mx A1 A2 = row_mx (- A1) (- A2). Proof. by split_mxE. Qed. Lemma opp_col_mx m1 m2 n (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : - col_mx A1 A2 = col_mx (- A1) (- A2). Proof. by split_mxE. Qed. Lemma opp_block_mx m1 m2 n1 n2 (Aul : 'M_(m1, n1)) Aur Adl (Adr : 'M_(m2, n2)) : - block_mx Aul Aur Adl Adr = block_mx (- Aul) (- Aur) (- Adl) (- Adr). Proof. by rewrite opp_col_mx !opp_row_mx. Qed. Lemma add_row_mx m n1 n2 (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) B1 B2 : row_mx A1 A2 + row_mx B1 B2 = row_mx (A1 + B1) (A2 + B2). Proof. by split_mxE. Qed. Lemma add_col_mx m1 m2 n (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) B1 B2 : col_mx A1 A2 + col_mx B1 B2 = col_mx (A1 + B1) (A2 + B2). Proof. by split_mxE. Qed. Lemma add_block_mx m1 m2 n1 n2 (Aul : 'M_(m1, n1)) Aur Adl (Adr : 'M_(m2, n2)) Bul Bur Bdl Bdr : let A := block_mx Aul Aur Adl Adr in let B := block_mx Bul Bur Bdl Bdr in A + B = block_mx (Aul + Bul) (Aur + Bur) (Adl + Bdl) (Adr + Bdr). Proof. by rewrite /= add_col_mx !add_row_mx. Qed. Lemma row_mx_eq0 (m n1 n2 : nat) (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)): (row_mx A1 A2 == 0) = (A1 == 0) && (A2 == 0). Proof. apply/eqP/andP; last by case=> /eqP-> /eqP->; rewrite row_mx0. by rewrite -row_mx0 => /eq_row_mx [-> ->]. Qed. Lemma col_mx_eq0 (m1 m2 n : nat) (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)): (col_mx A1 A2 == 0) = (A1 == 0) && (A2 == 0). Proof. by rewrite -![_ == 0](inj_eq trmx_inj) !trmx0 tr_col_mx row_mx_eq0. Qed. Lemma block_mx_eq0 m1 m2 n1 n2 (Aul : 'M_(m1, n1)) Aur Adl (Adr : 'M_(m2, n2)) : (block_mx Aul Aur Adl Adr == 0) = [&& Aul == 0, Aur == 0, Adl == 0 & Adr == 0]. Proof. by rewrite col_mx_eq0 !row_mx_eq0 !andbA. Qed. Lemma trmx_eq0 m n (A : 'M_(m, n)) : (A^T == 0) = (A == 0). Proof. by rewrite -trmx0 (inj_eq trmx_inj). Qed. Lemma matrix_eq0 m n (A : 'M_(m, n)) : (A == 0) = [forall i, forall j, A i j == 0]. Proof. apply/eqP/'forall_'forall_eqP => [-> i j|A_eq0]; first by rewrite !mxE. by apply/matrixP => i j; rewrite A_eq0 !mxE. Qed. Lemma matrix0Pn m n (A : 'M_(m, n)) : reflect (exists i j, A i j != 0) (A != 0). Proof. by rewrite matrix_eq0; apply/(iffP forallPn) => -[i /forallPn]; exists i. Qed. Lemma rV0Pn n (v : 'rV_n) : reflect (exists i, v 0 i != 0) (v != 0). Proof. apply: (iffP (matrix0Pn _)) => [[i [j]]|[j]]; last by exists 0, j. by rewrite ord1; exists j. Qed. Lemma cV0Pn n (v : 'cV_n) : reflect (exists i, v i 0 != 0) (v != 0). Proof. apply: (iffP (matrix0Pn _)) => [[i] [j]|[i]]; last by exists i, 0. by rewrite ord1; exists i. Qed. Definition nz_row m n (A : 'M_(m, n)) := oapp (fun i => row i A) 0 [pick i | row i A != 0]. Lemma nz_row_eq0 m n (A : 'M_(m, n)) : (nz_row A == 0) = (A == 0). Proof. rewrite /nz_row; symmetry; case: pickP => [i /= nzAi | Ai0]. by rewrite (negPf nzAi); apply: contraTF nzAi => /eqP->; rewrite row0 eqxx. by rewrite eqxx; apply/eqP/row_matrixP=> i; move/eqP: (Ai0 i) ->; rewrite row0. Qed. Definition is_diag_mx m n (A : 'M[V]_(m, n)) := [forall i : 'I__, forall j : 'I__, (i != j :> nat) ==> (A i j == 0)]. Lemma is_diag_mxP m n (A : 'M[V]_(m, n)) : reflect (forall i j : 'I__, i != j :> nat -> A i j = 0) (is_diag_mx A). Proof. by apply: (iffP 'forall_'forall_implyP) => /(_ _ _ _)/eqP. Qed. Lemma mx0_is_diag m n : is_diag_mx (0 : 'M[V]_(m, n)). Proof. by apply/is_diag_mxP => i j _; rewrite mxE. Qed. Lemma mx11_is_diag (M : 'M_1) : is_diag_mx M. Proof. by apply/is_diag_mxP => i j; rewrite !ord1 eqxx. Qed. Definition is_trig_mx m n (A : 'M[V]_(m, n)) := [forall i : 'I__, forall j : 'I__, (i < j)%N ==> (A i j == 0)]. Lemma is_trig_mxP m n (A : 'M[V]_(m, n)) : reflect (forall i j : 'I__, (i < j)%N -> A i j = 0) (is_trig_mx A). Proof. by apply: (iffP 'forall_'forall_implyP) => /(_ _ _ _)/eqP. Qed. Lemma is_diag_mx_is_trig m n (A : 'M[V]_(m, n)) : is_diag_mx A -> is_trig_mx A. Proof. by move=> /is_diag_mxP A_eq0; apply/is_trig_mxP=> i j lt_ij; rewrite A_eq0// ltn_eqF. Qed. Lemma mx0_is_trig m n : is_trig_mx (0 : 'M[V]_(m, n)). Proof. by apply/is_trig_mxP => i j _; rewrite mxE. Qed. Lemma mx11_is_trig (M : 'M_1) : is_trig_mx M. Proof. by apply/is_trig_mxP => i j; rewrite !ord1 ltnn. Qed. Lemma is_diag_mxEtrig m n (A : 'M[V]_(m, n)) : is_diag_mx A = is_trig_mx A && is_trig_mx A^T. Proof. apply/is_diag_mxP/andP => [Adiag|[/is_trig_mxP Atrig /is_trig_mxP ATtrig]]. by split; apply/is_trig_mxP => i j lt_ij; rewrite ?mxE ?Adiag//; [rewrite ltn_eqF|rewrite gtn_eqF]. by move=> i j; case: ltngtP => // [/Atrig|/ATtrig]; rewrite ?mxE. Qed. Lemma is_diag_trmx m n (A : 'M[V]_(m, n)) : is_diag_mx A^T = is_diag_mx A. Proof. by rewrite !is_diag_mxEtrig trmxK andbC. Qed. Lemma ursubmx_trig m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : m1 <= n1 -> is_trig_mx A -> ursubmx A = 0. Proof. move=> leq_m1_n1 /is_trig_mxP Atrig; apply/matrixP => i j. by rewrite !mxE Atrig//= ltn_addr// (@leq_trans m1). Qed. Lemma dlsubmx_diag m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : n1 <= m1 -> is_diag_mx A -> dlsubmx A = 0. Proof. move=> leq_m2_n2 /is_diag_mxP Adiag; apply/matrixP => i j. by rewrite !mxE Adiag// gtn_eqF//= ltn_addr// (@leq_trans n1). Qed. Lemma ulsubmx_trig m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : is_trig_mx A -> is_trig_mx (ulsubmx A). Proof. move=> /is_trig_mxP Atrig; apply/is_trig_mxP => i j lt_ij. by rewrite !mxE Atrig. Qed. Lemma drsubmx_trig m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : m1 <= n1 -> is_trig_mx A -> is_trig_mx (drsubmx A). Proof. move=> leq_m1_n1 /is_trig_mxP Atrig; apply/is_trig_mxP => i j lt_ij. by rewrite !mxE Atrig//= -addnS leq_add. Qed. Lemma ulsubmx_diag m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : is_diag_mx A -> is_diag_mx (ulsubmx A). Proof. rewrite !is_diag_mxEtrig trmx_ulsub. by move=> /andP[/ulsubmx_trig-> /ulsubmx_trig->]. Qed. Lemma drsubmx_diag m1 m2 n1 n2 (A : 'M[V]_(m1 + m2, n1 + n2)) : m1 = n1 -> is_diag_mx A -> is_diag_mx (drsubmx A). Proof. move=> eq_m1_n1 /is_diag_mxP Adiag; apply/is_diag_mxP => i j neq_ij. by rewrite !mxE Adiag//= eq_m1_n1 eqn_add2l. Qed. Lemma is_trig_block_mx m1 m2 n1 n2 ul ur dl dr : m1 = n1 -> @is_trig_mx (m1 + m2) (n1 + n2) (block_mx ul ur dl dr) = [&& ur == 0, is_trig_mx ul & is_trig_mx dr]. Proof. move=> eq_m1_n1; rewrite {}eq_m1_n1 in ul ur dl dr *. apply/is_trig_mxP/and3P => [Atrig|]; last first. move=> [/eqP-> /is_trig_mxP ul_trig /is_trig_mxP dr_trig] i j; rewrite !mxE. do 2![case: split_ordP => ? ->; rewrite ?mxE//=] => lt_ij; rewrite ?ul_trig//. move: lt_ij; rewrite ltnNge -ltnS. by rewrite (leq_trans (ltn_ord _))// -addnS leq_addr. by rewrite dr_trig//; move: lt_ij; rewrite ltn_add2l. split. - apply/eqP/matrixP => i j; have := Atrig (lshift _ i) (rshift _ j). rewrite !mxE; case: split_ordP => k /eqP; rewrite eq_shift// ?mxE. case: split_ordP => l /eqP; rewrite eq_shift// ?mxE => /eqP-> /eqP<- <- //. by rewrite /= (leq_trans (ltn_ord _)) ?leq_addr. - apply/is_trig_mxP => i j lt_ij; have := Atrig (lshift _ i) (lshift _ j). rewrite !mxE; case: split_ordP => k /eqP; rewrite eq_shift// ?mxE. by case: split_ordP => l /eqP; rewrite eq_shift// ?mxE => /eqP<- /eqP<- ->. - apply/is_trig_mxP => i j lt_ij; have := Atrig (rshift _ i) (rshift _ j). rewrite !mxE; case: split_ordP => k /eqP; rewrite eq_shift// ?mxE. case: split_ordP => l /eqP; rewrite eq_shift// ?mxE => /eqP<- /eqP<- -> //. by rewrite /= ltn_add2l. Qed. Lemma trigmx_ind (P : forall m n, 'M_(m, n) -> Type) : (forall m, P m 0%N 0) -> (forall n, P 0%N n 0) -> (forall m n x c A, is_trig_mx A -> P m n A -> P (1 + m)%N (1 + n)%N (block_mx x 0 c A)) -> forall m n A, is_trig_mx A -> P m n A. Proof. move=> P0l P0r PS m n A; elim: A => {m n} [m|n|m n xx r c] A PA; do ?by rewrite (flatmx0, thinmx0); by [apply: P0l|apply: P0r]. by rewrite is_trig_block_mx => // /and3P[/eqP-> _ Atrig]; apply: PS (PA _). Qed. Lemma trigsqmx_ind (P : forall n, 'M[V]_n -> Type) : (P 0%N 0) -> (forall n x c A, is_trig_mx A -> P n A -> P (1 + n)%N (block_mx x 0 c A)) -> forall n A, is_trig_mx A -> P n A. Proof. move=> P0 PS n A; elim/sqmx_ind: A => {n} [|n x r c] A PA. by rewrite thinmx0; apply: P0. by rewrite is_trig_block_mx => // /and3P[/eqP-> _ Atrig]; apply: PS (PA _). Qed. Lemma is_diag_block_mx m1 m2 n1 n2 ul ur dl dr : m1 = n1 -> @is_diag_mx (m1 + m2) (n1 + n2) (block_mx ul ur dl dr) = [&& ur == 0, dl == 0, is_diag_mx ul & is_diag_mx dr]. Proof. move=> eq_m1_n1. rewrite !is_diag_mxEtrig tr_block_mx !is_trig_block_mx// trmx_eq0. by rewrite andbACA -!andbA; congr [&& _, _, _ & _]; rewrite andbCA. Qed. Lemma diagmx_ind (P : forall m n, 'M_(m, n) -> Type) : (forall m, P m 0%N 0) -> (forall n, P 0%N n 0) -> (forall m n x c A, is_diag_mx A -> P m n A -> P (1 + m)%N (1 + n)%N (block_mx x 0 c A)) -> forall m n A, is_diag_mx A -> P m n A. Proof. move=> P0l P0r PS m n A Adiag; have Atrig := is_diag_mx_is_trig Adiag. elim/trigmx_ind: Atrig Adiag => // {}m {}n r c {}A _ PA. rewrite is_diag_block_mx => // /and4P[_ /eqP-> _ Adiag]. exact: PS (PA _). Qed. Lemma diagsqmx_ind (P : forall n, 'M[V]_n -> Type) : (P 0%N 0) -> (forall n x c A, is_diag_mx A -> P n A -> P (1 + n)%N (block_mx x 0 c A)) -> forall n A, is_diag_mx A -> P n A. Proof. move=> P0 PS n A; elim/sqmx_ind: A => [|{}n x r c] A PA. by rewrite thinmx0; apply: P0. rewrite is_diag_block_mx => // /and4P[/eqP-> /eqP-> _ Adiag]. exact: PS (PA _). Qed. End MatrixZmodule. Arguments is_diag_mx {V m n}. Arguments is_diag_mxP {V m n A}. Arguments is_trig_mx {V m n}. Arguments is_trig_mxP {V m n A}. Section FinZmodMatrix. Variables (V : finZmodType) (m n : nat). Local Notation MV := 'M[V]_(m, n). Canonical matrix_finZmodType := Eval hnf in [finZmodType of MV]. Canonical matrix_baseFinGroupType := Eval hnf in [baseFinGroupType of MV for +%R]. Canonical matrix_finGroupType := Eval hnf in [finGroupType of MV for +%R]. End FinZmodMatrix. (* Parametricity over the additive structure. *) Section MapZmodMatrix. Variables (aR rR : zmodType) (f : {additive aR -> rR}) (m n : nat). Local Notation "A ^f" := (map_mx f A) : ring_scope. Implicit Type A : 'M[aR]_(m, n). Lemma map_mx0 : 0^f = 0 :> 'M_(m, n). Proof. by rewrite map_const_mx raddf0. Qed. Lemma map_mxN A : (- A)^f = - A^f. Proof. by apply/matrixP=> i j; rewrite !mxE raddfN. Qed. Lemma map_mxD A B : (A + B)^f = A^f + B^f. Proof. by apply/matrixP=> i j; rewrite !mxE raddfD. Qed. Lemma map_mxB A B : (A - B)^f = A^f - B^f. Proof. by rewrite map_mxD map_mxN. Qed. Definition map_mx_sum := big_morph _ map_mxD map_mx0. Canonical map_mx_additive := Additive map_mxB. End MapZmodMatrix. (*****************************************************************************) (*********** Matrix ring module, graded ring, and ring structures ************) (*****************************************************************************) Section MatrixAlgebra. Variable R : ringType. Section RingModule. (* The ring module/vector space structure *) Variables m n : nat. Implicit Types A B : 'M[R]_(m, n). Fact scalemx_key : unit. Proof. by []. Qed. Definition scalemx x A := \matrix[scalemx_key]_(i, j) (x * A i j). (* Basis *) Fact delta_mx_key : unit. Proof. by []. Qed. Definition delta_mx i0 j0 : 'M[R]_(m, n) := \matrix[delta_mx_key]_(i, j) ((i == i0) && (j == j0))%:R. Local Notation "x *m: A" := (scalemx x A) (at level 40) : ring_scope. Lemma scale1mx A : 1 *m: A = A. Proof. by apply/matrixP=> i j; rewrite !mxE mul1r. Qed. Lemma scalemxDl A x y : (x + y) *m: A = x *m: A + y *m: A. Proof. by apply/matrixP=> i j; rewrite !mxE mulrDl. Qed. Lemma scalemxDr x A B : x *m: (A + B) = x *m: A + x *m: B. Proof. by apply/matrixP=> i j; rewrite !mxE mulrDr. Qed. Lemma scalemxA x y A : x *m: (y *m: A) = (x * y) *m: A. Proof. by apply/matrixP=> i j; rewrite !mxE mulrA. Qed. Definition matrix_lmodMixin := LmodMixin scalemxA scale1mx scalemxDr scalemxDl. Canonical matrix_lmodType := Eval hnf in LmodType R 'M[R]_(m, n) matrix_lmodMixin. Lemma scalemx_const a b : a *: const_mx b = const_mx (a * b). Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma matrix_sum_delta A : A = \sum_(i < m) \sum_(j < n) A i j *: delta_mx i j. Proof. apply/matrixP=> i j. rewrite summxE (bigD1_ord i) // summxE (bigD1_ord j) //= !mxE !eqxx mulr1. rewrite !big1 ?addr0 //= => [i' | j'] _. by rewrite summxE big1// => j' _; rewrite !mxE eq_liftF mulr0. by rewrite !mxE eqxx eq_liftF mulr0. Qed. End RingModule. Section StructuralLinear. Lemma swizzle_mx_is_scalable m n p q f g k : scalable (@swizzle_mx R m n p q f g k). Proof. by move=> a A; apply/matrixP=> i j; rewrite !mxE. Qed. Canonical swizzle_mx_scalable m n p q f g k := AddLinear (@swizzle_mx_is_scalable m n p q f g k). Local Notation SwizzleLin op := [linear of op as swizzle_mx _ _ _]. Canonical trmx_linear m n := SwizzleLin (@trmx R m n). Canonical row_linear m n i := SwizzleLin (@row R m n i). Canonical col_linear m n j := SwizzleLin (@col R m n j). Canonical row'_linear m n i := SwizzleLin (@row' R m n i). Canonical col'_linear m n j := SwizzleLin (@col' R m n j). Canonical mxsub_linear m n m' n' f g := SwizzleLin (@mxsub R m n m' n' f g). Canonical row_perm_linear m n s := SwizzleLin (@row_perm R m n s). Canonical col_perm_linear m n s := SwizzleLin (@col_perm R m n s). Canonical xrow_linear m n i1 i2 := SwizzleLin (@xrow R m n i1 i2). Canonical xcol_linear m n j1 j2 := SwizzleLin (@xcol R m n j1 j2). Canonical lsubmx_linear m n1 n2 := SwizzleLin (@lsubmx R m n1 n2). Canonical rsubmx_linear m n1 n2 := SwizzleLin (@rsubmx R m n1 n2). Canonical usubmx_linear m1 m2 n := SwizzleLin (@usubmx R m1 m2 n). Canonical dsubmx_linear m1 m2 n := SwizzleLin (@dsubmx R m1 m2 n). Canonical vec_mx_linear m n := SwizzleLin (@vec_mx R m n). Definition mxvec_is_linear m n := can2_linear (@vec_mxK R m n) mxvecK. Canonical mxvec_linear m n := AddLinear (@mxvec_is_linear m n). End StructuralLinear. Lemma trmx_delta m n i j : (delta_mx i j)^T = delta_mx j i :> 'M[R]_(n, m). Proof. by apply/matrixP=> i' j'; rewrite !mxE andbC. Qed. Lemma row_sum_delta n (u : 'rV_n) : u = \sum_(j < n) u 0 j *: delta_mx 0 j. Proof. by rewrite {1}[u]matrix_sum_delta big_ord1. Qed. Lemma delta_mx_lshift m n1 n2 i j : delta_mx i (lshift n2 j) = row_mx (delta_mx i j) 0 :> 'M_(m, n1 + n2). Proof. apply/matrixP=> i' j'; rewrite !mxE -(can_eq splitK) (unsplitK (inl _ _)). by case: split => ?; rewrite mxE ?andbF. Qed. Lemma delta_mx_rshift m n1 n2 i j : delta_mx i (rshift n1 j) = row_mx 0 (delta_mx i j) :> 'M_(m, n1 + n2). Proof. apply/matrixP=> i' j'; rewrite !mxE -(can_eq splitK) (unsplitK (inr _ _)). by case: split => ?; rewrite mxE ?andbF. Qed. Lemma delta_mx_ushift m1 m2 n i j : delta_mx (lshift m2 i) j = col_mx (delta_mx i j) 0 :> 'M_(m1 + m2, n). Proof. apply/matrixP=> i' j'; rewrite !mxE -(can_eq splitK) (unsplitK (inl _ _)). by case: split => ?; rewrite mxE. Qed. Lemma delta_mx_dshift m1 m2 n i j : delta_mx (rshift m1 i) j = col_mx 0 (delta_mx i j) :> 'M_(m1 + m2, n). Proof. apply/matrixP=> i' j'; rewrite !mxE -(can_eq splitK) (unsplitK (inr _ _)). by case: split => ?; rewrite mxE. Qed. Lemma vec_mx_delta m n i j : vec_mx (delta_mx 0 (mxvec_index i j)) = delta_mx i j :> 'M_(m, n). Proof. by apply/matrixP=> i' j'; rewrite !mxE /= [_ == _](inj_eq enum_rank_inj). Qed. Lemma mxvec_delta m n i j : mxvec (delta_mx i j) = delta_mx 0 (mxvec_index i j) :> 'rV_(m * n). Proof. by rewrite -vec_mx_delta vec_mxK. Qed. Ltac split_mxE := apply/matrixP=> i j; do ![rewrite mxE | case: split => ?]. Lemma scale_row_mx m n1 n2 a (A1 : 'M_(m, n1)) (A2 : 'M_(m, n2)) : a *: row_mx A1 A2 = row_mx (a *: A1) (a *: A2). Proof. by split_mxE. Qed. Lemma scale_col_mx m1 m2 n a (A1 : 'M_(m1, n)) (A2 : 'M_(m2, n)) : a *: col_mx A1 A2 = col_mx (a *: A1) (a *: A2). Proof. by split_mxE. Qed. Lemma scale_block_mx m1 m2 n1 n2 a (Aul : 'M_(m1, n1)) (Aur : 'M_(m1, n2)) (Adl : 'M_(m2, n1)) (Adr : 'M_(m2, n2)) : a *: block_mx Aul Aur Adl Adr = block_mx (a *: Aul) (a *: Aur) (a *: Adl) (a *: Adr). Proof. by rewrite scale_col_mx !scale_row_mx. Qed. (* Diagonal matrices *) Fact diag_mx_key : unit. Proof. by []. Qed. Definition diag_mx n (d : 'rV[R]_n) := \matrix[diag_mx_key]_(i, j) (d 0 i *+ (i == j)). Lemma tr_diag_mx n (d : 'rV_n) : (diag_mx d)^T = diag_mx d. Proof. by apply/matrixP=> i j; rewrite !mxE; case: eqVneq => // ->. Qed. Lemma diag_mx_is_linear n : linear (@diag_mx n). Proof. by move=> a A B; apply/matrixP=> i j; rewrite !mxE mulrnAr mulrnDl. Qed. Canonical diag_mx_additive n := Additive (@diag_mx_is_linear n). Canonical diag_mx_linear n := Linear (@diag_mx_is_linear n). Lemma diag_mx_sum_delta n (d : 'rV_n) : diag_mx d = \sum_i d 0 i *: delta_mx i i. Proof. apply/matrixP=> i j; rewrite summxE (bigD1_ord i) //= !mxE eqxx /=. by rewrite eq_sym mulr_natr big1 ?addr0 // => i'; rewrite !mxE eq_liftF mulr0. Qed. Lemma row_diag_mx n (d : 'rV_n) i : row i (diag_mx d) = d 0 i *: delta_mx 0 i. Proof. by apply/rowP => j; rewrite !mxE eqxx eq_sym mulr_natr. Qed. Lemma diag_mx_row m n (l : 'rV_n) (r : 'rV_m) : diag_mx (row_mx l r) = block_mx (diag_mx l) 0 0 (diag_mx r). Proof. apply/matrixP => i j. by do ?[rewrite !mxE; case: split_ordP => ? ->]; rewrite mxE eq_shift. Qed. Lemma diag_mxP n (A : 'M[R]_n) : reflect (exists d : 'rV_n, A = diag_mx d) (is_diag_mx A). Proof. apply: (iffP is_diag_mxP) => [Adiag|[d ->] i j neq_ij]; last first. by rewrite !mxE -val_eqE (negPf neq_ij). exists (\row_i A i i); apply/matrixP => i j; rewrite !mxE. by case: (altP (i =P j)) => [->|/Adiag->]. Qed. Lemma diag_mx_is_diag n (r : 'rV[R]_n) : is_diag_mx (diag_mx r). Proof. by apply/diag_mxP; exists r. Qed. Lemma diag_mx_is_trig n (r : 'rV[R]_n) : is_trig_mx (diag_mx r). Proof. exact/is_diag_mx_is_trig/diag_mx_is_diag. Qed. (* Scalar matrix : a diagonal matrix with a constant on the diagonal *) Section ScalarMx. Variable n : nat. Fact scalar_mx_key : unit. Proof. by []. Qed. Definition scalar_mx x : 'M[R]_n := \matrix[scalar_mx_key]_(i , j) (x *+ (i == j)). Notation "x %:M" := (scalar_mx x) : ring_scope. Lemma diag_const_mx a : diag_mx (const_mx a) = a%:M :> 'M_n. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tr_scalar_mx a : (a%:M)^T = a%:M. Proof. by apply/matrixP=> i j; rewrite !mxE eq_sym. Qed. Lemma trmx1 : (1%:M)^T = 1%:M. Proof. exact: tr_scalar_mx. Qed. Lemma scalar_mx_is_additive : additive scalar_mx. Proof. by move=> a b; rewrite -!diag_const_mx !raddfB. Qed. Canonical scalar_mx_additive := Additive scalar_mx_is_additive. Lemma scale_scalar_mx a1 a2 : a1 *: a2%:M = (a1 * a2)%:M :> 'M_n. Proof. by apply/matrixP=> i j; rewrite !mxE mulrnAr. Qed. Lemma scalemx1 a : a *: 1%:M = a%:M. Proof. by rewrite scale_scalar_mx mulr1. Qed. Lemma scalar_mx_sum_delta a : a%:M = \sum_i a *: delta_mx i i. Proof. by rewrite -diag_const_mx diag_mx_sum_delta; under eq_bigr do rewrite mxE. Qed. Lemma mx1_sum_delta : 1%:M = \sum_i delta_mx i i. Proof. by rewrite [1%:M]scalar_mx_sum_delta -scaler_sumr scale1r. Qed. Lemma row1 i : row i 1%:M = delta_mx 0 i. Proof. by apply/rowP=> j; rewrite !mxE eq_sym. Qed. Definition is_scalar_mx (A : 'M[R]_n) := if insub 0%N is Some i then A == (A i i)%:M else true. Lemma is_scalar_mxP A : reflect (exists a, A = a%:M) (is_scalar_mx A). Proof. rewrite /is_scalar_mx; case: insubP => [i _ _ | ]. by apply: (iffP eqP) => [|[a ->]]; [exists (A i i) | rewrite mxE eqxx]. rewrite -eqn0Ngt => /eqP n0; left; exists 0. by rewrite raddf0; rewrite n0 in A *; rewrite [A]flatmx0. Qed. Lemma scalar_mx_is_scalar a : is_scalar_mx a%:M. Proof. by apply/is_scalar_mxP; exists a. Qed. Lemma mx0_is_scalar : is_scalar_mx 0. Proof. by apply/is_scalar_mxP; exists 0; rewrite raddf0. Qed. Lemma scalar_mx_is_diag a : is_diag_mx (a%:M). Proof. by rewrite -diag_const_mx diag_mx_is_diag. Qed. Lemma is_scalar_mx_is_diag A : is_scalar_mx A -> is_diag_mx A. Proof. by move=> /is_scalar_mxP[a ->]; apply: scalar_mx_is_diag. Qed. Lemma scalar_mx_is_trig a : is_trig_mx (a%:M). Proof. by rewrite is_diag_mx_is_trig// scalar_mx_is_diag. Qed. Lemma is_scalar_mx_is_trig A : is_scalar_mx A -> is_trig_mx A. Proof. by move=> /is_scalar_mx_is_diag /is_diag_mx_is_trig. Qed. End ScalarMx. Notation "x %:M" := (scalar_mx _ x) : ring_scope. Lemma mx11_scalar (A : 'M_1) : A = (A 0 0)%:M. Proof. by apply/rowP=> j; rewrite ord1 mxE. Qed. Lemma scalar_mx_block n1 n2 a : a%:M = block_mx a%:M 0 0 a%:M :> 'M_(n1 + n2). Proof. apply/matrixP=> i j; rewrite !mxE. by do 2![case: split_ordP => ? ->; rewrite !mxE]; rewrite ?eq_shift. Qed. (* Matrix multiplication using bigops. *) Fact mulmx_key : unit. Proof. by []. Qed. Definition mulmx {m n p} (A : 'M_(m, n)) (B : 'M_(n, p)) : 'M[R]_(m, p) := \matrix[mulmx_key]_(i, k) \sum_j (A i j * B j k). Local Notation "A *m B" := (mulmx A B) : ring_scope. Lemma mulmxA m n p q (A : 'M_(m, n)) (B : 'M_(n, p)) (C : 'M_(p, q)) : A *m (B *m C) = A *m B *m C. Proof. apply/matrixP=> i l; rewrite !mxE; under eq_bigr do rewrite mxE big_distrr/=. rewrite exchange_big; apply: eq_bigr => j _; rewrite mxE big_distrl /=. by under eq_bigr do rewrite mulrA. Qed. Lemma mul0mx m n p (A : 'M_(n, p)) : 0 *m A = 0 :> 'M_(m, p). Proof. by apply/matrixP=> i k; rewrite !mxE big1 //= => j _; rewrite mxE mul0r. Qed. Lemma mulmx0 m n p (A : 'M_(m, n)) : A *m 0 = 0 :> 'M_(m, p). Proof. by apply/matrixP=> i k; rewrite !mxE big1 // => j _; rewrite mxE mulr0. Qed. Lemma mulmxN m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : A *m (- B) = - (A *m B). Proof. apply/matrixP=> i k; rewrite !mxE -sumrN. by under eq_bigr do rewrite mxE mulrN. Qed. Lemma mulNmx m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : - A *m B = - (A *m B). Proof. apply/matrixP=> i k; rewrite !mxE -sumrN. by under eq_bigr do rewrite mxE mulNr. Qed. Lemma mulmxDl m n p (A1 A2 : 'M_(m, n)) (B : 'M_(n, p)) : (A1 + A2) *m B = A1 *m B + A2 *m B. Proof. apply/matrixP=> i k; rewrite !mxE -big_split /=. by apply: eq_bigr => j _; rewrite !mxE -mulrDl. Qed. Lemma mulmxDr m n p (A : 'M_(m, n)) (B1 B2 : 'M_(n, p)) : A *m (B1 + B2) = A *m B1 + A *m B2. Proof. apply/matrixP=> i k; rewrite !mxE -big_split /=. by apply: eq_bigr => j _; rewrite mxE mulrDr. Qed. Lemma mulmxBl m n p (A1 A2 : 'M_(m, n)) (B : 'M_(n, p)) : (A1 - A2) *m B = A1 *m B - A2 *m B. Proof. by rewrite mulmxDl mulNmx. Qed. Lemma mulmxBr m n p (A : 'M_(m, n)) (B1 B2 : 'M_(n, p)) : A *m (B1 - B2) = A *m B1 - A *m B2. Proof. by rewrite mulmxDr mulmxN. Qed. Lemma mulmx_suml m n p (A : 'M_(n, p)) I r P (B_ : I -> 'M_(m, n)) : (\sum_(i <- r | P i) B_ i) *m A = \sum_(i <- r | P i) B_ i *m A. Proof. by apply: (big_morph (mulmx^~ A)) => [B C|]; rewrite ?mul0mx ?mulmxDl. Qed. Lemma mulmx_sumr m n p (A : 'M_(m, n)) I r P (B_ : I -> 'M_(n, p)) : A *m (\sum_(i <- r | P i) B_ i) = \sum_(i <- r | P i) A *m B_ i. Proof. by apply: (big_morph (mulmx A)) => [B C|]; rewrite ?mulmx0 ?mulmxDr. Qed. Lemma scalemxAl m n p a (A : 'M_(m, n)) (B : 'M_(n, p)) : a *: (A *m B) = (a *: A) *m B. Proof. apply/matrixP=> i k; rewrite !mxE big_distrr /=. by apply: eq_bigr => j _; rewrite mulrA mxE. Qed. (* Right scaling associativity requires a commutative ring *) Lemma rowE m n i (A : 'M_(m, n)) : row i A = delta_mx 0 i *m A. Proof. apply/rowP=> j; rewrite !mxE (bigD1_ord i) //= mxE !eqxx mul1r. by rewrite big1 ?addr0 // => i'; rewrite mxE /= lift_eqF mul0r. Qed. Lemma mul_rVP m n A B :((@mulmx 1 m n)^~ A =1 mulmx^~ B) <-> (A = B). Proof. by split=> [eqAB|->//]; apply/row_matrixP => i; rewrite !rowE eqAB. Qed. Lemma row_mul m n p (i : 'I_m) A (B : 'M_(n, p)) : row i (A *m B) = row i A *m B. Proof. by rewrite !rowE mulmxA. Qed. Lemma mulmx_sum_row m n (u : 'rV_m) (A : 'M_(m, n)) : u *m A = \sum_i u 0 i *: row i A. Proof. by apply/rowP=> j; rewrite mxE summxE; under [RHS]eq_bigr do rewrite !mxE. Qed. Lemma mxsub_mul m n m' n' p f g (A : 'M_(m, p)) (B : 'M_(p, n)) : mxsub f g (A *m B) = rowsub f A *m colsub g B :> 'M_(m', n'). Proof. by split_mxE; under [RHS]eq_bigr do rewrite !mxE. Qed. Lemma mul_rowsub_mx m n m' p f (A : 'M_(m, p)) (B : 'M_(p, n)) : rowsub f A *m B = rowsub f (A *m B) :> 'M_(m', n). Proof. by rewrite mxsub_mul mxsub_id. Qed. Lemma mulmx_colsub m n n' p g (A : 'M_(m, p)) (B : 'M_(p, n)) : A *m colsub g B = colsub g (A *m B) :> 'M_(m, n'). Proof. by rewrite mxsub_mul mxsub_id. Qed. Lemma mul_delta_mx_cond m n p (j1 j2 : 'I_n) (i1 : 'I_m) (k2 : 'I_p) : delta_mx i1 j1 *m delta_mx j2 k2 = delta_mx i1 k2 *+ (j1 == j2). Proof. apply/matrixP => i k; rewrite !mxE (bigD1_ord j1) //=. rewrite mulmxnE !mxE !eqxx andbT -natrM -mulrnA !mulnb !andbA andbAC. by rewrite big1 ?addr0 // => j; rewrite !mxE andbC -natrM lift_eqF. Qed. Lemma mul_delta_mx m n p (j : 'I_n) (i : 'I_m) (k : 'I_p) : delta_mx i j *m delta_mx j k = delta_mx i k. Proof. by rewrite mul_delta_mx_cond eqxx. Qed. Lemma mul_delta_mx_0 m n p (j1 j2 : 'I_n) (i1 : 'I_m) (k2 : 'I_p) : j1 != j2 -> delta_mx i1 j1 *m delta_mx j2 k2 = 0. Proof. by rewrite mul_delta_mx_cond => /negPf->. Qed. Lemma mul_diag_mx m n d (A : 'M_(m, n)) : diag_mx d *m A = \matrix_(i, j) (d 0 i * A i j). Proof. apply/matrixP=> i j; rewrite !mxE (bigD1 i) //= mxE eqxx big1 ?addr0 // => i'. by rewrite mxE eq_sym mulrnAl => /negPf->. Qed. Lemma mul_mx_diag m n (A : 'M_(m, n)) d : A *m diag_mx d = \matrix_(i, j) (A i j * d 0 j). Proof. apply/matrixP=> i j; rewrite !mxE (bigD1 j) //= mxE eqxx big1 ?addr0 // => i'. by rewrite mxE eq_sym mulrnAr; move/negPf->. Qed. Lemma mulmx_diag n (d e : 'rV_n) : diag_mx d *m diag_mx e = diag_mx (\row_j (d 0 j * e 0 j)). Proof. by apply/matrixP=> i j; rewrite mul_diag_mx !mxE mulrnAr. Qed. Lemma mul_scalar_mx m n a (A : 'M_(m, n)) : a%:M *m A = a *: A. Proof. by rewrite -diag_const_mx mul_diag_mx; apply/matrixP=> i j; rewrite !mxE. Qed. Lemma scalar_mxM n a b : (a * b)%:M = a%:M *m b%:M :> 'M_n. Proof. by rewrite mul_scalar_mx scale_scalar_mx. Qed. Lemma mul1mx m n (A : 'M_(m, n)) : 1%:M *m A = A. Proof. by rewrite mul_scalar_mx scale1r. Qed. Lemma mulmx1 m n (A : 'M_(m, n)) : A *m 1%:M = A. Proof. rewrite -diag_const_mx mul_mx_diag. by apply/matrixP=> i j; rewrite !mxE mulr1. Qed. Lemma rowsubE m m' n f (A : 'M_(m, n)) : rowsub f A = rowsub f 1%:M *m A :> 'M_(m', n). Proof. by rewrite mul_rowsub_mx mul1mx. Qed. (* mulmx and col_perm, row_perm, xcol, xrow *) Lemma mul_col_perm m n p s (A : 'M_(m, n)) (B : 'M_(n, p)) : col_perm s A *m B = A *m row_perm s^-1 B. Proof. apply/matrixP=> i k; rewrite !mxE (reindex_perm s^-1). by apply: eq_bigr => j _ /=; rewrite !mxE permKV. Qed. Lemma mul_row_perm m n p s (A : 'M_(m, n)) (B : 'M_(n, p)) : A *m row_perm s B = col_perm s^-1 A *m B. Proof. by rewrite mul_col_perm invgK. Qed. Lemma mul_xcol m n p j1 j2 (A : 'M_(m, n)) (B : 'M_(n, p)) : xcol j1 j2 A *m B = A *m xrow j1 j2 B. Proof. by rewrite mul_col_perm tpermV. Qed. (* Permutation matrix *) Definition perm_mx n s : 'M_n := row_perm s 1%:M. Definition tperm_mx n i1 i2 : 'M_n := perm_mx (tperm i1 i2). Lemma col_permE m n s (A : 'M_(m, n)) : col_perm s A = A *m perm_mx s^-1. Proof. by rewrite mul_row_perm mulmx1 invgK. Qed. Lemma row_permE m n s (A : 'M_(m, n)) : row_perm s A = perm_mx s *m A. Proof. by rewrite -[perm_mx _]mul1mx mul_row_perm mulmx1 -mul_row_perm mul1mx. Qed. Lemma xcolE m n j1 j2 (A : 'M_(m, n)) : xcol j1 j2 A = A *m tperm_mx j1 j2. Proof. by rewrite /xcol col_permE tpermV. Qed. Lemma xrowE m n i1 i2 (A : 'M_(m, n)) : xrow i1 i2 A = tperm_mx i1 i2 *m A. Proof. exact: row_permE. Qed. Lemma perm_mxEsub n s : @perm_mx n s = rowsub s 1%:M. Proof. by rewrite /perm_mx row_permEsub. Qed. Lemma tperm_mxEsub n i1 i2 : @tperm_mx n i1 i2 = rowsub (tperm i1 i2) 1%:M. Proof. by rewrite /tperm_mx perm_mxEsub. Qed. Lemma tr_perm_mx n (s : 'S_n) : (perm_mx s)^T = perm_mx s^-1. Proof. by rewrite -[_^T]mulmx1 tr_row_perm mul_col_perm trmx1 mul1mx. Qed. Lemma tr_tperm_mx n i1 i2 : (tperm_mx i1 i2)^T = tperm_mx i1 i2 :> 'M_n. Proof. by rewrite tr_perm_mx tpermV. Qed. Lemma perm_mx1 n : perm_mx 1 = 1%:M :> 'M_n. Proof. exact: row_perm1. Qed. Lemma perm_mxM n (s t : 'S_n) : perm_mx (s * t) = perm_mx s *m perm_mx t. Proof. by rewrite -row_permE -row_permM. Qed. Definition is_perm_mx n (A : 'M_n) := [exists s, A == perm_mx s]. Lemma is_perm_mxP n (A : 'M_n) : reflect (exists s, A = perm_mx s) (is_perm_mx A). Proof. by apply: (iffP existsP) => [] [s /eqP]; exists s. Qed. Lemma perm_mx_is_perm n (s : 'S_n) : is_perm_mx (perm_mx s). Proof. by apply/is_perm_mxP; exists s. Qed. Lemma is_perm_mx1 n : is_perm_mx (1%:M : 'M_n). Proof. by rewrite -perm_mx1 perm_mx_is_perm. Qed. Lemma is_perm_mxMl n (A B : 'M_n) : is_perm_mx A -> is_perm_mx (A *m B) = is_perm_mx B. Proof. case/is_perm_mxP=> s ->. apply/is_perm_mxP/is_perm_mxP=> [[t def_t] | [t ->]]; last first. by exists (s * t)%g; rewrite perm_mxM. exists (s^-1 * t)%g. by rewrite perm_mxM -def_t -!row_permE -row_permM mulVg row_perm1. Qed. Lemma is_perm_mx_tr n (A : 'M_n) : is_perm_mx A^T = is_perm_mx A. Proof. apply/is_perm_mxP/is_perm_mxP=> [[t def_t] | [t ->]]; exists t^-1%g. by rewrite -tr_perm_mx -def_t trmxK. by rewrite tr_perm_mx. Qed. Lemma is_perm_mxMr n (A B : 'M_n) : is_perm_mx B -> is_perm_mx (A *m B) = is_perm_mx A. Proof. case/is_perm_mxP=> s ->. rewrite -[s]invgK -col_permE -is_perm_mx_tr tr_col_perm row_permE. by rewrite is_perm_mxMl (perm_mx_is_perm, is_perm_mx_tr). Qed. (* Partial identity matrix (used in rank decomposition). *) Fact pid_mx_key : unit. Proof. by []. Qed. Definition pid_mx {m n} r : 'M[R]_(m, n) := \matrix[pid_mx_key]_(i, j) ((i == j :> nat) && (i < r))%:R. Lemma pid_mx_0 m n : pid_mx 0 = 0 :> 'M_(m, n). Proof. by apply/matrixP=> i j; rewrite !mxE andbF. Qed. Lemma pid_mx_1 r : pid_mx r = 1%:M :> 'M_r. Proof. by apply/matrixP=> i j; rewrite !mxE ltn_ord andbT. Qed. Lemma pid_mx_row n r : pid_mx r = row_mx 1%:M 0 :> 'M_(r, r + n). Proof. apply/matrixP=> i j; rewrite !mxE ltn_ord andbT. by case: split_ordP => j' ->; rewrite !mxE// (val_eqE (lshift n i)) eq_shift. Qed. Lemma pid_mx_col m r : pid_mx r = col_mx 1%:M 0 :> 'M_(r + m, r). Proof. apply/matrixP=> i j; rewrite !mxE andbC. by case: split_ordP => ? ->; rewrite !mxE//. Qed. Lemma pid_mx_block m n r : pid_mx r = block_mx 1%:M 0 0 0 :> 'M_(r + m, r + n). Proof. apply/matrixP=> i j; rewrite !mxE row_mx0 andbC. do ![case: split_ordP => ? ->; rewrite !mxE//]. by rewrite (val_eqE (lshift n _)) eq_shift. Qed. Lemma tr_pid_mx m n r : (pid_mx r)^T = pid_mx r :> 'M_(n, m). Proof. by apply/matrixP=> i j; rewrite !mxE; case: eqVneq => // ->. Qed. Lemma pid_mx_minv m n r : pid_mx (minn m r) = pid_mx r :> 'M_(m, n). Proof. by apply/matrixP=> i j; rewrite !mxE leq_min ltn_ord. Qed. Lemma pid_mx_minh m n r : pid_mx (minn n r) = pid_mx r :> 'M_(m, n). Proof. by apply: trmx_inj; rewrite !tr_pid_mx pid_mx_minv. Qed. Lemma mul_pid_mx m n p q r : (pid_mx q : 'M_(m, n)) *m (pid_mx r : 'M_(n, p)) = pid_mx (minn n (minn q r)). Proof. apply/matrixP=> i k; rewrite !mxE !leq_min. have [le_n_i | lt_i_n] := leqP n i. rewrite andbF big1 // => j _. by rewrite -pid_mx_minh !mxE leq_min ltnNge le_n_i andbF mul0r. rewrite (bigD1 (Ordinal lt_i_n)) //= big1 ?addr0 => [|j]. by rewrite !mxE eqxx /= -natrM mulnb andbCA. by rewrite -val_eqE /= !mxE eq_sym -natrM => /negPf->. Qed. Lemma pid_mx_id m n p r : r <= n -> (pid_mx r : 'M_(m, n)) *m (pid_mx r : 'M_(n, p)) = pid_mx r. Proof. by move=> le_r_n; rewrite mul_pid_mx minnn (minn_idPr _). Qed. Definition copid_mx {n} r : 'M_n := 1%:M - pid_mx r. Lemma mul_copid_mx_pid m n r : r <= m -> copid_mx r *m pid_mx r = 0 :> 'M_(m, n). Proof. by move=> le_r_m; rewrite mulmxBl mul1mx pid_mx_id ?subrr. Qed. Lemma mul_pid_mx_copid m n r : r <= n -> pid_mx r *m copid_mx r = 0 :> 'M_(m, n). Proof. by move=> le_r_n; rewrite mulmxBr mulmx1 pid_mx_id ?subrr. Qed. Lemma copid_mx_id n r : r <= n -> copid_mx r *m copid_mx r = copid_mx r :> 'M_n. Proof. by move=> le_r_n; rewrite mulmxBl mul1mx mul_pid_mx_copid // oppr0 addr0. Qed. Lemma pid_mxErow m n (le_mn : m <= n) : pid_mx m = rowsub (widen_ord le_mn) 1%:M. Proof. by apply/matrixP=> i j; rewrite !mxE -!val_eqE/= ltn_ord andbT. Qed. Lemma pid_mxEcol m n (le_mn : m <= n) : pid_mx n = colsub (widen_ord le_mn) 1%:M. Proof. by apply/matrixP=> i j; rewrite !mxE -!val_eqE/= ltn_ord andbT. Qed. (* Block products; we cover all 1 x 2, 2 x 1, and 2 x 2 block products. *) Lemma mul_mx_row m n p1 p2 (A : 'M_(m, n)) (Bl : 'M_(n, p1)) (Br : 'M_(n, p2)) : A *m row_mx Bl Br = row_mx (A *m Bl) (A *m Br). Proof. apply/matrixP=> i k; rewrite !mxE. by case defk: (split k); rewrite mxE; under eq_bigr do rewrite mxE defk. Qed. Lemma mul_col_mx m1 m2 n p (Au : 'M_(m1, n)) (Ad : 'M_(m2, n)) (B : 'M_(n, p)) : col_mx Au Ad *m B = col_mx (Au *m B) (Ad *m B). Proof. apply/matrixP=> i k; rewrite !mxE. by case defi: (split i); rewrite mxE; under eq_bigr do rewrite mxE defi. Qed. Lemma mul_row_col m n1 n2 p (Al : 'M_(m, n1)) (Ar : 'M_(m, n2)) (Bu : 'M_(n1, p)) (Bd : 'M_(n2, p)) : row_mx Al Ar *m col_mx Bu Bd = Al *m Bu + Ar *m Bd. Proof. apply/matrixP=> i k; rewrite !mxE big_split_ord /=. congr (_ + _); apply: eq_bigr => j _; first by rewrite row_mxEl col_mxEu. by rewrite row_mxEr col_mxEd. Qed. Lemma mul_col_row m1 m2 n p1 p2 (Au : 'M_(m1, n)) (Ad : 'M_(m2, n)) (Bl : 'M_(n, p1)) (Br : 'M_(n, p2)) : col_mx Au Ad *m row_mx Bl Br = block_mx (Au *m Bl) (Au *m Br) (Ad *m Bl) (Ad *m Br). Proof. by rewrite mul_col_mx !mul_mx_row. Qed. Lemma mul_row_block m n1 n2 p1 p2 (Al : 'M_(m, n1)) (Ar : 'M_(m, n2)) (Bul : 'M_(n1, p1)) (Bur : 'M_(n1, p2)) (Bdl : 'M_(n2, p1)) (Bdr : 'M_(n2, p2)) : row_mx Al Ar *m block_mx Bul Bur Bdl Bdr = row_mx (Al *m Bul + Ar *m Bdl) (Al *m Bur + Ar *m Bdr). Proof. by rewrite block_mxEh mul_mx_row !mul_row_col. Qed. Lemma mul_block_col m1 m2 n1 n2 p (Aul : 'M_(m1, n1)) (Aur : 'M_(m1, n2)) (Adl : 'M_(m2, n1)) (Adr : 'M_(m2, n2)) (Bu : 'M_(n1, p)) (Bd : 'M_(n2, p)) : block_mx Aul Aur Adl Adr *m col_mx Bu Bd = col_mx (Aul *m Bu + Aur *m Bd) (Adl *m Bu + Adr *m Bd). Proof. by rewrite mul_col_mx !mul_row_col. Qed. Lemma mulmx_block m1 m2 n1 n2 p1 p2 (Aul : 'M_(m1, n1)) (Aur : 'M_(m1, n2)) (Adl : 'M_(m2, n1)) (Adr : 'M_(m2, n2)) (Bul : 'M_(n1, p1)) (Bur : 'M_(n1, p2)) (Bdl : 'M_(n2, p1)) (Bdr : 'M_(n2, p2)) : block_mx Aul Aur Adl Adr *m block_mx Bul Bur Bdl Bdr = block_mx (Aul *m Bul + Aur *m Bdl) (Aul *m Bur + Aur *m Bdr) (Adl *m Bul + Adr *m Bdl) (Adl *m Bur + Adr *m Bdr). Proof. by rewrite mul_col_mx !mul_row_block. Qed. (* Correspondence between matrices and linear function on row vectors. *) Section LinRowVector. Variables m n : nat. Fact lin1_mx_key : unit. Proof. by []. Qed. Definition lin1_mx (f : 'rV[R]_m -> 'rV[R]_n) := \matrix[lin1_mx_key]_(i, j) f (delta_mx 0 i) 0 j. Variable f : {linear 'rV[R]_m -> 'rV[R]_n}. Lemma mul_rV_lin1 u : u *m lin1_mx f = f u. Proof. rewrite {2}[u]matrix_sum_delta big_ord1 linear_sum; apply/rowP=> i. by rewrite mxE summxE; apply: eq_bigr => j _; rewrite linearZ !mxE. Qed. End LinRowVector. (* Correspondence between matrices and linear function on matrices. *) Section LinMatrix. Variables m1 n1 m2 n2 : nat. Definition lin_mx (f : 'M[R]_(m1, n1) -> 'M[R]_(m2, n2)) := lin1_mx (mxvec \o f \o vec_mx). Variable f : {linear 'M[R]_(m1, n1) -> 'M[R]_(m2, n2)}. Lemma mul_rV_lin u : u *m lin_mx f = mxvec (f (vec_mx u)). Proof. exact: mul_rV_lin1. Qed. Lemma mul_vec_lin A : mxvec A *m lin_mx f = mxvec (f A). Proof. by rewrite mul_rV_lin mxvecK. Qed. Lemma mx_rV_lin u : vec_mx (u *m lin_mx f) = f (vec_mx u). Proof. by rewrite mul_rV_lin mxvecK. Qed. Lemma mx_vec_lin A : vec_mx (mxvec A *m lin_mx f) = f A. Proof. by rewrite mul_rV_lin !mxvecK. Qed. End LinMatrix. Canonical mulmx_additive m n p A := Additive (@mulmxBr m n p A). Section Mulmxr. Variables m n p : nat. Implicit Type A : 'M[R]_(m, n). Implicit Type B : 'M[R]_(n, p). Definition mulmxr B A := mulmx A B. Arguments mulmxr B A /. Definition lin_mulmxr B := lin_mx (mulmxr B). Lemma mulmxr_is_linear B : linear (mulmxr B). Proof. by move=> a A1 A2; rewrite /= mulmxDl scalemxAl. Qed. Canonical mulmxr_additive B := Additive (mulmxr_is_linear B). Canonical mulmxr_linear B := Linear (mulmxr_is_linear B). Lemma lin_mulmxr_is_linear : linear lin_mulmxr. Proof. move=> a A B; apply/row_matrixP; case/mxvec_indexP=> i j. rewrite linearP /= !rowE !mul_rV_lin /= vec_mx_delta -linearP mulmxDr. congr (mxvec (_ + _)); apply/row_matrixP=> k. rewrite linearZ /= !row_mul rowE mul_delta_mx_cond. by case: (k == i); [rewrite -!rowE linearZ | rewrite !mul0mx raddf0]. Qed. Canonical lin_mulmxr_additive := Additive lin_mulmxr_is_linear. Canonical lin_mulmxr_linear := Linear lin_mulmxr_is_linear. End Mulmxr. Arguments mulmxr {_ _ _} B A /. (* The trace. *) Section Trace. Variable n : nat. Definition mxtrace (A : 'M[R]_n) := \sum_i A i i. Local Notation "'\tr' A" := (mxtrace A) : ring_scope. Lemma mxtrace_tr A : \tr A^T = \tr A. Proof. by apply: eq_bigr=> i _; rewrite mxE. Qed. Lemma mxtrace_is_scalar : scalar mxtrace. Proof. move=> a A B; rewrite mulr_sumr -big_split /=. by apply: eq_bigr=> i _; rewrite !mxE. Qed. Canonical mxtrace_additive := Additive mxtrace_is_scalar. Canonical mxtrace_linear := Linear mxtrace_is_scalar. Lemma mxtrace0 : \tr 0 = 0. Proof. exact: raddf0. Qed. Lemma mxtraceD A B : \tr (A + B) = \tr A + \tr B. Proof. exact: raddfD. Qed. Lemma mxtraceZ a A : \tr (a *: A) = a * \tr A. Proof. exact: scalarZ. Qed. Lemma mxtrace_diag D : \tr (diag_mx D) = \sum_j D 0 j. Proof. by apply: eq_bigr => j _; rewrite mxE eqxx. Qed. Lemma mxtrace_scalar a : \tr a%:M = a *+ n. Proof. rewrite -diag_const_mx mxtrace_diag; under eq_bigr do rewrite mxE. by rewrite sumr_const card_ord. Qed. Lemma mxtrace1 : \tr 1%:M = n%:R. Proof. exact: mxtrace_scalar. Qed. End Trace. Local Notation "'\tr' A" := (mxtrace A) : ring_scope. Lemma trace_mx11 (A : 'M_1) : \tr A = A 0 0. Proof. by rewrite {1}[A]mx11_scalar mxtrace_scalar. Qed. Lemma mxtrace_block n1 n2 (Aul : 'M_n1) Aur Adl (Adr : 'M_n2) : \tr (block_mx Aul Aur Adl Adr) = \tr Aul + \tr Adr. Proof. rewrite /(\tr _) big_split_ord /=. by congr (_ + _); under eq_bigr do rewrite (block_mxEul, block_mxEdr). Qed. (* The matrix ring structure requires a strutural condition (dimension of the *) (* form n.+1) to satisfy the nontriviality condition we have imposed. *) Section MatrixRing. Variable n' : nat. Local Notation n := n'.+1. Lemma matrix_nonzero1 : 1%:M != 0 :> 'M_n. Proof. by apply/eqP=> /matrixP/(_ 0 0)/eqP; rewrite !mxE oner_eq0. Qed. Definition matrix_ringMixin := RingMixin (@mulmxA n n n n) (@mul1mx n n) (@mulmx1 n n) (@mulmxDl n n n) (@mulmxDr n n n) matrix_nonzero1. Canonical matrix_ringType := Eval hnf in RingType 'M[R]_n matrix_ringMixin. Canonical matrix_lAlgType := Eval hnf in LalgType R 'M[R]_n (@scalemxAl n n n). Lemma mulmxE : mulmx = *%R. Proof. by []. Qed. Lemma idmxE : 1%:M = 1 :> 'M_n. Proof. by []. Qed. Lemma scalar_mx_is_multiplicative : multiplicative (@scalar_mx n). Proof. by split=> //; apply: scalar_mxM. Qed. Canonical scalar_mx_rmorphism := AddRMorphism scalar_mx_is_multiplicative. End MatrixRing. Section LiftPerm. (* Block expresssion of a lifted permutation matrix, for the Cormen LUP. *) Variable n : nat. (* These could be in zmodp, but that would introduce a dependency on perm. *) Definition lift0_perm s : 'S_n.+1 := lift_perm 0 0 s. Lemma lift0_perm0 s : lift0_perm s 0 = 0. Proof. exact: lift_perm_id. Qed. Lemma lift0_perm_lift s k' : lift0_perm s (lift 0 k') = lift (0 : 'I_n.+1) (s k'). Proof. exact: lift_perm_lift. Qed. Lemma lift0_permK s : cancel (lift0_perm s) (lift0_perm s^-1). Proof. by move=> i; rewrite /lift0_perm -lift_permV permK. Qed. Lemma lift0_perm_eq0 s i : (lift0_perm s i == 0) = (i == 0). Proof. by rewrite (canF_eq (lift0_permK s)) lift0_perm0. Qed. (* Block expresssion of a lifted permutation matrix *) Definition lift0_mx A : 'M_(1 + n) := block_mx 1 0 0 A. Lemma lift0_mx_perm s : lift0_mx (perm_mx s) = perm_mx (lift0_perm s). Proof. apply/matrixP=> /= i j; rewrite !mxE split1 /=; case: unliftP => [i'|] -> /=. rewrite lift0_perm_lift !mxE split1 /=. by case: unliftP => [j'|] ->; rewrite ?(inj_eq (lift_inj _)) /= !mxE. rewrite lift0_perm0 !mxE split1 /=. by case: unliftP => [j'|] ->; rewrite /= mxE. Qed. Lemma lift0_mx_is_perm s : is_perm_mx (lift0_mx (perm_mx s)). Proof. by rewrite lift0_mx_perm perm_mx_is_perm. Qed. End LiftPerm. (* Determinants and adjugates are defined here, but most of their properties *) (* only hold for matrices over a commutative ring, so their theory is *) (* deferred to that section. *) (* The determinant, in one line with the Leibniz Formula *) Definition determinant n (A : 'M_n) : R := \sum_(s : 'S_n) (-1) ^+ s * \prod_i A i (s i). (* The cofactor of a matrix on the indexes i and j *) Definition cofactor n A (i j : 'I_n) : R := (-1) ^+ (i + j) * determinant (row' i (col' j A)). (* The adjugate matrix : defined as the transpose of the matrix of cofactors *) Fact adjugate_key : unit. Proof. by []. Qed. Definition adjugate n (A : 'M_n) := \matrix[adjugate_key]_(i, j) cofactor A j i. End MatrixAlgebra. Arguments delta_mx {R m n}. Arguments scalar_mx {R n}. Arguments perm_mx {R n}. Arguments tperm_mx {R n}. Arguments pid_mx {R m n}. Arguments copid_mx {R n}. Arguments lin_mulmxr {R m n p}. Prenex Implicits diag_mx is_scalar_mx. Prenex Implicits mulmx mxtrace determinant cofactor adjugate. Arguments is_scalar_mxP {R n A}. Arguments mul_delta_mx {R m n p}. Hint Extern 0 (is_true (is_diag_mx (scalar_mx _))) => apply: scalar_mx_is_diag : core. Hint Extern 0 (is_true (is_trig_mx (scalar_mx _))) => apply: scalar_mx_is_trig : core. Hint Extern 0 (is_true (is_diag_mx (diag_mx _))) => apply: diag_mx_is_diag : core. Hint Extern 0 (is_true (is_trig_mx (diag_mx _))) => apply: diag_mx_is_trig : core. Notation "a %:M" := (scalar_mx a) : ring_scope. Notation "A *m B" := (mulmx A B) : ring_scope. Arguments mulmxr {_ _ _ _} B A /. Notation "\tr A" := (mxtrace A) : ring_scope. Notation "'\det' A" := (determinant A) : ring_scope. Notation "'\adj' A" := (adjugate A) : ring_scope. (* Non-commutative transpose requires multiplication in the converse ring. *) Lemma trmx_mul_rev (R : ringType) m n p (A : 'M[R]_(m, n)) (B : 'M[R]_(n, p)) : (A *m B)^T = (B : 'M[R^c]_(n, p))^T *m (A : 'M[R^c]_(m, n))^T. Proof. by apply/matrixP=> k i; rewrite !mxE; apply: eq_bigr => j _; rewrite !mxE. Qed. Canonical matrix_countZmodType (M : countZmodType) m n := [countZmodType of 'M[M]_(m, n)]. Canonical matrix_countRingType (R : countRingType) n := [countRingType of 'M[R]_n.+1]. Canonical matrix_finLmodType (R : finRingType) m n := [finLmodType R of 'M[R]_(m, n)]. Canonical matrix_finRingType (R : finRingType) n' := Eval hnf in [finRingType of 'M[R]_n'.+1]. Canonical matrix_finLalgType (R : finRingType) n' := [finLalgType R of 'M[R]_n'.+1]. (* Parametricity over the algebra structure. *) Section MapRingMatrix. Variables (aR rR : ringType) (f : {rmorphism aR -> rR}). Local Notation "A ^f" := (map_mx f A) : ring_scope. Section FixedSize. Variables m n p : nat. Implicit Type A : 'M[aR]_(m, n). Lemma map_mxZ a A : (a *: A)^f = f a *: A^f. Proof. by apply/matrixP=> i j; rewrite !mxE rmorphM. Qed. Lemma map_mxM A B : (A *m B)^f = A^f *m B^f :> 'M_(m, p). Proof. apply/matrixP=> i k; rewrite !mxE rmorph_sum //. by apply: eq_bigr => j; rewrite !mxE rmorphM. Qed. Lemma map_delta_mx i j : (delta_mx i j)^f = delta_mx i j :> 'M_(m, n). Proof. by apply/matrixP=> i' j'; rewrite !mxE rmorph_nat. Qed. Lemma map_diag_mx d : (diag_mx d)^f = diag_mx d^f :> 'M_n. Proof. by apply/matrixP=> i j; rewrite !mxE rmorphMn. Qed. Lemma map_scalar_mx a : a%:M^f = (f a)%:M :> 'M_n. Proof. by apply/matrixP=> i j; rewrite !mxE rmorphMn. Qed. Lemma map_mx1 : 1%:M^f = 1%:M :> 'M_n. Proof. by rewrite map_scalar_mx rmorph1. Qed. Lemma map_perm_mx (s : 'S_n) : (perm_mx s)^f = perm_mx s. Proof. by apply/matrixP=> i j; rewrite !mxE rmorph_nat. Qed. Lemma map_tperm_mx (i1 i2 : 'I_n) : (tperm_mx i1 i2)^f = tperm_mx i1 i2. Proof. exact: map_perm_mx. Qed. Lemma map_pid_mx r : (pid_mx r)^f = pid_mx r :> 'M_(m, n). Proof. by apply/matrixP=> i j; rewrite !mxE rmorph_nat. Qed. Lemma trace_map_mx (A : 'M_n) : \tr A^f = f (\tr A). Proof. by rewrite rmorph_sum; apply: eq_bigr => i _; rewrite mxE. Qed. Lemma det_map_mx n' (A : 'M_n') : \det A^f = f (\det A). Proof. rewrite rmorph_sum //; apply: eq_bigr => s _. rewrite rmorphM rmorph_sign rmorph_prod; congr (_ * _). by apply: eq_bigr => i _; rewrite mxE. Qed. Lemma cofactor_map_mx (A : 'M_n) i j : cofactor A^f i j = f (cofactor A i j). Proof. by rewrite rmorphM rmorph_sign -det_map_mx map_row' map_col'. Qed. Lemma map_mx_adj (A : 'M_n) : (\adj A)^f = \adj A^f. Proof. by apply/matrixP=> i j; rewrite !mxE cofactor_map_mx. Qed. End FixedSize. Lemma map_copid_mx n r : (copid_mx r)^f = copid_mx r :> 'M_n. Proof. by rewrite map_mxB map_mx1 map_pid_mx. Qed. Lemma map_mx_is_multiplicative n' (n := n'.+1) : multiplicative (map_mx f : 'M_n -> 'M_n). Proof. by split; [apply: map_mxM | apply: map_mx1]. Qed. Canonical map_mx_rmorphism n' := AddRMorphism (map_mx_is_multiplicative n'). Lemma map_lin1_mx m n (g : 'rV_m -> 'rV_n) gf : (forall v, (g v)^f = gf v^f) -> (lin1_mx g)^f = lin1_mx gf. Proof. by move=> def_gf; apply/matrixP=> i j; rewrite !mxE -map_delta_mx -def_gf mxE. Qed. Lemma map_lin_mx m1 n1 m2 n2 (g : 'M_(m1, n1) -> 'M_(m2, n2)) gf : (forall A, (g A)^f = gf A^f) -> (lin_mx g)^f = lin_mx gf. Proof. move=> def_gf; apply: map_lin1_mx => A /=. by rewrite map_mxvec def_gf map_vec_mx. Qed. End MapRingMatrix. Section CommMx. (***********************************************************************) (************* Commutation property specialized to 'M[R]_n *************) (***********************************************************************) (* GRing.comm is bound to (non trivial) rings, and matrices form a *) (* (non trivial) ring only when they are square and of manifestly *) (* positive size. However during proofs in endomorphism reduction, we *) (* take restrictions, which are matrices of size #|V| (with V a matrix *) (* space) and it becomes cumbersome to state commutation between *) (* restrictions, unless we relax the setting, and this relaxation *) (* corresponds to comm_mx A B := A *m B = B *m A. *) (* As witnessed by comm_mxE, when A and B have type 'M_n.+1, *) (* comm_mx A B is convertible to GRing.comm A B. *) (* The boolean version comm_mxb is designed to be used with seq.allrel *) (***********************************************************************) Context {R : ringType} {n : nat}. Implicit Types (f g p : 'M[R]_n) (fs : seq 'M[R]_n) (d : 'rV[R]_n) (I : Type). Definition comm_mx f g : Prop := f *m g = g *m f. Definition comm_mxb f g : bool := f *m g == g *m f. Lemma comm_mx_sym f g : comm_mx f g -> comm_mx g f. Proof. by rewrite /comm_mx. Qed. Lemma comm_mx_refl f : comm_mx f f. Proof. by []. Qed. Lemma comm_mx0 f : comm_mx f 0. Proof. by rewrite /comm_mx mulmx0 mul0mx. Qed. Lemma comm0mx f : comm_mx 0 f. Proof. by rewrite /comm_mx mulmx0 mul0mx. Qed. Lemma comm_mx1 f : comm_mx f 1%:M. Proof. by rewrite /comm_mx mulmx1 mul1mx. Qed. Lemma comm1mx f : comm_mx 1%:M f. Proof. by rewrite /comm_mx mulmx1 mul1mx. Qed. Hint Resolve comm_mx0 comm0mx comm_mx1 comm1mx : core. Lemma comm_mxN f g : comm_mx f g -> comm_mx f (- g). Proof. by rewrite /comm_mx mulmxN mulNmx => ->. Qed. Lemma comm_mxN1 f : comm_mx f (- 1%:M). Proof. exact/comm_mxN/comm_mx1. Qed. Lemma comm_mxD f g g' : comm_mx f g -> comm_mx f g' -> comm_mx f (g + g'). Proof. by rewrite /comm_mx mulmxDl mulmxDr => -> ->. Qed. Lemma comm_mxB f g g' : comm_mx f g -> comm_mx f g' -> comm_mx f (g - g'). Proof. by move=> fg fg'; apply/comm_mxD => //; apply/comm_mxN. Qed. Lemma comm_mxM f g g' : comm_mx f g -> comm_mx f g' -> comm_mx f (g *m g'). Proof. by rewrite /comm_mx mulmxA => ->; rewrite -!mulmxA => ->. Qed. Lemma comm_mx_sum I (s : seq I) (P : pred I) (F : I -> 'M[R]_n) (f : 'M[R]_n) : (forall i : I, P i -> comm_mx f (F i)) -> comm_mx f (\sum_(i <- s | P i) F i). Proof. by move=> comm_mxfF; elim/big_ind: _ => // g h; apply: comm_mxD. Qed. Lemma comm_mxP f g : reflect (comm_mx f g) (comm_mxb f g). Proof. exact: eqP. Qed. Notation all_comm_mx fs := (all2rel comm_mxb fs). Lemma all_comm_mxP fs : reflect {in fs &, forall f g, f *m g = g *m f} (all_comm_mx fs). Proof. by apply: (iffP allrelP) => fsP ? ? ? ?; apply/eqP/fsP. Qed. Lemma all_comm_mx1 f : all_comm_mx [:: f]. Proof. by rewrite /comm_mxb all2rel1. Qed. Lemma all_comm_mx2P f g : reflect (f *m g = g *m f) (all_comm_mx [:: f; g]). Proof. by rewrite /comm_mxb /= all2rel2 ?eqxx //; exact: eqP. Qed. Lemma all_comm_mx_cons f fs : all_comm_mx (f :: fs) = all (comm_mxb f) fs && all_comm_mx fs. Proof. by rewrite /comm_mxb /= all2rel_cons //= eqxx. Qed. End CommMx. Notation all_comm_mx := (allrel comm_mxb). Lemma comm_mxE (R : ringType) (n : nat) : @comm_mx R n.+1 = @GRing.comm _. Proof. by []. Qed. Section ComMatrix. (* Lemmas for matrices with coefficients in a commutative ring *) Variable R : comRingType. Section AssocLeft. Variables m n p : nat. Implicit Type A : 'M[R]_(m, n). Implicit Type B : 'M[R]_(n, p). Lemma trmx_mul A B : (A *m B)^T = B^T *m A^T. Proof. rewrite trmx_mul_rev; apply/matrixP=> k i; rewrite !mxE. by apply: eq_bigr => j _; rewrite mulrC. Qed. Lemma scalemxAr a A B : a *: (A *m B) = A *m (a *: B). Proof. by apply: trmx_inj; rewrite trmx_mul !linearZ /= trmx_mul scalemxAl. Qed. Lemma mulmx_is_scalable A : scalable (@mulmx _ m n p A). Proof. by move=> a B; rewrite scalemxAr. Qed. Canonical mulmx_linear A := AddLinear (mulmx_is_scalable A). Definition lin_mulmx A : 'M[R]_(n * p, m * p) := lin_mx (mulmx A). Lemma lin_mulmx_is_linear : linear lin_mulmx. Proof. move=> a A B; apply/row_matrixP=> i; rewrite linearP /= !rowE !mul_rV_lin /=. by rewrite [_ *m _](linearP (mulmxr_linear _ _)) linearP. Qed. Canonical lin_mulmx_additive := Additive lin_mulmx_is_linear. Canonical lin_mulmx_linear := Linear lin_mulmx_is_linear. End AssocLeft. Section LinMulRow. Variables m n : nat. Definition lin_mul_row u : 'M[R]_(m * n, n) := lin1_mx (mulmx u \o vec_mx). Lemma lin_mul_row_is_linear : linear lin_mul_row. Proof. move=> a u v; apply/row_matrixP=> i; rewrite linearP /= !rowE !mul_rV_lin1 /=. by rewrite [_ *m _](linearP (mulmxr_linear _ _)). Qed. Canonical lin_mul_row_additive := Additive lin_mul_row_is_linear. Canonical lin_mul_row_linear := Linear lin_mul_row_is_linear. Lemma mul_vec_lin_row A u : mxvec A *m lin_mul_row u = u *m A. Proof. by rewrite mul_rV_lin1 /= mxvecK. Qed. End LinMulRow. Lemma mxvec_dotmul m n (A : 'M[R]_(m, n)) u v : mxvec (u^T *m v) *m (mxvec A)^T = u *m A *m v^T. Proof. transitivity (\sum_i \sum_j (u 0 i * A i j *: row j v^T)). apply/rowP=> i; rewrite {i}ord1 mxE (reindex _ (curry_mxvec_bij _ _)) /=. rewrite pair_bigA summxE; apply: eq_bigr => [[i j]] /= _. by rewrite !mxE !mxvecE mxE big_ord1 mxE mulrAC. rewrite mulmx_sum_row exchange_big; apply: eq_bigr => j _ /=. by rewrite mxE -scaler_suml. Qed. Section MatrixAlgType. Variable n' : nat. Local Notation n := n'.+1. Canonical matrix_algType := Eval hnf in AlgType R 'M[R]_n (fun k => scalemxAr k). End MatrixAlgType. Lemma diag_mxC n (d e : 'rV[R]_n) : diag_mx d *m diag_mx e = diag_mx e *m diag_mx d. Proof. by rewrite !mulmx_diag; congr (diag_mx _); apply/rowP=> i; rewrite !mxE mulrC. Qed. Lemma diag_mx_comm n (d e : 'rV[R]_n) : comm_mx (diag_mx d) (diag_mx e). Proof. exact: diag_mxC. Qed. Lemma scalar_mxC m n a (A : 'M[R]_(m, n)) : A *m a%:M = a%:M *m A. Proof. by apply: trmx_inj; rewrite trmx_mul tr_scalar_mx !mul_scalar_mx linearZ. Qed. Lemma mul_mx_scalar m n a (A : 'M[R]_(m, n)) : A *m a%:M = a *: A. Proof. by rewrite scalar_mxC mul_scalar_mx. Qed. Lemma comm_mx_scalar n a (A : 'M[R]_n) : comm_mx A a%:M. Proof. by rewrite /comm_mx mul_mx_scalar mul_scalar_mx. Qed. Lemma comm_scalar_mx n a (A : 'M[R]_n) : comm_mx a%:M A. Proof. exact/comm_mx_sym/comm_mx_scalar. Qed. Lemma mxtrace_mulC m n (A : 'M[R]_(m, n)) B : \tr (A *m B) = \tr (B *m A). Proof. have expand_trM C D: \tr (C *m D) = \sum_i \sum_j C i j * D j i. by apply: eq_bigr => i _; rewrite mxE. rewrite !{}expand_trM exchange_big /=. by do 2!apply: eq_bigr => ? _; apply: mulrC. Qed. (* The theory of determinants *) Lemma determinant_multilinear n (A B C : 'M[R]_n) i0 b c : row i0 A = b *: row i0 B + c *: row i0 C -> row' i0 B = row' i0 A -> row' i0 C = row' i0 A -> \det A = b * \det B + c * \det C. Proof. rewrite -[_ + _](row_id 0); move/row_eq=> ABC. move/row'_eq=> BA; move/row'_eq=> CA. rewrite !big_distrr -big_split; apply: eq_bigr => s _ /=. rewrite -!(mulrCA (_ ^+s)) -mulrDr; congr (_ * _). rewrite !(bigD1 i0 (_ : predT i0)) //= {}ABC !mxE mulrDl !mulrA. by congr (_ * _ + _ * _); apply: eq_bigr => i i0i; rewrite ?BA ?CA. Qed. Lemma determinant_alternate n (A : 'M[R]_n) i1 i2 : i1 != i2 -> A i1 =1 A i2 -> \det A = 0. Proof. move=> neq_i12 eqA12; pose t := tperm i1 i2. have oddMt s: (t * s)%g = ~~ s :> bool by rewrite odd_permM odd_tperm neq_i12. rewrite [\det A](bigID (@odd_perm _)) /=. apply: canLR (subrK _) _; rewrite add0r -sumrN. rewrite (reindex_inj (mulgI t)); apply: eq_big => //= s. rewrite oddMt => /negPf->; rewrite mulN1r mul1r; congr (- _). rewrite (reindex_perm t); apply: eq_bigr => /= i _. by rewrite permM tpermK /t; case: tpermP => // ->; rewrite eqA12. Qed. Lemma det_tr n (A : 'M[R]_n) : \det A^T = \det A. Proof. rewrite [\det A^T](reindex_inj invg_inj) /=. apply: eq_bigr => s _ /=; rewrite !odd_permV (reindex_perm s) /=. by congr (_ * _); apply: eq_bigr => i _; rewrite mxE permK. Qed. Lemma det_perm n (s : 'S_n) : \det (perm_mx s) = (-1) ^+ s :> R. Proof. rewrite [\det _](bigD1 s) //= big1 => [|i _]; last by rewrite /= !mxE eqxx. rewrite mulr1 big1 ?addr0 => //= t Dst. case: (pickP (fun i => s i != t i)) => [i ist | Est]. by rewrite (bigD1 i) // mulrCA /= !mxE (negPf ist) mul0r. by case/eqP: Dst; apply/permP => i; move/eqP: (Est i). Qed. Lemma det1 n : \det (1%:M : 'M[R]_n) = 1. Proof. by rewrite -perm_mx1 det_perm odd_perm1. Qed. Lemma det_mx00 (A : 'M[R]_0) : \det A = 1. Proof. by rewrite flatmx0 -(flatmx0 1%:M) det1. Qed. Lemma detZ n a (A : 'M[R]_n) : \det (a *: A) = a ^+ n * \det A. Proof. rewrite big_distrr /=; apply: eq_bigr => s _; rewrite mulrCA; congr (_ * _). rewrite -[n in a ^+ n]card_ord -prodr_const -big_split /=. by apply: eq_bigr=> i _; rewrite mxE. Qed. Lemma det0 n' : \det (0 : 'M[R]_n'.+1) = 0. Proof. by rewrite -(scale0r 0) detZ exprS !mul0r. Qed. Lemma det_scalar n a : \det (a%:M : 'M[R]_n) = a ^+ n. Proof. by rewrite -{1}(mulr1 a) -scale_scalar_mx detZ det1 mulr1. Qed. Lemma det_scalar1 a : \det (a%:M : 'M[R]_1) = a. Proof. exact: det_scalar. Qed. Lemma det_mx11 (M : 'M[R]_1) : \det M = M 0 0. Proof. by rewrite {1}[M]mx11_scalar det_scalar. Qed. Lemma det_mulmx n (A B : 'M[R]_n) : \det (A *m B) = \det A * \det B. Proof. rewrite big_distrl /=. pose F := ('I_n ^ n)%type; pose AB s i j := A i j * B j (s i). transitivity (\sum_(f : F) \sum_(s : 'S_n) (-1) ^+ s * \prod_i AB s i (f i)). rewrite exchange_big; apply: eq_bigr => /= s _; rewrite -big_distrr /=. congr (_ * _); rewrite -(bigA_distr_bigA (AB s)) /=. by apply: eq_bigr => x _; rewrite mxE. rewrite (bigID (fun f : F => injectiveb f)) /= addrC big1 ?add0r => [|f Uf]. rewrite (reindex (@pval _)) /=; last first. pose in_Sn := insubd (1%g : 'S_n). by exists in_Sn => /= f Uf; first apply: val_inj; apply: insubdK. apply: eq_big => /= [s | s _]; rewrite ?(valP s) // big_distrr /=. rewrite (reindex_inj (mulgI s)); apply: eq_bigr => t _ /=. rewrite big_split /= mulrA mulrCA mulrA mulrCA mulrA. rewrite -signr_addb odd_permM !pvalE; congr (_ * _); symmetry. by rewrite (reindex_perm s); apply: eq_bigr => i; rewrite permM. transitivity (\det (\matrix_(i, j) B (f i) j) * \prod_i A i (f i)). rewrite mulrC big_distrr /=; apply: eq_bigr => s _. rewrite mulrCA big_split //=; congr (_ * (_ * _)). by apply: eq_bigr => x _; rewrite mxE. case/injectivePn: Uf => i1 [i2 Di12 Ef12]. by rewrite (determinant_alternate Di12) ?simp //= => j; rewrite !mxE Ef12. Qed. Lemma detM n' (A B : 'M[R]_n'.+1) : \det (A * B) = \det A * \det B. Proof. exact: det_mulmx. Qed. (* Laplace expansion lemma *) Lemma expand_cofactor n (A : 'M[R]_n) i j : cofactor A i j = \sum_(s : 'S_n | s i == j) (-1) ^+ s * \prod_(k | i != k) A k (s k). Proof. case: n A i j => [|n] A i0 j0; first by case: i0. rewrite (reindex (lift_perm i0 j0)); last first. pose ulsf i (s : 'S_n.+1) k := odflt k (unlift (s i) (s (lift i k))). have ulsfK i (s : 'S_n.+1) k: lift (s i) (ulsf i s k) = s (lift i k). rewrite /ulsf; have:= neq_lift i k. by rewrite -(can_eq (permK s)) => /unlift_some[] ? ? ->. have inj_ulsf: injective (ulsf i0 _). move=> s; apply: can_inj (ulsf (s i0) s^-1%g) _ => k'. by rewrite {1}/ulsf ulsfK !permK liftK. exists (fun s => perm (inj_ulsf s)) => [s _ | s]. by apply/permP=> k'; rewrite permE /ulsf lift_perm_lift lift_perm_id liftK. move/(s _ =P _) => si0; apply/permP=> k. case: (unliftP i0 k) => [k'|] ->; rewrite ?lift_perm_id //. by rewrite lift_perm_lift -si0 permE ulsfK. rewrite /cofactor big_distrr /=. apply: eq_big => [s | s _]; first by rewrite lift_perm_id eqxx. rewrite -signr_odd mulrA -signr_addb oddD -odd_lift_perm; congr (_ * _). case: (pickP 'I_n) => [k0 _ | n0]; last first. by rewrite !big1 // => [j /unlift_some[i] | i _]; have:= n0 i. rewrite (reindex (lift i0)). by apply: eq_big => [k | k _] /=; rewrite ?neq_lift // !mxE lift_perm_lift. exists (fun k => odflt k0 (unlift i0 k)) => k; first by rewrite liftK. by case/unlift_some=> k' -> ->. Qed. Lemma expand_det_row n (A : 'M[R]_n) i0 : \det A = \sum_j A i0 j * cofactor A i0 j. Proof. rewrite /(\det A) (partition_big (fun s : 'S_n => s i0) predT) //=. apply: eq_bigr => j0 _; rewrite expand_cofactor big_distrr /=. apply: eq_bigr => s /eqP Dsi0. rewrite mulrCA (bigID (pred1 i0)) /= big_pred1_eq Dsi0; congr (_ * (_ * _)). by apply: eq_bigl => i; rewrite eq_sym. Qed. Lemma cofactor_tr n (A : 'M[R]_n) i j : cofactor A^T i j = cofactor A j i. Proof. rewrite /cofactor addnC; congr (_ * _). rewrite -tr_row' -tr_col' det_tr; congr (\det _). by apply/matrixP=> ? ?; rewrite !mxE. Qed. Lemma cofactorZ n a (A : 'M[R]_n) i j : cofactor (a *: A) i j = a ^+ n.-1 * cofactor A i j. Proof. by rewrite {1}/cofactor !linearZ detZ mulrCA mulrA. Qed. Lemma expand_det_col n (A : 'M[R]_n) j0 : \det A = \sum_i (A i j0 * cofactor A i j0). Proof. rewrite -det_tr (expand_det_row _ j0). by under eq_bigr do rewrite cofactor_tr mxE. Qed. Lemma trmx_adj n (A : 'M[R]_n) : (\adj A)^T = \adj A^T. Proof. by apply/matrixP=> i j; rewrite !mxE cofactor_tr. Qed. Lemma adjZ n a (A : 'M[R]_n) : \adj (a *: A) = a^+n.-1 *: \adj A. Proof. by apply/matrixP=> i j; rewrite !mxE cofactorZ. Qed. (* Cramer Rule : adjugate on the left *) Lemma mul_mx_adj n (A : 'M[R]_n) : A *m \adj A = (\det A)%:M. Proof. apply/matrixP=> i1 i2; rewrite !mxE; have [->|Di] := eqVneq. rewrite (expand_det_row _ i2) //=. by apply: eq_bigr => j _; congr (_ * _); rewrite mxE. pose B := \matrix_(i, j) (if i == i2 then A i1 j else A i j). have EBi12: B i1 =1 B i2 by move=> j; rewrite /= !mxE eqxx (negPf Di). rewrite -[_ *+ _](determinant_alternate Di EBi12) (expand_det_row _ i2). apply: eq_bigr => j _; rewrite !mxE eqxx; congr (_ * (_ * _)). apply: eq_bigr => s _; congr (_ * _); apply: eq_bigr => i _. by rewrite !mxE eq_sym -if_neg neq_lift. Qed. (* Cramer rule : adjugate on the right *) Lemma mul_adj_mx n (A : 'M[R]_n) : \adj A *m A = (\det A)%:M. Proof. by apply: trmx_inj; rewrite trmx_mul trmx_adj mul_mx_adj det_tr tr_scalar_mx. Qed. Lemma adj1 n : \adj (1%:M) = 1%:M :> 'M[R]_n. Proof. by rewrite -{2}(det1 n) -mul_adj_mx mulmx1. Qed. (* Left inverses are right inverses. *) Lemma mulmx1C n (A B : 'M[R]_n) : A *m B = 1%:M -> B *m A = 1%:M. Proof. move=> AB1; pose A' := \det B *: \adj A. suffices kA: A' *m A = 1%:M by rewrite -[B]mul1mx -kA -(mulmxA A') AB1 mulmx1. by rewrite -scalemxAl mul_adj_mx scale_scalar_mx mulrC -det_mulmx AB1 det1. Qed. (* Only tall matrices have inverses. *) Lemma mulmx1_min m n (A : 'M[R]_(m, n)) B : A *m B = 1%:M -> m <= n. Proof. move=> AB1; rewrite leqNgt; apply/negP=> /subnKC; rewrite addSnnS. move: (_ - _)%N => m' def_m; move: AB1; rewrite -{m}def_m in A B *. rewrite -(vsubmxK A) -(hsubmxK B) mul_col_row scalar_mx_block. case/eq_block_mx=> /mulmx1C BlAu1 AuBr0 _ => /eqP/idPn[]. by rewrite -[_ B]mul1mx -BlAu1 -mulmxA AuBr0 !mulmx0 eq_sym oner_neq0. Qed. Lemma det_ublock n1 n2 Aul (Aur : 'M[R]_(n1, n2)) Adr : \det (block_mx Aul Aur 0 Adr) = \det Aul * \det Adr. Proof. elim: n1 => [|n1 IHn1] in Aul Aur *. have ->: Aul = 1%:M by apply/matrixP=> i []. rewrite det1 mul1r; congr (\det _); apply/matrixP=> i j. by do 2![rewrite !mxE; case: splitP => [[]|k] //=; move/val_inj=> <- {k}]. rewrite (expand_det_col _ (lshift n2 0)) big_split_ord /=. rewrite addrC big1 1?simp => [|i _]; last by rewrite block_mxEdl mxE simp. rewrite (expand_det_col _ 0) big_distrl /=; apply: eq_bigr=> i _. rewrite block_mxEul -!mulrA; do 2!congr (_ * _). by rewrite col'_col_mx !col'Kl raddf0 row'Ku row'_row_mx IHn1. Qed. Lemma det_lblock n1 n2 Aul (Adl : 'M[R]_(n2, n1)) Adr : \det (block_mx Aul 0 Adl Adr) = \det Aul * \det Adr. Proof. by rewrite -det_tr tr_block_mx trmx0 det_ublock !det_tr. Qed. Lemma det_trig n (A : 'M[R]_n) : is_trig_mx A -> \det A = \prod_(i < n) A i i. Proof. elim/trigsqmx_ind => [|k x c B Bt IHB]; first by rewrite ?big_ord0 ?det_mx00. rewrite det_lblock big_ord_recl det_mx11 IHB//; congr (_ * _). by rewrite -[ord0](lshift0 _ 0) block_mxEul. by apply: eq_bigr => i; rewrite -!rshift1 block_mxEdr. Qed. Lemma det_diag n (d : 'rV[R]_n) : \det (diag_mx d) = \prod_i d 0 i. Proof. by rewrite det_trig//; apply: eq_bigr => i; rewrite !mxE eqxx. Qed. End ComMatrix. Arguments lin_mul_row {R m n} u. Arguments lin_mulmx {R m n p} A. Arguments comm_mx_scalar {R n}. Arguments comm_scalar_mx {R n}. Arguments diag_mx_comm {R n}. Canonical matrix_finAlgType (R : finComRingType) n' := [finAlgType R of 'M[R]_n'.+1]. Hint Resolve comm_mx_scalar comm_scalar_mx : core. Notation "@ 'scalar_mx_comm'" := (deprecate scalar_mx_comm comm_mx_scalar) (at level 10, only parsing) : fun_scope. Notation scalar_mx_comm := (@scalar_mx_comm _ _) (only parsing). (*****************************************************************************) (********************** Matrix unit ring and inverse matrices ****************) (*****************************************************************************) Section MatrixInv. Variables R : comUnitRingType. Section Defs. Variable n : nat. Implicit Type A : 'M[R]_n. Definition unitmx : pred 'M[R]_n := fun A => \det A \is a GRing.unit. Definition invmx A := if A \in unitmx then (\det A)^-1 *: \adj A else A. Lemma unitmxE A : (A \in unitmx) = (\det A \is a GRing.unit). Proof. by []. Qed. Lemma unitmx1 : 1%:M \in unitmx. Proof. by rewrite unitmxE det1 unitr1. Qed. Lemma unitmx_perm s : perm_mx s \in unitmx. Proof. by rewrite unitmxE det_perm unitrX ?unitrN ?unitr1. Qed. Lemma unitmx_tr A : (A^T \in unitmx) = (A \in unitmx). Proof. by rewrite unitmxE det_tr. Qed. Lemma unitmxZ a A : a \is a GRing.unit -> (a *: A \in unitmx) = (A \in unitmx). Proof. by move=> Ua; rewrite !unitmxE detZ unitrM unitrX. Qed. Lemma invmx1 : invmx 1%:M = 1%:M. Proof. by rewrite /invmx det1 invr1 scale1r adj1 if_same. Qed. Lemma invmxZ a A : a *: A \in unitmx -> invmx (a *: A) = a^-1 *: invmx A. Proof. rewrite /invmx !unitmxE detZ unitrM => /andP[Ua U_A]. rewrite Ua U_A adjZ !scalerA invrM {U_A}//=. case: (posnP n) A => [-> | n_gt0] A; first by rewrite flatmx0 [_ *: _]flatmx0. rewrite unitrX_pos // in Ua; rewrite -[_ * _](mulrK Ua) mulrC -!mulrA. by rewrite -exprSr prednK // !mulrA divrK ?unitrX. Qed. Lemma invmx_scalar a : invmx (a%:M) = a^-1%:M. Proof. case Ua: (a%:M \in unitmx). by rewrite -scalemx1 in Ua *; rewrite invmxZ // invmx1 scalemx1. rewrite /invmx Ua; have [->|n_gt0] := posnP n; first by rewrite ![_%:M]flatmx0. by rewrite unitmxE det_scalar unitrX_pos // in Ua; rewrite invr_out ?Ua. Qed. Lemma mulVmx : {in unitmx, left_inverse 1%:M invmx mulmx}. Proof. by move=> A nsA; rewrite /invmx nsA -scalemxAl mul_adj_mx scale_scalar_mx mulVr. Qed. Lemma mulmxV : {in unitmx, right_inverse 1%:M invmx mulmx}. Proof. by move=> A nsA; rewrite /invmx nsA -scalemxAr mul_mx_adj scale_scalar_mx mulVr. Qed. Lemma mulKmx m : {in unitmx, @left_loop _ 'M_(n, m) invmx mulmx}. Proof. by move=> A uA /= B; rewrite mulmxA mulVmx ?mul1mx. Qed. Lemma mulKVmx m : {in unitmx, @rev_left_loop _ 'M_(n, m) invmx mulmx}. Proof. by move=> A uA /= B; rewrite mulmxA mulmxV ?mul1mx. Qed. Lemma mulmxK m : {in unitmx, @right_loop 'M_(m, n) _ invmx mulmx}. Proof. by move=> A uA /= B; rewrite -mulmxA mulmxV ?mulmx1. Qed. Lemma mulmxKV m : {in unitmx, @rev_right_loop 'M_(m, n) _ invmx mulmx}. Proof. by move=> A uA /= B; rewrite -mulmxA mulVmx ?mulmx1. Qed. Lemma det_inv A : \det (invmx A) = (\det A)^-1. Proof. case uA: (A \in unitmx); last by rewrite /invmx uA invr_out ?negbT. by apply: (mulrI uA); rewrite -det_mulmx mulmxV ?divrr ?det1. Qed. Lemma unitmx_inv A : (invmx A \in unitmx) = (A \in unitmx). Proof. by rewrite !unitmxE det_inv unitrV. Qed. Lemma unitmx_mul A B : (A *m B \in unitmx) = (A \in unitmx) && (B \in unitmx). Proof. by rewrite -unitrM -det_mulmx. Qed. Lemma trmx_inv (A : 'M_n) : (invmx A)^T = invmx (A^T). Proof. by rewrite (fun_if trmx) linearZ /= trmx_adj -unitmx_tr -det_tr. Qed. Lemma invmxK : involutive invmx. Proof. move=> A; case uA : (A \in unitmx); last by rewrite /invmx !uA. by apply: (can_inj (mulKVmx uA)); rewrite mulVmx // mulmxV ?unitmx_inv. Qed. Lemma mulmx1_unit A B : A *m B = 1%:M -> A \in unitmx /\ B \in unitmx. Proof. by move=> AB1; apply/andP; rewrite -unitmx_mul AB1 unitmx1. Qed. Lemma intro_unitmx A B : B *m A = 1%:M /\ A *m B = 1%:M -> unitmx A. Proof. by case=> _ /mulmx1_unit[]. Qed. Lemma invmx_out : {in [predC unitmx], invmx =1 id}. Proof. by move=> A; rewrite inE /= /invmx -if_neg => ->. Qed. End Defs. Variable n' : nat. Local Notation n := n'.+1. Definition matrix_unitRingMixin := UnitRingMixin (@mulVmx n) (@mulmxV n) (@intro_unitmx n) (@invmx_out n). Canonical matrix_unitRing := Eval hnf in UnitRingType 'M[R]_n matrix_unitRingMixin. Canonical matrix_unitAlg := Eval hnf in [unitAlgType R of 'M[R]_n]. (* Lemmas requiring that the coefficients are in a unit ring *) Lemma detV (A : 'M_n) : \det A^-1 = (\det A)^-1. Proof. exact: det_inv. Qed. Lemma unitr_trmx (A : 'M_n) : (A^T \is a GRing.unit) = (A \is a GRing.unit). Proof. exact: unitmx_tr. Qed. Lemma trmxV (A : 'M_n) : A^-1^T = (A^T)^-1. Proof. exact: trmx_inv. Qed. Lemma perm_mxV (s : 'S_n) : perm_mx s^-1 = (perm_mx s)^-1. Proof. rewrite -[_^-1]mul1r; apply: (canRL (mulmxK (unitmx_perm s))). by rewrite -perm_mxM mulVg perm_mx1. Qed. Lemma is_perm_mxV (A : 'M_n) : is_perm_mx A^-1 = is_perm_mx A. Proof. apply/is_perm_mxP/is_perm_mxP=> [] [s defA]; exists s^-1%g. by rewrite -(invrK A) defA perm_mxV. by rewrite defA perm_mxV. Qed. End MatrixInv. Prenex Implicits unitmx invmx invmxK. Canonical matrix_countUnitRingType (R : countComUnitRingType) n := [countUnitRingType of 'M[R]_n.+1]. (* Finite inversible matrices and the general linear group. *) Section FinUnitMatrix. Variables (n : nat) (R : finComUnitRingType). Canonical matrix_finUnitRingType n' := Eval hnf in [finUnitRingType of 'M[R]_n'.+1]. Definition GLtype of phant R := {unit 'M[R]_n.-1.+1}. Coercion GLval ph (u : GLtype ph) : 'M[R]_n.-1.+1 := let: FinRing.Unit A _ := u in A. End FinUnitMatrix. Bind Scope group_scope with GLtype. Arguments GLval {n%N R ph} u%g. Notation "{ ''GL_' n [ R ] }" := (GLtype n (Phant R)) (at level 0, n at level 2, format "{ ''GL_' n [ R ] }") : type_scope. Notation "{ ''GL_' n ( p ) }" := {'GL_n['F_p]} (at level 0, n at level 2, p at level 10, format "{ ''GL_' n ( p ) }") : type_scope. Section GL_unit. Variables (n : nat) (R : finComUnitRingType). Canonical GL_subType := [subType of {'GL_n[R]} for GLval]. Definition GL_eqMixin := Eval hnf in [eqMixin of {'GL_n[R]} by <:]. Canonical GL_eqType := Eval hnf in EqType {'GL_n[R]} GL_eqMixin. Canonical GL_choiceType := Eval hnf in [choiceType of {'GL_n[R]}]. Canonical GL_countType := Eval hnf in [countType of {'GL_n[R]}]. Canonical GL_subCountType := Eval hnf in [subCountType of {'GL_n[R]}]. Canonical GL_finType := Eval hnf in [finType of {'GL_n[R]}]. Canonical GL_subFinType := Eval hnf in [subFinType of {'GL_n[R]}]. Canonical GL_baseFinGroupType := Eval hnf in [baseFinGroupType of {'GL_n[R]}]. Canonical GL_finGroupType := Eval hnf in [finGroupType of {'GL_n[R]}]. Definition GLgroup of phant R := [set: {'GL_n[R]}]. Canonical GLgroup_group ph := Eval hnf in [group of GLgroup ph]. Implicit Types u v : {'GL_n[R]}. Lemma GL_1E : GLval 1 = 1. Proof. by []. Qed. Lemma GL_VE u : GLval u^-1 = (GLval u)^-1. Proof. by []. Qed. Lemma GL_VxE u : GLval u^-1 = invmx u. Proof. by []. Qed. Lemma GL_ME u v : GLval (u * v) = GLval u * GLval v. Proof. by []. Qed. Lemma GL_MxE u v : GLval (u * v) = u *m v. Proof. by []. Qed. Lemma GL_unit u : GLval u \is a GRing.unit. Proof. exact: valP. Qed. Lemma GL_unitmx u : val u \in unitmx. Proof. exact: GL_unit. Qed. Lemma GL_det u : \det u != 0. Proof. by apply: contraL (GL_unitmx u); rewrite unitmxE => /eqP->; rewrite unitr0. Qed. End GL_unit. Notation "''GL_' n [ R ]" := (GLgroup n (Phant R)) (at level 8, n at level 2, format "''GL_' n [ R ]") : group_scope. Notation "''GL_' n ( p )" := 'GL_n['F_p] (at level 8, n at level 2, p at level 10, format "''GL_' n ( p )") : group_scope. Notation "''GL_' n [ R ]" := (GLgroup_group n (Phant R)) : Group_scope. Notation "''GL_' n ( p )" := (GLgroup_group n (Phant 'F_p)) : Group_scope. (*****************************************************************************) (********************** Matrices over a domain *******************************) (*****************************************************************************) Section MatrixDomain. Variable R : idomainType. Lemma scalemx_eq0 m n a (A : 'M[R]_(m, n)) : (a *: A == 0) = (a == 0) || (A == 0). Proof. case nz_a: (a == 0) / eqP => [-> | _]; first by rewrite scale0r eqxx. apply/eqP/eqP=> [aA0 | ->]; last exact: scaler0. apply/matrixP=> i j; apply/eqP; move/matrixP/(_ i j)/eqP: aA0. by rewrite !mxE mulf_eq0 nz_a. Qed. Lemma scalemx_inj m n a : a != 0 -> injective ( *:%R a : 'M[R]_(m, n) -> 'M[R]_(m, n)). Proof. move=> nz_a A B eq_aAB; apply: contraNeq nz_a. rewrite -[A == B]subr_eq0 -[a == 0]orbF => /negPf<-. by rewrite -scalemx_eq0 linearB subr_eq0 /= eq_aAB. Qed. Lemma det0P n (A : 'M[R]_n) : reflect (exists2 v : 'rV[R]_n, v != 0 & v *m A = 0) (\det A == 0). Proof. apply: (iffP eqP) => [detA0 | [v n0v vA0]]; last first. apply: contraNeq n0v => nz_detA; rewrite -(inj_eq (scalemx_inj nz_detA)). by rewrite scaler0 -mul_mx_scalar -mul_mx_adj mulmxA vA0 mul0mx. elim: n => [|n IHn] in A detA0 *. by case/idP: (oner_eq0 R); rewrite -detA0 [A]thinmx0 -(thinmx0 1%:M) det1. have [{detA0}A'0 | nzA'] := eqVneq (row 0 (\adj A)) 0; last first. exists (row 0 (\adj A)) => //; rewrite rowE -mulmxA mul_adj_mx detA0. by rewrite mul_mx_scalar scale0r. pose A' := col' 0 A; pose vA := col 0 A. have defA: A = row_mx vA A'. apply/matrixP=> i j; rewrite !mxE. by case: split_ordP => j' ->; rewrite !mxE ?ord1; congr (A i _); apply: val_inj. have{IHn} w_ j : exists w : 'rV_n.+1, [/\ w != 0, w 0 j = 0 & w *m A' = 0]. have [|wj nzwj wjA'0] := IHn (row' j A'). by apply/eqP; move/rowP/(_ j)/eqP: A'0; rewrite !mxE mulf_eq0 signr_eq0. exists (\row_k oapp (wj 0) 0 (unlift j k)). rewrite !mxE unlift_none -wjA'0; split=> //. apply: contraNneq nzwj => w0; apply/eqP/rowP=> k'. by move/rowP/(_ (lift j k')): w0; rewrite !mxE liftK. apply/rowP=> k; rewrite !mxE (bigD1_ord j) //= mxE unlift_none mul0r add0r. by apply: eq_big => //= k'; rewrite !mxE/= liftK. have [w0 [/rV0Pn[j nz_w0j] w00_0 w0A']] := w_ 0; pose a0 := (w0 *m vA) 0 0. have{w_} [wj [nz_wj wj0_0 wjA']] := w_ j; pose aj := (wj *m vA) 0 0. have [aj0 | nz_aj] := eqVneq aj 0. exists wj => //; rewrite defA (@mul_mx_row _ _ _ 1) [_ *m _]mx11_scalar -/aj. by rewrite aj0 raddf0 wjA' row_mx0. exists (aj *: w0 - a0 *: wj). apply: contraNneq nz_aj; move/rowP/(_ j)/eqP; rewrite !mxE wj0_0 mulr0 subr0. by rewrite mulf_eq0 (negPf nz_w0j) orbF. rewrite defA (@mul_mx_row _ _ _ 1) !mulmxBl -!scalemxAl w0A' wjA' !linear0. by rewrite -mul_mx_scalar -mul_scalar_mx -!mx11_scalar subrr addr0 row_mx0. Qed. End MatrixDomain. Arguments det0P {R n A}. (* Parametricity at the field level (mx_is_scalar, unit and inverse are only *) (* mapped at this level). *) Section MapFieldMatrix. Variables (aF : fieldType) (rF : comUnitRingType) (f : {rmorphism aF -> rF}). Local Notation "A ^f" := (map_mx f A) : ring_scope. Lemma map_mx_inj {m n} : injective (map_mx f : 'M_(m, n) -> 'M_(m, n)). Proof. move=> A B eq_AB; apply/matrixP=> i j. by move/matrixP/(_ i j): eq_AB; rewrite !mxE; apply: fmorph_inj. Qed. Lemma map_mx_is_scalar n (A : 'M_n) : is_scalar_mx A^f = is_scalar_mx A. Proof. rewrite /is_scalar_mx; case: (insub _) => // i. by rewrite mxE -map_scalar_mx inj_eq //; apply: map_mx_inj. Qed. Lemma map_unitmx n (A : 'M_n) : (A^f \in unitmx) = (A \in unitmx). Proof. by rewrite unitmxE det_map_mx // fmorph_unit // -unitfE. Qed. Lemma map_mx_unit n' (A : 'M_n'.+1) : (A^f \is a GRing.unit) = (A \is a GRing.unit). Proof. exact: map_unitmx. Qed. Lemma map_invmx n (A : 'M_n) : (invmx A)^f = invmx A^f. Proof. rewrite /invmx map_unitmx (fun_if (map_mx f)). by rewrite map_mxZ map_mx_adj det_map_mx fmorphV. Qed. Lemma map_mx_inv n' (A : 'M_n'.+1) : A^-1^f = A^f^-1. Proof. exact: map_invmx. Qed. Lemma map_mx_eq0 m n (A : 'M_(m, n)) : (A^f == 0) = (A == 0). Proof. by rewrite -(inj_eq map_mx_inj) raddf0. Qed. End MapFieldMatrix. Arguments map_mx_inj {aF rF f m n} [A1 A2] eqA12f : rename. (*****************************************************************************) (****************************** LUP decomposion ******************************) (*****************************************************************************) Section CormenLUP. Variable F : fieldType. (* Decomposition of the matrix A to P A = L U with *) (* - P a permutation matrix *) (* - L a unipotent lower triangular matrix *) (* - U an upper triangular matrix *) Fixpoint cormen_lup {n} := match n return let M := 'M[F]_n.+1 in M -> M * M * M with | 0 => fun A => (1, 1, A) | _.+1 => fun A => let k := odflt 0 [pick k | A k 0 != 0] in let A1 : 'M_(1 + _) := xrow 0 k A in let P1 : 'M_(1 + _) := tperm_mx 0 k in let Schur := ((A k 0)^-1 *: dlsubmx A1) *m ursubmx A1 in let: (P2, L2, U2) := cormen_lup (drsubmx A1 - Schur) in let P := block_mx 1 0 0 P2 *m P1 in let L := block_mx 1 0 ((A k 0)^-1 *: (P2 *m dlsubmx A1)) L2 in let U := block_mx (ulsubmx A1) (ursubmx A1) 0 U2 in (P, L, U) end. Lemma cormen_lup_perm n (A : 'M_n.+1) : is_perm_mx (cormen_lup A).1.1. Proof. elim: n => [|n IHn] /= in A *; first exact: is_perm_mx1. set A' := _ - _; move/(_ A'): IHn; case: cormen_lup => [[P L U]] {A'}/=. rewrite (is_perm_mxMr _ (perm_mx_is_perm _ _)). by case/is_perm_mxP => s ->; apply: lift0_mx_is_perm. Qed. Lemma cormen_lup_correct n (A : 'M_n.+1) : let: (P, L, U) := cormen_lup A in P * A = L * U. Proof. elim: n => [|n IHn] /= in A *; first by rewrite !mul1r. set k := odflt _ _; set A1 : 'M_(1 + _) := xrow _ _ _. set A' := _ - _; move/(_ A'): IHn; case: cormen_lup => [[P' L' U']] /= IHn. rewrite -mulrA -!mulmxE -xrowE -/A1 /= -[n.+2]/(1 + n.+1)%N -{1}(submxK A1). rewrite !mulmx_block !mul0mx !mulmx0 !add0r !addr0 !mul1mx -{L' U'}[L' *m _]IHn. rewrite -scalemxAl !scalemxAr -!mulmxA addrC -mulrDr {A'}subrK. congr (block_mx _ _ (_ *m _) _). rewrite [_ *: _]mx11_scalar !mxE lshift0 tpermL {}/A1 {}/k. case: pickP => /= [k nzAk0 | no_k]; first by rewrite mulVf ?mulmx1. rewrite (_ : dlsubmx _ = 0) ?mul0mx //; apply/colP=> i. by rewrite !mxE lshift0 (elimNf eqP (no_k _)). Qed. Lemma cormen_lup_detL n (A : 'M_n.+1) : \det (cormen_lup A).1.2 = 1. Proof. elim: n => [|n IHn] /= in A *; first by rewrite det1. set A' := _ - _; move/(_ A'): IHn; case: cormen_lup => [[P L U]] {A'}/= detL. by rewrite (@det_lblock _ 1) det1 mul1r. Qed. Lemma cormen_lup_lower n A (i j : 'I_n.+1) : i <= j -> (cormen_lup A).1.2 i j = (i == j)%:R. Proof. elim: n => [|n IHn] /= in A i j *; first by rewrite [i]ord1 [j]ord1 mxE. set A' := _ - _; move/(_ A'): IHn; case: cormen_lup => [[P L U]] {A'}/= Ll. rewrite !mxE split1; case: unliftP => [i'|] -> /=; rewrite !mxE split1. by case: unliftP => [j'|] -> //; apply: Ll. by case: unliftP => [j'|] ->; rewrite /= mxE. Qed. Lemma cormen_lup_upper n A (i j : 'I_n.+1) : j < i -> (cormen_lup A).2 i j = 0 :> F. Proof. elim: n => [|n IHn] /= in A i j *; first by rewrite [i]ord1. set A' := _ - _; move/(_ A'): IHn; case: cormen_lup => [[P L U]] {A'}/= Uu. rewrite !mxE split1; case: unliftP => [i'|] -> //=; rewrite !mxE split1. by case: unliftP => [j'|] ->; [apply: Uu | rewrite /= mxE]. Qed. End CormenLUP. Section mxOver. Section mxOverType. Context {m n : nat} {T : Type}. Implicit Types (S : {pred T}). Definition mxOver (S : {pred T}) := [qualify a M : 'M[T]_(m, n) | [forall i, [forall j, M i j \in S]]]. Fact mxOver_key S : pred_key (mxOver S). Proof. by []. Qed. Canonical mxOver_keyed S := KeyedQualifier (mxOver_key S). Lemma mxOverP {S : {pred T}} {M : 'M[T]__} : reflect (forall i j, M i j \in S) (M \is a mxOver S). Proof. exact/'forall_forallP. Qed. Lemma mxOverS (S1 S2 : {pred T}) : {subset S1 <= S2} -> {subset mxOver S1 <= mxOver S2}. Proof. by move=> sS12 M /mxOverP S1M; apply/mxOverP=> i j; apply/sS12/S1M. Qed. Lemma mxOver_const c S : c \in S -> const_mx c \is a mxOver S. Proof. by move=> cS; apply/mxOverP => i j; rewrite !mxE. Qed. Lemma mxOver_constE c S : (m > 0)%N -> (n > 0)%N -> (const_mx c \is a mxOver S) = (c \in S). Proof. move=> m_gt0 n_gt0; apply/idP/idP; last exact: mxOver_const. by move=> /mxOverP /(_ (Ordinal m_gt0) (Ordinal n_gt0)); rewrite mxE. Qed. End mxOverType. Lemma thinmxOver {n : nat} {T : Type} (M : 'M[T]_(n, 0)) S : M \is a mxOver S. Proof. by apply/mxOverP => ? []. Qed. Lemma flatmxOver {n : nat} {T : Type} (M : 'M[T]_(0, n)) S : M \is a mxOver S. Proof. by apply/mxOverP => - []. Qed. Section mxOverZmodule. Context {M : zmodType} {m n : nat}. Implicit Types (S : {pred M}). Lemma mxOver0 S : 0 \in S -> 0 \is a @mxOver m n _ S. Proof. exact: mxOver_const. Qed. Section mxOverAdd. Variables (S : {pred M}) (addS : addrPred S) (kS : keyed_pred addS). Fact mxOver_add_subproof : addr_closed (@mxOver m n _ kS). Proof. split=> [|p q Sp Sq]; first by rewrite mxOver0 // ?rpred0. by apply/mxOverP=> i j; rewrite mxE rpredD // !(mxOverP _). Qed. Canonical mxOver_addrPred := AddrPred mxOver_add_subproof. End mxOverAdd. Section mxOverOpp. Variables (S : {pred M}) (oppS : opprPred S) (kS : keyed_pred oppS). Fact mxOver_opp_subproof : oppr_closed (@mxOver m n _ kS). Proof. by move=> A /mxOverP SA; apply/mxOverP=> i j; rewrite mxE rpredN. Qed. Canonical mxOver_opprPred := OpprPred mxOver_opp_subproof. End mxOverOpp. Canonical mxOver_zmodPred (S : {pred M}) (zmodS : zmodPred S) (kS : keyed_pred zmodS) := ZmodPred (@mxOver_opp_subproof _ _ kS). End mxOverZmodule. Section mxOverRing. Context {R : ringType} {m n : nat}. Lemma mxOver_scalar S c : 0 \in S -> c \in S -> c%:M \is a @mxOver n n R S. Proof. by move=> S0 cS; apply/mxOverP => i j; rewrite !mxE; case: eqP. Qed. Lemma mxOver_scalarE S c : (n > 0)%N -> (c%:M \is a @mxOver n n R S) = ((n > 1) ==> (0 \in S)) && (c \in S). Proof. case: n => [|[|k]]//= _. by apply/mxOverP/idP => [/(_ ord0 ord0)|cij i j]; rewrite ?mxE ?ord1. apply/mxOverP/andP => [cij|[S0 cij] i j]; last by rewrite !mxE; case: eqP. by split; [have := cij 0 1|have := cij 0 0]; rewrite !mxE. Qed. Section mxOverScale. Variables (S : {pred R}) (mulS : mulrPred S) (kS : keyed_pred mulS). Lemma mxOverZ : {in kS & mxOver kS, forall a : R, forall v : 'M[R]_(m, n), a *: v \is a mxOver kS}. Proof. by move=> a v aS /mxOverP vS; apply/mxOverP => i j; rewrite !mxE rpredM. Qed. End mxOverScale. Lemma mxOver_diag (S : {pred R}) k (D : 'rV[R]_k) : 0 \in S -> D \is a mxOver S -> diag_mx D \is a mxOver S. Proof. move=> S0 DS; apply/mxOverP => i j; rewrite !mxE. by case: eqP => //; rewrite (mxOverP DS). Qed. Lemma mxOver_diagE (S : {pred R}) k (D : 'rV[R]_k) : k > 0 -> (diag_mx D \is a mxOver S) = ((k > 1) ==> (0 \in S)) && (D \is a mxOver S). Proof. case: k => [|[|k]]//= in D * => _. by rewrite [diag_mx _]mx11_scalar [D in RHS]mx11_scalar !mxE. apply/idP/andP => [/mxOverP DS|[S0 DS]]; last exact: mxOver_diag. split; first by have := DS 0 1; rewrite !mxE. by apply/mxOverP => i j; have := DS j j; rewrite ord1 !mxE eqxx. Qed. Section mxOverMul. Variables (S : predPredType R) (ringS : semiringPred S) (kS : keyed_pred ringS). Lemma mxOverM p q r : {in mxOver kS & mxOver kS, forall u : 'M[R]_(p, q), forall v : 'M[R]_(q, r), u *m v \is a mxOver kS}. Proof. move=> M N /mxOverP MS /mxOverP NS; apply/mxOverP => i j. by rewrite !mxE rpred_sum // => k _; rewrite rpredM. Qed. End mxOverMul. End mxOverRing. Section mxRingOver. Context {R : ringType} {n : nat}. Section semiring. Variables (S : {pred R}) (ringS : semiringPred S) (kS : keyed_pred ringS). Fact mxOver_mul_subproof : mulr_closed (@mxOver n.+1 n.+1 _ kS). Proof. by split; rewrite ?mxOver_scalar ?rpred0 ?rpred1//; apply: mxOverM. Qed. Canonical mxOver_mulrPred := MulrPred mxOver_mul_subproof. Canonical mxOver_semiringPred := SemiringPred mxOver_mul_subproof. End semiring. Canonical mxOver_subringPred (S : {pred R}) (ringS : subringPred S) (kS : keyed_pred ringS):= SubringPred (mxOver_mul_subproof kS). End mxRingOver. End mxOver. Notation "@ 'map_mx_sub'" := (deprecate map_mx_sub map_mxB) (at level 10, only parsing) : fun_scope. Notation map_mx_sub := (fun f => @map_mx_sub _ _ f) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/mxalgebra.v000066400000000000000000003775161375767750300226730ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import fintype finfun bigop finset fingroup perm. From mathcomp Require Import div prime binomial ssralg finalg zmodp matrix. (*****************************************************************************) (* In this file we develop the rank and row space theory of matrices, based *) (* on an extended Gaussian elimination procedure similar to LUP *) (* decomposition. This provides us with a concrete but generic model of *) (* finite dimensional vector spaces and F-algebras, in which vectors, linear *) (* functions, families, bases, subspaces, ideals and subrings are all *) (* represented using matrices. This model can be used as a foundation for *) (* the usual theory of abstract linear algebra, but it can also be used to *) (* develop directly substantial theories, such as the theory of finite group *) (* linear representation. *) (* Here we define the following concepts and notations: *) (* Gaussian_elimination A == a permuted triangular decomposition (L, U, r) *) (* of A, with L a column permutation of a lower triangular *) (* invertible matrix, U a row permutation of an upper *) (* triangular invertible matrix, and r the rank of A, all *) (* satisfying the identity L *m pid_mx r *m U = A. *) (* \rank A == the rank of A. *) (* row_free A <=> the rows of A are linearly free (i.e., the rank and *) (* height of A are equal). *) (* row_full A <=> the row-space of A spans all row-vectors (i.e., the *) (* rank and width of A are equal). *) (* col_ebase A == the extended column basis of A (the first matrix L *) (* returned by Gaussian_elimination A). *) (* row_ebase A == the extended row base of A (the second matrix U *) (* returned by Gaussian_elimination A). *) (* col_base A == a basis for the columns of A: a row-full matrix *) (* consisting of the first \rank A columns of col_ebase A. *) (* row_base A == a basis for the rows of A: a row-free matrix consisting *) (* of the first \rank A rows of row_ebase A. *) (* pinvmx A == a partial inverse for A in its row space (or on its *) (* column space, equivalently). In particular, if u is a *) (* row vector in the row_space of A, then u *m pinvmx A is *) (* the row vector of the coefficients of a decomposition *) (* of u as a sub of rows of A. *) (* kermx A == the row kernel of A : a square matrix whose row space *) (* consists of all u such that u *m A = 0 (it consists of *) (* the inverse of col_ebase A, with the top \rank A rows *) (* zeroed out). Also, kermx A is a partial right inverse *) (* to col_ebase A, in the row space anihilated by A. *) (* cokermx A == the cokernel of A : a square matrix whose column space *) (* consists of all v such that A *m v = 0 (it consists of *) (* the inverse of row_ebase A, with the leftmost \rank A *) (* columns zeroed out). *) (* maxrankfun A == injective function f so that rowsub f A is a submatrix *) (* of A with the same rank as A. *) (* fullrankfun fA == injective function f so that rowsub f A is row full, *) (* where fA is a proof of row_full A *) (* eigenvalue g a <=> a is an eigenvalue of the square matrix g. *) (* eigenspace g a == a square matrix whose row space is the eigenspace of *) (* the eigenvalue a of g (or 0 if a is not an eigenvalue). *) (* We use a different scope %MS for matrix row-space set-like operations; to *) (* avoid confusion, this scope should not be opened globally. Note that the *) (* the arguments of \rank _ and the operations below have default scope %MS. *) (* (A <= B)%MS <=> the row-space of A is included in the row-space of B. *) (* We test for this by testing if cokermx B anihilates A. *) (* (A < B)%MS <=> the row-space of A is properly included in the *) (* row-space of B. *) (* (A <= B <= C)%MS == (A <= B)%MS && (B <= C)%MS, and similarly for *) (* (A < B <= C)%MS, (A < B <= C)%MS and (A < B < C)%MS. *) (* (A == B)%MS == (A <= B <= A)%MS (A and B have the same row-space). *) (* (A :=: B)%MS == A and B behave identically wrt. \rank and <=. This *) (* triple rewrite rule is the Prop version of (A == B)%MS. *) (* Note that :=: cannot be treated as a setoid-style *) (* Equivalence because its arguments can have different *) (* types: A and B need not have the same number of rows, *) (* and often don't (e.g., in row_base A :=: A). *) (* <>%MS == a square matrix with the same row-space as A; <>%MS *) (* is a canonical representation of the subspace generated *) (* by A, viewed as a list of row-vectors: if (A == B)%MS, *) (* then <>%MS = <>%MS. *) (* (A + B)%MS == a square matrix whose row-space is the sum of the *) (* row-spaces of A and B; thus (A + B == col_mx A B)%MS. *) (* (\sum_i )%MS == the "big" version of (_ + _)%MS; as the latter *) (* has a canonical abelian monoid structure, most generic *) (* bigop lemmas apply (the other bigop indexing notations *) (* are also defined). *) (* (A :&: B)%MS == a square matrix whose row-space is the intersection of *) (* the row-spaces of A and B. *) (* (\bigcap_i )%MS == the "big" version of (_ :&: _)%MS, which also *) (* has a canonical abelian monoid structure. *) (* A^C%MS == a square matrix whose row-space is a complement to the *) (* the row-space of A (it consists of row_ebase A with the *) (* top \rank A rows zeroed out). *) (* (A :\: B)%MS == a square matrix whose row-space is a complement of the *) (* the row-space of (A :&: B)%MS in the row-space of A. *) (* We have (A :\: B := A :&: (capmx_gen A B)^C)%MS, where *) (* capmx_gen A B is a rectangular matrix equivalent to *) (* (A :&: B)%MS, i.e., (capmx_gen A B == A :&: B)%MS. *) (* proj_mx A B == a square matrix that projects (A + B)%MS onto A *) (* parallel to B, when (A :&: B)%MS = 0 (A and B must also *) (* be square). *) (* mxdirect S == the sum expression S is a direct sum. This is a NON *) (* EXTENSIONAL notation: the exact boolean expression is *) (* inferred from the syntactic form of S (expanding *) (* definitions, however); both (\sum_(i | _) _)%MS and *) (* (_ + _)%MS sums are recognized. This construct uses a *) (* variant of the reflexive ("quote") canonical structure, *) (* mxsum_expr. The structure also recognizes sums of *) (* matrix ranks, so that lemmas concerning the rank of *) (* direct sums can be used bidirectionally. *) (* stablemx V f <=> the matrix f represents an endomorphism that preserves V *) (* := (V *m f <= V)%MS *) (* The next set of definitions let us represent F-algebras using matrices: *) (* 'A[F]_(m, n) == the type of matrices encoding (sub)algebras of square *) (* n x n matrices, via mxvec; as in the matrix type *) (* notation, m and F can be omitted (m defaults to n ^ 2). *) (* := 'M[F]_(m, n ^ 2). *) (* (A \in R)%MS <=> the square matrix A belongs to the linear set of *) (* matrices (most often, a sub-algebra) encoded by the *) (* row space of R. This is simply notation, so all the *) (* lemmas and rewrite rules for (_ <= _)%MS can apply. *) (* := (mxvec A <= R)%MS. *) (* (R * S)%MS == a square n^2 x n^2 matrix whose row-space encodes the *) (* linear set of n x n matrices generated by the pointwise *) (* product of the sets of matrices encoded by R and S. *) (* 'C(R)%MS == a square matric encoding the centraliser of the set of *) (* square matrices encoded by R. *) (* 'C_S(R)%MS := (S :&: 'C(R))%MS (the centraliser of R in S). *) (* 'Z(R)%MS == the center of R (i.e., 'C_R(R)%MS). *) (* left_mx_ideal R S <=> S is a left ideal for R (R * S <= S)%MS. *) (* right_mx_ideal R S <=> S is a right ideal for R (S * R <= S)%MS. *) (* mx_ideal R S <=> S is a bilateral ideal for R. *) (* mxring_id R e <-> e is an identity element for R (Prop predicate). *) (* has_mxring_id R <=> R has a nonzero identity element (bool predicate). *) (* mxring R <=> R encodes a nontrivial subring. *) (*****************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope matrix_set_scope. Import GroupScope. Import GRing.Theory. Local Open Scope ring_scope. Reserved Notation "\rank A" (at level 10, A at level 8, format "\rank A"). Reserved Notation "A ^C" (at level 8, format "A ^C"). Notation "''A_' ( m , n )" := 'M_(m, n ^ 2) (at level 8, format "''A_' ( m , n )") : type_scope. Notation "''A_' ( n )" := 'A_(n ^ 2, n) (at level 8, only parsing) : type_scope. Notation "''A_' n" := 'A_(n) (at level 8, n at next level, format "''A_' n") : type_scope. Notation "''A' [ F ]_ ( m , n )" := 'M[F]_(m, n ^ 2) (at level 8, only parsing) : type_scope. Notation "''A' [ F ]_ ( n )" := 'A[F]_(n ^ 2, n) (at level 8, only parsing) : type_scope. Notation "''A' [ F ]_ n" := 'A[F]_(n) (at level 8, n at level 2, only parsing) : type_scope. Delimit Scope matrix_set_scope with MS. Local Notation simp := (Monoid.Theory.simpm, oppr0). (*****************************************************************************) (******************** Rank and row-space theory ******************************) (*****************************************************************************) Section RowSpaceTheory. Variable F : fieldType. Implicit Types m n p r : nat. Local Notation "''M_' ( m , n )" := 'M[F]_(m, n) : type_scope. Local Notation "''M_' n" := 'M[F]_(n, n) : type_scope. (* Decomposition with double pivoting; computes the rank, row and column *) (* images, kernels, and complements of a matrix. *) Fixpoint Gaussian_elimination {m n} : 'M_(m, n) -> 'M_m * 'M_n * nat := match m, n with | _.+1, _.+1 => fun A : 'M_(1 + _, 1 + _) => if [pick ij | A ij.1 ij.2 != 0] is Some (i, j) then let a := A i j in let A1 := xrow i 0 (xcol j 0 A) in let u := ursubmx A1 in let v := a^-1 *: dlsubmx A1 in let: (L, U, r) := Gaussian_elimination (drsubmx A1 - v *m u) in (xrow i 0 (block_mx 1 0 v L), xcol j 0 (block_mx a%:M u 0 U), r.+1) else (1%:M, 1%:M, 0%N) | _, _ => fun _ => (1%:M, 1%:M, 0%N) end. Section Defs. Variables (m n : nat) (A : 'M_(m, n)). Fact Gaussian_elimination_key : unit. Proof. by []. Qed. Let LUr := locked_with Gaussian_elimination_key (@Gaussian_elimination) m n A. Definition col_ebase := LUr.1.1. Definition row_ebase := LUr.1.2. Definition mxrank := if [|| m == 0 | n == 0]%N then 0%N else LUr.2. Definition row_free := mxrank == m. Definition row_full := mxrank == n. Definition row_base : 'M_(mxrank, n) := pid_mx mxrank *m row_ebase. Definition col_base : 'M_(m, mxrank) := col_ebase *m pid_mx mxrank. Definition complmx : 'M_n := copid_mx mxrank *m row_ebase. Definition kermx : 'M_m := copid_mx mxrank *m invmx col_ebase. Definition cokermx : 'M_n := invmx row_ebase *m copid_mx mxrank. Definition pinvmx : 'M_(n, m) := invmx row_ebase *m pid_mx mxrank *m invmx col_ebase. End Defs. Arguments mxrank {m%N n%N} A%MS. Local Notation "\rank A" := (mxrank A) : nat_scope. Arguments complmx {m%N n%N} A%MS. Local Notation "A ^C" := (complmx A) : matrix_set_scope. Definition submx_def := idfun (fun m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) => A *m cokermx B == 0). Fact submx_key : unit. Proof. by []. Qed. Definition submx := locked_with submx_key submx_def. Canonical submx_unlockable := [unlockable fun submx]. Arguments submx {m1%N m2%N n%N} A%MS B%MS : rename. Local Notation "A <= B" := (submx A B) : matrix_set_scope. Local Notation "A <= B <= C" := ((A <= B) && (B <= C))%MS : matrix_set_scope. Local Notation "A == B" := (A <= B <= A)%MS : matrix_set_scope. Definition ltmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) := (A <= B)%MS && ~~ (B <= A)%MS. Arguments ltmx {m1%N m2%N n%N} A%MS B%MS. Local Notation "A < B" := (ltmx A B) : matrix_set_scope. Definition eqmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) := prod (\rank A = \rank B) (forall m3 (C : 'M_(m3, n)), ((A <= C) = (B <= C)) * ((C <= A) = (C <= B)))%MS. Arguments eqmx {m1%N m2%N n%N} A%MS B%MS. Local Notation "A :=: B" := (eqmx A B) : matrix_set_scope. Notation stablemx V f := (V%MS *m f%R <= V%MS)%MS. Section LtmxIdentities. Variables (m1 m2 n : nat) (A : 'M_(m1, n)) (B : 'M_(m2, n)). Lemma ltmxE : (A < B)%MS = ((A <= B)%MS && ~~ (B <= A)%MS). Proof. by []. Qed. Lemma ltmxW : (A < B)%MS -> (A <= B)%MS. Proof. by case/andP. Qed. Lemma ltmxEneq : (A < B)%MS = (A <= B)%MS && ~~ (A == B)%MS. Proof. by apply: andb_id2l => ->. Qed. Lemma submxElt : (A <= B)%MS = (A == B)%MS || (A < B)%MS. Proof. by rewrite -andb_orr orbN andbT. Qed. End LtmxIdentities. (* The definition of the row-space operator is rigged to return the identity *) (* matrix for full matrices. To allow for further tweaks that will make the *) (* row-space intersection operator strictly commutative and monoidal, we *) (* slightly generalize some auxiliary definitions: we parametrize the *) (* "equivalent subspace and identity" choice predicate equivmx by a boolean *) (* determining whether the matrix should be the identity (so for genmx A its *) (* value is row_full A), and introduce a "quasi-identity" predicate qidmx *) (* that selects non-square full matrices along with the identity matrix 1%:M *) (* (this does not affect genmx, which chooses a square matrix). *) (* The choice witness for genmx A is either 1%:M for a row-full A, or else *) (* row_base A padded with null rows. *) Let qidmx m n (A : 'M_(m, n)) := if m == n then A == pid_mx n else row_full A. Let equivmx m n (A : 'M_(m, n)) idA (B : 'M_n) := (B == A)%MS && (qidmx B == idA). Let equivmx_spec m n (A : 'M_(m, n)) idA (B : 'M_n) := prod (B :=: A)%MS (qidmx B = idA). Definition genmx_witness m n (A : 'M_(m, n)) : 'M_n := if row_full A then 1%:M else pid_mx (\rank A) *m row_ebase A. Definition genmx_def := idfun (fun m n (A : 'M_(m, n)) => choose (equivmx A (row_full A)) (genmx_witness A) : 'M_n). Fact genmx_key : unit. Proof. by []. Qed. Definition genmx := locked_with genmx_key genmx_def. Canonical genmx_unlockable := [unlockable fun genmx]. Local Notation "<< A >>" := (genmx A) : matrix_set_scope. (* The setwise sum is tweaked so that 0 is a strict identity element for *) (* square matrices, because this lets us use the bigop component. As a result *) (* setwise sum is not quite strictly extensional. *) Let addsmx_nop m n (A : 'M_(m, n)) := conform_mx <>%MS A. Definition addsmx_def := idfun (fun m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) => if A == 0 then addsmx_nop B else if B == 0 then addsmx_nop A else <>%MS : 'M_n). Fact addsmx_key : unit. Proof. by []. Qed. Definition addsmx := locked_with addsmx_key addsmx_def. Canonical addsmx_unlockable := [unlockable fun addsmx]. Arguments addsmx {m1%N m2%N n%N} A%MS B%MS : rename. Local Notation "A + B" := (addsmx A B) : matrix_set_scope. Local Notation "\sum_ ( i | P ) B" := (\big[addsmx/0]_(i | P) B%MS) : matrix_set_scope. Local Notation "\sum_ ( i <- r | P ) B" := (\big[addsmx/0]_(i <- r | P) B%MS) : matrix_set_scope. (* The set intersection is similarly biased so that the identity matrix is a *) (* strict identity. This is somewhat more delicate than for the sum, because *) (* the test for the identity is non-extensional. This forces us to actually *) (* bias the choice operator so that it does not accidentally map an *) (* intersection of non-identity matrices to 1%:M; this would spoil *) (* associativity: if B :&: C = 1%:M but B and C are not identity, then for a *) (* square matrix A we have A :&: (B :&: C) = A != (A :&: B) :&: C in general. *) (* To complicate matters there may not be a square non-singular matrix *) (* different than 1%:M, since we could be dealing with 'M['F_2]_1. We *) (* sidestep the issue by making all non-square row-full matrices identities, *) (* and choosing a normal representative that preserves the qidmx property. *) (* Thus A :&: B = 1%:M iff A and B are both identities, and this suffices for *) (* showing that associativity is strict. *) Let capmx_witness m n (A : 'M_(m, n)) := if row_full A then conform_mx 1%:M A else <>%MS. Let capmx_norm m n (A : 'M_(m, n)) := choose (equivmx A (qidmx A)) (capmx_witness A). Let capmx_nop m n (A : 'M_(m, n)) := conform_mx (capmx_norm A) A. Definition capmx_gen m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) := lsubmx (kermx (col_mx A B)) *m A. Definition capmx_def := idfun (fun m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) => if qidmx A then capmx_nop B else if qidmx B then capmx_nop A else if row_full B then capmx_norm A else capmx_norm (capmx_gen A B) : 'M_n). Fact capmx_key : unit. Proof. by []. Qed. Definition capmx := locked_with capmx_key capmx_def. Canonical capmx_unlockable := [unlockable fun capmx]. Arguments capmx {m1%N m2%N n%N} A%MS B%MS : rename. Local Notation "A :&: B" := (capmx A B) : matrix_set_scope. Local Notation "\bigcap_ ( i | P ) B" := (\big[capmx/1%:M]_(i | P) B) : matrix_set_scope. Definition diffmx_def := idfun (fun m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) => <>%MS : 'M_n). Fact diffmx_key : unit. Proof. by []. Qed. Definition diffmx := locked_with diffmx_key diffmx_def. Canonical diffmx_unlockable := [unlockable fun diffmx]. Arguments diffmx {m1%N m2%N n%N} A%MS B%MS : rename. Local Notation "A :\: B" := (diffmx A B) : matrix_set_scope. Definition proj_mx n (U V : 'M_n) : 'M_n := pinvmx (col_mx U V) *m col_mx U 0. Local Notation GaussE := Gaussian_elimination. Fact mxrankE m n (A : 'M_(m, n)) : \rank A = (GaussE A).2. Proof. by rewrite /mxrank unlock /=; case: m n A => [|m] [|n]. Qed. Lemma rank_leq_row m n (A : 'M_(m, n)) : \rank A <= m. Proof. rewrite mxrankE. elim: m n A => [|m IHm] [|n] //= A; case: pickP => [[i j] _|] //=. by move: (_ - _) => B; case: GaussE (IHm _ B) => [[L U] r] /=. Qed. Lemma row_leq_rank m n (A : 'M_(m, n)) : (m <= \rank A) = row_free A. Proof. by rewrite /row_free eqn_leq rank_leq_row. Qed. Lemma rank_leq_col m n (A : 'M_(m, n)) : \rank A <= n. Proof. rewrite mxrankE. elim: m n A => [|m IHm] [|n] //= A; case: pickP => [[i j] _|] //=. by move: (_ - _) => B; case: GaussE (IHm _ B) => [[L U] r] /=. Qed. Lemma col_leq_rank m n (A : 'M_(m, n)) : (n <= \rank A) = row_full A. Proof. by rewrite /row_full eqn_leq rank_leq_col. Qed. Lemma eq_row_full m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B)%MS -> row_full A = row_full B. Proof. by rewrite /row_full => ->. Qed. Let unitmx1F := @unitmx1 F. Lemma row_ebase_unit m n (A : 'M_(m, n)) : row_ebase A \in unitmx. Proof. rewrite /row_ebase unlock; elim: m n A => [|m IHm] [|n] //= A. case: pickP => [[i j] /= nzAij | //=]; move: (_ - _) => B. case: GaussE (IHm _ B) => [[L U] r] /= uU. rewrite unitmxE xcolE det_mulmx (@det_ublock _ 1) det_scalar1 !unitrM. by rewrite unitfE nzAij -!unitmxE uU unitmx_perm. Qed. Lemma col_ebase_unit m n (A : 'M_(m, n)) : col_ebase A \in unitmx. Proof. rewrite /col_ebase unlock; elim: m n A => [|m IHm] [|n] //= A. case: pickP => [[i j] _|] //=; move: (_ - _) => B. case: GaussE (IHm _ B) => [[L U] r] /= uL. rewrite unitmxE xrowE det_mulmx (@det_lblock _ 1) det1 mul1r unitrM. by rewrite -unitmxE unitmx_perm. Qed. Hint Resolve rank_leq_row rank_leq_col row_ebase_unit col_ebase_unit : core. Lemma mulmx_ebase m n (A : 'M_(m, n)) : col_ebase A *m pid_mx (\rank A) *m row_ebase A = A. Proof. rewrite mxrankE /col_ebase /row_ebase unlock. elim: m n A => [n A | m IHm]; first by rewrite [A]flatmx0 [_ *m _]flatmx0. case=> [A | n]; first by rewrite [_ *m _]thinmx0 [A]thinmx0. rewrite -(add1n m) -?(add1n n) => A /=. case: pickP => [[i0 j0] | A0] /=; last first. apply/matrixP=> i j; rewrite pid_mx_0 mulmx0 mul0mx mxE. by move/eqP: (A0 (i, j)). set a := A i0 j0 => nz_a; set A1 := xrow _ _ _. set u := ursubmx _; set v := _ *: _; set B : 'M_(m, n) := _ - _. move: (rank_leq_col B) (rank_leq_row B) {IHm}(IHm n B); rewrite mxrankE. case: (GaussE B) => [[L U] r] /= r_m r_n defB. have ->: pid_mx (1 + r) = block_mx 1 0 0 (pid_mx r) :> 'M[F]_(1 + m, 1 + n). rewrite -(subnKC r_m) -(subnKC r_n) pid_mx_block -col_mx0 -row_mx0. by rewrite block_mxA castmx_id col_mx0 row_mx0 -scalar_mx_block -pid_mx_block. rewrite xcolE xrowE mulmxA -xcolE -!mulmxA. rewrite !(addr0, add0r, mulmx0, mul0mx, mulmx_block, mul1mx) mulmxA defB. rewrite addrC subrK mul_mx_scalar scalerA divff // scale1r. have ->: a%:M = ulsubmx A1 by rewrite [_ A1]mx11_scalar !mxE !lshift0 !tpermR. rewrite submxK /A1 xrowE !xcolE -!mulmxA mulmxA -!perm_mxM !tperm2 !perm_mx1. by rewrite mulmx1 mul1mx. Qed. Lemma mulmx_base m n (A : 'M_(m, n)) : col_base A *m row_base A = A. Proof. by rewrite mulmxA -[col_base A *m _]mulmxA pid_mx_id ?mulmx_ebase. Qed. Lemma mulmx1_min_rank r m n (A : 'M_(m, n)) M N : M *m A *m N = 1%:M :> 'M_r -> r <= \rank A. Proof. by rewrite -{1}(mulmx_base A) mulmxA -mulmxA; move/mulmx1_min. Qed. Arguments mulmx1_min_rank [r m n A]. Lemma mulmx_max_rank r m n (M : 'M_(m, r)) (N : 'M_(r, n)) : \rank (M *m N) <= r. Proof. set MN := M *m N; set rMN := \rank _. pose L : 'M_(rMN, m) := pid_mx rMN *m invmx (col_ebase MN). pose U : 'M_(n, rMN) := invmx (row_ebase MN) *m pid_mx rMN. suffices: L *m M *m (N *m U) = 1%:M by apply: mulmx1_min. rewrite mulmxA -(mulmxA L) -[M *m N]mulmx_ebase -/MN. by rewrite !mulmxA mulmxKV // mulmxK // !pid_mx_id /rMN ?pid_mx_1. Qed. Arguments mulmx_max_rank [r m n]. Lemma mxrank_tr m n (A : 'M_(m, n)) : \rank A^T = \rank A. Proof. apply/eqP; rewrite eqn_leq -{3}[A]trmxK -{1}(mulmx_base A) -{1}(mulmx_base A^T). by rewrite !trmx_mul !mulmx_max_rank. Qed. Lemma mxrank_add m n (A B : 'M_(m, n)) : \rank (A + B)%R <= \rank A + \rank B. Proof. by rewrite -{1}(mulmx_base A) -{1}(mulmx_base B) -mul_row_col mulmx_max_rank. Qed. Lemma mxrankM_maxl m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : \rank (A *m B) <= \rank A. Proof. by rewrite -{1}(mulmx_base A) -mulmxA mulmx_max_rank. Qed. Lemma mxrankM_maxr m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : \rank (A *m B) <= \rank B. Proof. by rewrite -mxrank_tr -(mxrank_tr B) trmx_mul mxrankM_maxl. Qed. Lemma mxrank_scale m n a (A : 'M_(m, n)) : \rank (a *: A) <= \rank A. Proof. by rewrite -mul_scalar_mx mxrankM_maxr. Qed. Lemma mxrank_scale_nz m n a (A : 'M_(m, n)) : a != 0 -> \rank (a *: A) = \rank A. Proof. move=> nza; apply/eqP; rewrite eqn_leq -{3}[A]scale1r -(mulVf nza). by rewrite -scalerA !mxrank_scale. Qed. Lemma mxrank_opp m n (A : 'M_(m, n)) : \rank (- A) = \rank A. Proof. by rewrite -scaleN1r mxrank_scale_nz // oppr_eq0 oner_eq0. Qed. Lemma mxrank0 m n : \rank (0 : 'M_(m, n)) = 0%N. Proof. by apply/eqP; rewrite -leqn0 -(@mulmx0 _ m 0 n 0) mulmx_max_rank. Qed. Lemma mxrank_eq0 m n (A : 'M_(m, n)) : (\rank A == 0%N) = (A == 0). Proof. apply/eqP/eqP=> [rA0 | ->{A}]; last exact: mxrank0. move: (col_base A) (row_base A) (mulmx_base A); rewrite rA0 => Ac Ar <-. by rewrite [Ac]thinmx0 mul0mx. Qed. Lemma mulmx_coker m n (A : 'M_(m, n)) : A *m cokermx A = 0. Proof. by rewrite -{1}[A]mulmx_ebase -!mulmxA mulKVmx // mul_pid_mx_copid ?mulmx0. Qed. Lemma submxE m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS = (A *m cokermx B == 0). Proof. by rewrite unlock. Qed. Lemma mulmxKpV m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS -> A *m pinvmx B *m B = A. Proof. rewrite submxE !mulmxA mulmxBr mulmx1 subr_eq0 => /eqP defA. rewrite -{4}[B]mulmx_ebase -!mulmxA mulKmx //. by rewrite (mulmxA (pid_mx _)) pid_mx_id // !mulmxA -{}defA mulmxKV. Qed. Lemma mulmxVp m n (A : 'M[F]_(m, n)) : row_free A -> A *m pinvmx A = 1%:M. Proof. move=> fA; rewrite -[X in X *m _]mulmx_ebase !mulmxA mulmxK ?row_ebase_unit//. rewrite -[X in X *m _]mulmxA mul_pid_mx !minnn (minn_idPr _) ?rank_leq_col//. by rewrite (eqP fA) pid_mx_1 mulmx1 mulmxV ?col_ebase_unit. Qed. Lemma mulmxKp p m n (B : 'M[F]_(m, n)) : row_free B -> cancel ((@mulmx _ p _ _)^~ B) (mulmx^~ (pinvmx B)). Proof. by move=> ? A; rewrite -mulmxA mulmxVp ?mulmx1. Qed. Lemma submxP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (exists D, A = D *m B) (A <= B)%MS. Proof. apply: (iffP idP) => [/mulmxKpV | [D ->]]; first by exists (A *m pinvmx B). by rewrite submxE -mulmxA mulmx_coker mulmx0. Qed. Arguments submxP {m1 m2 n A B}. Lemma submx_refl m n (A : 'M_(m, n)) : (A <= A)%MS. Proof. by rewrite submxE mulmx_coker. Qed. Hint Resolve submx_refl : core. Lemma submxMl m n p (D : 'M_(m, n)) (A : 'M_(n, p)) : (D *m A <= A)%MS. Proof. by rewrite submxE -mulmxA mulmx_coker mulmx0. Qed. Lemma submxMr m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : (A <= B)%MS -> (A *m C <= B *m C)%MS. Proof. by case/submxP=> D ->; rewrite -mulmxA submxMl. Qed. Lemma mulmx_sub m n1 n2 p (C : 'M_(m, n1)) A (B : 'M_(n2, p)) : (A <= B -> C *m A <= B)%MS. Proof. by case/submxP=> D ->; rewrite mulmxA submxMl. Qed. Lemma submx_trans m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A <= B -> B <= C -> A <= C)%MS. Proof. by case/submxP=> D ->{A}; apply: mulmx_sub. Qed. Lemma ltmx_sub_trans m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A < B)%MS -> (B <= C)%MS -> (A < C)%MS. Proof. case/andP=> sAB ltAB sBC; rewrite ltmxE (submx_trans sAB) //. by apply: contra ltAB; apply: submx_trans. Qed. Lemma sub_ltmx_trans m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A <= B)%MS -> (B < C)%MS -> (A < C)%MS. Proof. move=> sAB /andP[sBC ltBC]; rewrite ltmxE (submx_trans sAB) //. by apply: contra ltBC => sCA; apply: submx_trans sAB. Qed. Lemma ltmx_trans m n : transitive (@ltmx m m n). Proof. by move=> A B C; move/ltmxW; apply: sub_ltmx_trans. Qed. Lemma ltmx_irrefl m n : irreflexive (@ltmx m m n). Proof. by move=> A; rewrite /ltmx submx_refl andbF. Qed. Lemma sub0mx m1 m2 n (A : 'M_(m2, n)) : ((0 : 'M_(m1, n)) <= A)%MS. Proof. by rewrite submxE mul0mx. Qed. Lemma submx0null m1 m2 n (A : 'M[F]_(m1, n)) : (A <= (0 : 'M_(m2, n)))%MS -> A = 0. Proof. by case/submxP=> D; rewrite mulmx0. Qed. Lemma submx0 m n (A : 'M_(m, n)) : (A <= (0 : 'M_n))%MS = (A == 0). Proof. by apply/idP/eqP=> [|->]; [apply: submx0null | apply: sub0mx]. Qed. Lemma lt0mx m n (A : 'M_(m, n)) : ((0 : 'M_n) < A)%MS = (A != 0). Proof. by rewrite /ltmx sub0mx submx0. Qed. Lemma ltmx0 m n (A : 'M[F]_(m, n)) : (A < (0 : 'M_n))%MS = false. Proof. by rewrite /ltmx sub0mx andbF. Qed. Lemma eqmx0P m n (A : 'M_(m, n)) : reflect (A = 0) (A == (0 : 'M_n))%MS. Proof. by rewrite submx0 sub0mx andbT; apply: eqP. Qed. Lemma eqmx_eq0 m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B)%MS -> (A == 0) = (B == 0). Proof. by move=> eqAB; rewrite -!submx0 eqAB. Qed. Lemma addmx_sub m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m1, n)) (C : 'M_(m2, n)) : (A <= C)%MS -> (B <= C)%MS -> ((A + B)%R <= C)%MS. Proof. by case/submxP=> A' ->; case/submxP=> B' ->; rewrite -mulmxDl submxMl. Qed. Lemma rowsub_sub m1 m2 n (f : 'I_m2 -> 'I_m1) (A : 'M_(m1, n)) : (rowsub f A <= A)%MS. Proof. by rewrite rowsubE mulmx_sub. Qed. Lemma summx_sub m1 m2 n (B : 'M_(m2, n)) I (r : seq I) (P : pred I) (A_ : I -> 'M_(m1, n)) : (forall i, P i -> A_ i <= B)%MS -> ((\sum_(i <- r | P i) A_ i)%R <= B)%MS. Proof. by move=> leAB; elim/big_ind: _ => // [|C D]; [apply/sub0mx | apply/addmx_sub]. Qed. Lemma scalemx_sub m1 m2 n a (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS -> (a *: A <= B)%MS. Proof. by case/submxP=> A' ->; rewrite scalemxAl submxMl. Qed. Lemma row_sub m n i (A : 'M_(m, n)) : (row i A <= A)%MS. Proof. exact: rowsub_sub. Qed. Lemma eq_row_sub m n v (A : 'M_(m, n)) i : row i A = v -> (v <= A)%MS. Proof. by move <-; rewrite row_sub. Qed. Arguments eq_row_sub [m n v A]. Lemma nz_row_sub m n (A : 'M_(m, n)) : (nz_row A <= A)%MS. Proof. by rewrite /nz_row; case: pickP => [i|] _; rewrite ?row_sub ?sub0mx. Qed. Lemma row_subP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (forall i, row i A <= B)%MS (A <= B)%MS. Proof. apply: (iffP idP) => [sAB i|sAB]. by apply: submx_trans sAB; apply: row_sub. rewrite submxE; apply/eqP/row_matrixP=> i; apply/eqP. by rewrite row_mul row0 -submxE. Qed. Arguments row_subP {m1 m2 n A B}. Lemma rV_subP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (forall v : 'rV_n, v <= A -> v <= B)%MS (A <= B)%MS. Proof. apply: (iffP idP) => [sAB v Av | sAB]; first exact: submx_trans sAB. by apply/row_subP=> i; rewrite sAB ?row_sub. Qed. Arguments rV_subP {m1 m2 n A B}. Lemma row_subPn m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (exists i, ~~ (row i A <= B)%MS) (~~ (A <= B)%MS). Proof. by rewrite (sameP row_subP forallP); apply: forallPn. Qed. Lemma sub_rVP n (u v : 'rV_n) : reflect (exists a, u = a *: v) (u <= v)%MS. Proof. apply: (iffP submxP) => [[w ->] | [a ->]]. by exists (w 0 0); rewrite -mul_scalar_mx -mx11_scalar. by exists a%:M; rewrite mul_scalar_mx. Qed. Lemma rank_rV n (v : 'rV_n) : \rank v = (v != 0). Proof. case: eqP => [-> | nz_v]; first by rewrite mxrank0. by apply/eqP; rewrite eqn_leq rank_leq_row lt0n mxrank_eq0; apply/eqP. Qed. Lemma rowV0Pn m n (A : 'M_(m, n)) : reflect (exists2 v : 'rV_n, v <= A & v != 0)%MS (A != 0). Proof. rewrite -submx0; apply: (iffP idP) => [| [v svA]]; last first. by rewrite -submx0; apply: contra (submx_trans _). by case/row_subPn=> i; rewrite submx0; exists (row i A); rewrite ?row_sub. Qed. Lemma rowV0P m n (A : 'M_(m, n)) : reflect (forall v : 'rV_n, v <= A -> v = 0)%MS (A == 0). Proof. rewrite -[A == 0]negbK; case: rowV0Pn => IH. by right; case: IH => v svA nzv IH; case/eqP: nzv; apply: IH. by left=> v svA; apply/eqP/idPn=> nzv; case: IH; exists v. Qed. Lemma submx_full m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : row_full B -> (A <= B)%MS. Proof. by rewrite submxE /cokermx => /eqnP->; rewrite /copid_mx pid_mx_1 subrr !mulmx0. Qed. Lemma row_fullP m n (A : 'M_(m, n)) : reflect (exists B, B *m A = 1%:M) (row_full A). Proof. apply: (iffP idP) => [Afull | [B kA]]. by exists (1%:M *m pinvmx A); apply: mulmxKpV (submx_full _ Afull). by rewrite [_ A]eqn_leq rank_leq_col (mulmx1_min_rank B 1%:M) ?mulmx1. Qed. Arguments row_fullP {m n A}. Lemma row_full_inj m n p A : row_full A -> injective (@mulmx _ m n p A). Proof. case/row_fullP=> A' A'K; apply: can_inj (mulmx A') _ => B. by rewrite mulmxA A'K mul1mx. Qed. Lemma row_freeP m n (A : 'M_(m, n)) : reflect (exists B, A *m B = 1%:M) (row_free A). Proof. rewrite /row_free -mxrank_tr. apply: (iffP row_fullP) => [] [B kA]; by exists B^T; rewrite -trmx1 -kA trmx_mul ?trmxK. Qed. Lemma row_free_inj m n p A : row_free A -> injective ((@mulmx _ m n p)^~ A). Proof. case/row_freeP=> A' AK; apply: can_inj (mulmx^~ A') _ => B. by rewrite -mulmxA AK mulmx1. Qed. (* A variant of row_free_inj that exposes mulmxr, an alias for mulmx^~ *) (* but which is canonically additive *) Definition row_free_injr m n p A : row_free A -> injective (mulmxr A) := @row_free_inj m n p A. Lemma row_free_unit n (A : 'M_n) : row_free A = (A \in unitmx). Proof. apply/row_fullP/idP=> [[A'] | uA]; first by case/mulmx1_unit. by exists (invmx A); rewrite mulVmx. Qed. Lemma row_full_unit n (A : 'M_n) : row_full A = (A \in unitmx). Proof. exact: row_free_unit. Qed. Lemma mxrank_unit n (A : 'M_n) : A \in unitmx -> \rank A = n. Proof. by rewrite -row_full_unit => /eqnP. Qed. Lemma mxrank1 n : \rank (1%:M : 'M_n) = n. Proof. exact: mxrank_unit. Qed. Lemma mxrank_delta m n i j : \rank (delta_mx i j : 'M_(m, n)) = 1%N. Proof. apply/eqP; rewrite eqn_leq lt0n mxrank_eq0. rewrite -{1}(mul_delta_mx (0 : 'I_1)) mulmx_max_rank. by apply/eqP; move/matrixP; move/(_ i j); move/eqP; rewrite !mxE !eqxx oner_eq0. Qed. Lemma mxrankS m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS -> \rank A <= \rank B. Proof. by case/submxP=> D ->; rewrite mxrankM_maxr. Qed. Lemma submx1 m n (A : 'M_(m, n)) : (A <= 1%:M)%MS. Proof. by rewrite submx_full // row_full_unit unitmx1. Qed. Lemma sub1mx m n (A : 'M_(m, n)) : (1%:M <= A)%MS = row_full A. Proof. apply/idP/idP; last exact: submx_full. by move/mxrankS; rewrite mxrank1 col_leq_rank. Qed. Lemma ltmx1 m n (A : 'M_(m, n)) : (A < 1%:M)%MS = ~~ row_full A. Proof. by rewrite /ltmx sub1mx submx1. Qed. Lemma lt1mx m n (A : 'M_(m, n)) : (1%:M < A)%MS = false. Proof. by rewrite /ltmx submx1 andbF. Qed. Lemma pinvmxE n (A : 'M[F]_n) : A \in unitmx -> pinvmx A = invmx A. Proof. move=> A_unit; apply: (@row_free_inj _ _ _ A); rewrite ?row_free_unit//. by rewrite -[pinvmx _]mul1mx mulmxKpV ?sub1mx ?row_full_unit// mulVmx. Qed. Lemma mulVpmx m n (A : 'M[F]_(m, n)) : row_full A -> pinvmx A *m A = 1%:M. Proof. by move=> fA; rewrite -[pinvmx _]mul1mx mulmxKpV// sub1mx. Qed. Lemma pinvmx_free m n (A : 'M[F]_(m, n)) : row_full A -> row_free (pinvmx A). Proof. by move=> /mulVpmx pAA1; apply/row_freeP; exists A. Qed. Lemma pinvmx_full m n (A : 'M[F]_(m, n)) : row_free A -> row_full (pinvmx A). Proof. by move=> /mulmxVp ApA1; apply/row_fullP; exists A. Qed. Lemma eqmxP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (A :=: B)%MS (A == B)%MS. Proof. apply: (iffP andP) => [[sAB sBA] | eqAB]; last by rewrite !eqAB. split=> [|m3 C]; first by apply/eqP; rewrite eqn_leq !mxrankS. split; first by apply/idP/idP; apply: submx_trans. by apply/idP/idP=> sC; apply: submx_trans sC _. Qed. Arguments eqmxP {m1 m2 n A B}. Lemma rV_eqP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (forall u : 'rV_n, (u <= A) = (u <= B))%MS (A == B)%MS. Proof. apply: (iffP idP) => [eqAB u | eqAB]; first by rewrite (eqmxP eqAB). by apply/andP; split; apply/rV_subP=> u; rewrite eqAB. Qed. Lemma eqmx_refl m1 n (A : 'M_(m1, n)) : (A :=: A)%MS. Proof. by []. Qed. Lemma eqmx_sym m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B)%MS -> (B :=: A)%MS. Proof. by move=> eqAB; split=> [|m3 C]; rewrite !eqAB. Qed. Lemma eqmx_trans m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A :=: B)%MS -> (B :=: C)%MS -> (A :=: C)%MS. Proof. by move=> eqAB eqBC; split=> [|m4 D]; rewrite !eqAB !eqBC. Qed. Lemma eqmx_rank m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A == B)%MS -> \rank A = \rank B. Proof. by move/eqmxP->. Qed. Lemma lt_eqmx m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B)%MS -> forall C : 'M_(m3, n), (((A < C) = (B < C))%MS * ((C < A) = (C < B))%MS)%type. Proof. by move=> eqAB C; rewrite /ltmx !eqAB. Qed. Lemma eqmxMr m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : (A :=: B)%MS -> (A *m C :=: B *m C)%MS. Proof. by move=> eqAB; apply/eqmxP; rewrite !submxMr ?eqAB. Qed. Lemma eqmxMfull m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : row_full A -> (A *m B :=: B)%MS. Proof. case/row_fullP=> A' A'A; apply/eqmxP; rewrite submxMl /=. by apply/submxP; exists A'; rewrite mulmxA A'A mul1mx. Qed. Lemma eqmx0 m n : ((0 : 'M[F]_(m, n)) :=: (0 : 'M_n))%MS. Proof. by apply/eqmxP; rewrite !sub0mx. Qed. Lemma eqmx_scale m n a (A : 'M_(m, n)) : a != 0 -> (a *: A :=: A)%MS. Proof. move=> nz_a; apply/eqmxP; rewrite scalemx_sub //. by rewrite -{1}[A]scale1r -(mulVf nz_a) -scalerA scalemx_sub. Qed. Lemma eqmx_opp m n (A : 'M_(m, n)) : (- A :=: A)%MS. Proof. by rewrite -scaleN1r; apply: eqmx_scale => //; rewrite oppr_eq0 oner_eq0. Qed. Lemma submxMfree m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : row_free C -> (A *m C <= B *m C)%MS = (A <= B)%MS. Proof. case/row_freeP=> C' C_C'_1; apply/idP/idP=> sAB; last exact: submxMr. by rewrite -[A]mulmx1 -[B]mulmx1 -C_C'_1 !mulmxA submxMr. Qed. Lemma eqmxMfree m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : row_free C -> (A *m C :=: B *m C)%MS -> (A :=: B)%MS. Proof. by move=> Cfree eqAB; apply/eqmxP; move/eqmxP: eqAB; rewrite !submxMfree. Qed. Lemma mxrankMfree m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : row_free B -> \rank (A *m B) = \rank A. Proof. by move=> Bfree; rewrite -mxrank_tr trmx_mul eqmxMfull /row_full mxrank_tr. Qed. Lemma eq_row_base m n (A : 'M_(m, n)) : (row_base A :=: A)%MS. Proof. apply/eqmxP/andP; split; apply/submxP. exists (pid_mx (\rank A) *m invmx (col_ebase A)). by rewrite -{8}[A]mulmx_ebase !mulmxA mulmxKV // pid_mx_id. exists (col_ebase A *m pid_mx (\rank A)). by rewrite mulmxA -(mulmxA _ _ (pid_mx _)) pid_mx_id // mulmx_ebase. Qed. Lemma row_base0 (m n : nat) : row_base (0 : 'M[F]_(m, n)) = 0. Proof. by apply/eqmx0P; rewrite !eq_row_base !sub0mx. Qed. Let qidmx_eq1 n (A : 'M_n) : qidmx A = (A == 1%:M). Proof. by rewrite /qidmx eqxx pid_mx_1. Qed. Let genmx_witnessP m n (A : 'M_(m, n)) : equivmx A (row_full A) (genmx_witness A). Proof. rewrite /equivmx qidmx_eq1 /genmx_witness. case fullA: (row_full A); first by rewrite eqxx sub1mx submx1 fullA. set B := _ *m _; have defB : (B == A)%MS. apply/andP; split; apply/submxP. exists (pid_mx (\rank A) *m invmx (col_ebase A)). by rewrite -{3}[A]mulmx_ebase !mulmxA mulmxKV // pid_mx_id. exists (col_ebase A *m pid_mx (\rank A)). by rewrite mulmxA -(mulmxA _ _ (pid_mx _)) pid_mx_id // mulmx_ebase. rewrite defB -negb_add addbF; case: eqP defB => // ->. by rewrite sub1mx fullA. Qed. Lemma genmxE m n (A : 'M_(m, n)) : (<> :=: A)%MS. Proof. by rewrite unlock; apply/eqmxP; case/andP: (chooseP (genmx_witnessP A)). Qed. Lemma eq_genmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B -> <> = <>)%MS. Proof. move=> eqAB; rewrite unlock. have{} eqAB: equivmx A (row_full A) =1 equivmx B (row_full B). by move=> C; rewrite /row_full /equivmx !eqAB. rewrite (eq_choose eqAB) (choose_id _ (genmx_witnessP B)) //. by rewrite -eqAB genmx_witnessP. Qed. Lemma genmxP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (<> = <>)%MS (A == B)%MS. Proof. apply: (iffP idP) => eqAB; first exact: eq_genmx (eqmxP _). by rewrite -!(genmxE A) eqAB !genmxE andbb. Qed. Arguments genmxP {m1 m2 n A B}. Lemma genmx0 m n : <<0 : 'M_(m, n)>>%MS = 0. Proof. by apply/eqP; rewrite -submx0 genmxE sub0mx. Qed. Lemma genmx1 n : <<1%:M : 'M_n>>%MS = 1%:M. Proof. rewrite unlock; case/andP: (chooseP (@genmx_witnessP n n 1%:M)) => _ /eqP. by rewrite qidmx_eq1 row_full_unit unitmx1 => /eqP. Qed. Lemma genmx_id m n (A : 'M_(m, n)) : (<<<>>> = <>)%MS. Proof. exact/eq_genmx/genmxE. Qed. Lemma row_base_free m n (A : 'M_(m, n)) : row_free (row_base A). Proof. by apply/eqnP; rewrite eq_row_base. Qed. Lemma mxrank_gen m n (A : 'M_(m, n)) : \rank <> = \rank A. Proof. by rewrite genmxE. Qed. Lemma col_base_full m n (A : 'M_(m, n)) : row_full (col_base A). Proof. apply/row_fullP; exists (pid_mx (\rank A) *m invmx (col_ebase A)). by rewrite !mulmxA mulmxKV // pid_mx_id // pid_mx_1. Qed. Hint Resolve row_base_free col_base_full : core. Lemma mxrank_leqif_sup m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS -> \rank A <= \rank B ?= iff (B <= A)%MS. Proof. move=> sAB; split; first by rewrite mxrankS. apply/idP/idP=> [| sBA]; last by rewrite eqn_leq !mxrankS. case/submxP: sAB => D ->; set r := \rank B; rewrite -(mulmx_base B) mulmxA. rewrite mxrankMfree // => /row_fullP[E kE]. by rewrite -[rB in _ *m rB]mul1mx -kE -(mulmxA E) (mulmxA _ E) submxMl. Qed. Lemma mxrank_leqif_eq m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A <= B)%MS -> \rank A <= \rank B ?= iff (A == B)%MS. Proof. by move=> sAB; rewrite sAB; apply: mxrank_leqif_sup. Qed. Lemma ltmxErank m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A < B)%MS = (A <= B)%MS && (\rank A < \rank B). Proof. by apply: andb_id2l => sAB; rewrite (ltn_leqif (mxrank_leqif_sup sAB)). Qed. Lemma rank_ltmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A < B)%MS -> \rank A < \rank B. Proof. by rewrite ltmxErank => /andP[]. Qed. Lemma eqmx_cast m1 m2 n (A : 'M_(m1, n)) e : ((castmx e A : 'M_(m2, n)) :=: A)%MS. Proof. by case: e A; case: m2 / => A e; rewrite castmx_id. Qed. Lemma row_full_castmx m1 m2 n (A : 'M_(m1, n)) e : row_full (castmx e A : 'M_(m2, n)) = row_full A. Proof. exact/eq_row_full/eqmx_cast. Qed. Lemma row_free_castmx m1 m2 n (A : 'M_(m1, n)) e : row_free (castmx e A : 'M_(m2, n)) = row_free A. Proof. by rewrite /row_free eqmx_cast; congr (_ == _); rewrite e.1. Qed. Lemma eqmx_conform m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (conform_mx A B :=: A \/ conform_mx A B :=: B)%MS. Proof. case: (eqVneq m2 m1) => [-> | neqm12] in B *. by right; rewrite conform_mx_id. by left; rewrite nonconform_mx ?neqm12. Qed. Let eqmx_sum_nop m n (A : 'M_(m, n)) : (addsmx_nop A :=: A)%MS. Proof. case: (eqmx_conform <>%MS A) => // eq_id_gen. exact: eqmx_trans (genmxE A). Qed. Lemma rowsub_comp_sub (m n p q : nat) f (g : 'I_n -> 'I_p) (A : 'M_(m, q)) : (rowsub (f \o g) A <= rowsub f A)%MS. Proof. by rewrite rowsub_comp rowsubE mulmx_sub. Qed. Lemma submx_rowsub (m n p q : nat) (h : 'I_n -> 'I_p) f g (A : 'M_(m, q)) : f =1 g \o h -> (rowsub f A <= rowsub g A)%MS. Proof. by move=> /eq_rowsub->; rewrite rowsub_comp_sub. Qed. Arguments submx_rowsub [m1 m2 m3 n] h [f g A] _ : rename. Lemma eqmx_rowsub_comp_perm (m1 m2 n : nat) (s : 'S_m2) f (A : 'M_(m1, n)) : (rowsub (f \o s) A :=: rowsub f A)%MS. Proof. rewrite rowsub_comp rowsubE; apply: eqmxMfull. by rewrite -perm_mxEsub row_full_unit unitmx_perm. Qed. Lemma eqmx_rowsub_comp (m n p q : nat) f (g : 'I_n -> 'I_p) (A : 'M_(m, q)) : p <= n -> injective g -> (rowsub (f \o g) A :=: rowsub f A)%MS. Proof. move=> leq_pn g_inj; have eq_np : n == p by rewrite eqn_leq leq_pn (inj_leq g). rewrite (eqP eq_np) in g g_inj *. rewrite (eq_rowsub (f \o (perm g_inj))); last by move=> i; rewrite /= permE. exact: eqmx_rowsub_comp_perm. Qed. Lemma eqmx_rowsub (m n p q : nat) (h : 'I_n -> 'I_p) f g (A : 'M_(m, q)) : injective h -> p <= n -> f =1 g \o h -> (rowsub f A :=: rowsub g A)%MS. Proof. by move=> leq_pn h_inj /eq_rowsub->; apply: eqmx_rowsub_comp. Qed. Arguments eqmx_rowsub [m1 m2 m3 n] h [f g A] _ : rename. Section AddsmxSub. Variable (m1 m2 n : nat) (A : 'M[F]_(m1, n)) (B : 'M[F]_(m2, n)). Lemma col_mx_sub m3 (C : 'M_(m3, n)) : (col_mx A B <= C)%MS = (A <= C)%MS && (B <= C)%MS. Proof. rewrite !submxE mul_col_mx -col_mx0. by apply/eqP/andP; [case/eq_col_mx=> -> -> | case; do 2!move/eqP->]. Qed. Lemma addsmxE : (A + B :=: col_mx A B)%MS. Proof. have:= submx_refl (col_mx A B); rewrite col_mx_sub; case/andP=> sAS sBS. rewrite unlock; do 2?case: eqP => [AB0 | _]; last exact: genmxE. by apply/eqmxP; rewrite !eqmx_sum_nop sBS col_mx_sub AB0 sub0mx /=. by apply/eqmxP; rewrite !eqmx_sum_nop sAS col_mx_sub AB0 sub0mx andbT /=. Qed. Lemma addsmx_sub m3 (C : 'M_(m3, n)) : (A + B <= C)%MS = (A <= C)%MS && (B <= C)%MS. Proof. by rewrite addsmxE col_mx_sub. Qed. Lemma addsmxSl : (A <= A + B)%MS. Proof. by have:= submx_refl (A + B)%MS; rewrite addsmx_sub; case/andP. Qed. Lemma addsmxSr : (B <= A + B)%MS. Proof. by have:= submx_refl (A + B)%MS; rewrite addsmx_sub; case/andP. Qed. Lemma addsmx_idPr : reflect (A + B :=: B)%MS (A <= B)%MS. Proof. have:= @eqmxP _ _ _ (A + B)%MS B. by rewrite addsmxSr addsmx_sub submx_refl !andbT. Qed. Lemma addsmx_idPl : reflect (A + B :=: A)%MS (B <= A)%MS. Proof. have:= @eqmxP _ _ _ (A + B)%MS A. by rewrite addsmxSl addsmx_sub submx_refl !andbT. Qed. End AddsmxSub. Lemma adds0mx m1 m2 n (B : 'M_(m2, n)) : ((0 : 'M_(m1, n)) + B :=: B)%MS. Proof. by apply/eqmxP; rewrite addsmx_sub sub0mx addsmxSr /= andbT. Qed. Lemma addsmx0 m1 m2 n (A : 'M_(m1, n)) : (A + (0 : 'M_(m2, n)) :=: A)%MS. Proof. by apply/eqmxP; rewrite addsmx_sub sub0mx addsmxSl /= !andbT. Qed. Let addsmx_nop_eq0 m n (A : 'M_(m, n)) : (addsmx_nop A == 0) = (A == 0). Proof. by rewrite -!submx0 eqmx_sum_nop. Qed. Let addsmx_nop0 m n : addsmx_nop (0 : 'M_(m, n)) = 0. Proof. by apply/eqP; rewrite addsmx_nop_eq0. Qed. Let addsmx_nop_id n (A : 'M_n) : addsmx_nop A = A. Proof. exact: conform_mx_id. Qed. Lemma addsmxC m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A + B = B + A)%MS. Proof. have: (A + B == B + A)%MS. by apply/andP; rewrite !addsmx_sub andbC -addsmx_sub andbC -addsmx_sub. move/genmxP; rewrite [@addsmx]unlock -!submx0 !submx0. by do 2!case: eqP => [// -> | _]; rewrite ?genmx_id ?addsmx_nop0. Qed. Lemma adds0mx_id m1 n (B : 'M_n) : ((0 : 'M_(m1, n)) + B)%MS = B. Proof. by rewrite unlock eqxx addsmx_nop_id. Qed. Lemma addsmx0_id m2 n (A : 'M_n) : (A + (0 : 'M_(m2, n)))%MS = A. Proof. by rewrite addsmxC adds0mx_id. Qed. Lemma addsmxA m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A + (B + C) = A + B + C)%MS. Proof. have: (A + (B + C) :=: A + B + C)%MS. by apply/eqmxP/andP; rewrite !addsmx_sub -andbA andbA -!addsmx_sub. rewrite {1 3}[in @addsmx m1]unlock [in @addsmx n]unlock !addsmx_nop_id -!submx0. rewrite !addsmx_sub ![@addsmx]unlock -!submx0; move/eq_genmx. by do 3!case: (_ <= 0)%MS; rewrite //= !genmx_id. Qed. Canonical addsmx_monoid n := Monoid.Law (@addsmxA n n n n) (@adds0mx_id n n) (@addsmx0_id n n). Canonical addsmx_comoid n := Monoid.ComLaw (@addsmxC n n n). Lemma addsmxMr m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : ((A + B)%MS *m C :=: A *m C + B *m C)%MS. Proof. by apply/eqmxP; rewrite !addsmxE -!mul_col_mx !submxMr ?addsmxE. Qed. Lemma addsmxS m1 m2 m3 m4 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) (D : 'M_(m4, n)) : (A <= C -> B <= D -> A + B <= C + D)%MS. Proof. move=> sAC sBD. by rewrite addsmx_sub {1}addsmxC !(submx_trans _ (addsmxSr _ _)). Qed. Lemma addmx_sub_adds m m1 m2 n (A : 'M_(m, n)) (B : 'M_(m, n)) (C : 'M_(m1, n)) (D : 'M_(m2, n)) : (A <= C -> B <= D -> (A + B)%R <= C + D)%MS. Proof. move=> sAC; move/(addsmxS sAC); apply: submx_trans. by rewrite addmx_sub ?addsmxSl ?addsmxSr. Qed. Lemma addsmx_addKl n m1 m2 (A : 'M_(m1, n)) (B C : 'M_(m2, n)) : (B <= A)%MS -> (A + (B + C)%R :=: A + C)%MS. Proof. move=> sBA; apply/eqmxP; rewrite !addsmx_sub !addsmxSl. by rewrite -{3}[C](addKr B) !addmx_sub_adds ?eqmx_opp. Qed. Lemma addsmx_addKr n m1 m2 (A B : 'M_(m1, n)) (C : 'M_(m2, n)) : (B <= C)%MS -> ((A + B)%R + C :=: A + C)%MS. Proof. by rewrite -!(addsmxC C) addrC; apply: addsmx_addKl. Qed. Lemma adds_eqmx m1 m2 m3 m4 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) (D : 'M_(m4, n)) : (A :=: C -> B :=: D -> A + B :=: C + D)%MS. Proof. by move=> eqAC eqBD; apply/eqmxP; rewrite !addsmxS ?eqAC ?eqBD. Qed. Lemma genmx_adds m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (<<(A + B)%MS>> = <> + <>)%MS. Proof. rewrite -(eq_genmx (adds_eqmx (genmxE A) (genmxE B))). by rewrite [@addsmx]unlock !addsmx_nop_id !(fun_if (@genmx _ _)) !genmx_id. Qed. Lemma sub_addsmxP m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : reflect (exists u, A = u.1 *m B + u.2 *m C) (A <= B + C)%MS. Proof. apply: (iffP idP) => [|[u ->]]; last by rewrite addmx_sub_adds ?submxMl. rewrite addsmxE; case/submxP=> u ->; exists (lsubmx u, rsubmx u). by rewrite -mul_row_col hsubmxK. Qed. Arguments sub_addsmxP {m1 m2 m3 n A B C}. Variable I : finType. Implicit Type P : pred I. Lemma genmx_sums P n (B_ : I -> 'M_n) : <<(\sum_(i | P i) B_ i)%MS>>%MS = (\sum_(i | P i) <>)%MS. Proof. exact: (big_morph _ (@genmx_adds n n n) (@genmx0 n n)). Qed. Lemma sumsmx_sup i0 P m n (A : 'M_(m, n)) (B_ : I -> 'M_n) : P i0 -> (A <= B_ i0)%MS -> (A <= \sum_(i | P i) B_ i)%MS. Proof. by move=> Pi0 sAB; apply: submx_trans sAB _; rewrite (bigD1 i0) // addsmxSl. Qed. Arguments sumsmx_sup i0 [P m n A B_]. Lemma sumsmx_subP P m n (A_ : I -> 'M_n) (B : 'M_(m, n)) : reflect (forall i, P i -> A_ i <= B)%MS (\sum_(i | P i) A_ i <= B)%MS. Proof. apply: (iffP idP) => [sAB i Pi | sAB]. by apply: submx_trans sAB; apply: sumsmx_sup Pi _. by elim/big_rec: _ => [|i Ai Pi sAiB]; rewrite ?sub0mx // addsmx_sub sAB. Qed. Lemma summx_sub_sums P m n (A : I -> 'M[F]_(m, n)) B : (forall i, P i -> A i <= B i)%MS -> ((\sum_(i | P i) A i)%R <= \sum_(i | P i) B i)%MS. Proof. by move=> sAB; apply: summx_sub => i Pi; rewrite (sumsmx_sup i) ?sAB. Qed. Lemma sumsmxS P n (A B : I -> 'M[F]_n) : (forall i, P i -> A i <= B i)%MS -> (\sum_(i | P i) A i <= \sum_(i | P i) B i)%MS. Proof. by move=> sAB; apply/sumsmx_subP=> i Pi; rewrite (sumsmx_sup i) ?sAB. Qed. Lemma eqmx_sums P n (A B : I -> 'M[F]_n) : (forall i, P i -> A i :=: B i)%MS -> (\sum_(i | P i) A i :=: \sum_(i | P i) B i)%MS. Proof. by move=> eqAB; apply/eqmxP; rewrite !sumsmxS // => i; move/eqAB->. Qed. Lemma sub_sums_genmxP P m n p (A : 'M_(m, p)) (B_ : I -> 'M_(n, p)) : reflect (exists u_ : I -> 'M_(m, n), A = \sum_(i | P i) u_ i *m B_ i) (A <= \sum_(i | P i) <>)%MS. Proof. apply: (iffP idP) => [| [u_ ->]]; last first. by apply: summx_sub_sums => i _; rewrite genmxE; apply: submxMl. have [b] := ubnP #|P|; elim: b => // b IHb in P A *. case: (pickP P) => [i Pi | P0 _]; last first. rewrite big_pred0 //; move/submx0null->. by exists (fun _ => 0); rewrite big_pred0. rewrite (cardD1x Pi) (bigD1 i) //= => /IHb{b IHb} /= IHi. rewrite (adds_eqmx (genmxE _) (eqmx_refl _)) => /sub_addsmxP[u ->]. have [u_ ->] := IHi _ (submxMl u.2 _). exists [eta u_ with i |-> u.1]; rewrite (bigD1 i Pi)/= eqxx; congr (_ + _). by apply: eq_bigr => j /andP[_ /negPf->]. Qed. Lemma sub_sumsmxP P m n (A : 'M_(m, n)) (B_ : I -> 'M_n) : reflect (exists u_, A = \sum_(i | P i) u_ i *m B_ i) (A <= \sum_(i | P i) B_ i)%MS. Proof. by rewrite -(eqmx_sums (fun _ _ => genmxE _)); apply/sub_sums_genmxP. Qed. Lemma sumsmxMr_gen P m n A (B : 'M[F]_(m, n)) : ((\sum_(i | P i) A i)%MS *m B :=: \sum_(i | P i) <>)%MS. Proof. apply/eqmxP/andP; split; last first. by apply/sumsmx_subP=> i Pi; rewrite genmxE submxMr ?(sumsmx_sup i). have [u ->] := sub_sumsmxP _ _ _ (submx_refl (\sum_(i | P i) A i)%MS). by rewrite mulmx_suml summx_sub_sums // => i _; rewrite genmxE -mulmxA submxMl. Qed. Lemma sumsmxMr P n (A_ : I -> 'M[F]_n) (B : 'M_n) : ((\sum_(i | P i) A_ i)%MS *m B :=: \sum_(i | P i) (A_ i *m B))%MS. Proof. by apply: eqmx_trans (sumsmxMr_gen _ _ _) (eqmx_sums _) => i _; apply: genmxE. Qed. Lemma rank_pid_mx m n r : r <= m -> r <= n -> \rank (pid_mx r : 'M_(m, n)) = r. Proof. do 2!move/subnKC <-; rewrite pid_mx_block block_mxEv row_mx0 -addsmxE addsmx0. by rewrite -mxrank_tr tr_row_mx trmx0 trmx1 -addsmxE addsmx0 mxrank1. Qed. Lemma rank_copid_mx n r : r <= n -> \rank (copid_mx r : 'M_n) = (n - r)%N. Proof. move/subnKC <-; rewrite /copid_mx pid_mx_block scalar_mx_block. rewrite opp_block_mx !oppr0 add_block_mx !addr0 subrr block_mxEv row_mx0. rewrite -addsmxE adds0mx -mxrank_tr tr_row_mx trmx0 trmx1. by rewrite -addsmxE adds0mx mxrank1 addKn. Qed. Lemma mxrank_compl m n (A : 'M_(m, n)) : \rank A^C = (n - \rank A)%N. Proof. by rewrite mxrankMfree ?row_free_unit ?rank_copid_mx. Qed. Lemma mxrank_ker m n (A : 'M_(m, n)) : \rank (kermx A) = (m - \rank A)%N. Proof. by rewrite mxrankMfree ?row_free_unit ?unitmx_inv ?rank_copid_mx. Qed. Lemma kermx_eq0 n m (A : 'M_(m, n)) : (kermx A == 0) = row_free A. Proof. by rewrite -mxrank_eq0 mxrank_ker subn_eq0 row_leq_rank. Qed. Lemma mxrank_coker m n (A : 'M_(m, n)) : \rank (cokermx A) = (n - \rank A)%N. Proof. by rewrite eqmxMfull ?row_full_unit ?unitmx_inv ?rank_copid_mx. Qed. Lemma cokermx_eq0 n m (A : 'M_(m, n)) : (cokermx A == 0) = row_full A. Proof. by rewrite -mxrank_eq0 mxrank_coker subn_eq0 col_leq_rank. Qed. Lemma mulmx_ker m n (A : 'M_(m, n)) : kermx A *m A = 0. Proof. by rewrite -{2}[A]mulmx_ebase !mulmxA mulmxKV // mul_copid_mx_pid ?mul0mx. Qed. Lemma mulmxKV_ker m n p (A : 'M_(n, p)) (B : 'M_(m, n)) : B *m A = 0 -> B *m col_ebase A *m kermx A = B. Proof. rewrite mulmxA mulmxBr mulmx1 mulmxBl mulmxK //. rewrite -{1}[A]mulmx_ebase !mulmxA => /(canRL (mulmxK (row_ebase_unit A))). rewrite mul0mx // => BA0; apply: (canLR (addrK _)). by rewrite -(pid_mx_id _ _ n (rank_leq_col A)) mulmxA BA0 !mul0mx addr0. Qed. Lemma sub_kermxP p m n (A : 'M_(m, n)) (B : 'M_(p, m)) : reflect (B *m A = 0) (B <= kermx A)%MS. Proof. apply: (iffP submxP) => [[D ->]|]; first by rewrite -mulmxA mulmx_ker mulmx0. by move/mulmxKV_ker; exists (B *m col_ebase A). Qed. Lemma sub_kermx p m n (A : 'M_(m, n)) (B : 'M_(p, m)) : (B <= kermx A)%MS = (B *m A == 0). Proof. exact/sub_kermxP/eqP. Qed. Lemma kermx0 m n : (kermx (0 : 'M_(m, n)) :=: 1%:M)%MS. Proof. by apply/eqmxP; rewrite submx1/= sub_kermx mulmx0. Qed. Lemma mulmx_free_eq0 m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : row_free B -> (A *m B == 0) = (A == 0). Proof. by rewrite -sub_kermx -kermx_eq0 => /eqP->; rewrite submx0. Qed. Lemma inj_row_free m n (A : 'M_(m, n)) : (forall v : 'rV_m, v *m A = 0 -> v = 0) -> row_free A. Proof. move=> Ainj; rewrite -kermx_eq0; apply/eqP/row_matrixP => i. by rewrite row0; apply/Ainj; rewrite -row_mul mulmx_ker row0. Qed. Lemma row_freePn m n (M : 'M[F]_(m, n)) : reflect (exists i, (row i M <= row' i M)%MS) (~~ row_free M). Proof. rewrite -kermx_eq0; apply: (iffP (rowV0Pn _)) => [|[i0 /submxP[D rM]]]. move=> [v /sub_kermxP vM_eq0 /rV0Pn[i0 vi0_neq0]]; exists i0. have := vM_eq0; rewrite mulmx_sum_row (bigD1_ord i0)//=. move=> /(canRL (addrK _))/(canRL (scalerK _))->//. rewrite sub0r scalerN -scaleNr scalemx_sub// summx_sub// => l _. by rewrite scalemx_sub// -row_rowsub row_sub. exists (\row_j oapp (D 0) (- 1) (unlift i0 j)); last first. by apply/rV0Pn; exists i0; rewrite !mxE unlift_none/= oppr_eq0 oner_eq0. apply/sub_kermxP; rewrite mulmx_sum_row (bigD1_ord i0)//= !mxE. rewrite unlift_none scaleN1r rM mulmx_sum_row addrC -sumrB big1 // => l _. by rewrite !mxE liftK row_rowsub subrr. Qed. Lemma negb_row_free m n (M : 'M[F]_(m, n)) : ~~ row_free M = [exists i, (row i M <= row' i M)%MS]. Proof. exact/row_freePn/existsP. Qed. Lemma mulmx0_rank_max m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : A *m B = 0 -> \rank A + \rank B <= n. Proof. move=> AB0; rewrite -{3}(subnK (rank_leq_row B)) leq_add2r. by rewrite -mxrank_ker mxrankS // sub_kermx AB0. Qed. Lemma mxrank_Frobenius m n p q (A : 'M_(m, n)) B (C : 'M_(p, q)) : \rank (A *m B) + \rank (B *m C) <= \rank B + \rank (A *m B *m C). Proof. rewrite -{2}(mulmx_base (A *m B)) -mulmxA (eqmxMfull _ (col_base_full _)). set C2 := row_base _ *m C. rewrite -{1}(subnK (rank_leq_row C2)) -(mxrank_ker C2) addnAC leq_add2r. rewrite addnC -{1}(mulmx_base B) -mulmxA eqmxMfull //. set C1 := _ *m C; rewrite -{2}(subnKC (rank_leq_row C1)) leq_add2l -mxrank_ker. rewrite -(mxrankMfree _ (row_base_free (A *m B))). have: (row_base (A *m B) <= row_base B)%MS by rewrite !eq_row_base submxMl. case/submxP=> D defD; rewrite defD mulmxA mxrankMfree ?mxrankS //. by rewrite sub_kermx -mulmxA (mulmxA D) -defD -/C2 mulmx_ker. Qed. Lemma mxrank_mul_min m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : \rank A + \rank B - n <= \rank (A *m B). Proof. by have:= mxrank_Frobenius A 1%:M B; rewrite mulmx1 mul1mx mxrank1 leq_subLR. Qed. Lemma addsmx_compl_full m n (A : 'M_(m, n)) : row_full (A + A^C)%MS. Proof. rewrite /row_full addsmxE; apply/row_fullP. exists (row_mx (pinvmx A) (cokermx A)); rewrite mul_row_col. rewrite -{2}[A]mulmx_ebase -!mulmxA mulKmx // -mulmxDr !mulmxA. by rewrite pid_mx_id ?copid_mx_id // -mulmxDl addrC subrK mul1mx mulVmx. Qed. Lemma sub_capmx_gen m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A <= capmx_gen B C)%MS = (A <= B)%MS && (A <= C)%MS. Proof. apply/idP/andP=> [sAI | [/submxP[B' ->{A}] /submxP[C' eqBC']]]. rewrite !(submx_trans sAI) ?submxMl // /capmx_gen. have:= mulmx_ker (col_mx B C); set K := kermx _. rewrite -{1}[K]hsubmxK mul_row_col; move/(canRL (addrK _))->. by rewrite add0r -mulNmx submxMl. have: (row_mx B' (- C') <= kermx (col_mx B C))%MS. by rewrite sub_kermx mul_row_col eqBC' mulNmx subrr. case/submxP=> D; rewrite -[kermx _]hsubmxK mul_mx_row. by case/eq_row_mx=> -> _; rewrite -mulmxA submxMl. Qed. Let capmx_witnessP m n (A : 'M_(m, n)) : equivmx A (qidmx A) (capmx_witness A). Proof. rewrite /equivmx qidmx_eq1 /qidmx /capmx_witness. rewrite -sub1mx; case s1A: (1%:M <= A)%MS => /=; last first. rewrite !genmxE submx_refl /= -negb_add; apply: contra {s1A}(negbT s1A). have [<- | _] := eqP; first by rewrite genmxE. by case: eqP A => //= -> A /eqP ->; rewrite pid_mx_1. case: (m =P n) => [-> | ne_mn] in A s1A *. by rewrite conform_mx_id submx_refl pid_mx_1 eqxx. by rewrite nonconform_mx ?submx1 ?s1A ?eqxx //; case: eqP. Qed. Let capmx_normP m n (A : 'M_(m, n)) : equivmx_spec A (qidmx A) (capmx_norm A). Proof. by case/andP: (chooseP (capmx_witnessP A)) => /eqmxP defN /eqP. Qed. Let capmx_norm_eq m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : qidmx A = qidmx B -> (A == B)%MS -> capmx_norm A = capmx_norm B. Proof. move=> eqABid /eqmxP eqAB. have{eqABid} eqAB: equivmx A (qidmx A) =1 equivmx B (qidmx B). by move=> C; rewrite /equivmx eqABid !eqAB. rewrite {1}/capmx_norm (eq_choose eqAB). by apply: choose_id; first rewrite -eqAB; apply: capmx_witnessP. Qed. Let capmx_nopP m n (A : 'M_(m, n)) : equivmx_spec A (qidmx A) (capmx_nop A). Proof. rewrite /capmx_nop; case: (eqVneq m n) => [-> | ne_mn] in A *. by rewrite conform_mx_id. by rewrite nonconform_mx ?ne_mn //; apply: capmx_normP. Qed. Let sub_qidmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : qidmx B -> (A <= B)%MS. Proof. rewrite /qidmx => idB; apply: {A}submx_trans (submx1 A) _. by case: eqP B idB => [-> _ /eqP-> | _ B]; rewrite (=^~ sub1mx, pid_mx_1). Qed. Let qidmx_cap m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : qidmx (A :&: B)%MS = qidmx A && qidmx B. Proof. rewrite unlock -sub1mx. case idA: (qidmx A); case idB: (qidmx B); try by rewrite capmx_nopP. case s1B: (_ <= B)%MS; first by rewrite capmx_normP. apply/idP=> /(sub_qidmx 1%:M). by rewrite capmx_normP sub_capmx_gen s1B andbF. Qed. Let capmx_eq_norm m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : qidmx A = qidmx B -> (A :&: B)%MS = capmx_norm (A :&: B)%MS. Proof. move=> eqABid; rewrite unlock -sub1mx {}eqABid. have norm_id m (C : 'M_(m, n)) (N := capmx_norm C) : capmx_norm N = N. by apply: capmx_norm_eq; rewrite ?capmx_normP ?andbb. case idB: (qidmx B); last by case: ifP; rewrite norm_id. rewrite /capmx_nop; case: (eqVneq m2 n) => [-> | neqm2n] in B idB *. have idN := idB; rewrite -{1}capmx_normP !qidmx_eq1 in idN idB. by rewrite conform_mx_id (eqP idN) (eqP idB). by rewrite nonconform_mx ?neqm2n ?norm_id. Qed. Lemma capmxE m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :&: B :=: capmx_gen A B)%MS. Proof. rewrite unlock -sub1mx; apply/eqmxP. have:= submx_refl (capmx_gen A B); rewrite !sub_capmx_gen => /andP[sIA sIB]. case idA: (qidmx A); first by rewrite !capmx_nopP submx_refl sub_qidmx. case idB: (qidmx B); first by rewrite !capmx_nopP submx_refl sub_qidmx. case s1B: (1%:M <= B)%MS; rewrite !capmx_normP ?sub_capmx_gen sIA ?sIB //=. by rewrite submx_refl (submx_trans (submx1 _)). Qed. Lemma capmxSl m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :&: B <= A)%MS. Proof. by rewrite capmxE submxMl. Qed. Lemma sub_capmx m m1 m2 n (A : 'M_(m, n)) (B : 'M_(m1, n)) (C : 'M_(m2, n)) : (A <= B :&: C)%MS = (A <= B)%MS && (A <= C)%MS. Proof. by rewrite capmxE sub_capmx_gen. Qed. Lemma capmxC m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :&: B = B :&: A)%MS. Proof. have [eqAB|] := eqVneq (qidmx A) (qidmx B). rewrite (capmx_eq_norm eqAB) (capmx_eq_norm (esym eqAB)). apply: capmx_norm_eq; first by rewrite !qidmx_cap andbC. by apply/andP; split; rewrite !sub_capmx andbC -sub_capmx. by rewrite negb_eqb !unlock => /addbP <-; case: (qidmx A). Qed. Lemma capmxSr m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :&: B <= B)%MS. Proof. by rewrite capmxC capmxSl. Qed. Lemma capmx_idPr n m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (A :&: B :=: B)%MS (B <= A)%MS. Proof. have:= @eqmxP _ _ _ (A :&: B)%MS B. by rewrite capmxSr sub_capmx submx_refl !andbT. Qed. Lemma capmx_idPl n m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (A :&: B :=: A)%MS (A <= B)%MS. Proof. by rewrite capmxC; apply: capmx_idPr. Qed. Lemma capmxS m1 m2 m3 m4 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) (D : 'M_(m4, n)) : (A <= C -> B <= D -> A :&: B <= C :&: D)%MS. Proof. by move=> sAC sBD; rewrite sub_capmx {1}capmxC !(submx_trans (capmxSr _ _)). Qed. Lemma cap_eqmx m1 m2 m3 m4 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) (D : 'M_(m4, n)) : (A :=: C -> B :=: D -> A :&: B :=: C :&: D)%MS. Proof. by move=> eqAC eqBD; apply/eqmxP; rewrite !capmxS ?eqAC ?eqBD. Qed. Lemma capmxMr m1 m2 n p (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(n, p)) : ((A :&: B) *m C <= A *m C :&: B *m C)%MS. Proof. by rewrite sub_capmx !submxMr ?capmxSl ?capmxSr. Qed. Lemma cap0mx m1 m2 n (A : 'M_(m2, n)) : ((0 : 'M_(m1, n)) :&: A)%MS = 0. Proof. exact: submx0null (capmxSl _ _). Qed. Lemma capmx0 m1 m2 n (A : 'M_(m1, n)) : (A :&: (0 : 'M_(m2, n)))%MS = 0. Proof. exact: submx0null (capmxSr _ _). Qed. Lemma capmxT m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : row_full B -> (A :&: B :=: A)%MS. Proof. rewrite -sub1mx => s1B; apply/eqmxP. by rewrite capmxSl sub_capmx submx_refl (submx_trans (submx1 A)). Qed. Lemma capTmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : row_full A -> (A :&: B :=: B)%MS. Proof. by move=> Afull; apply/eqmxP; rewrite capmxC !capmxT ?andbb. Qed. Let capmx_nop_id n (A : 'M_n) : capmx_nop A = A. Proof. by rewrite /capmx_nop conform_mx_id. Qed. Lemma cap1mx n (A : 'M_n) : (1%:M :&: A = A)%MS. Proof. by rewrite unlock qidmx_eq1 eqxx capmx_nop_id. Qed. Lemma capmx1 n (A : 'M_n) : (A :&: 1%:M = A)%MS. Proof. by rewrite capmxC cap1mx. Qed. Lemma genmx_cap m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : <>%MS = (<> :&: <>)%MS. Proof. rewrite -(eq_genmx (cap_eqmx (genmxE A) (genmxE B))). case idAB: (qidmx <> || qidmx <>)%MS. rewrite [@capmx]unlock !capmx_nop_id !(fun_if (@genmx _ _)) !genmx_id. by case: (qidmx _) idAB => //= ->. case idA: (qidmx _) idAB => //= idB; rewrite {2}capmx_eq_norm ?idA //. set C := (_ :&: _)%MS; have eq_idC: row_full C = qidmx C. rewrite qidmx_cap idA -sub1mx sub_capmx genmxE; apply/andP=> [[s1A]]. by case/idP: idA; rewrite qidmx_eq1 -genmx1 (sameP eqP genmxP) submx1. rewrite unlock /capmx_norm eq_idC. by apply: choose_id (capmx_witnessP _); rewrite -eq_idC genmx_witnessP. Qed. Lemma capmxA m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A :&: (B :&: C) = A :&: B :&: C)%MS. Proof. rewrite (capmxC A B) capmxC; wlog idA: m1 m3 A C / qidmx A. move=> IH; case idA: (qidmx A); first exact: IH. case idC: (qidmx C); first by rewrite -IH. rewrite (@capmx_eq_norm n m3) ?qidmx_cap ?idA ?idC ?andbF //. rewrite capmx_eq_norm ?qidmx_cap ?idA ?idC ?andbF //. apply: capmx_norm_eq; first by rewrite !qidmx_cap andbAC. by apply/andP; split; rewrite !sub_capmx andbAC -!sub_capmx. rewrite -!(capmxC A) [in @capmx m1]unlock idA capmx_nop_id. have [eqBC|] := eqVneq (qidmx B) (qidmx C). rewrite (@capmx_eq_norm n) ?capmx_nopP // capmx_eq_norm //. by apply: capmx_norm_eq; rewrite ?qidmx_cap ?capmxS ?capmx_nopP. by rewrite !unlock capmx_nopP capmx_nop_id; do 2?case: (qidmx _) => //. Qed. Canonical capmx_monoid n := Monoid.Law (@capmxA n n n n) (@cap1mx n) (@capmx1 n). Canonical capmx_comoid n := Monoid.ComLaw (@capmxC n n n). Lemma bigcapmx_inf i0 P m n (A_ : I -> 'M_n) (B : 'M_(m, n)) : P i0 -> (A_ i0 <= B -> \bigcap_(i | P i) A_ i <= B)%MS. Proof. by move=> Pi0; apply: submx_trans; rewrite (bigD1 i0) // capmxSl. Qed. Lemma sub_bigcapmxP P m n (A : 'M_(m, n)) (B_ : I -> 'M_n) : reflect (forall i, P i -> A <= B_ i)%MS (A <= \bigcap_(i | P i) B_ i)%MS. Proof. apply: (iffP idP) => [sAB i Pi | sAB]. by apply: (submx_trans sAB); rewrite (bigcapmx_inf Pi). by elim/big_rec: _ => [|i Pi C sAC]; rewrite ?submx1 // sub_capmx sAB. Qed. Lemma genmx_bigcap P n (A_ : I -> 'M_n) : (<<\bigcap_(i | P i) A_ i>> = \bigcap_(i | P i) <>)%MS. Proof. exact: (big_morph _ (@genmx_cap n n n) (@genmx1 n)). Qed. Lemma matrix_modl m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (A <= C -> A + (B :&: C) :=: (A + B) :&: C)%MS. Proof. move=> sAC; set D := ((A + B) :&: C)%MS; apply/eqmxP. rewrite sub_capmx addsmxS ?capmxSl // addsmx_sub sAC capmxSr /=. have: (D <= B + A)%MS by rewrite addsmxC capmxSl. case/sub_addsmxP=> u defD; rewrite defD addrC addmx_sub_adds ?submxMl //. rewrite sub_capmx submxMl -[_ *m B](addrK (u.2 *m A)) -defD. by rewrite addmx_sub ?capmxSr // eqmx_opp mulmx_sub. Qed. Lemma matrix_modr m1 m2 m3 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) (C : 'M_(m3, n)) : (C <= A -> (A :&: B) + C :=: A :&: (B + C))%MS. Proof. by rewrite !(capmxC A) -!(addsmxC C); apply: matrix_modl. Qed. Lemma capmx_compl m n (A : 'M_(m, n)) : (A :&: A^C)%MS = 0. Proof. set D := (A :&: A^C)%MS; have: (D <= D)%MS by []. rewrite sub_capmx andbC => /andP[/submxP[B defB]]. rewrite submxE => /eqP; rewrite defB -!mulmxA mulKVmx ?copid_mx_id //. by rewrite mulmxA => ->; rewrite mul0mx. Qed. Lemma mxrank_mul_ker m n p (A : 'M_(m, n)) (B : 'M_(n, p)) : (\rank (A *m B) + \rank (A :&: kermx B))%N = \rank A. Proof. apply/eqP; set K := kermx B; set C := (A :&: K)%MS. rewrite -(eqmxMr B (eq_row_base A)); set K' := _ *m B. rewrite -{2}(subnKC (rank_leq_row K')) -mxrank_ker eqn_add2l. rewrite -(mxrankMfree _ (row_base_free A)) mxrank_leqif_sup. by rewrite sub_capmx -(eq_row_base A) submxMl sub_kermx -mulmxA mulmx_ker/=. have /submxP[C' defC]: (C <= row_base A)%MS by rewrite eq_row_base capmxSl. by rewrite defC submxMr // sub_kermx mulmxA -defC -sub_kermx capmxSr. Qed. Lemma mxrank_injP m n p (A : 'M_(m, n)) (f : 'M_(n, p)) : reflect (\rank (A *m f) = \rank A) ((A :&: kermx f)%MS == 0). Proof. rewrite -mxrank_eq0 -(eqn_add2l (\rank (A *m f))). by rewrite mxrank_mul_ker addn0 eq_sym; apply: eqP. Qed. Lemma mxrank_disjoint_sum m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :&: B)%MS = 0 -> \rank (A + B)%MS = (\rank A + \rank B)%N. Proof. move=> AB0; pose Ar := row_base A; pose Br := row_base B. have [Afree Bfree]: row_free Ar /\ row_free Br by rewrite !row_base_free. have: (Ar :&: Br <= A :&: B)%MS by rewrite capmxS ?eq_row_base. rewrite {}AB0 submx0 -mxrank_eq0 capmxE mxrankMfree //. set Cr := col_mx Ar Br; set Crl := lsubmx _; rewrite mxrank_eq0 => /eqP Crl0. rewrite -(adds_eqmx (eq_row_base _) (eq_row_base _)) addsmxE -/Cr. suffices K0: kermx Cr = 0. by apply/eqP; rewrite eqn_leq rank_leq_row -subn_eq0 -mxrank_ker K0 mxrank0. move/eqP: (mulmx_ker Cr); rewrite -[kermx Cr]hsubmxK mul_row_col -/Crl Crl0. rewrite mul0mx add0r -mxrank_eq0 mxrankMfree // mxrank_eq0 => /eqP->. exact: row_mx0. Qed. Lemma diffmxE m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :\: B :=: A :&: (capmx_gen A B)^C)%MS. Proof. by rewrite unlock; apply/eqmxP; rewrite !genmxE !capmxE andbb. Qed. Lemma genmx_diff m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (<> = A :\: B)%MS. Proof. by rewrite [@diffmx]unlock genmx_id. Qed. Lemma diffmxSl m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :\: B <= A)%MS. Proof. by rewrite diffmxE capmxSl. Qed. Lemma capmx_diff m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : ((A :\: B) :&: B)%MS = 0. Proof. apply/eqP; pose C := capmx_gen A B; rewrite -submx0 -(capmx_compl C). by rewrite sub_capmx -capmxE sub_capmx andbAC -sub_capmx -diffmxE -sub_capmx. Qed. Lemma addsmx_diff_cap_eq m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :\: B + A :&: B :=: A)%MS. Proof. apply/eqmxP; rewrite addsmx_sub capmxSl diffmxSl /=. set C := (A :\: B)%MS; set D := capmx_gen A B. suffices sACD: (A <= C + D)%MS. by rewrite (submx_trans sACD) ?addsmxS ?capmxE. have:= addsmx_compl_full D; rewrite /row_full addsmxE. case/row_fullP=> U /(congr1 (mulmx A)); rewrite mulmx1. rewrite -[U]hsubmxK mul_row_col mulmxDr addrC 2!mulmxA. set V := _ *m _ => defA; rewrite -defA; move/(canRL (addrK _)): defA => defV. suffices /submxP[W ->]: (V <= C)%MS by rewrite -mul_row_col addsmxE submxMl. rewrite diffmxE sub_capmx {1}defV -mulNmx addmx_sub 1?mulmx_sub //. by rewrite -capmxE capmxSl. Qed. Lemma mxrank_cap_compl m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (\rank (A :&: B) + \rank (A :\: B))%N = \rank A. Proof. rewrite addnC -mxrank_disjoint_sum ?addsmx_diff_cap_eq //. by rewrite (capmxC A) capmxA capmx_diff cap0mx. Qed. Lemma mxrank_sum_cap m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (\rank (A + B) + \rank (A :&: B) = \rank A + \rank B)%N. Proof. set C := (A :&: B)%MS; set D := (A :\: B)%MS. have rDB: \rank (A + B)%MS = \rank (D + B)%MS. apply/eqP; rewrite mxrank_leqif_sup; first by rewrite addsmxS ?diffmxSl. by rewrite addsmx_sub addsmxSr -(addsmx_diff_cap_eq A B) addsmxS ?capmxSr. rewrite {1}rDB mxrank_disjoint_sum ?capmx_diff //. by rewrite addnC addnA mxrank_cap_compl. Qed. Lemma mxrank_adds_leqif m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : \rank (A + B) <= \rank A + \rank B ?= iff (A :&: B <= (0 : 'M_n))%MS. Proof. rewrite -mxrank_sum_cap; split; first exact: leq_addr. by rewrite addnC (@eqn_add2r _ 0) eq_sym mxrank_eq0 -submx0. Qed. (* Subspace projection matrix *) Lemma proj_mx_sub m n U V (W : 'M_(m, n)) : (W *m proj_mx U V <= U)%MS. Proof. by rewrite !mulmx_sub // -addsmxE addsmx0. Qed. Lemma proj_mx_compl_sub m n U V (W : 'M_(m, n)) : (W <= U + V -> W - W *m proj_mx U V <= V)%MS. Proof. rewrite addsmxE => sWUV; rewrite mulmxA -{1}(mulmxKpV sWUV) -mulmxBr. by rewrite mulmx_sub // opp_col_mx add_col_mx subrr subr0 -addsmxE adds0mx. Qed. Lemma proj_mx_id m n U V (W : 'M_(m, n)) : (U :&: V = 0)%MS -> (W <= U)%MS -> W *m proj_mx U V = W. Proof. move=> dxUV sWU; apply/eqP; rewrite -subr_eq0 -submx0 -dxUV. rewrite sub_capmx addmx_sub ?eqmx_opp ?proj_mx_sub //= -eqmx_opp opprB. by rewrite proj_mx_compl_sub // (submx_trans sWU) ?addsmxSl. Qed. Lemma proj_mx_0 m n U V (W : 'M_(m, n)) : (U :&: V = 0)%MS -> (W <= V)%MS -> W *m proj_mx U V = 0. Proof. move=> dxUV sWV; apply/eqP; rewrite -submx0 -dxUV. rewrite sub_capmx proj_mx_sub /= -[_ *m _](subrK W) addmx_sub // -eqmx_opp. by rewrite opprB proj_mx_compl_sub // (submx_trans sWV) ?addsmxSr. Qed. Lemma add_proj_mx m n U V (W : 'M_(m, n)) : (U :&: V = 0)%MS -> (W <= U + V)%MS -> W *m proj_mx U V + W *m proj_mx V U = W. Proof. move=> dxUV sWUV; apply/eqP; rewrite -subr_eq0 -submx0 -dxUV. rewrite -addrA sub_capmx {2}addrCA -!(opprB W). by rewrite !{1}addmx_sub ?proj_mx_sub ?eqmx_opp ?proj_mx_compl_sub // addsmxC. Qed. Lemma proj_mx_proj n (U V : 'M_n) : let P := proj_mx U V in (U :&: V = 0)%MS -> P *m P = P. Proof. by move=> P dxUV; rewrite -[P in P *m _]mul1mx proj_mx_id ?proj_mx_sub ?mul1mx. Qed. (* Completing a partially injective matrix to get a unit matrix. *) Lemma complete_unitmx m n (U : 'M_(m, n)) (f : 'M_n) : \rank (U *m f) = \rank U -> {g : 'M_n | g \in unitmx & U *m f = U *m g}. Proof. move=> injfU; pose V := <>%MS; pose W := V *m f. pose g := proj_mx V (V^C)%MS *m f + cokermx V *m row_ebase W. have defW: V *m g = W. rewrite mulmxDr mulmxA proj_mx_id ?genmxE ?capmx_compl //. by rewrite mulmxA mulmx_coker mul0mx addr0. exists g; last first. have /submxP[u ->]: (U <= V)%MS by rewrite genmxE. by rewrite -!mulmxA defW. rewrite -row_full_unit -sub1mx; apply/submxP. have: (invmx (col_ebase W) *m W <= V *m g)%MS by rewrite defW submxMl. case/submxP=> v def_v; exists (invmx (row_ebase W) *m (v *m V + (V^C)%MS)). rewrite -mulmxA mulmxDl -mulmxA -def_v -{3}[W]mulmx_ebase -mulmxA. rewrite mulKmx ?col_ebase_unit // [_ *m g]mulmxDr mulmxA. rewrite (proj_mx_0 (capmx_compl _)) // mul0mx add0r 2!mulmxA. rewrite mulmxK ?row_ebase_unit // copid_mx_id ?rank_leq_row //. rewrite (eqmxMr _ (genmxE U)) injfU genmxE addrC -mulmxDl subrK. by rewrite mul1mx mulVmx ?row_ebase_unit. Qed. (* Two matrices with the same shape represent the same subspace *) (* iff they differ only by a change of basis. *) Lemma eqmxMunitP m n (U V : 'M_(m, n)) : reflect (exists2 P, P \in unitmx & U = P *m V) (U == V)%MS. Proof. apply: (iffP eqmxP) => [eqUV | [P Punit ->]]; last first. by apply/eqmxMfull; rewrite row_full_unit. have [D defU]: exists D, U = D *m V by apply/submxP; rewrite eqUV. have{eqUV} [Pt Pt_unit defUt]: {Pt | Pt \in unitmx & V^T *m D^T = V^T *m Pt}. by apply/complete_unitmx; rewrite -trmx_mul -defU !mxrank_tr eqUV. by exists Pt^T; last apply/trmx_inj; rewrite ?unitmx_tr // defU !trmx_mul trmxK. Qed. (* Mapping between two subspaces with the same dimension. *) Lemma eq_rank_unitmx m1 m2 n (U : 'M_(m1, n)) (V : 'M_(m2, n)) : \rank U = \rank V -> {f : 'M_n | f \in unitmx & V :=: U *m f}%MS. Proof. move=> eqrUV; pose f := invmx (row_ebase <>%MS) *m row_ebase <>%MS. have defUf: (<> *m f :=: <>)%MS. rewrite -[<>%MS]mulmx_ebase mulmxA mulmxK ?row_ebase_unit // -mulmxA. rewrite genmxE eqrUV -genmxE -{3}[<>%MS]mulmx_ebase -mulmxA. move: (pid_mx _ *m _) => W; apply/eqmxP. by rewrite !eqmxMfull ?andbb // row_full_unit col_ebase_unit. have{defUf} defV: (V :=: U *m f)%MS. by apply/eqmxP; rewrite -!(eqmxMr f (genmxE U)) !defUf !genmxE andbb. have injfU: \rank (U *m f) = \rank U by rewrite -defV eqrUV. by have [g injg defUg] := complete_unitmx injfU; exists g; rewrite -?defUg. Qed. (* maximal rank and full rank submatrices *) Section MaxRankSubMatrix. Variables (m n : nat) (A : 'M_(m, n)). Definition maxrankfun : 'I_m ^ \rank A := [arg max_(f > finfun (widen_ord (rank_leq_row A))) \rank (rowsub f A)]. Local Notation mxf := maxrankfun. Lemma maxrowsub_free : row_free (rowsub mxf A). Proof. rewrite /mxf; case: arg_maxnP => //= f _ fM; apply/negP => /negP rfA. have [i NriA] : exists i, ~~ (row i A <= rowsub f A)%MS. by apply/row_subPn; apply: contraNN rfA => /mxrankS; rewrite row_leq_rank. have [j rjfA] : exists j, (row (f j) A <= rowsub (f \o lift j) A)%MS. case/row_freePn: rfA => j. by rewrite row_rowsub row'Esub -mxsub_comp; exists j. pose g : 'I_m ^ \rank A := finfun [eta f with j |-> i]. suff: (rowsub f A < rowsub g A)%MS by rewrite ltmxErank andbC ltnNge fM. rewrite ltmxE; apply/andP; split; last first. apply: contra NriA; apply: submx_trans. by rewrite (eq_row_sub j)// row_rowsub ffunE/= eqxx. apply/row_subP => k; rewrite !row_rowsub. have [->|/negPf eq_kjF] := eqVneq k j; last first. by rewrite (eq_row_sub k)// row_rowsub ffunE/= eq_kjF. rewrite (submx_trans rjfA)// (submx_rowsub (lift j))// => l /=. by rewrite ffunE/= eq_sym (negPf (neq_lift _ _)). Qed. Lemma eq_maxrowsub : (rowsub mxf A :=: A)%MS. Proof. apply/eqmxP; rewrite -(eq_leqif (mxrank_leqif_eq _))//. exact: maxrowsub_free. apply/row_subP => i; apply/submxP; exists (delta_mx 0 (mxf i)). by rewrite -rowE; apply/rowP => j; rewrite !mxE. Qed. Lemma maxrankfun_inj : injective mxf. Proof. move=> i j eqAij; have /row_free_inj := maxrowsub_free. move=> /(_ 1%N) /(_ (delta_mx 0 i) (delta_mx 0 j)). rewrite -!rowE !row_rowsub eqAij => /(_ erefl) /matrixP /(_ 0 i) /eqP. by rewrite !mxE eqxx/=; case: (i =P j); rewrite // oner_eq0. Qed. Variable (rkA : row_full A). Lemma maxrowsub_full : row_full (rowsub mxf A). Proof. by rewrite /row_full eq_maxrowsub. Qed. Hint Resolve maxrowsub_full : core. Definition fullrankfun : 'I_m ^ n := finfun (mxf \o cast_ord (esym (eqP rkA))). Local Notation frf := fullrankfun. Lemma fullrowsub_full : row_full (rowsub frf A). Proof. by rewrite mxsub_ffunl rowsub_comp rowsub_cast esymK row_full_castmx. Qed. Lemma fullrowsub_unit : rowsub frf A \in unitmx. Proof. by rewrite -row_full_unit fullrowsub_full. Qed. Lemma fullrowsub_free : row_free (rowsub frf A). Proof. by rewrite row_free_unit fullrowsub_unit. Qed. Lemma mxrank_fullrowsub : \rank (rowsub frf A) = n. Proof. exact/eqP/fullrowsub_full. Qed. Lemma eq_fullrowsub : (rowsub frf A :=: A)%MS. Proof. rewrite mxsub_ffunl rowsub_comp rowsub_cast esymK. exact: (eqmx_trans (eqmx_cast _ _) eq_maxrowsub). Qed. Lemma fullrankfun_inj : injective frf. Proof. by move=> i j; rewrite !ffunE => /maxrankfun_inj /(congr1 val)/= /val_inj. Qed. End MaxRankSubMatrix. Section SumExpr. (* This is the infrastructure to support the mxdirect predicate. We use a *) (* bespoke canonical structure to decompose a matrix expression into binary *) (* and n-ary products, using some of the "quote" technology. This lets us *) (* characterize direct sums as set sums whose rank is equal to the sum of the *) (* ranks of the individual terms. The mxsum_expr/proper_mxsum_expr structures *) (* below supply both the decomposition and the calculation of the rank sum. *) (* The mxsum_spec dependent predicate family expresses the consistency of *) (* these two decompositions. *) (* The main technical difficulty we need to overcome is the fact that *) (* the "catch-all" case of canonical structures has a priority lower than *) (* constant expansion. However, it is undesireable that local abbreviations *) (* be opaque for the direct-sum predicate, e.g., not be able to handle *) (* let S := (\sum_(i | P i) LargeExpression i)%MS in mxdirect S -> ...). *) (* As in "quote", we use the interleaving of constant expansion and *) (* canonical projection matching to achieve our goal: we use a "wrapper" type *) (* (indeed, the wrapped T type defined in ssrfun.v) with a self-inserting *) (* non-primitive constructor to gain finer control over the type and *) (* structure inference process. The innermost, primitive, constructor flags *) (* trivial sums; it is initially hidden by an eta-expansion, which has been *) (* made into a (default) canonical structure -- this lets type inference *) (* automatically insert this outer tag. *) (* In detail, we define three types *) (* mxsum_spec S r <-> There exists a finite list of matrices A1, ..., Ak *) (* such that S is the set sum of the Ai, and r is the sum *) (* of the ranks of the Ai, i.e., S = (A1 + ... + Ak)%MS *) (* and r = \rank A1 + ... + \rank Ak. Note that *) (* mxsum_spec is a recursive dependent predicate family *) (* whose elimination rewrites simultaneaously S, r and *) (* the height of S. *) (* proper_mxsum_expr n == The interface for proper sum expressions; this is *) (* a double-entry interface, keyed on both the matrix sum *) (* value and the rank sum. The matrix value is restricted *) (* to square matrices, as the "+"%MS operator always *) (* returns a square matrix. This interface has two *) (* canonical insances, for binary and n-ary sums. *) (* mxsum_expr m n == The interface for general sum expressions, comprising *) (* both proper sums and trivial sums consisting of a *) (* single matrix. The key values are WRAPPED as this lets *) (* us give priority to the "proper sum" interpretation *) (* (see below). To allow for trivial sums, the matrix key *) (* can have any dimension. The mxsum_expr interface has *) (* two canonical instances, for trivial and proper sums, *) (* keyed to the Wrap and wrap constructors, respectively. *) (* The projections for the two interfaces above are *) (* proper_mxsum_val, mxsum_val : these are respectively coercions to 'M_n *) (* and wrapped 'M_(m, n); thus, the matrix sum for an *) (* S : mxsum_expr m n can be written unwrap S. *) (* proper_mxsum_rank, mxsum_rank : projections to the nat and wrapped nat, *) (* respectively; the rank sum for S : mxsum_expr m n is *) (* thus written unwrap (mxsum_rank S). *) (* The mxdirect A predicate actually gets A in a phantom argument, which is *) (* used to infer an (implicit) S : mxsum_expr such that unwrap S = A; the *) (* actual definition is \rank (unwrap S) == unwrap (mxsum_rank S). *) (* Note that the inference of S is inherently ambiguous: ANY matrix can be *) (* viewed as a trivial sum, including one whose description is manifestly a *) (* proper sum. We use the wrapped type and the interaction between delta *) (* reduction and canonical structure inference to resolve this ambiguity in *) (* favor of proper sums, as follows: *) (* - The phantom type sets up a unification problem of the form *) (* unwrap (mxsum_val ?S) = A *) (* with unknown evar ?S : mxsum_expr m n. *) (* - As the constructor wrap is also a default Canonical instance for the *) (* wrapped type, so A is immediately replaced with unwrap (wrap A) and *) (* we get the residual unification problem *) (* mxsum_val ?S = wrap A *) (* - Now Coq tries to apply the proper sum Canonical instance, which has *) (* key projection wrap (proper_mxsum_val ?PS) where ?PS is a fresh evar *) (* (of type proper_mxsum_expr n). This can only succeed if m = n, and if *) (* a solution can be found to the recursive unification problem *) (* proper_mxsum_val ?PS = A *) (* This causes Coq to look for one of the two canonical constants for *) (* proper_mxsum_val (addsmx or bigop) at the head of A, delta-expanding *) (* A as needed, and then inferring recursively mxsum_expr structures for *) (* the last argument(s) of that constant. *) (* - If the above step fails then the wrap constant is expanded, revealing *) (* the primitive Wrap constructor; the unification problem now becomes *) (* mxsum_val ?S = Wrap A *) (* which fits perfectly the trivial sum canonical structure, whose key *) (* projection is Wrap ?B where ?B is a fresh evar. Thus the inference *) (* succeeds, and returns the trivial sum. *) (* Note that the rank projections also register canonical values, so that the *) (* same process can be used to infer a sum structure from the rank sum. In *) (* that case, however, there is no ambiguity and the inference can fail, *) (* because the rank sum for a trivial sum is not an arbitrary integer -- it *) (* must be of the form \rank ?B. It is nevertheless necessary to use the *) (* wrapped nat type for the rank sums, because in the non-trivial case the *) (* head constant of the nat expression is determined by the proper_mxsum_expr *) (* canonical structure, so the mxsum_expr structure must use a generic *) (* constant, namely wrap. *) Inductive mxsum_spec n : forall m, 'M[F]_(m, n) -> nat -> Prop := | TrivialMxsum m A : @mxsum_spec n m A (\rank A) | ProperMxsum m1 m2 T1 T2 r1 r2 of @mxsum_spec n m1 T1 r1 & @mxsum_spec n m2 T2 r2 : mxsum_spec (T1 + T2)%MS (r1 + r2)%N. Arguments mxsum_spec {n%N m%N} T%MS r%N. Structure mxsum_expr m n := Mxsum { mxsum_val :> wrapped 'M_(m, n); mxsum_rank : wrapped nat; _ : mxsum_spec (unwrap mxsum_val) (unwrap mxsum_rank) }. Canonical trivial_mxsum m n A := @Mxsum m n (Wrap A) (Wrap (\rank A)) (TrivialMxsum A). Structure proper_mxsum_expr n := ProperMxsumExpr { proper_mxsum_val :> 'M_n; proper_mxsum_rank : nat; _ : mxsum_spec proper_mxsum_val proper_mxsum_rank }. Definition proper_mxsumP n (S : proper_mxsum_expr n) := let: ProperMxsumExpr _ _ termS := S return mxsum_spec S (proper_mxsum_rank S) in termS. Canonical sum_mxsum n (S : proper_mxsum_expr n) := @Mxsum n n (wrap (S : 'M_n)) (wrap (proper_mxsum_rank S)) (proper_mxsumP S). Section Binary. Variable (m1 m2 n : nat) (S1 : mxsum_expr m1 n) (S2 : mxsum_expr m2 n). Fact binary_mxsum_proof : mxsum_spec (unwrap S1 + unwrap S2) (unwrap (mxsum_rank S1) + unwrap (mxsum_rank S2)). Proof. by case: S1 S2 => [A1 r1 A1P] [A2 r2 A2P]; right. Qed. Canonical binary_mxsum_expr := ProperMxsumExpr binary_mxsum_proof. End Binary. Section Nary. Context J (r : seq J) (P : pred J) n (S_ : J -> mxsum_expr n n). Fact nary_mxsum_proof : mxsum_spec (\sum_(j <- r | P j) unwrap (S_ j)) (\sum_(j <- r | P j) unwrap (mxsum_rank (S_ j))). Proof. elim/big_rec2: _ => [|j]; first by rewrite -(mxrank0 n n); left. by case: (S_ j); right. Qed. Canonical nary_mxsum_expr := ProperMxsumExpr nary_mxsum_proof. End Nary. Definition mxdirect_def m n T of phantom 'M_(m, n) (unwrap (mxsum_val T)) := \rank (unwrap T) == unwrap (mxsum_rank T). End SumExpr. Notation mxdirect A := (mxdirect_def (Phantom 'M_(_,_) A%MS)). Lemma mxdirectP n (S : proper_mxsum_expr n) : reflect (\rank S = proper_mxsum_rank S) (mxdirect S). Proof. exact: eqnP. Qed. Arguments mxdirectP {n S}. Lemma mxdirect_trivial m n A : mxdirect (unwrap (@trivial_mxsum m n A)). Proof. exact: eqxx. Qed. Lemma mxrank_sum_leqif m n (S : mxsum_expr m n) : \rank (unwrap S) <= unwrap (mxsum_rank S) ?= iff mxdirect (unwrap S). Proof. rewrite /mxdirect_def; case: S => [[A] [r] /= defAr]; split=> //=. elim: m A r / defAr => // m1 m2 A1 A2 r1 r2 _ leAr1 _ leAr2. by apply: leq_trans (leq_add leAr1 leAr2); rewrite mxrank_adds_leqif. Qed. Lemma mxdirectE m n (S : mxsum_expr m n) : mxdirect (unwrap S) = (\rank (unwrap S) == unwrap (mxsum_rank S)). Proof. by []. Qed. Lemma mxdirectEgeq m n (S : mxsum_expr m n) : mxdirect (unwrap S) = (\rank (unwrap S) >= unwrap (mxsum_rank S)). Proof. by rewrite (geq_leqif (mxrank_sum_leqif S)). Qed. Section BinaryDirect. Variables m1 m2 n : nat. Lemma mxdirect_addsE (S1 : mxsum_expr m1 n) (S2 : mxsum_expr m2 n) : mxdirect (unwrap S1 + unwrap S2) = [&& mxdirect (unwrap S1), mxdirect (unwrap S2) & unwrap S1 :&: unwrap S2 == 0]%MS. Proof. rewrite (@mxdirectE n) /=. have:= leqif_add (mxrank_sum_leqif S1) (mxrank_sum_leqif S2). move/(leqif_trans (mxrank_adds_leqif (unwrap S1) (unwrap S2)))=> ->. by rewrite andbC -andbA submx0. Qed. Lemma mxdirect_addsP (A : 'M_(m1, n)) (B : 'M_(m2, n)) : reflect (A :&: B = 0)%MS (mxdirect (A + B)). Proof. by rewrite mxdirect_addsE !mxdirect_trivial; apply: eqP. Qed. End BinaryDirect. Section NaryDirect. Variables (P : pred I) (n : nat). Let TIsum A_ i := (A_ i :&: (\sum_(j | P j && (j != i)) A_ j) = 0 :> 'M_n)%MS. Let mxdirect_sums_recP (S_ : I -> mxsum_expr n n) : reflect (forall i, P i -> mxdirect (unwrap (S_ i)) /\ TIsum (unwrap \o S_) i) (mxdirect (\sum_(i | P i) (unwrap (S_ i)))). Proof. rewrite /TIsum; apply: (iffP eqnP) => /= [dxS i Pi | dxS]. set Si' := (\sum_(j | _) unwrap (S_ j))%MS. have: mxdirect (unwrap (S_ i) + Si') by apply/eqnP; rewrite /= -!(bigD1 i). by rewrite mxdirect_addsE => /and3P[-> _ /eqP]. set Q := P; have [m] := ubnP #|Q|; have: Q \subset P by []. elim: m Q => // m IHm Q /subsetP-sQP. case: (pickP Q) => [i Qi | Q0]; last by rewrite !big_pred0 ?mxrank0. rewrite (cardD1x Qi) !((bigD1 i) Q) //=. move/IHm=> <- {IHm}/=; last by apply/subsetP=> j /andP[/sQP]. case: (dxS i (sQP i Qi)) => /eqnP=> <- TiQ_0; rewrite mxrank_disjoint_sum //. apply/eqP; rewrite -submx0 -{2}TiQ_0 capmxS //=. by apply/sumsmx_subP=> j /= /andP[Qj i'j]; rewrite (sumsmx_sup j) ?[P j]sQP. Qed. Lemma mxdirect_sumsP (A_ : I -> 'M_n) : reflect (forall i, P i -> A_ i :&: (\sum_(j | P j && (j != i)) A_ j) = 0)%MS (mxdirect (\sum_(i | P i) A_ i)). Proof. apply: (iffP (mxdirect_sums_recP _)) => dxA i /dxA; first by case. by rewrite mxdirect_trivial. Qed. Lemma mxdirect_sumsE (S_ : I -> mxsum_expr n n) (xunwrap := unwrap) : reflect (and (forall i, P i -> mxdirect (unwrap (S_ i))) (mxdirect (\sum_(i | P i) (xunwrap (S_ i))))) (mxdirect (\sum_(i | P i) (unwrap (S_ i)))). Proof. apply: (iffP (mxdirect_sums_recP _)) => [dxS | [dxS_ dxS] i Pi]. by do [split; last apply/mxdirect_sumsP] => i; case/dxS. by split; [apply: dxS_ | apply: mxdirect_sumsP Pi]. Qed. End NaryDirect. Section SubDaddsmx. Variables m m1 m2 n : nat. Variables (A : 'M[F]_(m, n)) (B1 : 'M[F]_(m1, n)) (B2 : 'M[F]_(m2, n)). Variant sub_daddsmx_spec : Prop := SubDaddsmxSpec A1 A2 of (A1 <= B1)%MS & (A2 <= B2)%MS & A = A1 + A2 & forall C1 C2, (C1 <= B1)%MS -> (C2 <= B2)%MS -> A = C1 + C2 -> C1 = A1 /\ C2 = A2. Lemma sub_daddsmx : (B1 :&: B2 = 0)%MS -> (A <= B1 + B2)%MS -> sub_daddsmx_spec. Proof. move=> dxB /sub_addsmxP[u defA]. exists (u.1 *m B1) (u.2 *m B2); rewrite ?submxMl // => C1 C2 sCB1 sCB2. move/(canLR (addrK _)) => defC1. suffices: (C2 - u.2 *m B2 <= B1 :&: B2)%MS. by rewrite dxB submx0 subr_eq0 -defC1 defA; move/eqP->; rewrite addrK. rewrite sub_capmx -opprB -{1}(canLR (addKr _) defA) -addrA defC1. by rewrite !(eqmx_opp, addmx_sub) ?submxMl. Qed. End SubDaddsmx. Section SubDsumsmx. Variables (P : pred I) (m n : nat) (A : 'M[F]_(m, n)) (B : I -> 'M[F]_n). Variant sub_dsumsmx_spec : Prop := SubDsumsmxSpec A_ of forall i, P i -> (A_ i <= B i)%MS & A = \sum_(i | P i) A_ i & forall C, (forall i, P i -> C i <= B i)%MS -> A = \sum_(i | P i) C i -> {in SimplPred P, C =1 A_}. Lemma sub_dsumsmx : mxdirect (\sum_(i | P i) B i) -> (A <= \sum_(i | P i) B i)%MS -> sub_dsumsmx_spec. Proof. move/mxdirect_sumsP=> dxB /sub_sumsmxP[u defA]. pose A_ i := u i *m B i. exists A_ => //= [i _ | C sCB defAC i Pi]; first exact: submxMl. apply/eqP; rewrite -subr_eq0 -submx0 -{dxB}(dxB i Pi) /=. rewrite sub_capmx addmx_sub ?eqmx_opp ?submxMl ?sCB //=. rewrite -(subrK A (C i)) -addrA -opprB addmx_sub ?eqmx_opp //. rewrite addrC defAC (bigD1 i) // addKr /= summx_sub // => j Pi'j. by rewrite (sumsmx_sup j) ?sCB //; case/andP: Pi'j. rewrite addrC defA (bigD1 i) // addKr /= summx_sub // => j Pi'j. by rewrite (sumsmx_sup j) ?submxMl. Qed. End SubDsumsmx. Section Eigenspace. Variables (n : nat) (g : 'M_n). Definition eigenspace a := kermx (g - a%:M). Definition eigenvalue : pred F := fun a => eigenspace a != 0. Lemma eigenspaceP a m (W : 'M_(m, n)) : reflect (W *m g = a *: W) (W <= eigenspace a)%MS. Proof. by rewrite sub_kermx mulmxBr subr_eq0 mul_mx_scalar; apply/eqP. Qed. Lemma eigenvalueP a : reflect (exists2 v : 'rV_n, v *m g = a *: v & v != 0) (eigenvalue a). Proof. by apply: (iffP (rowV0Pn _)) => [] [v]; move/eigenspaceP; exists v. Qed. Lemma eigenvectorP {v : 'rV_n} : reflect (exists a, (v <= eigenspace a)%MS) (stablemx v g). Proof. by apply: (iffP (sub_rVP _ _)) => -[a] /eigenspaceP; exists a. Qed. Lemma mxdirect_sum_eigenspace (P : pred I) a_ : {in P &, injective a_} -> mxdirect (\sum_(i | P i) eigenspace (a_ i)). Proof. have [m] := ubnP #|P|; elim: m P => // m IHm P lePm inj_a. apply/mxdirect_sumsP=> i Pi; apply/eqP/rowV0P => v. rewrite sub_capmx => /andP[/eigenspaceP def_vg]. set Vi' := (\sum_(i | _) _)%MS => Vi'v. have dxVi': mxdirect Vi'. rewrite (cardD1x Pi) in lePm; apply: IHm => //. by apply: sub_in2 inj_a => j /andP[]. case/sub_dsumsmx: Vi'v => // u Vi'u def_v _. rewrite def_v big1 // => j Pi'j; apply/eqP. have nz_aij: a_ i - a_ j != 0. by case/andP: Pi'j => Pj ne_ji; rewrite subr_eq0 eq_sym (inj_in_eq inj_a). case: (sub_dsumsmx dxVi' (sub0mx 1 _)) => C _ _ uniqC. rewrite -(eqmx_eq0 (eqmx_scale _ nz_aij)). rewrite (uniqC (fun k => (a_ i - a_ k) *: u k)) => // [|k Pi'k|]. - by rewrite -(uniqC (fun _ => 0)) ?big1 // => k Pi'k; apply: sub0mx. - by rewrite scalemx_sub ?Vi'u. rewrite -{1}(subrr (v *m g)) {1}def_vg def_v scaler_sumr mulmx_suml -sumrB. by apply: eq_bigr => k /Vi'u/eigenspaceP->; rewrite scalerBl. Qed. End Eigenspace. End RowSpaceTheory. Hint Resolve submx_refl : core. Arguments submxP {F m1 m2 n A B}. Arguments eq_row_sub [F m n v A]. Arguments row_subP {F m1 m2 n A B}. Arguments rV_subP {F m1 m2 n A B}. Arguments row_subPn {F m1 m2 n A B}. Arguments sub_rVP {F n u v}. Arguments rV_eqP {F m1 m2 n A B}. Arguments rowV0Pn {F m n A}. Arguments rowV0P {F m n A}. Arguments eqmx0P {F m n A}. Arguments row_fullP {F m n A}. Arguments row_freeP {F m n A}. Arguments eqmxP {F m1 m2 n A B}. Arguments genmxP {F m1 m2 n A B}. Arguments addsmx_idPr {F m1 m2 n A B}. Arguments addsmx_idPl {F m1 m2 n A B}. Arguments sub_addsmxP {F m1 m2 m3 n A B C}. Arguments sumsmx_sup [F I] i0 [P m n A B_]. Arguments sumsmx_subP {F I P m n A_ B}. Arguments sub_sumsmxP {F I P m n A B_}. Arguments sub_kermxP {F p m n A B}. Arguments capmx_idPr {F n m1 m2 A B}. Arguments capmx_idPl {F n m1 m2 A B}. Arguments bigcapmx_inf [F I] i0 [P m n A_ B]. Arguments sub_bigcapmxP {F I P m n A B_}. Arguments mxrank_injP {F m n} p {A f}. Arguments mxdirectP {F n S}. Arguments mxdirect_addsP {F m1 m2 n A B}. Arguments mxdirect_sumsP {F I P n A_}. Arguments mxdirect_sumsE {F I P n S_}. Arguments eigenspaceP {F n g a m W}. Arguments eigenvalueP {F n g a}. Arguments submx_rowsub [F m1 m2 m3 n] h [f g A] _ : rename. Arguments eqmx_rowsub [F m1 m2 m3 n] h [f g A] _ : rename. Arguments mxrank {F m%N n%N} A%MS. Arguments complmx {F m%N n%N} A%MS. Arguments row_full {F m%N n%N} A%MS. Arguments submx {F m1%N m2%N n%N} A%MS B%MS : rename. Arguments ltmx {F m1%N m2%N n%N} A%MS B%MS. Arguments eqmx {F m1%N m2%N n%N} A%MS B%MS. Arguments addsmx {F m1%N m2%N n%N} A%MS B%MS : rename. Arguments capmx {F m1%N m2%N n%N} A%MS B%MS : rename. Arguments diffmx {F m1%N m2%N n%N} A%MS B%MS : rename. Arguments genmx {F m%N n%N} A%R : rename. Notation "\rank A" := (mxrank A) : nat_scope. Notation "<< A >>" := (genmx A) : matrix_set_scope. Notation "A ^C" := (complmx A) : matrix_set_scope. Notation "A <= B" := (submx A B) : matrix_set_scope. Notation "A < B" := (ltmx A B) : matrix_set_scope. Notation "A <= B <= C" := ((submx A B) && (submx B C)) : matrix_set_scope. Notation "A < B <= C" := (ltmx A B && submx B C) : matrix_set_scope. Notation "A <= B < C" := (submx A B && ltmx B C) : matrix_set_scope. Notation "A < B < C" := (ltmx A B && ltmx B C) : matrix_set_scope. Notation "A == B" := ((submx A B) && (submx B A)) : matrix_set_scope. Notation "A :=: B" := (eqmx A B) : matrix_set_scope. Notation "A + B" := (addsmx A B) : matrix_set_scope. Notation "A :&: B" := (capmx A B) : matrix_set_scope. Notation "A :\: B" := (diffmx A B) : matrix_set_scope. Notation mxdirect S := (mxdirect_def (Phantom 'M_(_,_) S%MS)). Notation "\sum_ ( i <- r | P ) B" := (\big[addsmx/0%R]_(i <- r | P%B) B%MS) : matrix_set_scope. Notation "\sum_ ( i <- r ) B" := (\big[addsmx/0%R]_(i <- r) B%MS) : matrix_set_scope. Notation "\sum_ ( m <= i < n | P ) B" := (\big[addsmx/0%R]_(m <= i < n | P%B) B%MS) : matrix_set_scope. Notation "\sum_ ( m <= i < n ) B" := (\big[addsmx/0%R]_(m <= i < n) B%MS) : matrix_set_scope. Notation "\sum_ ( i | P ) B" := (\big[addsmx/0%R]_(i | P%B) B%MS) : matrix_set_scope. Notation "\sum_ i B" := (\big[addsmx/0%R]_i B%MS) : matrix_set_scope. Notation "\sum_ ( i : t | P ) B" := (\big[addsmx/0%R]_(i : t | P%B) B%MS) (only parsing) : matrix_set_scope. Notation "\sum_ ( i : t ) B" := (\big[addsmx/0%R]_(i : t) B%MS) (only parsing) : matrix_set_scope. Notation "\sum_ ( i < n | P ) B" := (\big[addsmx/0%R]_(i < n | P%B) B%MS) : matrix_set_scope. Notation "\sum_ ( i < n ) B" := (\big[addsmx/0%R]_(i < n) B%MS) : matrix_set_scope. Notation "\sum_ ( i 'in' A | P ) B" := (\big[addsmx/0%R]_(i in A | P%B) B%MS) : matrix_set_scope. Notation "\sum_ ( i 'in' A ) B" := (\big[addsmx/0%R]_(i in A) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i <- r | P ) B" := (\big[capmx/1%:M]_(i <- r | P%B) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i <- r ) B" := (\big[capmx/1%:M]_(i <- r) B%MS) : matrix_set_scope. Notation "\bigcap_ ( m <= i < n | P ) B" := (\big[capmx/1%:M]_(m <= i < n | P%B) B%MS) : matrix_set_scope. Notation "\bigcap_ ( m <= i < n ) B" := (\big[capmx/1%:M]_(m <= i < n) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i | P ) B" := (\big[capmx/1%:M]_(i | P%B) B%MS) : matrix_set_scope. Notation "\bigcap_ i B" := (\big[capmx/1%:M]_i B%MS) : matrix_set_scope. Notation "\bigcap_ ( i : t | P ) B" := (\big[capmx/1%:M]_(i : t | P%B) B%MS) (only parsing) : matrix_set_scope. Notation "\bigcap_ ( i : t ) B" := (\big[capmx/1%:M]_(i : t) B%MS) (only parsing) : matrix_set_scope. Notation "\bigcap_ ( i < n | P ) B" := (\big[capmx/1%:M]_(i < n | P%B) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i < n ) B" := (\big[capmx/1%:M]_(i < n) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i 'in' A | P ) B" := (\big[capmx/1%:M]_(i in A | P%B) B%MS) : matrix_set_scope. Notation "\bigcap_ ( i 'in' A ) B" := (\big[capmx/1%:M]_(i in A) B%MS) : matrix_set_scope. Notation stablemx V f := (V%MS *m f%R <= V%MS)%MS. Section Stability. Variable (F : fieldType). Lemma eqmx_stable m m' n (V : 'M[F]_(m, n)) (V' : 'M[F]_(m', n)) (f : 'M[F]_n) : (V :=: V')%MS -> stablemx V f = stablemx V' f. Proof. by move=> eqVV'; rewrite (eqmxMr _ eqVV') eqVV'. Qed. Section FixedDim. Variables (m n : nat) (V W : 'M[F]_(m, n)) (f g : 'M[F]_n). Lemma stablemx_row_base : (stablemx (row_base V) f) = (stablemx V f). Proof. by apply: eqmx_stable; apply: eq_row_base. Qed. Lemma stablemx_full : row_full V -> stablemx V f. Proof. exact: submx_full. Qed. Lemma stablemxM : stablemx V f -> stablemx V g -> stablemx V (f *m g). Proof. by move=> f_stab /(submx_trans _)->//; rewrite mulmxA submxMr. Qed. Lemma stablemxD : stablemx V f -> stablemx V g -> stablemx V (f + g). Proof. by move=> f_stab g_stab; rewrite mulmxDr addmx_sub. Qed. Lemma stablemxN : stablemx V (- f) = stablemx V f. Proof. by rewrite mulmxN eqmx_opp. Qed. Lemma stablemxC x : stablemx V x%:M. Proof. by rewrite mul_mx_scalar scalemx_sub. Qed. Lemma stablemx0 : stablemx V 0. Proof. by rewrite mulmx0 sub0mx. Qed. Lemma stableDmx : stablemx V f -> stablemx W f -> stablemx (V + W)%MS f. Proof. by move=> fV fW; rewrite addsmxMr addsmxS. Qed. Lemma stableNmx : stablemx (- V) f = stablemx V f. Proof. by rewrite mulNmx !eqmx_opp. Qed. Lemma stable0mx : stablemx (0 : 'M_(m, n)) f. Proof. by rewrite mul0mx. Qed. End FixedDim. Lemma stableCmx (m n : nat) x (f : 'M[F]_(m, n)) : stablemx x%:M f. Proof. have [->|x_neq0] := eqVneq x 0; first by rewrite mul_scalar_mx scale0r sub0mx. by rewrite -![x%:M]scalemx1 eqmx_scale// submx_full// -sub1mx. Qed. Lemma stablemx_sums (n : nat) (I : finType) (V_ : I -> 'M[F]_n) (f : 'M_n) : (forall i, stablemx (V_ i) f) -> stablemx (\sum_i V_ i)%MS f. Proof. by move=> fV; rewrite sumsmxMr; apply/sumsmx_subP => i; rewrite (sumsmx_sup i). Qed. Lemma stablemx_unit (n : nat) (V f : 'M[F]_n) : V \in unitmx -> stablemx V f. Proof. by move=> Vunit; rewrite submx_full ?row_full_unit. Qed. Section Commutation. Variable (n : nat). Implicit Types (f g : 'M[F]_n). Lemma comm_mx_stable (f g : 'M[F]_n) : comm_mx f g -> stablemx f g. Proof. by move=> comm_fg; rewrite [_ *m _]comm_fg mulmx_sub. Qed. Lemma comm_mx_stable_ker (f g : 'M[F]_n) : comm_mx f g -> stablemx (kermx f) g. Proof. move=> comm_fg; apply/sub_kermxP. by rewrite -mulmxA -[g *m _]comm_fg mulmxA mulmx_ker mul0mx. Qed. Lemma comm_mx_stable_eigenspace (f g : 'M[F]_n) a : comm_mx f g -> stablemx (eigenspace f a) g. Proof. move=> cfg; rewrite comm_mx_stable_ker//. by apply/comm_mx_sym/comm_mxB => //; apply:comm_mx_scalar. Qed. End Commutation. End Stability. Section DirectSums. Variables (F : fieldType) (I : finType) (P : pred I). Lemma mxdirect_delta n f : {in P &, injective f} -> mxdirect (\sum_(i | P i) <>). Proof. pose fP := image f P => Uf; have UfP: uniq fP by apply/dinjectiveP. suffices /mxdirectP : mxdirect (\sum_i <>). rewrite /= !(bigID [mem fP] predT) -!big_uniq //= !big_map !big_enum. by move/mxdirectP; rewrite mxdirect_addsE => /andP[]. apply/mxdirectP=> /=; transitivity (mxrank (1%:M : 'M[F]_n)). apply/eqmx_rank; rewrite submx1 mx1_sum_delta summx_sub_sums // => i _. by rewrite -(mul_delta_mx (0 : 'I_1)) genmxE submxMl. rewrite mxrank1 -[LHS]card_ord -sum1_card. by apply/eq_bigr=> i _; rewrite /= mxrank_gen mxrank_delta. Qed. End DirectSums. Section CardGL. Variable F : finFieldType. Lemma card_GL n : n > 0 -> #|'GL_n[F]| = (#|F| ^ 'C(n, 2) * \prod_(1 <= i < n.+1) (#|F| ^ i - 1))%N. Proof. case: n => // n' _; set n := n'.+1; set p := #|F|. rewrite big_nat_rev big_add1 -triangular_sum expn_sum -big_split /=. pose fr m := [pred A : 'M[F]_(m, n) | \rank A == m]. set m := n; rewrite [in m.+1]/m; transitivity #|fr m|. by rewrite cardsT /= card_sub; apply: eq_card => A; rewrite -row_free_unit. have: m <= n by []; elim: m => [_ | m IHm /ltnW-le_mn]. rewrite (@eq_card1 _ (0 : 'M_(0, n))) ?big_geq //= => A. by rewrite flatmx0 !inE !eqxx. rewrite big_nat_recr // -{}IHm //= !subSS mulnBr muln1 -expnD subnKC //. rewrite -sum_nat_const /= -sum1_card -add1n. rewrite (partition_big dsubmx (fr m)) /= => [|A]; last first. rewrite !inE -{1}(vsubmxK A); move: {A}(_ A) (_ A) => Ad Au Afull. rewrite eqn_leq rank_leq_row -(leq_add2l (\rank Au)) -mxrank_sum_cap. rewrite {1 3}[@mxrank]lock addsmxE (eqnP Afull) -lock -addnA. by rewrite leq_add ?rank_leq_row ?leq_addr. apply: eq_bigr => A rAm; rewrite (reindex (col_mx^~ A)) /=; last first. exists usubmx => [v _ | vA]; first by rewrite col_mxKu. by case/andP=> _ /eqP <-; rewrite vsubmxK. transitivity #|~: [set v *m A | v in 'rV_m]|; last first. rewrite cardsCs setCK card_imset ?card_matrix ?card_ord ?mul1n //. have [B AB1] := row_freeP rAm; apply: can_inj (mulmx^~ B) _ => v. by rewrite -mulmxA AB1 mulmx1. rewrite -sum1_card; apply: eq_bigl => v; rewrite !inE col_mxKd eqxx. rewrite andbT eqn_leq rank_leq_row /= -(leq_add2r (\rank (v :&: A)%MS)). rewrite -addsmxE mxrank_sum_cap (eqnP rAm) addnAC leq_add2r. rewrite (ltn_leqif (mxrank_leqif_sup _)) ?capmxSl // sub_capmx submx_refl. by congr (~~ _); apply/submxP/imsetP=> [] [u]; exists u. Qed. (* An alternate, somewhat more elementary proof, that does not rely on the *) (* row-space theory, but directly performs the LUP decomposition. *) Lemma LUP_card_GL n : n > 0 -> #|'GL_n[F]| = (#|F| ^ 'C(n, 2) * \prod_(1 <= i < n.+1) (#|F| ^ i - 1))%N. Proof. case: n => // n' _; set n := n'.+1; set p := #|F|. rewrite cardsT /= card_sub /GRing.unit /= big_add1 /= -triangular_sum -/n. elim: {n'}n => [|n IHn]. rewrite !big_geq // mul1n (@eq_card _ _ predT) ?card_matrix //= => M. by rewrite {1}[M]flatmx0 -(flatmx0 1%:M) unitmx1. rewrite !big_nat_recr //= expnD mulnAC mulnA -{}IHn -mulnA mulnC. set LHS := #|_|; rewrite -[n.+1]muln1 -{2}[n]mul1n {}/LHS. rewrite -!card_matrix subn1 -(cardC1 0) -mulnA; set nzC := predC1 _. rewrite -sum1_card (partition_big lsubmx nzC) => [|A]; last first. rewrite unitmxE unitfE; apply: contra; move/eqP=> v0. rewrite -[A]hsubmxK v0 -[n.+1]/(1 + n)%N -col_mx0. rewrite -[rsubmx _]vsubmxK -det_tr tr_row_mx !tr_col_mx !trmx0. by rewrite det_lblock [0]mx11_scalar det_scalar1 mxE mul0r. rewrite -sum_nat_const; apply: eq_bigr => /= v /cV0Pn[k nza]. have xrkK: involutive (@xrow F _ _ 0 k). by move=> m A /=; rewrite /xrow -row_permM tperm2 row_perm1. rewrite (reindex_inj (inv_inj (xrkK (1 + n)%N))) /= -[n.+1]/(1 + n)%N. rewrite (partition_big ursubmx xpredT) //= -sum_nat_const. apply: eq_bigr => u _; set a : F := v _ _ in nza. set v1 : 'cV_(1 + n) := xrow 0 k v. have def_a: usubmx v1 = a%:M. by rewrite [_ v1]mx11_scalar mxE lshift0 mxE tpermL. pose Schur := dsubmx v1 *m (a^-1 *: u). pose L : 'M_(1 + n) := block_mx a%:M 0 (dsubmx v1) 1%:M. pose U B : 'M_(1 + n) := block_mx 1 (a^-1 *: u) 0 B. rewrite (reindex (fun B => L *m U B)); last first. exists (fun A1 => drsubmx A1 - Schur) => [B _ | A1]. by rewrite mulmx_block block_mxKdr mul1mx addrC addKr. rewrite !inE mulmx_block !mulmx0 mul0mx !mulmx1 !addr0 mul1mx addrC subrK. rewrite mul_scalar_mx scalerA divff // scale1r andbC; case/and3P => /eqP <- _. rewrite -{1}(hsubmxK A1) xrowE mul_mx_row row_mxKl -xrowE => /eqP def_v. rewrite -def_a block_mxEh vsubmxK /v1 -def_v xrkK. apply: trmx_inj; rewrite tr_row_mx tr_col_mx trmx_ursub trmx_drsub trmx_lsub. by rewrite hsubmxK vsubmxK. rewrite -sum1_card; apply: eq_bigl => B; rewrite xrowE unitmxE. rewrite !det_mulmx unitrM -unitmxE unitmx_perm det_lblock det_ublock. rewrite !det_scalar1 det1 mulr1 mul1r unitrM unitfE nza -unitmxE. rewrite mulmx_block !mulmx0 mul0mx !addr0 !mulmx1 mul1mx block_mxKur. rewrite mul_scalar_mx scalerA divff // scale1r eqxx andbT. by rewrite block_mxEh mul_mx_row row_mxKl -def_a vsubmxK -xrowE xrkK eqxx andbT. Qed. Lemma card_GL_1 : #|'GL_1[F]| = #|F|.-1. Proof. by rewrite card_GL // mul1n big_nat1 expn1 subn1. Qed. Lemma card_GL_2 : #|'GL_2[F]| = (#|F| * #|F|.-1 ^ 2 * #|F|.+1)%N. Proof. rewrite card_GL // big_ltn // big_nat1 expn1 -(addn1 #|F|) -subn1 -!mulnA. by rewrite -subn_sqr. Qed. End CardGL. Lemma logn_card_GL_p n p : prime p -> logn p #|'GL_n(p)| = 'C(n, 2). Proof. move=> p_pr; have p_gt1 := prime_gt1 p_pr. have p_i_gt0: p ^ _ > 0 by move=> i; rewrite expn_gt0 ltnW. rewrite (card_GL _ (ltn0Sn n.-1)) card_ord Fp_cast // big_add1 /=. pose p'gt0 m := m > 0 /\ logn p m = 0%N. suffices [Pgt0 p'P]: p'gt0 (\prod_(0 <= i < n.-1.+1) (p ^ i.+1 - 1))%N. by rewrite lognM // p'P pfactorK // addn0; case n. apply: big_ind => [|m1 m2 [m10 p'm1] [m20]|i _]; rewrite {}/p'gt0 ?logn1 //. by rewrite muln_gt0 m10 lognM ?p'm1. rewrite lognE -if_neg subn_gt0 p_pr /= -{1 2}(exp1n i.+1) ltn_exp2r // p_gt1. by rewrite dvdn_subr ?dvdn_exp // gtnNdvd. Qed. Section MatrixAlgebra. Variables F : fieldType. Local Notation "A \in R" := (@submx F _ _ _ (mxvec A) R). Lemma mem0mx m n (R : 'A_(m, n)) : 0 \in R. Proof. by rewrite linear0 sub0mx. Qed. Lemma memmx0 n A : (A \in (0 : 'A_n)) -> A = 0. Proof. by rewrite submx0 mxvec_eq0; move/eqP. Qed. Lemma memmx1 n (A : 'M_n) : (A \in mxvec 1%:M) = is_scalar_mx A. Proof. apply/sub_rVP/is_scalar_mxP=> [[a] | [a ->]]. by rewrite -linearZ scale_scalar_mx mulr1 => /(can_inj mxvecK); exists a. by exists a; rewrite -linearZ scale_scalar_mx mulr1. Qed. Lemma memmx_subP m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : reflect (forall A, A \in R1 -> A \in R2) (R1 <= R2)%MS. Proof. apply: (iffP idP) => [sR12 A R1_A | sR12]; first exact: submx_trans sR12. by apply/rV_subP=> vA; rewrite -(vec_mxK vA); apply: sR12. Qed. Arguments memmx_subP {m1 m2 n R1 R2}. Lemma memmx_eqP m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : reflect (forall A, (A \in R1) = (A \in R2)) (R1 == R2)%MS. Proof. apply: (iffP eqmxP) => [eqR12 A | eqR12]; first by rewrite eqR12. by apply/eqmxP/rV_eqP=> vA; rewrite -(vec_mxK vA) eqR12. Qed. Arguments memmx_eqP {m1 m2 n R1 R2}. Lemma memmx_addsP m1 m2 n A (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : reflect (exists D, [/\ D.1 \in R1, D.2 \in R2 & A = D.1 + D.2]) (A \in R1 + R2)%MS. Proof. apply: (iffP sub_addsmxP) => [[u /(canRL mxvecK)->] | [D []]]. exists (vec_mx (u.1 *m R1), vec_mx (u.2 *m R2)). by rewrite /= linearD !vec_mxK !submxMl. case/submxP=> u1 defD1 /submxP[u2 defD2] ->. by exists (u1, u2); rewrite linearD /= defD1 defD2. Qed. Arguments memmx_addsP {m1 m2 n A R1 R2}. Lemma memmx_sumsP (I : finType) (P : pred I) n (A : 'M_n) R_ : reflect (exists2 A_, A = \sum_(i | P i) A_ i & forall i, A_ i \in R_ i) (A \in \sum_(i | P i) R_ i)%MS. Proof. apply: (iffP sub_sumsmxP) => [[C defA] | [A_ -> R_A] {A}]. exists (fun i => vec_mx (C i *m R_ i)) => [|i]. by rewrite -linear_sum -defA /= mxvecK. by rewrite vec_mxK submxMl. exists (fun i => mxvec (A_ i) *m pinvmx (R_ i)). by rewrite linear_sum; apply: eq_bigr => i _; rewrite mulmxKpV. Qed. Arguments memmx_sumsP {I P n A R_}. Lemma has_non_scalar_mxP m n (R : 'A_(m, n)) : (1%:M \in R)%MS -> reflect (exists2 A, A \in R & ~~ is_scalar_mx A)%MS (1 < \rank R). Proof. case: (posnP n) => [-> | n_gt0] in R *; set S := mxvec _ => sSR. by rewrite [R]thinmx0 mxrank0; right; case; rewrite /is_scalar_mx ?insubF. have rankS: \rank S = 1%N. apply/eqP; rewrite eqn_leq rank_leq_row lt0n mxrank_eq0 mxvec_eq0. by rewrite -mxrank_eq0 mxrank1 -lt0n. rewrite -{2}rankS (ltn_leqif (mxrank_leqif_sup sSR)). apply: (iffP idP) => [/row_subPn[i] | [A sAR]]. rewrite -[row i R]vec_mxK memmx1; set A := vec_mx _ => nsA. by exists A; rewrite // vec_mxK row_sub. by rewrite -memmx1; apply/contra/submx_trans. Qed. Definition mulsmx m1 m2 n (R1 : 'A[F]_(m1, n)) (R2 : 'A_(m2, n)) := (\sum_i <>)%MS. Arguments mulsmx {m1%N m2%N n%N} R1%MS R2%MS. Local Notation "R1 * R2" := (mulsmx R1 R2) : matrix_set_scope. Lemma genmx_muls m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : <<(R1 * R2)%MS>>%MS = (R1 * R2)%MS. Proof. by rewrite genmx_sums; apply: eq_bigr => i; rewrite genmx_id. Qed. Lemma mem_mulsmx m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) A1 A2 : (A1 \in R1 -> A2 \in R2 -> A1 *m A2 \in R1 * R2)%MS. Proof. move=> R_A1 R_A2; rewrite -[A2]mxvecK; case/submxP: R_A2 => a ->{A2}. rewrite mulmx_sum_row !linear_sum summx_sub // => i _. rewrite !linearZ scalemx_sub {a}//= (sumsmx_sup i) // genmxE. rewrite -[A1]mxvecK; case/submxP: R_A1 => a ->{A1}. by apply/submxP; exists a; rewrite mulmxA mul_rV_lin. Qed. Lemma mulsmx_subP m1 m2 m n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R : 'A_(m, n)) : reflect (forall A1 A2, A1 \in R1 -> A2 \in R2 -> A1 *m A2 \in R) (R1 * R2 <= R)%MS. Proof. apply: (iffP memmx_subP) => [sR12R A1 A2 R_A1 R_A2 | sR12R A]. by rewrite sR12R ?mem_mulsmx. case/memmx_sumsP=> A_ -> R_A; rewrite linear_sum summx_sub //= => j _. rewrite (submx_trans (R_A _)) // genmxE; apply/row_subP=> i. by rewrite row_mul mul_rV_lin sR12R ?vec_mxK ?row_sub. Qed. Arguments mulsmx_subP {m1 m2 m n R1 R2 R}. Lemma mulsmxS m1 m2 m3 m4 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R3 : 'A_(m3, n)) (R4 : 'A_(m4, n)) : (R1 <= R3 -> R2 <= R4 -> R1 * R2 <= R3 * R4)%MS. Proof. move=> sR13 sR24; apply/mulsmx_subP=> A1 A2 R_A1 R_A2. by apply: mem_mulsmx; [apply: submx_trans sR13 | apply: submx_trans sR24]. Qed. Lemma muls_eqmx m1 m2 m3 m4 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R3 : 'A_(m3, n)) (R4 : 'A_(m4, n)) : (R1 :=: R3 -> R2 :=: R4 -> R1 * R2 = R3 * R4)%MS. Proof. move=> eqR13 eqR24; rewrite -(genmx_muls R1 R2) -(genmx_muls R3 R4). by apply/genmxP; rewrite !mulsmxS ?eqR13 ?eqR24. Qed. Lemma mulsmxP m1 m2 n A (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : reflect (exists2 A1, forall i, A1 i \in R1 & exists2 A2, forall i, A2 i \in R2 & A = \sum_(i < n ^ 2) A1 i *m A2 i) (A \in R1 * R2)%MS. Proof. apply: (iffP idP) => [R_A|[A1 R_A1 [A2 R_A2 ->{A}]]]; last first. by rewrite linear_sum summx_sub // => i _; rewrite mem_mulsmx. have{R_A}: (A \in R1 * <>)%MS. by apply: memmx_subP R_A; rewrite mulsmxS ?genmxE. case/memmx_sumsP=> A_ -> R_A; pose A2_ i := vec_mx (row i <>%MS). pose A1_ i := mxvec (A_ i) *m pinvmx (R1 *m lin_mx (mulmxr (A2_ i))) *m R1. exists (vec_mx \o A1_) => [i|]; first by rewrite vec_mxK submxMl. exists A2_ => [i|]; first by rewrite vec_mxK -(genmxE R2) row_sub. apply: eq_bigr => i _; rewrite -[_ *m _](mx_rV_lin (mulmxr_linear _ _)). by rewrite -mulmxA mulmxKpV ?mxvecK // -(genmxE (_ *m _)) R_A. Qed. Arguments mulsmxP {m1 m2 n A R1 R2}. Lemma mulsmxA m1 m2 m3 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R3 : 'A_(m3, n)) : (R1 * (R2 * R3) = R1 * R2 * R3)%MS. Proof. rewrite -(genmx_muls (_ * _)%MS) -genmx_muls; apply/genmxP/andP; split. apply/mulsmx_subP=> A1 A23 R_A1; case/mulsmxP=> A2 R_A2 [A3 R_A3 ->{A23}]. by rewrite !linear_sum summx_sub //= => i _; rewrite mulmxA !mem_mulsmx. apply/mulsmx_subP=> _ A3 /mulsmxP[A1 R_A1 [A2 R_A2 ->]] R_A3. rewrite mulmx_suml linear_sum summx_sub //= => i _. by rewrite -mulmxA !mem_mulsmx. Qed. Lemma mulsmxDl m1 m2 m3 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R3 : 'A_(m3, n)) : ((R1 + R2) * R3 = R1 * R3 + R2 * R3)%MS. Proof. rewrite -(genmx_muls R2 R3) -(genmx_muls R1 R3) -genmx_muls -genmx_adds. apply/genmxP; rewrite andbC addsmx_sub !mulsmxS ?addsmxSl ?addsmxSr //=. apply/mulsmx_subP=> _ A3 /memmx_addsP[A [R_A1 R_A2 ->]] R_A3. by rewrite mulmxDl linearD addmx_sub_adds ?mem_mulsmx. Qed. Lemma mulsmxDr m1 m2 m3 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) (R3 : 'A_(m3, n)) : (R1 * (R2 + R3) = R1 * R2 + R1 * R3)%MS. Proof. rewrite -(genmx_muls R1 R3) -(genmx_muls R1 R2) -genmx_muls -genmx_adds. apply/genmxP; rewrite andbC addsmx_sub !mulsmxS ?addsmxSl ?addsmxSr //=. apply/mulsmx_subP=> A1 _ R_A1 /memmx_addsP[A [R_A2 R_A3 ->]]. by rewrite mulmxDr linearD addmx_sub_adds ?mem_mulsmx. Qed. Lemma mulsmx0 m1 m2 n (R1 : 'A_(m1, n)) : (R1 * (0 : 'A_(m2, n)) = 0)%MS. Proof. apply/eqP; rewrite -submx0; apply/mulsmx_subP=> A1 A0 _. by rewrite [A0 \in 0]eqmx0 => /memmx0->; rewrite mulmx0 mem0mx. Qed. Lemma muls0mx m1 m2 n (R2 : 'A_(m2, n)) : ((0 : 'A_(m1, n)) * R2 = 0)%MS. Proof. apply/eqP; rewrite -submx0; apply/mulsmx_subP=> A0 A2. by rewrite [A0 \in 0]eqmx0 => /memmx0->; rewrite mul0mx mem0mx. Qed. Definition left_mx_ideal m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) := (R1 * R2 <= R2)%MS. Definition right_mx_ideal m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) := (R2 * R1 <= R2)%MS. Definition mx_ideal m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) := left_mx_ideal R1 R2 && right_mx_ideal R1 R2. Definition mxring_id m n (R : 'A_(m, n)) e := [/\ e != 0, e \in R, forall A, A \in R -> e *m A = A & forall A, A \in R -> A *m e = A]%MS. Definition has_mxring_id m n (R : 'A[F]_(m , n)) := (R != 0) && (row_mx 0 (row_mx (mxvec R) (mxvec R)) <= row_mx (cokermx R) (row_mx (lin_mx (mulmx R \o lin_mulmx)) (lin_mx (mulmx R \o lin_mulmxr))))%MS. Definition mxring m n (R : 'A_(m, n)) := left_mx_ideal R R && has_mxring_id R. Lemma mxring_idP m n (R : 'A_(m, n)) : reflect (exists e, mxring_id R e) (has_mxring_id R). Proof. apply: (iffP andP) => [[nzR] | [e [nz_e Re ideR idRe]]]. case/submxP=> v; rewrite -[v]vec_mxK; move/vec_mx: v => e. rewrite !mul_mx_row; case/eq_row_mx => /eqP. rewrite eq_sym -submxE => Re. case/eq_row_mx; rewrite !{1}mul_rV_lin1 /= mxvecK. set u := (_ *m _) => /(can_inj mxvecK) idRe /(can_inj mxvecK) ideR. exists e; split=> // [ | A /submxP[a defA] | A /submxP[a defA]]. - by apply: contra nzR; rewrite ideR => /eqP->; rewrite !linear0. - by rewrite -{2}[A]mxvecK defA idRe mulmxA mx_rV_lin -defA /= mxvecK. by rewrite -{2}[A]mxvecK defA ideR mulmxA mx_rV_lin -defA /= mxvecK. split. by apply: contraNneq nz_e => R0; rewrite R0 eqmx0 in Re; rewrite (memmx0 Re). apply/submxP; exists (mxvec e); rewrite !mul_mx_row !{1}mul_rV_lin1. rewrite submxE in Re; rewrite {Re}(eqP Re). congr (row_mx 0 (row_mx (mxvec _) (mxvec _))); apply/row_matrixP=> i. by rewrite !row_mul !mul_rV_lin1 /= mxvecK ideR vec_mxK ?row_sub. by rewrite !row_mul !mul_rV_lin1 /= mxvecK idRe vec_mxK ?row_sub. Qed. Arguments mxring_idP {m n R}. Section CentMxDef. Variables (m n : nat) (R : 'A[F]_(m, n)). Definition cent_mx_fun (B : 'M[F]_n) := R *m lin_mx (mulmxr B \- mulmx B). Lemma cent_mx_fun_is_linear : linear cent_mx_fun. Proof. move=> a A B; apply/row_matrixP=> i; rewrite linearP row_mul mul_rV_lin. rewrite /= [row i _ as v in a *: v]row_mul mul_rV_lin row_mul mul_rV_lin. by rewrite -linearP -(linearP [linear of mulmx _ \- mulmxr _]). Qed. Canonical cent_mx_fun_additive := Additive cent_mx_fun_is_linear. Canonical cent_mx_fun_linear := Linear cent_mx_fun_is_linear. Definition cent_mx := kermx (lin_mx cent_mx_fun). Definition center_mx := (R :&: cent_mx)%MS. End CentMxDef. Local Notation "''C' ( R )" := (cent_mx R) : matrix_set_scope. Local Notation "''Z' ( R )" := (center_mx R) : matrix_set_scope. Lemma cent_rowP m n B (R : 'A_(m, n)) : reflect (forall i (A := vec_mx (row i R)), A *m B = B *m A) (B \in 'C(R))%MS. Proof. apply: (iffP sub_kermxP); rewrite mul_vec_lin => cBE. move/(canRL mxvecK): cBE => cBE i A /=; move/(congr1 (row i)): cBE. rewrite row_mul mul_rV_lin -/A; move/(canRL mxvecK). by move/(canRL (subrK _)); rewrite !linear0 add0r. apply: (canLR vec_mxK); apply/row_matrixP=> i. by rewrite row_mul mul_rV_lin /= cBE subrr !linear0. Qed. Arguments cent_rowP {m n B R}. Lemma cent_mxP m n B (R : 'A_(m, n)) : reflect (forall A, A \in R -> A *m B = B *m A) (B \in 'C(R))%MS. Proof. apply: (iffP cent_rowP) => cEB => [A sAE | i A]. rewrite -[A]mxvecK -(mulmxKpV sAE); move: (mxvec A *m _) => u. rewrite !mulmx_sum_row !linear_sum mulmx_suml; apply: eq_bigr => i _ /=. by rewrite !linearZ -scalemxAl /= cEB. by rewrite cEB // vec_mxK row_sub. Qed. Arguments cent_mxP {m n B R}. Lemma scalar_mx_cent m n a (R : 'A_(m, n)) : (a%:M \in 'C(R))%MS. Proof. by apply/cent_mxP=> A _; apply: scalar_mxC. Qed. Lemma center_mx_sub m n (R : 'A_(m, n)) : ('Z(R) <= R)%MS. Proof. exact: capmxSl. Qed. Lemma center_mxP m n A (R : 'A_(m, n)) : reflect (A \in R /\ forall B, B \in R -> B *m A = A *m B) (A \in 'Z(R))%MS. Proof. rewrite sub_capmx; case R_A: (A \in R); last by right; case. by apply: (iffP cent_mxP) => [cAR | [_ cAR]]. Qed. Arguments center_mxP {m n A R}. Lemma mxring_id_uniq m n (R : 'A_(m, n)) e1 e2 : mxring_id R e1 -> mxring_id R e2 -> e1 = e2. Proof. by case=> [_ Re1 idRe1 _] [_ Re2 _ ide2R]; rewrite -(idRe1 _ Re2) ide2R. Qed. Lemma cent_mx_ideal m n (R : 'A_(m, n)) : left_mx_ideal 'C(R)%MS 'C(R)%MS. Proof. apply/mulsmx_subP=> A1 A2 C_A1 C_A2; apply/cent_mxP=> B R_B. by rewrite mulmxA (cent_mxP C_A1) // -!mulmxA (cent_mxP C_A2). Qed. Lemma cent_mx_ring m n (R : 'A_(m, n)) : n > 0 -> mxring 'C(R)%MS. Proof. move=> n_gt0; rewrite /mxring cent_mx_ideal; apply/mxring_idP. exists 1%:M; split=> [||A _|A _]; rewrite ?mulmx1 ?mul1mx ?scalar_mx_cent //. by rewrite -mxrank_eq0 mxrank1 -lt0n. Qed. Lemma mxdirect_adds_center m1 m2 n (R1 : 'A_(m1, n)) (R2 : 'A_(m2, n)) : mx_ideal (R1 + R2)%MS R1 -> mx_ideal (R1 + R2)%MS R2 -> mxdirect (R1 + R2) -> ('Z((R1 + R2)%MS) :=: 'Z(R1) + 'Z(R2))%MS. Proof. case/andP=> idlR1 idrR1 /andP[idlR2 idrR2] /mxdirect_addsP dxR12. apply/eqmxP/andP; split. apply/memmx_subP=> z0; rewrite sub_capmx => /andP[]. case/memmx_addsP=> z [R1z1 R2z2 ->{z0}] Cz. rewrite linearD addmx_sub_adds //= ?sub_capmx ?R1z1 ?R2z2 /=. apply/cent_mxP=> A R1_A; have R_A := submx_trans R1_A (addsmxSl R1 R2). have Rz2 := submx_trans R2z2 (addsmxSr R1 R2). rewrite -{1}[z.1](addrK z.2) mulmxBr (cent_mxP Cz) // mulmxDl. rewrite [A *m z.2]memmx0 1?[z.2 *m A]memmx0 ?addrK //. by rewrite -dxR12 sub_capmx (mulsmx_subP idlR1) // (mulsmx_subP idrR2). by rewrite -dxR12 sub_capmx (mulsmx_subP idrR1) // (mulsmx_subP idlR2). apply/cent_mxP=> A R2_A; have R_A := submx_trans R2_A (addsmxSr R1 R2). have Rz1 := submx_trans R1z1 (addsmxSl R1 R2). rewrite -{1}[z.2](addKr z.1) mulmxDr (cent_mxP Cz) // mulmxDl. rewrite mulmxN [A *m z.1]memmx0 1?[z.1 *m A]memmx0 ?addKr //. by rewrite -dxR12 sub_capmx (mulsmx_subP idrR1) // (mulsmx_subP idlR2). by rewrite -dxR12 sub_capmx (mulsmx_subP idlR1) // (mulsmx_subP idrR2). rewrite addsmx_sub; apply/andP; split. apply/memmx_subP=> z; rewrite sub_capmx => /andP[R1z cR1z]. have Rz := submx_trans R1z (addsmxSl R1 R2). rewrite sub_capmx Rz; apply/cent_mxP=> A0. case/memmx_addsP=> A [R1_A1 R2_A2] ->{A0}. have R_A2 := submx_trans R2_A2 (addsmxSr R1 R2). rewrite mulmxDl mulmxDr (cent_mxP cR1z) //; congr (_ + _). rewrite [A.2 *m z]memmx0 1?[z *m A.2]memmx0 //. by rewrite -dxR12 sub_capmx (mulsmx_subP idrR1) // (mulsmx_subP idlR2). by rewrite -dxR12 sub_capmx (mulsmx_subP idlR1) // (mulsmx_subP idrR2). apply/memmx_subP=> z; rewrite !sub_capmx => /andP[R2z cR2z]. have Rz := submx_trans R2z (addsmxSr R1 R2); rewrite Rz. apply/cent_mxP=> _ /memmx_addsP[A [R1_A1 R2_A2 ->]]. rewrite mulmxDl mulmxDr (cent_mxP cR2z _ R2_A2) //; congr (_ + _). have R_A1 := submx_trans R1_A1 (addsmxSl R1 R2). rewrite [A.1 *m z]memmx0 1?[z *m A.1]memmx0 //. by rewrite -dxR12 sub_capmx (mulsmx_subP idlR1) // (mulsmx_subP idrR2). by rewrite -dxR12 sub_capmx (mulsmx_subP idrR1) // (mulsmx_subP idlR2). Qed. Lemma mxdirect_sums_center (I : finType) m n (R : 'A_(m, n)) R_ : (\sum_i R_ i :=: R)%MS -> mxdirect (\sum_i R_ i) -> (forall i : I, mx_ideal R (R_ i)) -> ('Z(R) :=: \sum_i 'Z(R_ i))%MS. Proof. move=> defR dxR idealR. have sR_R: (R_ _ <= R)%MS by move=> i; rewrite -defR (sumsmx_sup i). have anhR i j A B : i != j -> A \in R_ i -> B \in R_ j -> A *m B = 0. move=> ne_ij RiA RjB; apply: memmx0. have [[_ idRiR] [idRRj _]] := (andP (idealR i), andP (idealR j)). rewrite -(mxdirect_sumsP dxR j) // sub_capmx (sumsmx_sup i) //. by rewrite (mulsmx_subP idRRj) // (memmx_subP (sR_R i)). by rewrite (mulsmx_subP idRiR) // (memmx_subP (sR_R j)). apply/eqmxP/andP; split. apply/memmx_subP=> Z; rewrite sub_capmx => /andP[]. rewrite -{1}defR => /memmx_sumsP[z ->{Z} Rz cRz]. apply/memmx_sumsP; exists z => // i; rewrite sub_capmx Rz. apply/cent_mxP=> A RiA; have:= cent_mxP cRz A (memmx_subP (sR_R i) A RiA). rewrite (bigD1 i) //= mulmxDl mulmxDr mulmx_suml mulmx_sumr. by rewrite !big1 ?addr0 // => j; last rewrite eq_sym; move/anhR->. apply/sumsmx_subP => i _; apply/memmx_subP=> z; rewrite sub_capmx. case/andP=> Riz cRiz; rewrite sub_capmx (memmx_subP (sR_R i)) //=. apply/cent_mxP=> A; rewrite -{1}defR; case/memmx_sumsP=> a -> R_a. rewrite (bigD1 i) // mulmxDl mulmxDr mulmx_suml mulmx_sumr. rewrite !big1 => [|j|j]; first by rewrite !addr0 (cent_mxP cRiz). by rewrite eq_sym => /anhR->. by move/anhR->. Qed. End MatrixAlgebra. Arguments mulsmx {F m1%N m2%N n%N} R1%MS R2%MS. Arguments left_mx_ideal {F m1%N m2%N n%N} R%MS S%MS : rename. Arguments right_mx_ideal {F m1%N m2%N n%N} R%MS S%MS : rename. Arguments mx_ideal {F m1%N m2%N n%N} R%MS S%MS : rename. Arguments mxring_id {F m%N n%N} R%MS e%R. Arguments has_mxring_id {F m%N n%N} R%MS. Arguments mxring {F m%N n%N} R%MS. Arguments cent_mx {F m%N n%N} R%MS. Arguments center_mx {F m%N n%N} R%MS. Notation "A \in R" := (submx (mxvec A) R) : matrix_set_scope. Notation "R * S" := (mulsmx R S) : matrix_set_scope. Notation "''C' ( R )" := (cent_mx R) : matrix_set_scope. Notation "''C_' R ( S )" := (R :&: 'C(S))%MS : matrix_set_scope. Notation "''C_' ( R ) ( S )" := ('C_R(S))%MS (only parsing) : matrix_set_scope. Notation "''Z' ( R )" := (center_mx R) : matrix_set_scope. Arguments memmx_subP {F m1 m2 n R1 R2}. Arguments memmx_eqP {F m1 m2 n R1 R2}. Arguments memmx_addsP {F m1 m2 n} A {R1 R2}. Arguments memmx_sumsP {F I P n A R_}. Arguments mulsmx_subP {F m1 m2 m n R1 R2 R}. Arguments mulsmxP {F m1 m2 n A R1 R2}. Arguments mxring_idP F {m n R}. Arguments cent_rowP {F m n B R}. Arguments cent_mxP {F m n B R}. Arguments center_mxP {F m n A R}. (* Parametricity for the row-space/F-algebra theory. *) Section MapMatrixSpaces. Variables (aF rF : fieldType) (f : {rmorphism aF -> rF}). Local Notation "A ^f" := (map_mx f A) : ring_scope. Lemma Gaussian_elimination_map m n (A : 'M_(m, n)) : Gaussian_elimination A^f = ((col_ebase A)^f, (row_ebase A)^f, \rank A). Proof. rewrite mxrankE /row_ebase /col_ebase unlock. elim: m n A => [|m IHm] [|n] A /=; rewrite ?map_mx1 //. set pAnz := [pred k | A k.1 k.2 != 0]. rewrite (@eq_pick _ _ pAnz) => [|k]; last by rewrite /= mxE fmorph_eq0. case: {+}(pick _) => [[i j]|]; last by rewrite !map_mx1. rewrite mxE -fmorphV -map_xcol -map_xrow -map_dlsubmx -map_drsubmx. rewrite -map_ursubmx -map_mxZ -map_mxM -map_mxB {}IHm /=. case: {+}(Gaussian_elimination _) => [[L U] r] /=; rewrite map_xrow map_xcol. by rewrite !(@map_block_mx _ _ f 1 _ 1) !map_mx0 ?map_mx1 ?map_scalar_mx. Qed. Lemma mxrank_map m n (A : 'M_(m, n)) : \rank A^f = \rank A. Proof. by rewrite mxrankE Gaussian_elimination_map. Qed. Lemma row_free_map m n (A : 'M_(m, n)) : row_free A^f = row_free A. Proof. by rewrite /row_free mxrank_map. Qed. Lemma row_full_map m n (A : 'M_(m, n)) : row_full A^f = row_full A. Proof. by rewrite /row_full mxrank_map. Qed. Lemma map_row_ebase m n (A : 'M_(m, n)) : (row_ebase A)^f = row_ebase A^f. Proof. by rewrite {2}/row_ebase unlock Gaussian_elimination_map. Qed. Lemma map_col_ebase m n (A : 'M_(m, n)) : (col_ebase A)^f = col_ebase A^f. Proof. by rewrite {2}/col_ebase unlock Gaussian_elimination_map. Qed. Lemma map_row_base m n (A : 'M_(m, n)) : (row_base A)^f = castmx (mxrank_map A, erefl n) (row_base A^f). Proof. move: (mxrank_map A); rewrite {2}/row_base mxrank_map => eqrr. by rewrite castmx_id map_mxM map_pid_mx map_row_ebase. Qed. Lemma map_col_base m n (A : 'M_(m, n)) : (col_base A)^f = castmx (erefl m, mxrank_map A) (col_base A^f). Proof. move: (mxrank_map A); rewrite {2}/col_base mxrank_map => eqrr. by rewrite castmx_id map_mxM map_pid_mx map_col_ebase. Qed. Lemma map_pinvmx m n (A : 'M_(m, n)) : (pinvmx A)^f = pinvmx A^f. Proof. rewrite !map_mxM !map_invmx map_row_ebase map_col_ebase. by rewrite map_pid_mx -mxrank_map. Qed. Lemma map_kermx m n (A : 'M_(m, n)) : (kermx A)^f = kermx A^f. Proof. by rewrite !map_mxM map_invmx map_col_ebase -mxrank_map map_copid_mx. Qed. Lemma map_cokermx m n (A : 'M_(m, n)) : (cokermx A)^f = cokermx A^f. Proof. by rewrite !map_mxM map_invmx map_row_ebase -mxrank_map map_copid_mx. Qed. Lemma map_submx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A^f <= B^f)%MS = (A <= B)%MS. Proof. by rewrite !submxE -map_cokermx -map_mxM map_mx_eq0. Qed. Lemma map_ltmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A^f < B^f)%MS = (A < B)%MS. Proof. by rewrite /ltmx !map_submx. Qed. Lemma map_eqmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A^f :=: B^f)%MS <-> (A :=: B)%MS. Proof. split=> [/eqmxP|eqAB]; first by rewrite !map_submx => /eqmxP. by apply/eqmxP; rewrite !map_submx !eqAB !submx_refl. Qed. Lemma map_genmx m n (A : 'M_(m, n)) : (<>^f :=: <>)%MS. Proof. by apply/eqmxP; rewrite !(genmxE, map_submx) andbb. Qed. Lemma map_addsmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (((A + B)%MS)^f :=: A^f + B^f)%MS. Proof. by apply/eqmxP; rewrite !addsmxE -map_col_mx !map_submx !addsmxE andbb. Qed. Lemma map_capmx_gen m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (capmx_gen A B)^f = capmx_gen A^f B^f. Proof. by rewrite map_mxM map_lsubmx map_kermx map_col_mx. Qed. Lemma map_capmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : ((A :&: B)^f :=: A^f :&: B^f)%MS. Proof. by apply/eqmxP; rewrite !capmxE -map_capmx_gen !map_submx -!capmxE andbb. Qed. Lemma map_complmx m n (A : 'M_(m, n)) : (A^C^f = A^f^C)%MS. Proof. by rewrite map_mxM map_row_ebase -mxrank_map map_copid_mx. Qed. Lemma map_diffmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) : ((A :\: B)^f :=: A^f :\: B^f)%MS. Proof. apply/eqmxP; rewrite !diffmxE -map_capmx_gen -map_complmx. by rewrite -!map_capmx !map_submx -!diffmxE andbb. Qed. Lemma map_eigenspace n (g : 'M_n) a : (eigenspace g a)^f = eigenspace g^f (f a). Proof. by rewrite map_kermx map_mxB ?map_scalar_mx. Qed. Lemma eigenvalue_map n (g : 'M_n) a : eigenvalue g^f (f a) = eigenvalue g a. Proof. by rewrite /eigenvalue -map_eigenspace map_mx_eq0. Qed. Lemma memmx_map m n A (E : 'A_(m, n)) : (A^f \in E^f)%MS = (A \in E)%MS. Proof. by rewrite -map_mxvec map_submx. Qed. Lemma map_mulsmx m1 m2 n (E1 : 'A_(m1, n)) (E2 : 'A_(m2, n)) : ((E1 * E2)%MS^f :=: E1^f * E2^f)%MS. Proof. rewrite /mulsmx; elim/big_rec2: _ => [|i A Af _ eqA]; first by rewrite map_mx0. apply: (eqmx_trans (map_addsmx _ _)); apply: adds_eqmx {A Af}eqA. apply/eqmxP; rewrite !map_genmx !genmxE map_mxM. apply/rV_eqP=> u; congr (u <= _ *m _)%MS. by apply: map_lin_mx => //= A; rewrite map_mxM // map_vec_mx map_row. Qed. Lemma map_cent_mx m n (E : 'A_(m, n)) : ('C(E)%MS)^f = 'C(E^f)%MS. Proof. rewrite map_kermx; congr kermx; apply: map_lin_mx => A; rewrite map_mxM. by congr (_ *m _); apply: map_lin_mx => B; rewrite map_mxB ?map_mxM. Qed. Lemma map_center_mx m n (E : 'A_(m, n)) : (('Z(E))^f :=: 'Z(E^f))%MS. Proof. by rewrite /center_mx -map_cent_mx; apply: map_capmx. Qed. End MapMatrixSpaces. Notation "@ 'mulsmx_addl'" := (deprecate mulsmx_addl mulsmxDl) (at level 10, only parsing) : fun_scope. Notation "@ 'mulsmx_addr'" := (deprecate mulsmx_addr mulsmxDr) (at level 10, only parsing) : fun_scope. Notation mulsmx_addl := (@mulsmx_addl _ _ _ _ _) (only parsing). Notation mulsmx_addr := (@mulsmx_addr _ _ _ _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/mxpoly.v000066400000000000000000001656271375767750300222570ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype tuple finfun bigop fingroup perm. From mathcomp Require Import ssralg zmodp matrix mxalgebra poly polydiv. (******************************************************************************) (* This file provides basic support for formal computation with matrices, *) (* mainly results combining matrices and univariate polynomials, such as the *) (* Cayley-Hamilton theorem; it also contains an extension of the first order *) (* representation of algebra introduced in ssralg (GRing.term/formula). *) (* rVpoly v == the little-endian decoding of the row vector v as a *) (* polynomial p = \sum_i (v 0 i)%:P * 'X^i. *) (* poly_rV p == the partial inverse to rVpoly, for polynomials of degree *) (* less than d to 'rV_d (d is inferred from the context). *) (* Sylvester_mx p q == the Sylvester matrix of p and q. *) (* resultant p q == the resultant of p and q, i.e., \det (Sylvester_mx p q). *) (* horner_mx A == the morphism from {poly R} to 'M_n (n of the form n'.+1) *) (* mapping a (scalar) polynomial p to the value of its *) (* scalar matrix interpretation at A (this is an instance of *) (* the generic horner_morph construct defined in poly). *) (* powers_mx A d == the d x (n ^ 2) matrix whose rows are the mxvec encodings *) (* of the first d powers of A (n of the form n'.+1). Thus, *) (* vec_mx (v *m powers_mx A d) = horner_mx A (rVpoly v). *) (* char_poly A == the characteristic polynomial of A. *) (* char_poly_mx A == a matrix whose determinant is char_poly A. *) (* companionmx p == a matrix whose char_poly is p *) (* mxminpoly A == the minimal polynomial of A, i.e., the smallest monic *) (* polynomial that annihilates A (A must be nontrivial). *) (* degree_mxminpoly A == the (positive) degree of mxminpoly A. *) (* mx_inv_horner A == the inverse of horner_mx A for polynomials of degree *) (* smaller than degree_mxminpoly A. *) (* kermxpoly g p == the kernel of p(g) *) (* geigenspace g a == the generalized eigenspace of g for eigenvalue a *) (* := kermxpoly g ('X ^ n - a%:P) where g : 'M_n *) (* eigenpoly g p <=> p is an eigen polynomial for g, i.e. kermxpoly g p != 0 *) (* integralOver RtoK u <-> u is in the integral closure of the image of R *) (* under RtoK : R -> K, i.e. u is a root of the image of a *) (* monic polynomial in R. *) (* algebraicOver FtoE u <-> u : E is algebraic over E; it is a root of the *) (* image of a nonzero polynomial under FtoE; as F must be a *) (* fieldType, this is equivalent to integralOver FtoE u. *) (* integralRange RtoK <-> the integral closure of the image of R contains *) (* all of K (:= forall u, integralOver RtoK u). *) (* This toolkit for building formal matrix expressions is packaged in the *) (* MatrixFormula submodule, and comprises the following: *) (* eval_mx e == GRing.eval lifted to matrices (:= map_mx (GRing.eval e)). *) (* mx_term A == GRing.Const lifted to matrices. *) (* mulmx_term A B == the formal product of two matrices of terms. *) (* mxrank_form m A == a GRing.formula asserting that the interpretation of *) (* the term matrix A has rank m. *) (* submx_form A B == a GRing.formula asserting that the row space of the *) (* interpretation of the term matrix A is included in the *) (* row space of the interpretation of B. *) (* seq_of_rV v == the seq corresponding to a row vector. *) (* row_env e == the flattening of a tensored environment e : seq 'rV_d. *) (* row_var F d k == the term vector of width d such that for e : seq 'rV[F]_d *) (* we have eval e 'X_k = eval_mx (row_env e) (row_var d k). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Import Monoid.Theory. Local Open Scope ring_scope. Import Pdiv.Idomain. (* Row vector <-> bounded degree polynomial bijection *) Section RowPoly. Variables (R : ringType) (d : nat). Implicit Types u v : 'rV[R]_d. Implicit Types p q : {poly R}. Definition rVpoly v := \poly_(k < d) (if insub k is Some i then v 0 i else 0). Definition poly_rV p := \row_(i < d) p`_i. Lemma coef_rVpoly v k : (rVpoly v)`_k = if insub k is Some i then v 0 i else 0. Proof. by rewrite coef_poly; case: insubP => [i ->|]; rewrite ?if_same. Qed. Lemma coef_rVpoly_ord v (i : 'I_d) : (rVpoly v)`_i = v 0 i. Proof. by rewrite coef_rVpoly valK. Qed. Lemma rVpoly_delta i : rVpoly (delta_mx 0 i) = 'X^i. Proof. apply/polyP=> j; rewrite coef_rVpoly coefXn. case: insubP => [k _ <- | j_ge_d]; first by rewrite mxE. by case: eqP j_ge_d => // ->; rewrite ltn_ord. Qed. Lemma rVpolyK : cancel rVpoly poly_rV. Proof. by move=> u; apply/rowP=> i; rewrite mxE coef_rVpoly_ord. Qed. Lemma poly_rV_K p : size p <= d -> rVpoly (poly_rV p) = p. Proof. move=> le_p_d; apply/polyP=> k; rewrite coef_rVpoly. case: insubP => [i _ <- | ]; first by rewrite mxE. by rewrite -ltnNge => le_d_l; rewrite nth_default ?(leq_trans le_p_d). Qed. Lemma poly_rV_is_linear : linear poly_rV. Proof. by move=> a p q; apply/rowP=> i; rewrite !mxE coefD coefZ. Qed. Canonical poly_rV_additive := Additive poly_rV_is_linear. Canonical poly_rV_linear := Linear poly_rV_is_linear. Lemma rVpoly_is_linear : linear rVpoly. Proof. move=> a u v; apply/polyP=> k; rewrite coefD coefZ !coef_rVpoly. by case: insubP => [i _ _ | _]; rewrite ?mxE // mulr0 addr0. Qed. Canonical rVpoly_additive := Additive rVpoly_is_linear. Canonical rVpoly_linear := Linear rVpoly_is_linear. End RowPoly. Prenex Implicits rVpoly rVpolyK. Arguments poly_rV {R d}. Arguments poly_rV_K {R d} [p] le_p_d. Section Resultant. Variables (R : ringType) (p q : {poly R}). Let dS := ((size q).-1 + (size p).-1)%N. Local Notation band r := (lin1_mx (poly_rV \o r \o* rVpoly)). Definition Sylvester_mx : 'M[R]_dS := col_mx (band p) (band q). Lemma Sylvester_mxE (i j : 'I_dS) : let S_ r k := r`_(j - k) *+ (k <= j) in Sylvester_mx i j = match split i with inl k => S_ p k | inr k => S_ q k end. Proof. move=> S_; rewrite mxE; case: {i}(split i) => i; rewrite !mxE /=; by rewrite rVpoly_delta coefXnM ltnNge if_neg -mulrb. Qed. Definition resultant := \det Sylvester_mx. End Resultant. Prenex Implicits Sylvester_mx resultant. Lemma resultant_in_ideal (R : comRingType) (p q : {poly R}) : size p > 1 -> size q > 1 -> {uv : {poly R} * {poly R} | size uv.1 < size q /\ size uv.2 < size p & (resultant p q)%:P = uv.1 * p + uv.2 * q}. Proof. move=> p_nc q_nc; pose dp := (size p).-1; pose dq := (size q).-1. pose S := Sylvester_mx p q; pose dS := (dq + dp)%N. have dS_gt0: dS > 0 by rewrite /dS /dq -(subnKC q_nc). pose j0 := Ordinal dS_gt0. pose Ss0 := col_mx (p *: \col_(i < dq) 'X^i) (q *: \col_(i < dp) 'X^i). pose Ss := \matrix_(i, j) (if j == j0 then Ss0 i 0 else (S i j)%:P). pose u ds s := \sum_(i < ds) cofactor Ss (s i) j0 * 'X^i. exists (u _ (lshift dp), u _ ((rshift dq) _)). suffices sz_u ds s: ds > 1 -> size (u ds.-1 s) < ds by rewrite !sz_u. move/ltn_predK=> {2}<-; apply: leq_trans (size_sum _ _ _) _. apply/bigmax_leqP=> i _. have ->: cofactor Ss (s i) j0 = (cofactor S (s i) j0)%:P. rewrite rmorphM rmorph_sign -det_map_mx; congr (_ * \det _). by apply/matrixP=> i' j'; rewrite !mxE. apply: leq_trans (size_mul_leq _ _) (leq_trans _ (valP i)). by rewrite size_polyC size_polyXn addnS /= -add1n leq_add2r leq_b1. transitivity (\det Ss); last first. rewrite (expand_det_col Ss j0) big_split_ord !big_distrl /=. by congr (_ + _); apply: eq_bigr => i _; rewrite mxE eqxx (col_mxEu, col_mxEd) !mxE mulrC mulrA mulrAC. pose S_ j1 := map_mx polyC (\matrix_(i, j) S i (if j == j0 then j1 else j)). pose Ss0_ i dj := \poly_(j < dj) S i (insubd j0 j). pose Ss_ dj := \matrix_(i, j) (if j == j0 then Ss0_ i dj else (S i j)%:P). have{Ss u} ->: Ss = Ss_ dS. apply/matrixP=> i j; rewrite mxE [in X in _ = X]mxE; case: (j == j0) => {j}//. apply/polyP=> k; rewrite coef_poly Sylvester_mxE mxE. have [k_ge_dS | k_lt_dS] := leqP dS k. case: (split i) => {}i; rewrite !mxE coefMXn; case: ifP => // /negbT; rewrite -ltnNge ltnS => hi. apply: (leq_sizeP _ _ (leqnn (size p))); rewrite -(ltn_predK p_nc). by rewrite ltn_subRL (leq_trans _ k_ge_dS) // ltn_add2r. - apply: (leq_sizeP _ _ (leqnn (size q))); rewrite -(ltn_predK q_nc). by rewrite ltn_subRL (leq_trans _ k_ge_dS) // addnC ltn_add2l. by rewrite insubdK //; case: (split i) => {}i; rewrite !mxE coefMXn; case: leqP. case: (ubnPgeq dS) (dS_gt0); elim=> // dj IHj ltjS _; pose j1 := Ordinal ltjS. pose rj0T (A : 'M[{poly R}]_dS) := row j0 A^T. have: rj0T (Ss_ dj.+1) = 'X^dj *: rj0T (S_ j1) + 1 *: rj0T (Ss_ dj). apply/rowP=> i; apply/polyP=> k; rewrite scale1r !(Sylvester_mxE, mxE) eqxx. rewrite coefD coefXnM coefC !coef_poly ltnS subn_eq0 ltn_neqAle andbC. have [k_le_dj | k_gt_dj] /= := leqP k dj; last by rewrite addr0. rewrite Sylvester_mxE insubdK; last exact: leq_ltn_trans (ltjS). by have [->|] := eqP; rewrite (addr0, add0r). rewrite -det_tr => /determinant_multilinear->; try by apply/matrixP=> i j; rewrite !mxE lift_eqF. have [dj0 | dj_gt0] := posnP dj; rewrite ?dj0 !mul1r. rewrite !det_tr det_map_mx addrC (expand_det_col _ j0) big1 => [|i _]. rewrite add0r; congr (\det _)%:P. apply/matrixP=> i j; rewrite [in X in _ = X]mxE; case: eqP => // ->. by congr (S i _); apply: val_inj. by rewrite mxE /= [Ss0_ _ _]poly_def big_ord0 mul0r. have /determinant_alternate->: j1 != j0 by rewrite -val_eqE -lt0n. by rewrite mulr0 add0r det_tr IHj // ltnW. by move=> i; rewrite !mxE if_same. Qed. Lemma resultant_eq0 (R : idomainType) (p q : {poly R}) : (resultant p q == 0) = (size (gcdp p q) > 1). Proof. have dvdpp := dvdpp; set r := gcdp p q. pose dp := (size p).-1; pose dq := (size q).-1. have /andP[r_p r_q]: (r %| p) && (r %| q) by rewrite -dvdp_gcd. apply/det0P/idP=> [[uv nz_uv] | r_nonC]. have [p0 _ | p_nz] := eqVneq p 0. have: dq + dp > 0. rewrite lt0n; apply: contraNneq nz_uv => dqp0. by rewrite dqp0 in uv *; rewrite [uv]thinmx0. by rewrite /dp /dq /r p0 size_poly0 addn0 gcd0p -subn1 subn_gt0. do [rewrite -[uv]hsubmxK -{1}row_mx0 mul_row_col !mul_rV_lin1 /=] in nz_uv *. set u := rVpoly _; set v := rVpoly _; pose m := gcdp (v * p) (v * q). have lt_vp: size v < size p by rewrite (polySpred p_nz) ltnS size_poly. move/(congr1 rVpoly)/eqP; rewrite -linearD linear0 poly_rV_K; last first. rewrite (leq_trans (size_add _ _)) // geq_max. rewrite !(leq_trans (size_mul_leq _ _)) // -subn1 leq_subLR. by rewrite addnC addnA leq_add ?leqSpred ?size_poly. by rewrite addnCA leq_add ?leqSpred ?size_poly. rewrite addrC addr_eq0 => /eqP vq_up. have nz_v: v != 0. apply: contraNneq nz_uv => v0; apply/eqP. congr row_mx; apply: (can_inj rVpolyK); rewrite linear0 // -/u. by apply: contra_eq vq_up; rewrite v0 mul0r -addr_eq0 add0r => /mulf_neq0->. have r_nz: r != 0 := dvdpN0 r_p p_nz. have /dvdpP [[c w] /= nz_c wv]: v %| m by rewrite dvdp_gcd !dvdp_mulr. have m_wd d: m %| v * d -> w %| d. case/dvdpP=> [[k f]] /= nz_k /(congr1 ( *:%R c)). rewrite mulrC scalerA scalerAl scalerAr wv mulrA => /(mulIf nz_v)def_fw. by apply/dvdpP; exists (c * k, f); rewrite //= mulf_neq0. have w_r: w %| r by rewrite dvdp_gcd !m_wd ?dvdp_gcdl ?dvdp_gcdr. have w_nz: w != 0 := dvdpN0 w_r r_nz. have p_m: p %| m by rewrite dvdp_gcd vq_up -mulNr !dvdp_mull. rewrite (leq_trans _ (dvdp_leq r_nz w_r)) // -(ltn_add2l (size v)). rewrite addnC -ltn_subRL subn1 -size_mul // mulrC -wv size_scale //. rewrite (leq_trans lt_vp) // dvdp_leq // -size_poly_eq0. by rewrite -(size_scale _ nz_c) size_poly_eq0 wv mulf_neq0. have [[c p'] /= nz_c p'r] := dvdpP _ _ r_p. have [[k q'] /= nz_k q'r] := dvdpP _ _ r_q. have def_r := subnKC r_nonC; have r_nz: r != 0 by rewrite -size_poly_eq0 -def_r. have le_p'_dp: size p' <= dp. have [-> | nz_p'] := eqVneq p' 0; first by rewrite size_poly0. by rewrite /dp -(size_scale p nz_c) p'r size_mul // addnC -def_r leq_addl. have le_q'_dq: size q' <= dq. have [-> | nz_q'] := eqVneq q' 0; first by rewrite size_poly0. by rewrite /dq -(size_scale q nz_k) q'r size_mul // addnC -def_r leq_addl. exists (row_mx (- c *: poly_rV q') (k *: poly_rV p')). apply: contraNneq r_nz; rewrite -row_mx0; case/eq_row_mx=> q0 p0. have{} p0: p = 0. apply/eqP; rewrite -size_poly_eq0 -(size_scale p nz_c) p'r. rewrite -(size_scale _ nz_k) scalerAl -(poly_rV_K le_p'_dp) -linearZ p0. by rewrite linear0 mul0r size_poly0. rewrite /r p0 gcd0p -size_poly_eq0 -(size_scale q nz_k) q'r. rewrite -(size_scale _ nz_c) scalerAl -(poly_rV_K le_q'_dq) -linearZ. by rewrite -[c]opprK scaleNr q0 !linear0 mul0r size_poly0. rewrite mul_row_col scaleNr mulNmx !mul_rV_lin1 /= !linearZ /= !poly_rV_K //. by rewrite !scalerCA p'r q'r mulrCA addNr. Qed. Section HornerMx. Variables (R : comRingType) (n' : nat). Local Notation n := n'.+1. Implicit Types (A B : 'M[R]_n) (p q : {poly R}). Section OneMatrix. Variable A : 'M[R]_n. Definition horner_mx := horner_morph (comm_mx_scalar^~ A). Canonical horner_mx_additive := [additive of horner_mx]. Canonical horner_mx_rmorphism := [rmorphism of horner_mx]. Lemma horner_mx_C a : horner_mx a%:P = a%:M. Proof. exact: horner_morphC. Qed. Lemma horner_mx_X : horner_mx 'X = A. Proof. exact: horner_morphX. Qed. Lemma horner_mxZ : scalable horner_mx. Proof. move=> a p /=; rewrite -mul_polyC rmorphM /=. by rewrite horner_mx_C [_ * _]mul_scalar_mx. Qed. Canonical horner_mx_linear := AddLinear horner_mxZ. Canonical horner_mx_lrmorphism := [lrmorphism of horner_mx]. Definition powers_mx d := \matrix_(i < d) mxvec (A ^+ i). Lemma horner_rVpoly m (u : 'rV_m) : horner_mx (rVpoly u) = vec_mx (u *m powers_mx m). Proof. rewrite mulmx_sum_row linear_sum [rVpoly u]poly_def rmorph_sum. apply: eq_bigr => i _. by rewrite valK !linearZ rmorphX /= horner_mx_X rowK /= mxvecK. Qed. End OneMatrix. Lemma horner_mx_diag (d : 'rV[R]_n) (p : {poly R}) : horner_mx (diag_mx d) p = diag_mx (map_mx (horner p) d). Proof. apply/matrixP => i j; rewrite !mxE. elim/poly_ind: p => [|p c ihp]; first by rewrite rmorph0 horner0 mxE mul0rn. rewrite !hornerE mulrnDl rmorphD rmorphM /= horner_mx_X horner_mx_C !mxE. rewrite (bigD1 j)//= ihp mxE ?eqxx mulr1n -mulrnAl big1 ?addr0//. by case: (altP (i =P j)) => [->|]; rewrite /= !(mulr1n, addr0, mul0r). by move=> k /negPf nkF; rewrite mxE nkF mulr0. Qed. Lemma comm_mx_horner A B p : comm_mx A B -> comm_mx A (horner_mx B p). Proof. move=> fg; apply: commr_horner => // i. by rewrite coef_map; apply/comm_scalar_mx. Qed. Lemma comm_horner_mx A B p : comm_mx A B -> comm_mx (horner_mx A p) B. Proof. by move=> ?; apply/comm_mx_sym/comm_mx_horner/comm_mx_sym. Qed. Lemma comm_horner_mx2 A p q : GRing.comm (horner_mx A p) (horner_mx A q). Proof. exact/comm_mx_horner/comm_horner_mx. Qed. End HornerMx. Lemma horner_mx_stable (K : fieldType) m n p (V : 'M[K]_(n.+1, m.+1)) (f : 'M_m.+1) : stablemx V f -> stablemx V (horner_mx f p). Proof. move=> V_fstab; elim/poly_ind: p => [|p c]; first by rewrite rmorph0 stablemx0. move=> fp_stable; rewrite rmorphD rmorphM/= horner_mx_X horner_mx_C. by rewrite stablemxD ?stablemxM ?fp_stable ?stablemxC. Qed. Prenex Implicits horner_mx powers_mx. Section CharPoly. Variables (R : ringType) (n : nat) (A : 'M[R]_n). Implicit Types p q : {poly R}. Definition char_poly_mx := 'X%:M - map_mx (@polyC R) A. Definition char_poly := \det char_poly_mx. Let diagA := [seq A i i | i <- index_enum _ & true]. Let size_diagA : size diagA = n. Proof. by rewrite -[n]card_ord size_map; have [e _ _ []] := big_enumP. Qed. Let split_diagA : exists2 q, \prod_(x <- diagA) ('X - x%:P) + q = char_poly & size q <= n.-1. Proof. rewrite [char_poly](bigD1 1%g) //=; set q := \sum_(s | _) _; exists q. congr (_ + _); rewrite odd_perm1 mul1r big_map big_filter /=. by apply: eq_bigr => i _; rewrite !mxE perm1 eqxx. apply: leq_trans {q}(size_sum _ _ _) _; apply/bigmax_leqP=> s nt_s. have{nt_s} [i nfix_i]: exists i, s i != i. apply/existsP; rewrite -negb_forall; apply: contra nt_s => s_1. by apply/eqP/permP=> i; apply/eqP; rewrite perm1 (forallP s_1). apply: leq_trans (_ : #|[pred j | s j == j]|.+1 <= n.-1). rewrite -sum1_card (@big_mkcond nat) /= size_Msign. apply: (big_ind2 (fun p m => size p <= m.+1)) => [| p mp q mq IHp IHq | j _]. - by rewrite size_poly1. - apply: leq_trans (size_mul_leq _ _) _. by rewrite -subn1 -addnS leq_subLR addnA leq_add. rewrite !mxE eq_sym !inE; case: (s j == j); first by rewrite polyseqXsubC. by rewrite sub0r size_opp size_polyC leq_b1. rewrite -[n in n.-1]card_ord -(cardC (pred2 (s i) i)) card2 nfix_i !ltnS. apply/subset_leq_card/subsetP=> j /(_ =P j) fix_j. rewrite !inE -{1}fix_j (inj_eq perm_inj) orbb. by apply: contraNneq nfix_i => <-; rewrite fix_j. Qed. Lemma size_char_poly : size char_poly = n.+1. Proof. have [q <- lt_q_n] := split_diagA; have le_q_n := leq_trans lt_q_n (leq_pred n). by rewrite size_addl size_prod_XsubC size_diagA. Qed. Lemma char_poly_monic : char_poly \is monic. Proof. rewrite monicE -(monicP (monic_prod_XsubC diagA xpredT id)). rewrite !lead_coefE size_char_poly. have [q <- lt_q_n] := split_diagA; have le_q_n := leq_trans lt_q_n (leq_pred n). by rewrite size_prod_XsubC size_diagA coefD (nth_default 0 le_q_n) addr0. Qed. Lemma char_poly_trace : n > 0 -> char_poly`_n.-1 = - \tr A. Proof. move=> n_gt0; have [q <- lt_q_n] := split_diagA; set p := \prod_(x <- _) _. rewrite coefD {q lt_q_n}(nth_default 0 lt_q_n) addr0. have{n_gt0} ->: p`_n.-1 = ('X * p)`_n by rewrite coefXM eqn0Ngt n_gt0. have ->: \tr A = \sum_(x <- diagA) x by rewrite big_map big_filter. rewrite -size_diagA {}/p; elim: diagA => [|x d IHd]. by rewrite !big_nil mulr1 coefX oppr0. rewrite !big_cons coefXM mulrBl coefB IHd opprD addrC; congr (- _ + _). rewrite mul_polyC coefZ [size _]/= -(size_prod_XsubC _ id) -lead_coefE. by rewrite (monicP _) ?monic_prod_XsubC ?mulr1. Qed. Lemma char_poly_det : char_poly`_0 = (- 1) ^+ n * \det A. Proof. rewrite big_distrr coef_sum [0%N]lock /=; apply: eq_bigr => s _. rewrite -{1}rmorphN -rmorphX mul_polyC coefZ /=. rewrite mulrA -exprD addnC exprD -mulrA -lock; congr (_ * _). transitivity (\prod_(i < n) - A i (s i)); last by rewrite prodrN card_ord. elim: (index_enum _) => [|i e IHe]; rewrite !(big_nil, big_cons) ?coef1 //. by rewrite coefM big_ord1 IHe !mxE coefB coefC coefMn coefX mul0rn sub0r. Qed. End CharPoly. Prenex Implicits char_poly_mx char_poly. Lemma mx_poly_ring_isom (R : ringType) n' (n := n'.+1) : exists phi : {rmorphism 'M[{poly R}]_n -> {poly 'M[R]_n}}, [/\ bijective phi, forall p, phi p%:M = map_poly scalar_mx p, forall A, phi (map_mx polyC A) = A%:P & forall A i j k, (phi A)`_k i j = (A i j)`_k]. Proof. set M_RX := 'M[{poly R}]_n; set MR_X := ({poly 'M[R]_n}). pose Msize (A : M_RX) := \max_i \max_j size (A i j). pose phi (A : M_RX) := \poly_(k < Msize A) \matrix_(i, j) (A i j)`_k. have coef_phi A i j k: (phi A)`_k i j = (A i j)`_k. rewrite coef_poly; case: (ltnP k _) => le_m_k; rewrite mxE // nth_default //. by apply: leq_trans (leq_trans (leq_bigmax i) le_m_k); apply: (leq_bigmax j). have phi_is_rmorphism : rmorphism phi. do 2?[split=> [A B|]]; apply/polyP=> k; apply/matrixP=> i j; last 1 first. - rewrite coef_phi mxE coefMn !coefC. by case: (k == _); rewrite ?mxE ?mul0rn. - by rewrite !(coef_phi, mxE, coefD, coefN). rewrite !coef_phi !mxE !coefM summxE coef_sum. pose F k1 k2 := (A i k1)`_k2 * (B k1 j)`_(k - k2). transitivity (\sum_k1 \sum_(k2 < k.+1) F k1 k2); rewrite {}/F. by apply: eq_bigr=> k1 _; rewrite coefM. rewrite exchange_big /=; apply: eq_bigr => k2 _. by rewrite mxE; apply: eq_bigr => k1 _; rewrite !coef_phi. have bij_phi: bijective phi. exists (fun P : MR_X => \matrix_(i, j) \poly_(k < size P) P`_k i j) => [A|P]. apply/matrixP=> i j; rewrite mxE; apply/polyP=> k. rewrite coef_poly -coef_phi. by case: leqP => // P_le_k; rewrite nth_default ?mxE. apply/polyP=> k; apply/matrixP=> i j; rewrite coef_phi mxE coef_poly. by case: leqP => // P_le_k; rewrite nth_default ?mxE. exists (RMorphism phi_is_rmorphism). split=> // [p | A]; apply/polyP=> k; apply/matrixP=> i j. by rewrite coef_phi coef_map !mxE coefMn. by rewrite coef_phi !mxE !coefC; case k; last rewrite /= mxE. Qed. Theorem Cayley_Hamilton (R : comRingType) n' (A : 'M[R]_n'.+1) : horner_mx A (char_poly A) = 0. Proof. have [phi [_ phiZ phiC _]] := mx_poly_ring_isom R n'. apply/rootP/factor_theorem; rewrite -phiZ -mul_adj_mx rmorphM. by move: (phi _) => q; exists q; rewrite rmorphB phiC phiZ map_polyX. Qed. Lemma eigenvalue_root_char (F : fieldType) n (A : 'M[F]_n) a : eigenvalue A a = root (char_poly A) a. Proof. transitivity (\det (a%:M - A) == 0). apply/eigenvalueP/det0P=> [[v Av_av v_nz] | [v v_nz Av_av]]; exists v => //. by rewrite mulmxBr Av_av mul_mx_scalar subrr. by apply/eqP; rewrite -mul_mx_scalar eq_sym -subr_eq0 -mulmxBr Av_av. congr (_ == 0); rewrite horner_sum; apply: eq_bigr => s _. rewrite hornerM horner_exp !hornerE; congr (_ * _). rewrite (big_morph _ (fun p q => hornerM p q a) (hornerC 1 a)). by apply: eq_bigr => i _; rewrite !mxE !(hornerE, hornerMn). Qed. Lemma char_poly_trig {R : comRingType} n (A : 'M[R]_n) : is_trig_mx A -> char_poly A = \prod_(i < n) ('X - (A i i)%:P). Proof. move=> /is_trig_mxP Atrig; rewrite /char_poly det_trig. by apply: eq_bigr => i; rewrite !mxE eqxx. by apply/is_trig_mxP => i j lt_ij; rewrite !mxE -val_eqE ltn_eqF ?Atrig ?subrr. Qed. Definition companionmx {R : ringType} (p : seq R) (d := (size p).-1) := \matrix_(i < d, j < d) if (i == d.-1 :> nat) then - p`_j else (i.+1 == j :> nat)%:R. Lemma companionmxK {R : comRingType} (p : {poly R}) : p \is monic -> char_poly (companionmx p) = p. Proof. pose D n : 'M[{poly R}]_n := \matrix_(i, j) ('X *+ (i == j.+1 :> nat) - ((i == j)%:R)%:P). have detD n : \det (D n) = (-1) ^+ n. elim: n => [|n IHn]; first by rewrite det_mx00. rewrite (expand_det_row _ ord0) big_ord_recl !mxE /= sub0r. rewrite big1 ?addr0; last by move=> i _; rewrite !mxE /= subrr mul0r. rewrite /cofactor mul1r [X in \det X](_ : _ = D _) ?IHn ?exprS//. by apply/matrixP=> i j; rewrite !mxE /= /bump !add1n eqSS. elim/poly_ind: p => [|p c IHp]. by rewrite monicE lead_coef0 eq_sym oner_eq0. have [->|p_neq0] := eqVneq p 0. rewrite mul0r add0r monicE lead_coefC => /eqP->. by rewrite /companionmx /char_poly size_poly1 det_mx00. rewrite monicE lead_coefDl ?lead_coefMX => [p_monic|]; last first. rewrite size_polyC size_mulX ?polyX_eq0// ltnS. by rewrite (leq_trans (leq_b1 _)) ?size_poly_gt0. rewrite -[in RHS]IHp // /companionmx size_MXaddC (negPf p_neq0) /=. rewrite /char_poly polySpred //. have [->|spV1_gt0] := posnP (size p).-1. rewrite [X in \det X]mx11_scalar det_scalar1 !mxE ?eqxx det_mx00. by rewrite mul1r -horner_coef0 hornerMXaddC mulr0 add0r rmorphN opprK. rewrite (expand_det_col _ ord0) /= -[(size p).-1]prednK //. rewrite big_ord_recr big_ord_recl/= big1 ?add0r //=; last first. move=> i _; rewrite !mxE -val_eqE /= /bump leq0n add1n eqSS. by rewrite ltn_eqF ?subrr ?mul0r. rewrite !mxE ?subnn -horner_coef0 /= hornerMXaddC. rewrite !(eqxx, mulr0, add0r, addr0, subr0, rmorphN, opprK)/=. rewrite mulrC /cofactor; congr (_ * 'X + _). rewrite /cofactor -signr_odd oddD addbb mul1r; congr (\det _). apply/matrixP => i j; rewrite !mxE -val_eqE coefD coefMX coefC. by rewrite /= /bump /= !add1n !eqSS addr0. rewrite /cofactor [X in \det X](_ : _ = D _). by rewrite detD /= addn0 -signr_odd -signr_addb addbb mulr1. apply/matrixP=> i j; rewrite !mxE -!val_eqE /= /bump /=. by rewrite leqNgt ltn_ord add0n add1n [_ == _.-2.+1]ltn_eqF. Qed. Lemma mulmx_delta_companion (R : ringType) (p : seq R) (i: 'I_(size p).-1) (i_small : i.+1 < (size p).-1): delta_mx 0 i *m companionmx p = delta_mx 0 (Ordinal i_small) :> 'rV__. Proof. apply/rowP => j; rewrite !mxE (bigD1 i) //= ?(=^~val_eqE, mxE) /= eqxx mul1r. rewrite ltn_eqF ?big1 ?addr0 1?eq_sym //; last first. by rewrite -ltnS prednK // (leq_trans _ i_small). by move=> k /negPf ki_eqF; rewrite !mxE eqxx ki_eqF mul0r. Qed. Section MinPoly. Variables (F : fieldType) (n' : nat). Local Notation n := n'.+1. Variable A : 'M[F]_n. Implicit Types p q : {poly F}. Fact degree_mxminpoly_proof : exists d, \rank (powers_mx A d.+1) <= d. Proof. by exists (n ^ 2)%N; rewrite rank_leq_col. Qed. Definition degree_mxminpoly := ex_minn degree_mxminpoly_proof. Local Notation d := degree_mxminpoly. Local Notation Ad := (powers_mx A d). Lemma mxminpoly_nonconstant : d > 0. Proof. rewrite /d; case: ex_minnP => -[] //; rewrite leqn0 mxrank_eq0; move/eqP. by move/row_matrixP/(_ 0)/eqP; rewrite rowK row0 mxvec_eq0 -mxrank_eq0 mxrank1. Qed. Lemma minpoly_mx1 : (1%:M \in Ad)%MS. Proof. by apply: (eq_row_sub (Ordinal mxminpoly_nonconstant)); rewrite rowK. Qed. Lemma minpoly_mx_free : row_free Ad. Proof. have:= mxminpoly_nonconstant; rewrite /d; case: ex_minnP => -[] // d' _ /(_ d'). by move/implyP; rewrite ltnn implybF -ltnS ltn_neqAle rank_leq_row andbT negbK. Qed. Lemma horner_mx_mem p : (horner_mx A p \in Ad)%MS. Proof. elim/poly_ind: p => [|p a IHp]; first by rewrite rmorph0 // linear0 sub0mx. rewrite rmorphD rmorphM /= horner_mx_C horner_mx_X. rewrite addrC -scalemx1 linearP /= -(mul_vec_lin (mulmxr_linear _ A)). case/submxP: IHp => u ->{p}. have: (powers_mx A (1 + d) <= Ad)%MS. rewrite -(geq_leqif (mxrank_leqif_sup _)). by rewrite (eqnP minpoly_mx_free) /d; case: ex_minnP. rewrite addnC; apply/row_subP=> i. by apply: eq_row_sub (lshift 1 i) _; rewrite !rowK. apply: submx_trans; rewrite addmx_sub ?scalemx_sub //. by apply: (eq_row_sub 0); rewrite rowK. rewrite -mulmxA mulmx_sub {u}//; apply/row_subP=> i. rewrite row_mul rowK mul_vec_lin /= mulmxE -exprSr. by apply: (eq_row_sub (rshift 1 i)); rewrite rowK. Qed. Definition mx_inv_horner B := rVpoly (mxvec B *m pinvmx Ad). Lemma mx_inv_horner0 : mx_inv_horner 0 = 0. Proof. by rewrite /mx_inv_horner !(linear0, mul0mx). Qed. Lemma mx_inv_hornerK B : (B \in Ad)%MS -> horner_mx A (mx_inv_horner B) = B. Proof. by move=> sBAd; rewrite horner_rVpoly mulmxKpV ?mxvecK. Qed. Lemma minpoly_mxM B C : (B \in Ad -> C \in Ad -> B * C \in Ad)%MS. Proof. move=> AdB AdC; rewrite -(mx_inv_hornerK AdB) -(mx_inv_hornerK AdC). by rewrite -rmorphM ?horner_mx_mem. Qed. Lemma minpoly_mx_ring : mxring Ad. Proof. apply/andP; split; first exact/mulsmx_subP/minpoly_mxM. apply/mxring_idP; exists 1%:M; split=> *; rewrite ?mulmx1 ?mul1mx //. by rewrite -mxrank_eq0 mxrank1. exact: minpoly_mx1. Qed. Definition mxminpoly := 'X^d - mx_inv_horner (A ^+ d). Local Notation p_A := mxminpoly. Lemma size_mxminpoly : size p_A = d.+1. Proof. by rewrite size_addl ?size_polyXn // size_opp ltnS size_poly. Qed. Lemma mxminpoly_monic : p_A \is monic. Proof. rewrite monicE /lead_coef size_mxminpoly coefB coefXn eqxx /=. by rewrite nth_default ?size_poly // subr0. Qed. Lemma size_mod_mxminpoly p : size (p %% p_A) <= d. Proof. by rewrite -ltnS -size_mxminpoly ltn_modp // -size_poly_eq0 size_mxminpoly. Qed. Lemma mx_root_minpoly : horner_mx A p_A = 0. Proof. rewrite rmorphB -{3}(horner_mx_X A) -rmorphX /=. by rewrite mx_inv_hornerK ?subrr ?horner_mx_mem. Qed. Lemma horner_rVpolyK (u : 'rV_d) : mx_inv_horner (horner_mx A (rVpoly u)) = rVpoly u. Proof. congr rVpoly; rewrite horner_rVpoly vec_mxK. by apply: (row_free_inj minpoly_mx_free); rewrite mulmxKpV ?submxMl. Qed. Lemma horner_mxK p : mx_inv_horner (horner_mx A p) = p %% p_A. Proof. rewrite {1}(Pdiv.IdomainMonic.divp_eq mxminpoly_monic p) rmorphD rmorphM /=. rewrite mx_root_minpoly mulr0 add0r. by rewrite -(poly_rV_K (size_mod_mxminpoly _)) horner_rVpolyK. Qed. Lemma mxminpoly_min p : horner_mx A p = 0 -> p_A %| p. Proof. by move=> pA0; rewrite /dvdp -horner_mxK pA0 mx_inv_horner0. Qed. Lemma mxminpoly_minP p : reflect (horner_mx A p = 0) (p_A %| p). Proof. apply: (iffP idP); last exact: mxminpoly_min. by move=> /Pdiv.Field.dvdpP[q ->]; rewrite rmorphM/= mx_root_minpoly mulr0. Qed. Lemma dvd_mxminpoly p : (p_A %| p) = (horner_mx A p == 0). Proof. exact/mxminpoly_minP/eqP. Qed. Lemma horner_rVpoly_inj : injective (horner_mx A \o rVpoly : 'rV_d -> 'M_n). Proof. apply: can_inj (poly_rV \o mx_inv_horner) _ => u /=. by rewrite horner_rVpolyK rVpolyK. Qed. Lemma mxminpoly_linear_is_scalar : (d <= 1) = is_scalar_mx A. Proof. have scalP := has_non_scalar_mxP minpoly_mx1. rewrite leqNgt -(eqnP minpoly_mx_free); apply/scalP/idP=> [|[[B]]]. case scalA: (is_scalar_mx A); [by right | left]. by exists A; rewrite ?scalA // -{1}(horner_mx_X A) horner_mx_mem. move/mx_inv_hornerK=> <- nsB; case/is_scalar_mxP=> a defA; case/negP: nsB. move: {B}(_ B); apply: poly_ind => [|p c]. by rewrite rmorph0 ?mx0_is_scalar. rewrite rmorphD ?rmorphM /= horner_mx_X defA; case/is_scalar_mxP=> b ->. by rewrite -rmorphM horner_mx_C -rmorphD /= scalar_mx_is_scalar. Qed. Lemma mxminpoly_dvd_char : p_A %| char_poly A. Proof. exact/mxminpoly_min/Cayley_Hamilton. Qed. Lemma eigenvalue_root_min a : eigenvalue A a = root p_A a. Proof. apply/idP/idP=> Aa; last first. rewrite eigenvalue_root_char !root_factor_theorem in Aa *. exact: dvdp_trans Aa mxminpoly_dvd_char. have{Aa} [v Av_av v_nz] := eigenvalueP Aa. apply: contraR v_nz => pa_nz; rewrite -{pa_nz}(eqmx_eq0 (eqmx_scale _ pa_nz)). apply/eqP; rewrite -(mulmx0 _ v) -mx_root_minpoly. elim/poly_ind: p_A => [|p c IHp]. by rewrite rmorph0 horner0 scale0r mulmx0. rewrite !hornerE rmorphD rmorphM /= horner_mx_X horner_mx_C scalerDl. by rewrite -scalerA mulmxDr mul_mx_scalar mulmxA -IHp -scalemxAl Av_av. Qed. Lemma root_mxminpoly a : root p_A a = root (char_poly A) a. Proof. by rewrite -eigenvalue_root_min eigenvalue_root_char. Qed. End MinPoly. Lemma mxminpoly_diag {F : fieldType} {n} (d : 'rV[F]_n.+1) (u := undup [seq d 0 i | i <- enum 'I_n.+1]) : mxminpoly (diag_mx d) = \prod_(r <- u) ('X - r%:P). Proof. apply/eqP; rewrite -eqp_monic ?mxminpoly_monic ?monic_prod_XsubC// /eqp. rewrite mxminpoly_min/=; last first. rewrite horner_mx_diag; apply/matrixP => i j; rewrite !mxE horner_prod. case: (altP (i =P j)) => [->|neq_ij//]; rewrite mulr1n. rewrite (bigD1_seq (d 0 j)) ?undup_uniq ?mem_undup ?map_f// /=. by rewrite hornerD hornerN hornerX hornerC subrr mul0r. apply: uniq_roots_dvdp; last by rewrite uniq_rootsE undup_uniq. apply/allP => x; rewrite mem_undup root_mxminpoly char_poly_trig//. rewrite -(big_map _ predT (fun x => _ - x%:P)) root_prod_XsubC. by move=> /mapP[i _ ->]; apply/mapP; exists i; rewrite ?(mxE, eqxx). Qed. Prenex Implicits degree_mxminpoly mxminpoly mx_inv_horner. Arguments mx_inv_hornerK {F n' A} [B] AnB. Arguments horner_rVpoly_inj {F n' A} [u1 u2] eq_u12A : rename. (* Parametricity. *) Section MapRingMatrix. Variables (aR rR : ringType) (f : {rmorphism aR -> rR}). Local Notation "A ^f" := (map_mx (GRing.RMorphism.apply f) A) : ring_scope. Local Notation fp := (map_poly (GRing.RMorphism.apply f)). Variables (d n : nat) (A : 'M[aR]_n). Lemma map_rVpoly (u : 'rV_d) : fp (rVpoly u) = rVpoly u^f. Proof. apply/polyP=> k; rewrite coef_map !coef_rVpoly. by case: (insub k) => [i|]; rewrite /= ?rmorph0 // mxE. Qed. Lemma map_poly_rV p : (poly_rV p)^f = poly_rV (fp p) :> 'rV_d. Proof. by apply/rowP=> j; rewrite !mxE coef_map. Qed. Lemma map_char_poly_mx : map_mx fp (char_poly_mx A) = char_poly_mx A^f. Proof. rewrite raddfB /= map_scalar_mx /= map_polyX; congr (_ - _). by apply/matrixP=> i j; rewrite !mxE map_polyC. Qed. Lemma map_char_poly : fp (char_poly A) = char_poly A^f. Proof. by rewrite -det_map_mx map_char_poly_mx. Qed. End MapRingMatrix. Section MapResultant. Lemma map_resultant (aR rR : ringType) (f : {rmorphism {poly aR} -> rR}) p q : f (lead_coef p) != 0 -> f (lead_coef q) != 0 -> f (resultant p q)= resultant (map_poly f p) (map_poly f q). Proof. move=> nz_fp nz_fq; rewrite /resultant /Sylvester_mx !size_map_poly_id0 //. rewrite -det_map_mx /= map_col_mx; congr (\det (col_mx _ _)); by apply: map_lin1_mx => v; rewrite map_poly_rV rmorphM /= map_rVpoly. Qed. End MapResultant. Section MapComRing. Variables (aR rR : comRingType) (f : {rmorphism aR -> rR}). Local Notation "A ^f" := (map_mx f A) : ring_scope. Local Notation fp := (map_poly f). Variables (n' : nat) (A : 'M[aR]_n'.+1). Lemma map_powers_mx e : (powers_mx A e)^f = powers_mx A^f e. Proof. by apply/row_matrixP=> i; rewrite -map_row !rowK map_mxvec rmorphX. Qed. Lemma map_horner_mx p : (horner_mx A p)^f = horner_mx A^f (fp p). Proof. rewrite -[p](poly_rV_K (leqnn _)) map_rVpoly. by rewrite !horner_rVpoly map_vec_mx map_mxM map_powers_mx. Qed. End MapComRing. Section MapField. Variables (aF rF : fieldType) (f : {rmorphism aF -> rF}). Local Notation "A ^f" := (map_mx f A) : ring_scope. Local Notation fp := (map_poly f). Variables (n' : nat) (A : 'M[aF]_n'.+1) (p : {poly aF}). Lemma map_mx_companion (e := congr1 predn (size_map_poly _ _)) : (companionmx p)^f = castmx (e, e) (companionmx (fp p)). Proof. apply/matrixP => i j; rewrite !(castmxE, mxE) /= (fun_if f). by rewrite rmorphN coef_map size_map_poly rmorph_nat. Qed. Lemma companion_map_poly (e := esym (congr1 predn (size_map_poly _ _))) : companionmx (fp p) = castmx (e, e) (companionmx p)^f. Proof. by rewrite map_mx_companion castmx_comp castmx_id. Qed. Lemma degree_mxminpoly_map : degree_mxminpoly A^f = degree_mxminpoly A. Proof. by apply: eq_ex_minn => e; rewrite -map_powers_mx mxrank_map. Qed. Lemma mxminpoly_map : mxminpoly A^f = fp (mxminpoly A). Proof. rewrite rmorphB; congr (_ - _). by rewrite /= map_polyXn degree_mxminpoly_map. rewrite degree_mxminpoly_map -rmorphX /=. apply/polyP=> i; rewrite coef_map //= !coef_rVpoly degree_mxminpoly_map. case/insub: i => [i|]; last by rewrite rmorph0. by rewrite -map_powers_mx -map_pinvmx // -map_mxvec -map_mxM // mxE. Qed. Lemma map_mx_inv_horner u : fp (mx_inv_horner A u) = mx_inv_horner A^f u^f. Proof. rewrite map_rVpoly map_mxM map_mxvec map_pinvmx map_powers_mx. by rewrite /mx_inv_horner degree_mxminpoly_map. Qed. End MapField. Section KernelLemmas. Variable K : fieldType. (* convertible to kermx (horner_mx g p) when n = n.+1 *) Definition kermxpoly n (g : 'M_n) (p : {poly K}) : 'M_n := kermx ((if n is n.+1 then horner_mx^~ p : 'M_n.+1 -> 'M_n.+1 else \0) g). Lemma kermxpolyC n (g : 'M_n) c : c != 0 -> kermxpoly g c%:P = 0. Proof. move=> c_neq0; case: n => [|n] in g *; first by rewrite thinmx0. apply/eqP; rewrite /kermxpoly horner_mx_C kermx_eq0 row_free_unit. by rewrite -scalemx1 scaler_unit ?unitmx1// unitfE. Qed. Lemma kermxpoly1 n (g : 'M_n) : kermxpoly g 1 = 0. Proof. by rewrite kermxpolyC ?oner_eq0. Qed. Lemma kermxpolyX n (g : 'M_n) : kermxpoly g 'X = kermx g. Proof. case: n => [|n] in g *; first by rewrite !thinmx0. by rewrite /kermxpoly horner_mx_X. Qed. Lemma kermxpoly_min n (g : 'M_n.+1) p : mxminpoly g %| p -> (kermxpoly g p :=: 1)%MS. Proof. by rewrite /kermxpoly => /mxminpoly_minP ->; apply: kermx0. Qed. Lemma comm_mx_stable_kermxpoly n (f g : 'M_n) (p : {poly K}) : comm_mx f g -> stablemx (kermxpoly f p) g. Proof. case: n => [|n] in f g *; first by rewrite !thinmx0. move=> fg; rewrite /kermxpoly; apply: comm_mx_stable_ker. by apply/comm_mx_sym/comm_mx_horner/comm_mx_sym. Qed. Lemma mxdirect_kermxpoly n (g : 'M_n) (p q : {poly K}) : coprimep p q -> (kermxpoly g p :&: kermxpoly g q = 0)%MS. Proof. case: n => [|n] in g *; first by rewrite thinmx0 ?cap0mx ?submx_refl. move=> /Bezout_eq1_coprimepP [[/= u v]]; rewrite mulrC [v * _]mulrC => cpq. apply/eqP/rowV0P => x. rewrite sub_capmx => /andP[/sub_kermxP xgp0 /sub_kermxP xgq0]. move: cpq => /(congr1 (mulmx x \o horner_mx g))/=. rewrite !(rmorphM, rmorphD, rmorph1, mulmx1, mulmxDr, mulmxA). by rewrite xgp0 xgq0 !mul0mx add0r. Qed. Lemma kermxpolyM n (g : 'M_n) (p q : {poly K}) : coprimep p q -> (kermxpoly g (p * q) :=: kermxpoly g p + kermxpoly g q)%MS. Proof. case: n => [|n] in g *; first by rewrite !thinmx0. move=> /Bezout_eq1_coprimepP [[/= u v]]; rewrite mulrC [v * _]mulrC => cpq. apply/eqmxP/andP; split; last first. apply/sub_kermxP/eqmx0P; rewrite !addsmxMr [in X in (_ + X)%MS]mulrC. by rewrite !rmorphM/= !mulmxA !mulmx_ker !mul0mx !addsmx0 submx_refl. move: cpq => /(congr1 (horner_mx g))/=; rewrite rmorph1 rmorphD/=. rewrite -[X in (X <= _)%MS]mulr1 => <-; rewrite mulrDr mulrC addrC. rewrite addmx_sub_adds//; apply/sub_kermxP; rewrite mulmxE -mulrA -rmorphM. by rewrite mulrAC [q * p]mulrC rmorphM/= mulrA -!mulmxE mulmx_ker mul0mx. rewrite -[_ * _ * q]mulrA [u * _]mulrC. by rewrite rmorphM mulrA -!mulmxE mulmx_ker mul0mx. Qed. Lemma kermxpoly_prod n (g : 'M_n) (I : finType) (P : {pred I}) (p_ : I -> {poly K}) : {in P &, forall i j, j != i -> coprimep (p_ i) (p_ j)} -> (kermxpoly g (\prod_(i | P i) p_ i) :=: \sum_(i | P i) kermxpoly g (p_ i))%MS. Proof. move=> p_coprime; elim: index_enum (index_enum_uniq I). by rewrite !big_nil ?kermxpoly1 ?submx_refl//. move=> j js ihjs /= /andP[jNjs js_uniq]; apply/eqmxP. rewrite !big_cons; case: ifP => [Pj|PNj]; rewrite ?ihjs ?submx_refl//. suff cjjs: coprimep (p_ j) (\prod_(i <- js | P i) p_ i). by rewrite !kermxpolyM// !(adds_eqmx (eqmx_refl _) (ihjs _)) ?submx_refl. rewrite (@big_morph _ _ _ true andb) ?big_all_cond ?coprimep1//; last first. by move=> p q; rewrite coprimepMr. apply/allP => i i_js; apply/implyP => Pi; apply: p_coprime => //. by apply: contraNneq jNjs => <-. Qed. Lemma mxdirect_sum_kermx n (g : 'M_n) (I : finType) (P : {pred I}) (p_ : I -> {poly K}) : {in P &, forall i j, j != i -> coprimep (p_ i) (p_ j)} -> mxdirect (\sum_(i | P i) kermxpoly g (p_ i))%MS. Proof. move=> p_coprime; apply/mxdirect_sumsP => i Pi; apply/eqmx0P. have cpNi : {in [pred j | P j && (j != i)] &, forall j k : I, k != j -> coprimep (p_ j) (p_ k)}. by move=> j k /andP[Pj _] /andP[Pk _]; apply: p_coprime. rewrite -!(cap_eqmx (eqmx_refl _) (kermxpoly_prod g _))//. rewrite mxdirect_kermxpoly ?submx_refl//. rewrite (@big_morph _ _ _ true andb) ?big_all_cond ?coprimep1//; last first. by move=> p q; rewrite coprimepMr. by apply/allP => j _; apply/implyP => /andP[Pj neq_ji]; apply: p_coprime. Qed. Lemma eigenspace_poly n a (f : 'M_n) : eigenspace f a = kermxpoly f ('X - a%:P). Proof. case: n => [|m] in a f *; first by rewrite !thinmx0. by congr (kermx _); rewrite rmorphB /= ?horner_mx_X ?horner_mx_C. Qed. Definition geigenspace n (g : 'M_n) a := kermxpoly g (('X - a%:P) ^+ n). Lemma geigenspaceE n' (g : 'M_n'.+1) a : geigenspace g a = kermx ((g - a%:M) ^+ n'.+1). Proof. by rewrite /geigenspace /kermxpoly rmorphX rmorphB /= horner_mx_X horner_mx_C. Qed. Lemma eigenspace_sub_geigen n (g : 'M_n) a : (eigenspace g a <= geigenspace g a)%MS. Proof. case: n => [|n] in g *; rewrite ?thinmx0 ?sub0mx// geigenspaceE. by apply/sub_kermxP; rewrite exprS mulmxA mulmx_ker mul0mx. Qed. Lemma mxdirect_sum_geigenspace (I : finType) (n : nat) (g : 'M_n) (P : {pred I}) (a_ : I -> K) : {in P &, injective a_} -> mxdirect (\sum_(i | P i) geigenspace g (a_ i)). Proof. move=> /inj_in_eq eq_a; apply: mxdirect_sum_kermx => i j Pi Pj Nji. by rewrite coprimep_expr ?coprimep_expl// coprimep_XsubC root_XsubC eq_a. Qed. Definition eigenpoly n (g : 'M_n) : pred {poly K} := (fun p => kermxpoly g p != 0). Lemma eigenpolyP n (g : 'M_n) (p : {poly K}) : reflect (exists2 v : 'rV_n, (v <= kermxpoly g p)%MS & v != 0) (eigenpoly g p). Proof. exact: rowV0Pn. Qed. Lemma eigenvalue_poly n a (f : 'M_n) : eigenvalue f a = eigenpoly f ('X - a%:P). Proof. by rewrite /eigenpoly /eigenvalue eigenspace_poly. Qed. Lemma comm_mx_stable_geigenspace n (f g : 'M_n) a : comm_mx f g -> stablemx (geigenspace f a) g. Proof. exact: comm_mx_stable_kermxpoly. Qed. End KernelLemmas. Section MapKermxPoly. Variables (aF rF : fieldType) (f : {rmorphism aF -> rF}). Lemma map_kermxpoly (n : nat) (g : 'M_n) (p : {poly aF}) : map_mx f (kermxpoly g p) = kermxpoly (map_mx f g) (map_poly f p). Proof. by case: n => [|n] in g *; rewrite ?thinmx0// map_kermx map_horner_mx. Qed. Lemma map_geigenspace (n : nat) (g : 'M_n) (a : aF) : map_mx f (geigenspace g a) = geigenspace (map_mx f g) (f a). Proof. by rewrite map_kermxpoly rmorphX rmorphB /= map_polyX map_polyC. Qed. Lemma eigenpoly_map n (g : 'M_n) (p : {poly aF}) : eigenpoly (map_mx f g) (map_poly f p) = eigenpoly g p. Proof. by rewrite /eigenpoly -map_kermxpoly map_mx_eq0. Qed. End MapKermxPoly. Section IntegralOverRing. Definition integralOver (R K : ringType) (RtoK : R -> K) (z : K) := exists2 p, p \is monic & root (map_poly RtoK p) z. Definition integralRange R K RtoK := forall z, @integralOver R K RtoK z. Variables (B R K : ringType) (BtoR : B -> R) (RtoK : {rmorphism R -> K}). Lemma integral_rmorph x : integralOver BtoR x -> integralOver (RtoK \o BtoR) (RtoK x). Proof. by case=> p; exists p; rewrite // map_poly_comp rmorph_root. Qed. Lemma integral_id x : integralOver RtoK (RtoK x). Proof. by exists ('X - x%:P); rewrite ?monicXsubC ?rmorph_root ?root_XsubC. Qed. Lemma integral_nat n : integralOver RtoK n%:R. Proof. by rewrite -(rmorph_nat RtoK); apply: integral_id. Qed. Lemma integral0 : integralOver RtoK 0. Proof. exact: (integral_nat 0). Qed. Lemma integral1 : integralOver RtoK 1. Proof. exact: (integral_nat 1). Qed. Lemma integral_poly (p : {poly K}) : (forall i, integralOver RtoK p`_i) <-> {in p : seq K, integralRange RtoK}. Proof. split=> intRp => [_ /(nthP 0)[i _ <-] // | i]; rewrite -[p]coefK coef_poly. by case: ifP => [ltip | _]; [apply/intRp/mem_nth | apply: integral0]. Qed. End IntegralOverRing. Section IntegralOverComRing. Variables (R K : comRingType) (RtoK : {rmorphism R -> K}). Lemma integral_horner_root w (p q : {poly K}) : p \is monic -> root p w -> {in p : seq K, integralRange RtoK} -> {in q : seq K, integralRange RtoK} -> integralOver RtoK q.[w]. Proof. move=> mon_p pw0 intRp intRq. pose memR y := exists x, y = RtoK x. have memRid x: memR (RtoK x) by exists x. have memR_nat n: memR n%:R by rewrite -(rmorph_nat RtoK). have [memR0 memR1]: memR 0 * memR 1 := (memR_nat 0%N, memR_nat 1%N). have memRN1: memR (- 1) by exists (- 1); rewrite rmorphN1. pose rVin (E : K -> Prop) n (a : 'rV[K]_n) := forall i, E (a 0 i). pose pXin (E : K -> Prop) (r : {poly K}) := forall i, E r`_i. pose memM E n (X : 'rV_n) y := exists a, rVin E n a /\ y = (a *m X^T) 0 0. pose finM E S := exists n, exists X, forall y, memM E n X y <-> S y. have tensorM E n1 n2 X Y: finM E (memM (memM E n2 Y) n1 X). exists (n1 * n2)%N, (mxvec (X^T *m Y)) => y. split=> [[a [Ea Dy]] | [a1 [/fin_all_exists[a /all_and2[Ea Da1]] ->]]]. exists (Y *m (vec_mx a)^T); split=> [i|]. exists (row i (vec_mx a)); split=> [j|]; first by rewrite !mxE; apply: Ea. by rewrite -row_mul -{1}[Y]trmxK -trmx_mul !mxE. by rewrite -[Y]trmxK -!trmx_mul mulmxA -mxvec_dotmul trmx_mul trmxK vec_mxK. exists (mxvec (\matrix_i a i)); split. by case/mxvec_indexP=> i j; rewrite mxvecE mxE; apply: Ea. rewrite -[mxvec _]trmxK -trmx_mul mxvec_dotmul -mulmxA trmx_mul !mxE. apply: eq_bigr => i _; rewrite Da1 !mxE; congr (_ * _). by apply: eq_bigr => j _; rewrite !mxE. suffices [m [X [[u [_ Du]] idealM]]]: exists m, exists X, let M := memM memR m X in M 1 /\ forall y, M y -> M (q.[w] * y). - do [set M := memM _ m X; move: q.[w] => z] in idealM *. have MX i: M (X 0 i). by exists (delta_mx 0 i); split=> [j|]; rewrite -?rowE !mxE. have /fin_all_exists[a /all_and2[Fa Da1]] i := idealM _ (MX i). have /fin_all_exists[r Dr] i := fin_all_exists (Fa i). pose A := \matrix_(i, j) r j i; pose B := z%:M - map_mx RtoK A. have XB0: X *m B = 0. apply/eqP; rewrite mulmxBr mul_mx_scalar subr_eq0; apply/eqP/rowP=> i. by rewrite !mxE Da1 mxE; apply: eq_bigr=> j _; rewrite !mxE mulrC Dr. exists (char_poly A); first exact: char_poly_monic. have: (\det B *: (u *m X^T)) 0 0 == 0. rewrite scalemxAr -linearZ -mul_mx_scalar -mul_mx_adj mulmxA XB0 /=. by rewrite mul0mx trmx0 mulmx0 mxE. rewrite mxE -Du mulr1 rootE -horner_evalE -!det_map_mx; congr (\det _ == 0). rewrite !raddfB /= !map_scalar_mx /= map_polyX horner_evalE hornerX. by apply/matrixP=> i j; rewrite !mxE map_polyC /horner_eval hornerC. pose gen1 x E y := exists2 r, pXin E r & y = r.[x]; pose gen := foldr gen1 memR. have gen1S (E : K -> Prop) x y: E 0 -> E y -> gen1 x E y. by exists y%:P => [i|]; rewrite ?hornerC ?coefC //; case: ifP. have genR S y: memR y -> gen S y. by elim: S => //= x S IH in y * => /IH; apply/gen1S/IH. have gen0 := genR _ 0 memR0; have gen_1 := genR _ 1 memR1. have{gen1S} genS S y: y \in S -> gen S y. elim: S => //= x S IH /predU1P[-> | /IH//]; last exact: gen1S. by exists 'X => [i|]; rewrite ?hornerX // coefX; apply: genR. pose propD (R : K -> Prop) := forall x y, R x -> R y -> R (x + y). have memRD: propD memR. by move=> _ _ [a ->] [b ->]; exists (a + b); rewrite rmorphD. have genD S: propD (gen S). elim: S => //= x S IH _ _ [r1 Sr1 ->] [r2 Sr2 ->]; rewrite -hornerD. by exists (r1 + r2) => // i; rewrite coefD; apply: IH. have gen_sum S := big_ind _ (gen0 S) (genD S). pose propM (R : K -> Prop) := forall x y, R x -> R y -> R (x * y). have memRM: propM memR. by move=> _ _ [a ->] [b ->]; exists (a * b); rewrite rmorphM. have genM S: propM (gen S). elim: S => //= x S IH _ _ [r1 Sr1 ->] [r2 Sr2 ->]; rewrite -hornerM. by exists (r1 * r2) => // i; rewrite coefM; apply: gen_sum => j _; apply: IH. have gen_horner S r y: pXin (gen S) r -> gen S y -> gen S r.[y]. move=> Sq Sy; rewrite horner_coef; apply: gen_sum => [[i _] /= _]. by elim: {2}i => [|n IHn]; rewrite ?mulr1 // exprSr mulrA; apply: genM. pose S := w :: q ++ p; suffices [m [X defX]]: finM memR (gen S). exists m, X => M; split=> [|y /defX Xy]; first exact/defX. apply/defX/genM => //; apply: gen_horner => // [i|]; last exact/genS/mem_head. rewrite -[q]coefK coef_poly; case: ifP => // lt_i_q. by apply: genS; rewrite inE mem_cat mem_nth ?orbT. pose intR R y := exists r, [/\ r \is monic, root r y & pXin R r]. pose fix genI s := if s is y :: s1 then intR (gen s1) y /\ genI s1 else True. have{mon_p pw0 intRp intRq}: genI S. split; set S1 := _ ++ _; first exists p. split=> // i; rewrite -[p]coefK coef_poly; case: ifP => // lt_i_p. by apply: genS; rewrite mem_cat orbC mem_nth. set S2 := S1; have: all (mem S1) S2 by apply/allP. elim: S2 => //= y S2 IH /andP[S1y S12]; split; last exact: IH. have{q S S1 IH S1y S12 intRp intRq} [q mon_q qx0]: integralOver RtoK y. by move: S1y; rewrite mem_cat => /orP[]; [apply: intRq | apply: intRp]. exists (map_poly RtoK q); split=> // [|i]; first exact: monic_map. by rewrite coef_map /=; apply: genR. elim: {w p q}S => /= [_|x S IH [[p [mon_p px0 Sp]] /IH{IH}[m2 [X2 defS]]]]. exists 1%N, 1 => y; split=> [[a [Fa ->]] | Fy]. by rewrite tr_scalar_mx mulmx1; apply: Fa. by exists y%:M; split=> [i|]; rewrite 1?ord1 ?tr_scalar_mx ?mulmx1 mxE. pose m1 := (size p).-1; pose X1 := \row_(i < m1) x ^+ i. have [m [X defM]] := tensorM memR m1 m2 X1 X2; set M := memM _ _ _ in defM. exists m, X => y; rewrite -/M; split=> [/defM[a [M2a]] | [q Sq]] -> {y}. exists (rVpoly a) => [i|]. by rewrite coef_rVpoly; case/insub: i => // i; apply/defS/M2a. rewrite mxE (horner_coef_wide _ (size_poly _ _)) -/(rVpoly a). by apply: eq_bigr => i _; rewrite coef_rVpoly_ord !mxE. have M_0: M 0 by exists 0; split=> [i|]; rewrite ?mul0mx mxE. have M_D: propD M. move=> _ _ [a [Fa ->]] [b [Fb ->]]; exists (a + b). by rewrite mulmxDl !mxE; split=> // i; rewrite mxE; apply: memRD. have{M_0 M_D} Msum := big_ind _ M_0 M_D. rewrite horner_coef; apply: (Msum) => i _; case: i q`_i {Sq}(Sq i) => /=. elim: {q}(size q) => // n IHn i i_le_n y Sy. have [i_lt_m1 | m1_le_i] := ltnP i m1. apply/defM; exists (y *: delta_mx 0 (Ordinal i_lt_m1)); split=> [j|]. by apply/defS; rewrite !mxE /= mulr_natr; case: eqP. by rewrite -scalemxAl -rowE !mxE. rewrite -(subnK m1_le_i) exprD -[x ^+ m1]subr0 -(rootP px0) horner_coef. rewrite polySpred ?monic_neq0 // -/m1 big_ord_recr /= -lead_coefE. rewrite opprD addrC (monicP mon_p) mul1r subrK !mulrN -mulNr !mulr_sumr. apply: Msum => j _; rewrite mulrA mulrACA -exprD; apply: IHn. by rewrite -addnS addnC addnBA // leq_subLR leq_add. by rewrite -mulN1r; do 2!apply: (genM) => //; apply: genR. Qed. Lemma integral_root_monic u p : p \is monic -> root p u -> {in p : seq K, integralRange RtoK} -> integralOver RtoK u. Proof. move=> mon_p pu0 intRp; rewrite -[u]hornerX. apply: integral_horner_root mon_p pu0 intRp _. by apply/integral_poly => i; rewrite coefX; apply: integral_nat. Qed. Let integral0_RtoK := integral0 RtoK. Let integral1_RtoK := integral1 RtoK. Let monicXsubC_K := @monicXsubC K. Hint Resolve integral0_RtoK integral1_RtoK monicXsubC_K : core. Let XsubC0 (u : K) : root ('X - u%:P) u. Proof. by rewrite root_XsubC. Qed. Let intR_XsubC u : integralOver RtoK (- u) -> {in 'X - u%:P : seq K, integralRange RtoK}. Proof. by move=> intRu v; rewrite polyseqXsubC !inE => /pred2P[]->. Qed. Lemma integral_opp u : integralOver RtoK u -> integralOver RtoK (- u). Proof. by rewrite -{1}[u]opprK => /intR_XsubC/integral_root_monic; apply. Qed. Lemma integral_horner (p : {poly K}) u : {in p : seq K, integralRange RtoK} -> integralOver RtoK u -> integralOver RtoK p.[u]. Proof. by move=> ? /integral_opp/intR_XsubC/integral_horner_root; apply. Qed. Lemma integral_sub u v : integralOver RtoK u -> integralOver RtoK v -> integralOver RtoK (u - v). Proof. move=> intRu /integral_opp/intR_XsubC/integral_horner/(_ intRu). by rewrite !hornerE. Qed. Lemma integral_add u v : integralOver RtoK u -> integralOver RtoK v -> integralOver RtoK (u + v). Proof. by rewrite -{2}[v]opprK => intRu /integral_opp; apply: integral_sub. Qed. Lemma integral_mul u v : integralOver RtoK u -> integralOver RtoK v -> integralOver RtoK (u * v). Proof. rewrite -{2}[v]hornerX -hornerZ => intRu; apply: integral_horner. by apply/integral_poly=> i; rewrite coefZ coefX mulr_natr mulrb; case: ifP. Qed. End IntegralOverComRing. Section IntegralOverField. Variables (F E : fieldType) (FtoE : {rmorphism F -> E}). Definition algebraicOver (fFtoE : F -> E) u := exists2 p, p != 0 & root (map_poly fFtoE p) u. Notation mk_mon p := ((lead_coef p)^-1 *: p). Lemma integral_algebraic u : algebraicOver FtoE u <-> integralOver FtoE u. Proof. split=> [] [p p_nz pu0]; last by exists p; rewrite ?monic_neq0. exists (mk_mon p); first by rewrite monicE lead_coefZ mulVf ?lead_coef_eq0. by rewrite linearZ rootE hornerZ (rootP pu0) mulr0. Qed. Lemma algebraic_id a : algebraicOver FtoE (FtoE a). Proof. exact/integral_algebraic/integral_id. Qed. Lemma algebraic0 : algebraicOver FtoE 0. Proof. exact/integral_algebraic/integral0. Qed. Lemma algebraic1 : algebraicOver FtoE 1. Proof. exact/integral_algebraic/integral1. Qed. Lemma algebraic_opp x : algebraicOver FtoE x -> algebraicOver FtoE (- x). Proof. by move/integral_algebraic/integral_opp/integral_algebraic. Qed. Lemma algebraic_add x y : algebraicOver FtoE x -> algebraicOver FtoE y -> algebraicOver FtoE (x + y). Proof. move/integral_algebraic=> intFx /integral_algebraic intFy. exact/integral_algebraic/integral_add. Qed. Lemma algebraic_sub x y : algebraicOver FtoE x -> algebraicOver FtoE y -> algebraicOver FtoE (x - y). Proof. by move=> algFx /algebraic_opp; apply: algebraic_add. Qed. Lemma algebraic_mul x y : algebraicOver FtoE x -> algebraicOver FtoE y -> algebraicOver FtoE (x * y). Proof. move/integral_algebraic=> intFx /integral_algebraic intFy. exact/integral_algebraic/integral_mul. Qed. Lemma algebraic_inv u : algebraicOver FtoE u -> algebraicOver FtoE u^-1. Proof. have [-> | /expf_neq0 nz_u_n] := eqVneq u 0; first by rewrite invr0. case=> p nz_p pu0; exists (Poly (rev p)). apply/eqP=> /polyP/(_ 0%N); rewrite coef_Poly coef0 nth_rev ?size_poly_gt0 //. by apply/eqP; rewrite subn1 lead_coef_eq0. apply/eqP/(mulfI (nz_u_n (size p).-1)); rewrite mulr0 -(rootP pu0). rewrite (@horner_coef_wide _ (size p)); last first. by rewrite size_map_poly -(size_rev p) size_Poly. rewrite horner_coef mulr_sumr size_map_poly. rewrite [rhs in _ = rhs](reindex_inj rev_ord_inj) /=. apply: eq_bigr => i _; rewrite !coef_map coef_Poly nth_rev // mulrCA. by congr (_ * _); rewrite -{1}(subnKC (valP i)) addSn addnC exprD exprVn ?mulfK. Qed. Lemma algebraic_div x y : algebraicOver FtoE x -> algebraicOver FtoE y -> algebraicOver FtoE (x / y). Proof. by move=> algFx /algebraic_inv; apply: algebraic_mul. Qed. Lemma integral_inv x : integralOver FtoE x -> integralOver FtoE x^-1. Proof. by move/integral_algebraic/algebraic_inv/integral_algebraic. Qed. Lemma integral_div x y : integralOver FtoE x -> integralOver FtoE y -> integralOver FtoE (x / y). Proof. by move=> algFx /integral_inv; apply: integral_mul. Qed. Lemma integral_root p u : p != 0 -> root p u -> {in p : seq E, integralRange FtoE} -> integralOver FtoE u. Proof. move=> nz_p pu0 algFp. have mon_p1: mk_mon p \is monic. by rewrite monicE lead_coefZ mulVf ?lead_coef_eq0. have p1u0: root (mk_mon p) u by rewrite rootE hornerZ (rootP pu0) mulr0. apply: integral_root_monic mon_p1 p1u0 _ => _ /(nthP 0)[i ltip <-]. rewrite coefZ mulrC; rewrite size_scale ?invr_eq0 ?lead_coef_eq0 // in ltip. by apply: integral_div; apply/algFp/mem_nth; rewrite -?polySpred. Qed. End IntegralOverField. (* Lifting term, formula, envs and eval to matrices. Wlog, and for the sake *) (* of simplicity, we only lift (tensor) envs to row vectors; we can always *) (* use mxvec/vec_mx to store and retrieve matrices. *) (* We don't provide definitions for addition, subtraction, scaling, etc, *) (* because they have simple matrix expressions. *) Module MatrixFormula. Section MatrixFormula. Variable F : fieldType. Local Notation False := GRing.False. Local Notation True := GRing.True. Local Notation And := GRing.And (only parsing). Local Notation Add := GRing.Add (only parsing). Local Notation Bool b := (GRing.Bool b%bool). Local Notation term := (GRing.term F). Local Notation form := (GRing.formula F). Local Notation eval := GRing.eval. Local Notation holds := GRing.holds. Local Notation qf_form := GRing.qf_form. Local Notation qf_eval := GRing.qf_eval. Definition eval_mx (e : seq F) := @map_mx term F (eval e). Definition mx_term := @map_mx F term GRing.Const. Lemma eval_mx_term e m n (A : 'M_(m, n)) : eval_mx e (mx_term A) = A. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Definition mulmx_term m n p (A : 'M[term]_(m, n)) (B : 'M_(n, p)) := \matrix_(i, k) (\big[Add/0]_j (A i j * B j k))%T. Lemma eval_mulmx e m n p (A : 'M[term]_(m, n)) (B : 'M_(n, p)) : eval_mx e (mulmx_term A B) = eval_mx e A *m eval_mx e B. Proof. apply/matrixP=> i k; rewrite !mxE /= ((big_morph (eval e)) 0 +%R) //=. by apply: eq_bigr => j _; rewrite /= !mxE. Qed. Local Notation morphAnd f := ((big_morph f) true andb). Let Schur m n (A : 'M[term]_(1 + m, 1 + n)) (a := A 0 0) := \matrix_(i, j) (drsubmx A i j - a^-1 * dlsubmx A i 0%R * ursubmx A 0%R j)%T. Fixpoint mxrank_form (r m n : nat) : 'M_(m, n) -> form := match m, n return 'M_(m, n) -> form with | m'.+1, n'.+1 => fun A : 'M_(1 + m', 1 + n') => let nzA k := A k.1 k.2 != 0 in let xSchur k := Schur (xrow k.1 0%R (xcol k.2 0%R A)) in let recf k := Bool (r > 0) /\ mxrank_form r.-1 (xSchur k) in GRing.Pick nzA recf (Bool (r == 0%N)) | _, _ => fun _ => Bool (r == 0%N) end%T. Lemma mxrank_form_qf r m n (A : 'M_(m, n)) : qf_form (mxrank_form r A). Proof. by elim: m r n A => [|m IHm] r [|n] A //=; rewrite GRing.Pick_form_qf /=. Qed. Lemma eval_mxrank e r m n (A : 'M_(m, n)) : qf_eval e (mxrank_form r A) = (\rank (eval_mx e A) == r). Proof. elim: m r n A => [|m IHm] r [|n] A /=; try by case r. rewrite GRing.eval_Pick /mxrank unlock /=; set pf := fun _ => _. rewrite -(@eq_pick _ pf) => [|k]; rewrite {}/pf ?mxE // eq_sym. case: pick => [[i j]|] //=; set B := _ - _; have:= mxrankE B. case: (Gaussian_elimination B) r => [[_ _] _] [|r] //= <-; rewrite {}IHm eqSS. by congr (\rank _ == r); apply/matrixP=> k l; rewrite !(mxE, big_ord1) !tpermR. Qed. Lemma eval_vec_mx e m n (u : 'rV_(m * n)) : eval_mx e (vec_mx u) = vec_mx (eval_mx e u). Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma eval_mxvec e m n (A : 'M_(m, n)) : eval_mx e (mxvec A) = mxvec (eval_mx e A). Proof. by rewrite -{2}[A]mxvecK eval_vec_mx vec_mxK. Qed. Section Subsetmx. Variables (m1 m2 n : nat) (A : 'M[term]_(m1, n)) (B : 'M[term]_(m2, n)). Definition submx_form := \big[And/True]_(r < n.+1) (mxrank_form r (col_mx A B) ==> mxrank_form r B)%T. Lemma eval_col_mx e : eval_mx e (col_mx A B) = col_mx (eval_mx e A) (eval_mx e B). Proof. by apply/matrixP=> i j; do 2![rewrite !mxE //; case: split => ?]. Qed. Lemma submx_form_qf : qf_form submx_form. Proof. by rewrite (morphAnd (@qf_form _)) ?big1 //= => r _; rewrite !mxrank_form_qf. Qed. Lemma eval_submx e : qf_eval e submx_form = (eval_mx e A <= eval_mx e B)%MS. Proof. rewrite (morphAnd (qf_eval e)) //= big_andE /=. apply/forallP/idP=> /= [|sAB d]; last first. rewrite !eval_mxrank eval_col_mx -addsmxE; apply/implyP=> /eqP <-. by rewrite mxrank_leqif_sup ?addsmxSr // addsmx_sub sAB /=. move/(_ (inord (\rank (eval_mx e (col_mx A B))))). rewrite inordK ?ltnS ?rank_leq_col // !eval_mxrank eqxx /= eval_col_mx. by rewrite -addsmxE mxrank_leqif_sup ?addsmxSr // addsmx_sub; case/andP. Qed. End Subsetmx. Section Env. Variable d : nat. Definition seq_of_rV (v : 'rV_d) : seq F := fgraph [ffun i => v 0 i]. Lemma size_seq_of_rV v : size (seq_of_rV v) = d. Proof. by rewrite tuple.size_tuple card_ord. Qed. Lemma nth_seq_of_rV x0 v (i : 'I_d) : nth x0 (seq_of_rV v) i = v 0 i. Proof. by rewrite nth_fgraph_ord ffunE. Qed. Definition row_var k : 'rV[term]_d := \row_i ('X_(k * d + i))%T. Definition row_env (e : seq 'rV_d) := flatten (map seq_of_rV e). Lemma nth_row_env e k (i : 'I_d) : (row_env e)`_(k * d + i) = e`_k 0 i. Proof. elim: e k => [|v e IHe] k; first by rewrite !nth_nil mxE. rewrite /row_env /= nth_cat size_seq_of_rV. case: k => [|k]; first by rewrite (valP i) nth_seq_of_rV. by rewrite mulSn -addnA -if_neg -leqNgt leq_addr addKn IHe. Qed. Lemma eval_row_var e k : eval_mx (row_env e) (row_var k) = e`_k :> 'rV_d. Proof. by apply/rowP=> i; rewrite !mxE /= nth_row_env. Qed. Definition Exists_row_form k (f : form) := foldr GRing.Exists f (codom (fun i : 'I_d => k * d + i)%N). Lemma Exists_rowP e k f : d > 0 -> ((exists v : 'rV[F]_d, holds (row_env (set_nth 0 e k v)) f) <-> holds (row_env e) (Exists_row_form k f)). Proof. move=> d_gt0; pose i_ j := Ordinal (ltn_pmod j d_gt0). have d_eq j: (j = j %/ d * d + i_ j)%N := divn_eq j d. split=> [[v f_v] | ]; last case/GRing.foldExistsP=> e' ee' f_e'. apply/GRing.foldExistsP; exists (row_env (set_nth 0 e k v)) => {f f_v}// j. rewrite [j]d_eq !nth_row_env nth_set_nth /=; case: eqP => // ->. by case/imageP; exists (i_ j). exists (\row_i e'`_(k * d + i)); apply: eq_holds f_e' => j /=. move/(_ j): ee'; rewrite [j]d_eq !nth_row_env nth_set_nth /=. case: eqP => [-> | ne_j_k -> //]; first by rewrite mxE. apply/mapP=> [[r lt_r_d]]; rewrite -d_eq => def_j; case: ne_j_k. by rewrite def_j divnMDl // divn_small ?addn0. Qed. End Env. End MatrixFormula. End MatrixFormula. math-comp-mathcomp-1.12.0/mathcomp/algebra/poly.v000066400000000000000000003074311375767750300217010ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import fintype bigop div ssralg countalg binomial tuple. (******************************************************************************) (* This file provides a library for univariate polynomials over ring *) (* structures; it also provides an extended theory for polynomials whose *) (* coefficients range over commutative rings and integral domains. *) (* *) (* {poly R} == the type of polynomials with coefficients of type R, *) (* represented as lists with a non zero last element *) (* (big endian representation); the coefficient type R *) (* must have a canonical ringType structure cR. In fact *) (* {poly R} denotes the concrete type polynomial cR; R *) (* is just a phantom argument that lets type inference *) (* reconstruct the (hidden) ringType structure cR. *) (* p : seq R == the big-endian sequence of coefficients of p, via *) (* the coercion polyseq : polynomial >-> seq. *) (* Poly s == the polynomial with coefficient sequence s (ignoring *) (* trailing zeroes). *) (* \poly_(i < n) E(i) == the polynomial of degree at most n - 1 whose *) (* coefficients are given by the general term E(i) *) (* 0, 1, - p, p + q, == the usual ring operations: {poly R} has a canonical *) (* p * q, p ^+ n, ... ringType structure, which is commutative / integral *) (* when R is commutative / integral, respectively. *) (* polyC c, c%:P == the constant polynomial c *) (* 'X == the (unique) variable *) (* 'X^n == a power of 'X; 'X^0 is 1, 'X^1 is convertible to 'X *) (* p`_i == the coefficient of 'X^i in p; this is in fact just *) (* the ring_scope notation generic seq-indexing using *) (* nth 0%R, combined with the polyseq coercion. *) (* coefp i == the linear function p |-> p`_i (self-exapanding). *) (* size p == 1 + the degree of p, or 0 if p = 0 (this is the *) (* generic seq function combined with polyseq). *) (* lead_coef p == the coefficient of the highest monomial in p, or 0 *) (* if p = 0 (hence lead_coef p = 0 iff p = 0) *) (* p \is monic <=> lead_coef p == 1 (0 is not monic). *) (* p \is a polyOver S <=> the coefficients of p satisfy S; S should have a *) (* key that should be (at least) an addrPred. *) (* p.[x] == the evaluation of a polynomial p at a point x using *) (* the Horner scheme *) (* *** The multi-rule hornerE (resp., hornerE_comm) unwinds *) (* horner evaluation of a polynomial expression (resp., *) (* in a non commutative ring, with side conditions). *) (* p^`() == formal derivative of p *) (* p^`(n) == formal n-derivative of p *) (* p^`N(n) == formal n-derivative of p divided by n! *) (* p \Po q == polynomial composition; because this is naturally a *) (* a linear morphism in the first argument, this *) (* notation is transposed (q comes before p for redex *) (* selection, etc). *) (* := \sum(i < size p) p`_i *: q ^+ i *) (* comm_poly p x == x and p.[x] commute; this is a sufficient condition *) (* for evaluating (q * p).[x] as q.[x] * p.[x] when R *) (* is not commutative. *) (* comm_coef p x == x commutes with all the coefficients of p (clearly, *) (* this implies comm_poly p x). *) (* root p x == x is a root of p, i.e., p.[x] = 0 *) (* n.-unity_root x == x is an nth root of unity, i.e., a root of 'X^n - 1 *) (* n.-primitive_root x == x is a primitive nth root of unity, i.e., n is the *) (* least positive integer m > 0 such that x ^+ m = 1. *) (* *** The submodule poly.UnityRootTheory can be used to *) (* import selectively the part of the theory of roots *) (* of unity that doesn't mention polynomials explicitly *) (* map_poly f p == the image of the polynomial by the function f (which *) (* (locally, p^f) is usually a ring morphism). *) (* p^:P == p lifted to {poly {poly R}} (:= map_poly polyC p). *) (* commr_rmorph f u == u commutes with the image of f (i.e., with all f x). *) (* horner_morph cfu == given cfu : commr_rmorph f u, the function mapping p *) (* to the value of map_poly f p at u; this is a ring *) (* morphism from {poly R} to the codomain of f when f *) (* is a ring morphism. *) (* horner_eval u == the function mapping p to p.[u]; this function can *) (* only be used for u in a commutative ring, so it is *) (* always a linear ring morphism from {poly R} to R. *) (* horner_alg a == given a in some R-algebra A, the function evaluating *) (* a polynomial p at a; it is always a linear ring *) (* morphism from {poly R} to A. *) (* diff_roots x y == x and y are distinct roots; if R is a field, this *) (* just means x != y, but this concept is generalized *) (* to the case where R is only a ring with units (i.e., *) (* a unitRingType); in which case it means that x and y *) (* commute, and that the difference x - y is a unit *) (* (i.e., has a multiplicative inverse) in R. *) (* to just x != y). *) (* uniq_roots s == s is a sequence or pairwise distinct roots, in the *) (* sense of diff_roots p above. *) (* *** We only show that these operations and properties are transferred by *) (* morphisms whose domain is a field (thus ensuring injectivity). *) (* We prove the factor_theorem, and the max_poly_roots inequality relating *) (* the number of distinct roots of a polynomial and its size. *) (* The some polynomial lemmas use following suffix interpretation : *) (* C - constant polynomial (as in polyseqC : a%:P = nseq (a != 0) a). *) (* X - the polynomial variable 'X (as in coefX : 'X`_i = (i == 1%N)). *) (* Xn - power of 'X (as in monicXn : monic 'X^n). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope unity_root_scope. Import GRing.Theory. Local Open Scope ring_scope. Reserved Notation "{ 'poly' T }" (at level 0, format "{ 'poly' T }"). Reserved Notation "c %:P" (at level 2, format "c %:P"). Reserved Notation "p ^:P" (at level 2, format "p ^:P"). Reserved Notation "'X" (at level 0). Reserved Notation "''X^' n" (at level 3, n at level 2, format "''X^' n"). Reserved Notation "\poly_ ( i < n ) E" (at level 36, E at level 36, i, n at level 50, format "\poly_ ( i < n ) E"). Reserved Notation "p \Po q" (at level 50). Reserved Notation "p ^`N ( n )" (at level 8, format "p ^`N ( n )"). Reserved Notation "n .-unity_root" (at level 2, format "n .-unity_root"). Reserved Notation "n .-primitive_root" (at level 2, format "n .-primitive_root"). Local Notation simp := Monoid.simpm. Section Polynomial. Variable R : ringType. (* Defines a polynomial as a sequence with <> 0 last element *) Record polynomial := Polynomial {polyseq :> seq R; _ : last 1 polyseq != 0}. Canonical polynomial_subType := Eval hnf in [subType for polyseq]. Definition polynomial_eqMixin := Eval hnf in [eqMixin of polynomial by <:]. Canonical polynomial_eqType := Eval hnf in EqType polynomial polynomial_eqMixin. Definition polynomial_choiceMixin := [choiceMixin of polynomial by <:]. Canonical polynomial_choiceType := Eval hnf in ChoiceType polynomial polynomial_choiceMixin. Lemma poly_inj : injective polyseq. Proof. exact: val_inj. Qed. Definition poly_of of phant R := polynomial. Identity Coercion type_poly_of : poly_of >-> polynomial. Definition coefp i (p : poly_of (Phant R)) := p`_i. End Polynomial. (* We need to break off the section here to let the Bind Scope directives *) (* take effect. *) Bind Scope ring_scope with poly_of. Bind Scope ring_scope with polynomial. Arguments polyseq {R} p%R. Arguments poly_inj {R} [p1%R p2%R] : rename. Arguments coefp {R} i%N / p%R. Notation "{ 'poly' T }" := (poly_of (Phant T)). Definition poly_countMixin (R : countRingType) := [countMixin of polynomial R by <:]. Canonical polynomial_countType R := CountType _ (poly_countMixin R). Canonical poly_countType (R : countRingType) := [countType of {poly R}]. Section PolynomialTheory. Variable R : ringType. Implicit Types (a b c x y z : R) (p q r d : {poly R}). Canonical poly_subType := Eval hnf in [subType of {poly R}]. Canonical poly_eqType := Eval hnf in [eqType of {poly R}]. Canonical poly_choiceType := Eval hnf in [choiceType of {poly R}]. Definition lead_coef p := p`_(size p).-1. Lemma lead_coefE p : lead_coef p = p`_(size p).-1. Proof. by []. Qed. Definition poly_nil := @Polynomial R [::] (oner_neq0 R). Definition polyC c : {poly R} := insubd poly_nil [:: c]. Local Notation "c %:P" := (polyC c). (* Remember the boolean (c != 0) is coerced to 1 if true and 0 if false *) Lemma polyseqC c : c%:P = nseq (c != 0) c :> seq R. Proof. by rewrite val_insubd /=; case: (c == 0). Qed. Lemma size_polyC c : size c%:P = (c != 0). Proof. by rewrite polyseqC size_nseq. Qed. Lemma coefC c i : c%:P`_i = if i == 0%N then c else 0. Proof. by rewrite polyseqC; case: i => [|[]]; case: eqP. Qed. Lemma polyCK : cancel polyC (coefp 0). Proof. by move=> c; rewrite [coefp 0 _]coefC. Qed. Lemma polyC_inj : injective polyC. Proof. by move=> c1 c2 eqc12; have:= coefC c2 0; rewrite -eqc12 coefC. Qed. Lemma lead_coefC c : lead_coef c%:P = c. Proof. by rewrite /lead_coef polyseqC; case: eqP. Qed. (* Extensional interpretation (poly <=> nat -> R) *) Lemma polyP p q : nth 0 p =1 nth 0 q <-> p = q. Proof. split=> [eq_pq | -> //]; apply: poly_inj. without loss lt_pq: p q eq_pq / size p < size q. move=> IH; case: (ltngtP (size p) (size q)); try by move/IH->. by move/(@eq_from_nth _ 0); apply. case: q => q nz_q /= in lt_pq eq_pq *; case/eqP: nz_q. by rewrite (last_nth 0) -(subnKC lt_pq) /= -eq_pq nth_default ?leq_addr. Qed. Lemma size1_polyC p : size p <= 1 -> p = (p`_0)%:P. Proof. move=> le_p_1; apply/polyP=> i; rewrite coefC. by case: i => // i; rewrite nth_default // (leq_trans le_p_1). Qed. (* Builds a polynomial by extension. *) Definition cons_poly c p : {poly R} := if p is Polynomial ((_ :: _) as s) ns then @Polynomial R (c :: s) ns else c%:P. Lemma polyseq_cons c p : cons_poly c p = (if ~~ nilp p then c :: p else c%:P) :> seq R. Proof. by case: p => [[]]. Qed. Lemma size_cons_poly c p : size (cons_poly c p) = (if nilp p && (c == 0) then 0%N else (size p).+1). Proof. by case: p => [[|c' s] _] //=; rewrite size_polyC; case: eqP. Qed. Lemma coef_cons c p i : (cons_poly c p)`_i = if i == 0%N then c else p`_i.-1. Proof. by case: p i => [[|c' s] _] [] //=; rewrite polyseqC; case: eqP => //= _ []. Qed. (* Build a polynomial directly from a list of coefficients. *) Definition Poly := foldr cons_poly 0%:P. Lemma PolyK c s : last c s != 0 -> Poly s = s :> seq R. Proof. case: s => {c}/= [_ |c s]; first by rewrite polyseqC eqxx. elim: s c => /= [|a s IHs] c nz_c; rewrite polyseq_cons ?{}IHs //. by rewrite !polyseqC !eqxx nz_c. Qed. Lemma polyseqK p : Poly p = p. Proof. by apply: poly_inj; apply: PolyK (valP p). Qed. Lemma size_Poly s : size (Poly s) <= size s. Proof. elim: s => [|c s IHs] /=; first by rewrite polyseqC eqxx. by rewrite polyseq_cons; case: ifP => // _; rewrite size_polyC; case: (~~ _). Qed. Lemma coef_Poly s i : (Poly s)`_i = s`_i. Proof. by elim: s i => [|c s IHs] /= [|i]; rewrite !(coefC, eqxx, coef_cons) /=. Qed. (* Build a polynomial from an infinite sequence of coefficients and a bound. *) Definition poly_expanded_def n E := Poly (mkseq E n). Fact poly_key : unit. Proof. by []. Qed. Definition poly := locked_with poly_key poly_expanded_def. Canonical poly_unlockable := [unlockable fun poly]. Local Notation "\poly_ ( i < n ) E" := (poly n (fun i : nat => E)). Lemma polyseq_poly n E : E n.-1 != 0 -> \poly_(i < n) E i = mkseq [eta E] n :> seq R. Proof. rewrite unlock; case: n => [|n] nzEn; first by rewrite polyseqC eqxx. by rewrite (@PolyK 0) // -nth_last nth_mkseq size_mkseq. Qed. Lemma size_poly n E : size (\poly_(i < n) E i) <= n. Proof. by rewrite unlock (leq_trans (size_Poly _)) ?size_mkseq. Qed. Lemma size_poly_eq n E : E n.-1 != 0 -> size (\poly_(i < n) E i) = n. Proof. by move/polyseq_poly->; apply: size_mkseq. Qed. Lemma coef_poly n E k : (\poly_(i < n) E i)`_k = (if k < n then E k else 0). Proof. rewrite unlock coef_Poly. have [lt_kn | le_nk] := ltnP k n; first by rewrite nth_mkseq. by rewrite nth_default // size_mkseq. Qed. Lemma lead_coef_poly n E : n > 0 -> E n.-1 != 0 -> lead_coef (\poly_(i < n) E i) = E n.-1. Proof. by case: n => // n _ nzE; rewrite /lead_coef size_poly_eq // coef_poly leqnn. Qed. Lemma coefK p : \poly_(i < size p) p`_i = p. Proof. by apply/polyP=> i; rewrite coef_poly; case: ltnP => // /(nth_default 0)->. Qed. (* Zmodule structure for polynomial *) Definition add_poly_def p q := \poly_(i < maxn (size p) (size q)) (p`_i + q`_i). Fact add_poly_key : unit. Proof. by []. Qed. Definition add_poly := locked_with add_poly_key add_poly_def. Canonical add_poly_unlockable := [unlockable fun add_poly]. Definition opp_poly_def p := \poly_(i < size p) - p`_i. Fact opp_poly_key : unit. Proof. by []. Qed. Definition opp_poly := locked_with opp_poly_key opp_poly_def. Canonical opp_poly_unlockable := [unlockable fun opp_poly]. Fact coef_add_poly p q i : (add_poly p q)`_i = p`_i + q`_i. Proof. rewrite unlock coef_poly; case: leqP => //. by rewrite geq_max => /andP[le_p_i le_q_i]; rewrite !nth_default ?add0r. Qed. Fact coef_opp_poly p i : (opp_poly p)`_i = - p`_i. Proof. rewrite unlock coef_poly /=. by case: leqP => // le_p_i; rewrite nth_default ?oppr0. Qed. Fact add_polyA : associative add_poly. Proof. by move=> p q r; apply/polyP=> i; rewrite !coef_add_poly addrA. Qed. Fact add_polyC : commutative add_poly. Proof. by move=> p q; apply/polyP=> i; rewrite !coef_add_poly addrC. Qed. Fact add_poly0 : left_id 0%:P add_poly. Proof. by move=> p; apply/polyP=> i; rewrite coef_add_poly coefC if_same add0r. Qed. Fact add_polyN : left_inverse 0%:P opp_poly add_poly. Proof. move=> p; apply/polyP=> i. by rewrite coef_add_poly coef_opp_poly coefC if_same addNr. Qed. Definition poly_zmodMixin := ZmodMixin add_polyA add_polyC add_poly0 add_polyN. Canonical poly_zmodType := Eval hnf in ZmodType {poly R} poly_zmodMixin. Canonical polynomial_zmodType := Eval hnf in ZmodType (polynomial R) poly_zmodMixin. (* Properties of the zero polynomial *) Lemma polyC0 : 0%:P = 0 :> {poly R}. Proof. by []. Qed. Lemma polyseq0 : (0 : {poly R}) = [::] :> seq R. Proof. by rewrite polyseqC eqxx. Qed. Lemma size_poly0 : size (0 : {poly R}) = 0%N. Proof. by rewrite polyseq0. Qed. Lemma coef0 i : (0 : {poly R})`_i = 0. Proof. by rewrite coefC if_same. Qed. Lemma lead_coef0 : lead_coef 0 = 0 :> R. Proof. exact: lead_coefC. Qed. Lemma size_poly_eq0 p : (size p == 0%N) = (p == 0). Proof. by rewrite size_eq0 -polyseq0. Qed. Lemma size_poly_leq0 p : (size p <= 0) = (p == 0). Proof. by rewrite leqn0 size_poly_eq0. Qed. Lemma size_poly_leq0P p : reflect (p = 0) (size p <= 0%N). Proof. by apply: (iffP idP); rewrite size_poly_leq0; move/eqP. Qed. Lemma size_poly_gt0 p : (0 < size p) = (p != 0). Proof. by rewrite lt0n size_poly_eq0. Qed. Lemma gt_size_poly_neq0 p n : (size p > n)%N -> p != 0. Proof. by move=> /(leq_ltn_trans _) h; rewrite -size_poly_eq0 lt0n_neq0 ?h. Qed. Lemma nil_poly p : nilp p = (p == 0). Proof. exact: size_poly_eq0. Qed. Lemma poly0Vpos p : {p = 0} + {size p > 0}. Proof. by rewrite lt0n size_poly_eq0; case: eqVneq; [left | right]. Qed. Lemma polySpred p : p != 0 -> size p = (size p).-1.+1. Proof. by rewrite -size_poly_eq0 -lt0n => /prednK. Qed. Lemma lead_coef_eq0 p : (lead_coef p == 0) = (p == 0). Proof. rewrite -nil_poly /lead_coef nth_last. by case: p => [[|x s] /= /negbTE // _]; rewrite eqxx. Qed. Lemma polyC_eq0 (c : R) : (c%:P == 0) = (c == 0). Proof. by rewrite -nil_poly polyseqC; case: (c == 0). Qed. Lemma size_poly1P p : reflect (exists2 c, c != 0 & p = c%:P) (size p == 1%N). Proof. apply: (iffP eqP) => [pC | [c nz_c ->]]; last by rewrite size_polyC nz_c. have def_p: p = (p`_0)%:P by rewrite -size1_polyC ?pC. by exists p`_0; rewrite // -polyC_eq0 -def_p -size_poly_eq0 pC. Qed. Lemma size_polyC_leq1 (c : R) : (size c%:P <= 1)%N. Proof. by rewrite size_polyC; case: (c == 0). Qed. Lemma leq_sizeP p i : reflect (forall j, i <= j -> p`_j = 0) (size p <= i). Proof. apply: (iffP idP) => [hp j hij| hp]. by apply: nth_default; apply: leq_trans hij. case: (eqVneq p) (lead_coef_eq0 p) => [->|p0]; first by rewrite size_poly0. rewrite leqNgt; apply/contraFN => hs. by apply/eqP/hp; rewrite -ltnS (ltn_predK hs). Qed. (* Size, leading coef, morphism properties of coef *) Lemma coefD p q i : (p + q)`_i = p`_i + q`_i. Proof. exact: coef_add_poly. Qed. Lemma coefN p i : (- p)`_i = - p`_i. Proof. exact: coef_opp_poly. Qed. Lemma coefB p q i : (p - q)`_i = p`_i - q`_i. Proof. by rewrite coefD coefN. Qed. Canonical coefp_additive i := Additive ((fun p => (coefB p)^~ i) : additive (coefp i)). Lemma coefMn p n i : (p *+ n)`_i = p`_i *+ n. Proof. exact: (raddfMn (coefp_additive i)). Qed. Lemma coefMNn p n i : (p *- n)`_i = p`_i *- n. Proof. by rewrite coefN coefMn. Qed. Lemma coef_sum I (r : seq I) (P : pred I) (F : I -> {poly R}) k : (\sum_(i <- r | P i) F i)`_k = \sum_(i <- r | P i) (F i)`_k. Proof. exact: (raddf_sum (coefp_additive k)). Qed. Lemma polyCD : {morph polyC : a b / a + b}. Proof. by move=> a b; apply/polyP=> [[|i]]; rewrite coefD !coefC ?addr0. Qed. Lemma polyCN : {morph polyC : c / - c}. Proof. by move=> c; apply/polyP=> [[|i]]; rewrite coefN !coefC ?oppr0. Qed. Lemma polyCB : {morph polyC : a b / a - b}. Proof. by move=> a b; rewrite polyCD polyCN. Qed. Canonical polyC_additive := Additive polyCB. Lemma polyCMn n : {morph polyC : c / c *+ n}. Proof. exact: raddfMn. Qed. Lemma size_opp p : size (- p) = size p. Proof. by apply/eqP; rewrite eqn_leq -{3}(opprK p) -[-%R]/opp_poly unlock !size_poly. Qed. Lemma lead_coefN p : lead_coef (- p) = - lead_coef p. Proof. by rewrite /lead_coef size_opp coefN. Qed. Lemma size_add p q : size (p + q) <= maxn (size p) (size q). Proof. by rewrite -[+%R]/add_poly unlock; apply: size_poly. Qed. Lemma size_addl p q : size p > size q -> size (p + q) = size p. Proof. move=> ltqp; rewrite -[+%R]/add_poly unlock size_poly_eq (maxn_idPl (ltnW _))//. by rewrite addrC nth_default ?simp ?nth_last //; case: p ltqp => [[]]. Qed. Lemma size_sum I (r : seq I) (P : pred I) (F : I -> {poly R}) : size (\sum_(i <- r | P i) F i) <= \max_(i <- r | P i) size (F i). Proof. elim/big_rec2: _ => [|i p q _ IHp]; first by rewrite size_poly0. by rewrite -(maxn_idPr IHp) maxnA leq_max size_add. Qed. Lemma lead_coefDl p q : size p > size q -> lead_coef (p + q) = lead_coef p. Proof. move=> ltqp; rewrite /lead_coef coefD size_addl //. by rewrite addrC nth_default ?simp // -ltnS (ltn_predK ltqp). Qed. Lemma lead_coefDr p q : size q > size p -> lead_coef (p + q) = lead_coef q. Proof. by move/lead_coefDl<-; rewrite addrC. Qed. (* Polynomial ring structure. *) Definition mul_poly_def p q := \poly_(i < (size p + size q).-1) (\sum_(j < i.+1) p`_j * q`_(i - j)). Fact mul_poly_key : unit. Proof. by []. Qed. Definition mul_poly := locked_with mul_poly_key mul_poly_def. Canonical mul_poly_unlockable := [unlockable fun mul_poly]. Fact coef_mul_poly p q i : (mul_poly p q)`_i = \sum_(j < i.+1) p`_j * q`_(i - j)%N. Proof. rewrite unlock coef_poly -subn1 ltn_subRL add1n; case: leqP => // le_pq_i1. rewrite big1 // => j _; have [lq_q_ij | gt_q_ij] := leqP (size q) (i - j). by rewrite [q`__]nth_default ?mulr0. rewrite nth_default ?mul0r // -(leq_add2r (size q)) (leq_trans le_pq_i1) //. by rewrite -leq_subLR -subnSK. Qed. Fact coef_mul_poly_rev p q i : (mul_poly p q)`_i = \sum_(j < i.+1) p`_(i - j)%N * q`_j. Proof. rewrite coef_mul_poly (reindex_inj rev_ord_inj) /=. by apply: eq_bigr => j _; rewrite (sub_ordK j). Qed. Fact mul_polyA : associative mul_poly. Proof. move=> p q r; apply/polyP=> i; rewrite coef_mul_poly coef_mul_poly_rev. pose coef3 j k := p`_j * (q`_(i - j - k)%N * r`_k). transitivity (\sum_(j < i.+1) \sum_(k < i.+1 | k <= i - j) coef3 j k). apply: eq_bigr => /= j _; rewrite coef_mul_poly_rev big_distrr /=. by rewrite (big_ord_narrow_leq (leq_subr _ _)). rewrite (exchange_big_dep predT) //=; apply: eq_bigr => k _. transitivity (\sum_(j < i.+1 | j <= i - k) coef3 j k). apply: eq_bigl => j; rewrite -ltnS -(ltnS j) -!subSn ?leq_ord //. by rewrite -subn_gt0 -(subn_gt0 j) -!subnDA addnC. rewrite (big_ord_narrow_leq (leq_subr _ _)) coef_mul_poly big_distrl /=. by apply: eq_bigr => j _; rewrite /coef3 -!subnDA addnC mulrA. Qed. Fact mul_1poly : left_id 1%:P mul_poly. Proof. move=> p; apply/polyP => i; rewrite coef_mul_poly big_ord_recl subn0. by rewrite big1 => [|j _]; rewrite coefC !simp. Qed. Fact mul_poly1 : right_id 1%:P mul_poly. Proof. move=> p; apply/polyP => i; rewrite coef_mul_poly_rev big_ord_recl subn0. by rewrite big1 => [|j _]; rewrite coefC !simp. Qed. Fact mul_polyDl : left_distributive mul_poly +%R. Proof. move=> p q r; apply/polyP=> i; rewrite coefD !coef_mul_poly -big_split. by apply: eq_bigr => j _; rewrite coefD mulrDl. Qed. Fact mul_polyDr : right_distributive mul_poly +%R. Proof. move=> p q r; apply/polyP=> i; rewrite coefD !coef_mul_poly -big_split. by apply: eq_bigr => j _; rewrite coefD mulrDr. Qed. Fact poly1_neq0 : 1%:P != 0 :> {poly R}. Proof. by rewrite polyC_eq0 oner_neq0. Qed. Definition poly_ringMixin := RingMixin mul_polyA mul_1poly mul_poly1 mul_polyDl mul_polyDr poly1_neq0. Canonical poly_ringType := Eval hnf in RingType {poly R} poly_ringMixin. Canonical polynomial_ringType := Eval hnf in RingType (polynomial R) poly_ringMixin. Lemma polyC1 : 1%:P = 1 :> {poly R}. Proof. by []. Qed. Lemma polyseq1 : (1 : {poly R}) = [:: 1] :> seq R. Proof. by rewrite polyseqC oner_neq0. Qed. Lemma size_poly1 : size (1 : {poly R}) = 1%N. Proof. by rewrite polyseq1. Qed. Lemma coef1 i : (1 : {poly R})`_i = (i == 0%N)%:R. Proof. by case: i => [|i]; rewrite polyseq1 /= ?nth_nil. Qed. Lemma lead_coef1 : lead_coef 1 = 1 :> R. Proof. exact: lead_coefC. Qed. Lemma coefM p q i : (p * q)`_i = \sum_(j < i.+1) p`_j * q`_(i - j)%N. Proof. exact: coef_mul_poly. Qed. Lemma coefMr p q i : (p * q)`_i = \sum_(j < i.+1) p`_(i - j)%N * q`_j. Proof. exact: coef_mul_poly_rev. Qed. Lemma size_mul_leq p q : size (p * q) <= (size p + size q).-1. Proof. by rewrite -[*%R]/mul_poly unlock size_poly. Qed. Lemma mul_lead_coef p q : lead_coef p * lead_coef q = (p * q)`_(size p + size q).-2. Proof. pose dp := (size p).-1; pose dq := (size q).-1. have [-> | nz_p] := eqVneq p 0; first by rewrite lead_coef0 !mul0r coef0. have [-> | nz_q] := eqVneq q 0; first by rewrite lead_coef0 !mulr0 coef0. have ->: (size p + size q).-2 = (dp + dq)%N. by do 2!rewrite polySpred // addSn addnC. have lt_p_pq: dp < (dp + dq).+1 by rewrite ltnS leq_addr. rewrite coefM (bigD1 (Ordinal lt_p_pq)) ?big1 ?simp ?addKn //= => i. rewrite -val_eqE neq_ltn /= => /orP[lt_i_p | gt_i_p]; last first. by rewrite nth_default ?mul0r //; rewrite -polySpred in gt_i_p. rewrite [q`__]nth_default ?mulr0 //= -subSS -{1}addnS -polySpred //. by rewrite addnC -addnBA ?leq_addr. Qed. Lemma size_proper_mul p q : lead_coef p * lead_coef q != 0 -> size (p * q) = (size p + size q).-1. Proof. apply: contraNeq; rewrite mul_lead_coef eqn_leq size_mul_leq -ltnNge => lt_pq. by rewrite nth_default // -subn1 -(leq_add2l 1) -leq_subLR leq_sub2r. Qed. Lemma lead_coef_proper_mul p q : let c := lead_coef p * lead_coef q in c != 0 -> lead_coef (p * q) = c. Proof. by move=> /= nz_c; rewrite mul_lead_coef -size_proper_mul. Qed. Lemma size_prod_leq (I : finType) (P : pred I) (F : I -> {poly R}) : size (\prod_(i | P i) F i) <= (\sum_(i | P i) size (F i)).+1 - #|P|. Proof. rewrite -sum1_card. elim/big_rec3: _ => [|i n m p _ IHp]; first by rewrite size_poly1. have [-> | nz_p] := eqVneq p 0; first by rewrite mulr0 size_poly0. rewrite (leq_trans (size_mul_leq _ _)) // subnS -!subn1 leq_sub2r //. rewrite -addnS -addnBA ?leq_add2l // ltnW // -subn_gt0 (leq_trans _ IHp) //. by rewrite polySpred. Qed. Lemma coefCM c p i : (c%:P * p)`_i = c * p`_i. Proof. rewrite coefM big_ord_recl subn0. by rewrite big1 => [|j _]; rewrite coefC !simp. Qed. Lemma coefMC c p i : (p * c%:P)`_i = p`_i * c. Proof. rewrite coefMr big_ord_recl subn0. by rewrite big1 => [|j _]; rewrite coefC !simp. Qed. Lemma polyCM : {morph polyC : a b / a * b}. Proof. by move=> a b; apply/polyP=> [[|i]]; rewrite coefCM !coefC ?simp. Qed. Fact polyC_multiplicative : multiplicative polyC. Proof. by split; first apply: polyCM. Qed. Canonical polyC_rmorphism := AddRMorphism polyC_multiplicative. Lemma polyC_exp n : {morph polyC : c / c ^+ n}. Proof. exact: rmorphX. Qed. Lemma size_exp_leq p n : size (p ^+ n) <= ((size p).-1 * n).+1. Proof. elim: n => [|n IHn]; first by rewrite size_poly1. have [-> | nzp] := poly0Vpos p; first by rewrite exprS mul0r size_poly0. rewrite exprS (leq_trans (size_mul_leq _ _)) //. by rewrite -{1}(prednK nzp) mulnS -addnS leq_add2l. Qed. Lemma size_Msign p n : size ((-1) ^+ n * p) = size p. Proof. by rewrite -signr_odd; case: (odd n); rewrite ?mul1r // mulN1r size_opp. Qed. Fact coefp0_multiplicative : multiplicative (coefp 0 : {poly R} -> R). Proof. split=> [p q|]; last by rewrite polyCK. by rewrite [coefp 0 _]coefM big_ord_recl big_ord0 addr0. Qed. Canonical coefp0_rmorphism := AddRMorphism coefp0_multiplicative. (* Algebra structure of polynomials. *) Definition scale_poly_def a (p : {poly R}) := \poly_(i < size p) (a * p`_i). Fact scale_poly_key : unit. Proof. by []. Qed. Definition scale_poly := locked_with scale_poly_key scale_poly_def. Canonical scale_poly_unlockable := [unlockable fun scale_poly]. Fact scale_polyE a p : scale_poly a p = a%:P * p. Proof. apply/polyP=> n; rewrite unlock coef_poly coefCM. by case: leqP => // le_p_n; rewrite nth_default ?mulr0. Qed. Fact scale_polyA a b p : scale_poly a (scale_poly b p) = scale_poly (a * b) p. Proof. by rewrite !scale_polyE mulrA polyCM. Qed. Fact scale_1poly : left_id 1 scale_poly. Proof. by move=> p; rewrite scale_polyE mul1r. Qed. Fact scale_polyDr a : {morph scale_poly a : p q / p + q}. Proof. by move=> p q; rewrite !scale_polyE mulrDr. Qed. Fact scale_polyDl p : {morph scale_poly^~ p : a b / a + b}. Proof. by move=> a b /=; rewrite !scale_polyE raddfD mulrDl. Qed. Fact scale_polyAl a p q : scale_poly a (p * q) = scale_poly a p * q. Proof. by rewrite !scale_polyE mulrA. Qed. Definition poly_lmodMixin := LmodMixin scale_polyA scale_1poly scale_polyDr scale_polyDl. Canonical poly_lmodType := Eval hnf in LmodType R {poly R} poly_lmodMixin. Canonical polynomial_lmodType := Eval hnf in LmodType R (polynomial R) poly_lmodMixin. Canonical poly_lalgType := Eval hnf in LalgType R {poly R} scale_polyAl. Canonical polynomial_lalgType := Eval hnf in LalgType R (polynomial R) scale_polyAl. Lemma mul_polyC a p : a%:P * p = a *: p. Proof. by rewrite -scale_polyE. Qed. Lemma alg_polyC a : a%:A = a%:P :> {poly R}. Proof. by rewrite -mul_polyC mulr1. Qed. Lemma coefZ a p i : (a *: p)`_i = a * p`_i. Proof. rewrite -[*:%R]/scale_poly unlock coef_poly. by case: leqP => // le_p_n; rewrite nth_default ?mulr0. Qed. Lemma size_scale_leq a p : size (a *: p) <= size p. Proof. by rewrite -[*:%R]/scale_poly unlock size_poly. Qed. Canonical coefp_linear i : {scalar {poly R}} := AddLinear ((fun a => (coefZ a) ^~ i) : scalable_for *%R (coefp i)). Canonical coefp0_lrmorphism := [lrmorphism of coefp 0]. (* The indeterminate, at last! *) Definition polyX_def := Poly [:: 0; 1]. Fact polyX_key : unit. Proof. by []. Qed. Definition polyX : {poly R} := locked_with polyX_key polyX_def. Canonical polyX_unlockable := [unlockable of polyX]. Local Notation "'X" := polyX. Lemma polyseqX : 'X = [:: 0; 1] :> seq R. Proof. by rewrite unlock !polyseq_cons nil_poly eqxx /= polyseq1. Qed. Lemma size_polyX : size 'X = 2. Proof. by rewrite polyseqX. Qed. Lemma polyX_eq0 : ('X == 0) = false. Proof. by rewrite -size_poly_eq0 size_polyX. Qed. Lemma coefX i : 'X`_i = (i == 1%N)%:R. Proof. by case: i => [|[|i]]; rewrite polyseqX //= nth_nil. Qed. Lemma lead_coefX : lead_coef 'X = 1. Proof. by rewrite /lead_coef polyseqX. Qed. Lemma commr_polyX p : GRing.comm p 'X. Proof. apply/polyP=> i; rewrite coefMr coefM. by apply: eq_bigr => j _; rewrite coefX commr_nat. Qed. Lemma coefMX p i : (p * 'X)`_i = (if (i == 0)%N then 0 else p`_i.-1). Proof. rewrite coefMr big_ord_recl coefX ?simp. case: i => [|i]; rewrite ?big_ord0 //= big_ord_recl polyseqX subn1 /=. by rewrite big1 ?simp // => j _; rewrite nth_nil !simp. Qed. Lemma coefXM p i : ('X * p)`_i = (if (i == 0)%N then 0 else p`_i.-1). Proof. by rewrite -commr_polyX coefMX. Qed. Lemma cons_poly_def p a : cons_poly a p = p * 'X + a%:P. Proof. apply/polyP=> i; rewrite coef_cons coefD coefMX coefC. by case: ifP; rewrite !simp. Qed. Lemma poly_ind (K : {poly R} -> Type) : K 0 -> (forall p c, K p -> K (p * 'X + c%:P)) -> (forall p, K p). Proof. move=> K0 Kcons p; rewrite -[p]polyseqK. by elim: {p}(p : seq R) => //= p c IHp; rewrite cons_poly_def; apply: Kcons. Qed. Lemma polyseqXsubC a : 'X - a%:P = [:: - a; 1] :> seq R. Proof. by rewrite -['X]mul1r -polyCN -cons_poly_def polyseq_cons polyseq1. Qed. Lemma size_XsubC a : size ('X - a%:P) = 2%N. Proof. by rewrite polyseqXsubC. Qed. Lemma size_XaddC b : size ('X + b%:P) = 2. Proof. by rewrite -[b]opprK rmorphN size_XsubC. Qed. Lemma lead_coefXsubC a : lead_coef ('X - a%:P) = 1. Proof. by rewrite lead_coefE polyseqXsubC. Qed. Lemma polyXsubC_eq0 a : ('X - a%:P == 0) = false. Proof. by rewrite -nil_poly polyseqXsubC. Qed. Lemma size_MXaddC p c : size (p * 'X + c%:P) = (if (p == 0) && (c == 0) then 0%N else (size p).+1). Proof. by rewrite -cons_poly_def size_cons_poly nil_poly. Qed. Lemma polyseqMX p : p != 0 -> p * 'X = 0 :: p :> seq R. Proof. by move=> nz_p; rewrite -[p * _]addr0 -cons_poly_def polyseq_cons nil_poly nz_p. Qed. Lemma size_mulX p : p != 0 -> size (p * 'X) = (size p).+1. Proof. by move/polyseqMX->. Qed. Lemma lead_coefMX p : lead_coef (p * 'X) = lead_coef p. Proof. have [-> | nzp] := eqVneq p 0; first by rewrite mul0r. by rewrite /lead_coef !nth_last polyseqMX. Qed. Lemma size_XmulC a : a != 0 -> size ('X * a%:P) = 2. Proof. by move=> nz_a; rewrite -commr_polyX size_mulX ?polyC_eq0 ?size_polyC nz_a. Qed. Local Notation "''X^' n" := ('X ^+ n). Lemma coefXn n i : 'X^n`_i = (i == n)%:R. Proof. by elim: n i => [|n IHn] [|i]; rewrite ?coef1 // exprS coefXM ?IHn. Qed. Lemma polyseqXn n : 'X^n = rcons (nseq n 0) 1 :> seq R. Proof. elim: n => [|n IHn]; rewrite ?polyseq1 // exprSr. by rewrite polyseqMX -?size_poly_eq0 IHn ?size_rcons. Qed. Lemma size_polyXn n : size 'X^n = n.+1. Proof. by rewrite polyseqXn size_rcons size_nseq. Qed. Lemma commr_polyXn p n : GRing.comm p 'X^n. Proof. exact/commrX/commr_polyX. Qed. Lemma lead_coefXn n : lead_coef 'X^n = 1. Proof. by rewrite /lead_coef nth_last polyseqXn last_rcons. Qed. Lemma polyseqMXn n p : p != 0 -> p * 'X^n = ncons n 0 p :> seq R. Proof. case: n => [|n] nz_p; first by rewrite mulr1. elim: n => [|n IHn]; first exact: polyseqMX. by rewrite exprSr mulrA polyseqMX -?nil_poly IHn. Qed. Lemma coefMXn n p i : (p * 'X^n)`_i = if i < n then 0 else p`_(i - n). Proof. have [-> | /polyseqMXn->] := eqVneq p 0; last exact: nth_ncons. by rewrite mul0r !coef0 if_same. Qed. Lemma coefXnM n p i : ('X^n * p)`_i = if i < n then 0 else p`_(i - n). Proof. by rewrite -commr_polyXn coefMXn. Qed. (* Expansion of a polynomial as an indexed sum *) Lemma poly_def n E : \poly_(i < n) E i = \sum_(i < n) E i *: 'X^i. Proof. rewrite unlock; elim: n => [|n IHn] in E *; first by rewrite big_ord0. rewrite big_ord_recl /= cons_poly_def addrC expr0 alg_polyC. congr (_ + _); rewrite (iotaDl 1 0) -map_comp IHn big_distrl /=. by apply: eq_bigr => i _; rewrite -scalerAl exprSr. Qed. (* Monic predicate *) Definition monic := [qualify p | lead_coef p == 1]. Fact monic_key : pred_key monic. Proof. by []. Qed. Canonical monic_keyed := KeyedQualifier monic_key. Lemma monicE p : (p \is monic) = (lead_coef p == 1). Proof. by []. Qed. Lemma monicP p : reflect (lead_coef p = 1) (p \is monic). Proof. exact: eqP. Qed. Lemma monic1 : 1 \is monic. Proof. exact/eqP/lead_coef1. Qed. Lemma monicX : 'X \is monic. Proof. exact/eqP/lead_coefX. Qed. Lemma monicXn n : 'X^n \is monic. Proof. exact/eqP/lead_coefXn. Qed. Lemma monic_neq0 p : p \is monic -> p != 0. Proof. by rewrite -lead_coef_eq0 => /eqP->; apply: oner_neq0. Qed. Lemma lead_coef_monicM p q : p \is monic -> lead_coef (p * q) = lead_coef q. Proof. have [-> | nz_q] := eqVneq q 0; first by rewrite mulr0. by move/monicP=> mon_p; rewrite lead_coef_proper_mul mon_p mul1r ?lead_coef_eq0. Qed. Lemma lead_coef_Mmonic p q : q \is monic -> lead_coef (p * q) = lead_coef p. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite mul0r. by move/monicP=> mon_q; rewrite lead_coef_proper_mul mon_q mulr1 ?lead_coef_eq0. Qed. Lemma size_monicM p q : p \is monic -> q != 0 -> size (p * q) = (size p + size q).-1. Proof. move/monicP=> mon_p nz_q. by rewrite size_proper_mul // mon_p mul1r lead_coef_eq0. Qed. Lemma size_Mmonic p q : p != 0 -> q \is monic -> size (p * q) = (size p + size q).-1. Proof. move=> nz_p /monicP mon_q. by rewrite size_proper_mul // mon_q mulr1 lead_coef_eq0. Qed. Lemma monicMl p q : p \is monic -> (p * q \is monic) = (q \is monic). Proof. by move=> mon_p; rewrite !monicE lead_coef_monicM. Qed. Lemma monicMr p q : q \is monic -> (p * q \is monic) = (p \is monic). Proof. by move=> mon_q; rewrite !monicE lead_coef_Mmonic. Qed. Fact monic_mulr_closed : mulr_closed monic. Proof. by split=> [|p q mon_p]; rewrite (monic1, monicMl). Qed. Canonical monic_mulrPred := MulrPred monic_mulr_closed. Lemma monic_exp p n : p \is monic -> p ^+ n \is monic. Proof. exact: rpredX. Qed. Lemma monic_prod I rI (P : pred I) (F : I -> {poly R}): (forall i, P i -> F i \is monic) -> \prod_(i <- rI | P i) F i \is monic. Proof. exact: rpred_prod. Qed. Lemma monicXsubC c : 'X - c%:P \is monic. Proof. exact/eqP/lead_coefXsubC. Qed. Lemma monic_prod_XsubC I rI (P : pred I) (F : I -> R) : \prod_(i <- rI | P i) ('X - (F i)%:P) \is monic. Proof. by apply: monic_prod => i _; apply: monicXsubC. Qed. Lemma size_prod_XsubC I rI (F : I -> R) : size (\prod_(i <- rI) ('X - (F i)%:P)) = (size rI).+1. Proof. elim: rI => [|i r /= <-]; rewrite ?big_nil ?size_poly1 // big_cons. rewrite size_monicM ?monicXsubC ?monic_neq0 ?monic_prod_XsubC //. by rewrite size_XsubC. Qed. Lemma size_exp_XsubC n a : size (('X - a%:P) ^+ n) = n.+1. Proof. rewrite -[n]card_ord -prodr_const -big_filter size_prod_XsubC. by have [e _ _ [_ ->]] := big_enumP. Qed. (* Some facts about regular elements. *) Lemma lreg_lead p : GRing.lreg (lead_coef p) -> GRing.lreg p. Proof. move/mulrI_eq0=> reg_p; apply: mulrI0_lreg => q /eqP; apply: contraTeq => nz_q. by rewrite -lead_coef_eq0 lead_coef_proper_mul reg_p lead_coef_eq0. Qed. Lemma rreg_lead p : GRing.rreg (lead_coef p) -> GRing.rreg p. Proof. move/mulIr_eq0=> reg_p; apply: mulIr0_rreg => q /eqP; apply: contraTeq => nz_q. by rewrite -lead_coef_eq0 lead_coef_proper_mul reg_p lead_coef_eq0. Qed. Lemma lreg_lead0 p : GRing.lreg (lead_coef p) -> p != 0. Proof. by move/lreg_neq0; rewrite lead_coef_eq0. Qed. Lemma rreg_lead0 p : GRing.rreg (lead_coef p) -> p != 0. Proof. by move/rreg_neq0; rewrite lead_coef_eq0. Qed. Lemma lreg_size c p : GRing.lreg c -> size (c *: p) = size p. Proof. move=> reg_c; have [-> | nz_p] := eqVneq p 0; first by rewrite scaler0. rewrite -mul_polyC size_proper_mul; first by rewrite size_polyC lreg_neq0. by rewrite lead_coefC mulrI_eq0 ?lead_coef_eq0. Qed. Lemma lreg_polyZ_eq0 c p : GRing.lreg c -> (c *: p == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 => /lreg_size->. Qed. Lemma lead_coef_lreg c p : GRing.lreg c -> lead_coef (c *: p) = c * lead_coef p. Proof. by move=> reg_c; rewrite !lead_coefE coefZ lreg_size. Qed. Lemma rreg_size c p : GRing.rreg c -> size (p * c%:P) = size p. Proof. move=> reg_c; have [-> | nz_p] := eqVneq p 0; first by rewrite mul0r. rewrite size_proper_mul; first by rewrite size_polyC rreg_neq0 ?addn1. by rewrite lead_coefC mulIr_eq0 ?lead_coef_eq0. Qed. Lemma rreg_polyMC_eq0 c p : GRing.rreg c -> (p * c%:P == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 => /rreg_size->. Qed. Lemma rreg_div0 q r d : GRing.rreg (lead_coef d) -> size r < size d -> (q * d + r == 0) = (q == 0) && (r == 0). Proof. move=> reg_d lt_r_d; rewrite addrC addr_eq0. have [-> | nz_q] := eqVneq q 0; first by rewrite mul0r oppr0. apply: contraTF lt_r_d => /eqP->; rewrite -leqNgt size_opp. rewrite size_proper_mul ?mulIr_eq0 ?lead_coef_eq0 //. by rewrite (polySpred nz_q) leq_addl. Qed. Lemma monic_comreg p : p \is monic -> GRing.comm p (lead_coef p)%:P /\ GRing.rreg (lead_coef p). Proof. by move/monicP->; split; [apply: commr1 | apply: rreg1]. Qed. (* Horner evaluation of polynomials *) Implicit Types s rs : seq R. Fixpoint horner_rec s x := if s is a :: s' then horner_rec s' x * x + a else 0. Definition horner p := horner_rec p. Local Notation "p .[ x ]" := (horner p x) : ring_scope. Lemma horner0 x : (0 : {poly R}).[x] = 0. Proof. by rewrite /horner polyseq0. Qed. Lemma hornerC c x : (c%:P).[x] = c. Proof. by rewrite /horner polyseqC; case: eqP; rewrite /= ?simp. Qed. Lemma hornerX x : 'X.[x] = x. Proof. by rewrite /horner polyseqX /= !simp. Qed. Lemma horner_cons p c x : (cons_poly c p).[x] = p.[x] * x + c. Proof. rewrite /horner polyseq_cons; case: nilP => //= ->. by rewrite !simp -/(_.[x]) hornerC. Qed. Lemma horner_coef0 p : p.[0] = p`_0. Proof. by rewrite /horner; case: (p : seq R) => //= c p'; rewrite !simp. Qed. Lemma hornerMXaddC p c x : (p * 'X + c%:P).[x] = p.[x] * x + c. Proof. by rewrite -cons_poly_def horner_cons. Qed. Lemma hornerMX p x : (p * 'X).[x] = p.[x] * x. Proof. by rewrite -[p * 'X]addr0 hornerMXaddC addr0. Qed. Lemma horner_Poly s x : (Poly s).[x] = horner_rec s x. Proof. by elim: s => [|a s /= <-]; rewrite (horner0, horner_cons). Qed. Lemma horner_coef p x : p.[x] = \sum_(i < size p) p`_i * x ^+ i. Proof. rewrite /horner. elim: {p}(p : seq R) => /= [|a s ->]; first by rewrite big_ord0. rewrite big_ord_recl simp addrC big_distrl /=. by congr (_ + _); apply: eq_bigr => i _; rewrite -mulrA exprSr. Qed. Lemma horner_coef_wide n p x : size p <= n -> p.[x] = \sum_(i < n) p`_i * x ^+ i. Proof. move=> le_p_n. rewrite horner_coef (big_ord_widen n (fun i => p`_i * x ^+ i)) // big_mkcond. by apply: eq_bigr => i _; case: ltnP => // le_p_i; rewrite nth_default ?simp. Qed. Lemma horner_poly n E x : (\poly_(i < n) E i).[x] = \sum_(i < n) E i * x ^+ i. Proof. rewrite (@horner_coef_wide n) ?size_poly //. by apply: eq_bigr => i _; rewrite coef_poly ltn_ord. Qed. Lemma hornerN p x : (- p).[x] = - p.[x]. Proof. rewrite -[-%R]/opp_poly unlock horner_poly horner_coef -sumrN /=. by apply: eq_bigr => i _; rewrite mulNr. Qed. Lemma hornerD p q x : (p + q).[x] = p.[x] + q.[x]. Proof. rewrite -[+%R]/add_poly unlock horner_poly; set m := maxn _ _. rewrite !(@horner_coef_wide m) ?leq_max ?leqnn ?orbT // -big_split /=. by apply: eq_bigr => i _; rewrite -mulrDl. Qed. Lemma hornerXsubC a x : ('X - a%:P).[x] = x - a. Proof. by rewrite hornerD hornerN hornerC hornerX. Qed. Lemma horner_sum I (r : seq I) (P : pred I) F x : (\sum_(i <- r | P i) F i).[x] = \sum_(i <- r | P i) (F i).[x]. Proof. by elim/big_rec2: _ => [|i _ p _ <-]; rewrite (horner0, hornerD). Qed. Lemma hornerCM a p x : (a%:P * p).[x] = a * p.[x]. Proof. elim/poly_ind: p => [|p c IHp]; first by rewrite !(mulr0, horner0). by rewrite mulrDr mulrA -polyCM !hornerMXaddC IHp mulrDr mulrA. Qed. Lemma hornerZ c p x : (c *: p).[x] = c * p.[x]. Proof. by rewrite -mul_polyC hornerCM. Qed. Lemma hornerMn n p x : (p *+ n).[x] = p.[x] *+ n. Proof. by elim: n => [| n IHn]; rewrite ?horner0 // !mulrS hornerD IHn. Qed. Definition comm_coef p x := forall i, p`_i * x = x * p`_i. Definition comm_poly p x := x * p.[x] = p.[x] * x. Lemma comm_coef_poly p x : comm_coef p x -> comm_poly p x. Proof. move=> cpx; rewrite /comm_poly !horner_coef big_distrl big_distrr /=. by apply: eq_bigr => i _; rewrite /= mulrA -cpx -!mulrA commrX. Qed. Lemma comm_poly0 x : comm_poly 0 x. Proof. by rewrite /comm_poly !horner0 !simp. Qed. Lemma comm_poly1 x : comm_poly 1 x. Proof. by rewrite /comm_poly !hornerC !simp. Qed. Lemma comm_polyX x : comm_poly 'X x. Proof. by rewrite /comm_poly !hornerX. Qed. Lemma commr_horner a b p : GRing.comm a b -> comm_coef p a -> GRing.comm a p.[b]. Proof. move=> cab cpa; rewrite horner_coef; apply: commr_sum => i _. by apply: commrM => //; apply: commrX. Qed. Lemma hornerM_comm p q x : comm_poly q x -> (p * q).[x] = p.[x] * q.[x]. Proof. move=> comm_qx. elim/poly_ind: p => [|p c IHp]; first by rewrite !(simp, horner0). rewrite mulrDl hornerD hornerCM -mulrA -commr_polyX mulrA hornerMX. by rewrite {}IHp -mulrA -comm_qx mulrA -mulrDl hornerMXaddC. Qed. Lemma horner_exp_comm p x n : comm_poly p x -> (p ^+ n).[x] = p.[x] ^+ n. Proof. move=> comm_px; elim: n => [|n IHn]; first by rewrite hornerC. by rewrite !exprSr -IHn hornerM_comm. Qed. Lemma hornerXn x n : ('X^n).[x] = x ^+ n. Proof. by rewrite horner_exp_comm /comm_poly hornerX. Qed. Definition hornerE_comm := (hornerD, hornerN, hornerX, hornerC, horner_cons, simp, hornerCM, hornerZ, (fun p x => hornerM_comm p (comm_polyX x))). Definition root p : pred R := fun x => p.[x] == 0. Lemma mem_root p x : x \in root p = (p.[x] == 0). Proof. by []. Qed. Lemma rootE p x : (root p x = (p.[x] == 0)) * ((x \in root p) = (p.[x] == 0)). Proof. by []. Qed. Lemma rootP p x : reflect (p.[x] = 0) (root p x). Proof. exact: eqP. Qed. Lemma rootPt p x : reflect (p.[x] == 0) (root p x). Proof. exact: idP. Qed. Lemma rootPf p x : reflect ((p.[x] == 0) = false) (~~ root p x). Proof. exact: negPf. Qed. Lemma rootC a x : root a%:P x = (a == 0). Proof. by rewrite rootE hornerC. Qed. Lemma root0 x : root 0 x. Proof. by rewrite rootC. Qed. Lemma root1 x : ~~ root 1 x. Proof. by rewrite rootC oner_eq0. Qed. Lemma rootX x : root 'X x = (x == 0). Proof. by rewrite rootE hornerX. Qed. Lemma rootN p x : root (- p) x = root p x. Proof. by rewrite rootE hornerN oppr_eq0. Qed. Lemma root_size_gt1 a p : p != 0 -> root p a -> 1 < size p. Proof. rewrite ltnNge => nz_p; apply: contraL => /size1_polyC Dp. by rewrite Dp rootC -polyC_eq0 -Dp. Qed. Lemma root_XsubC a x : root ('X - a%:P) x = (x == a). Proof. by rewrite rootE hornerXsubC subr_eq0. Qed. Lemma root_XaddC a x : root ('X + a%:P) x = (x == - a). Proof. by rewrite -root_XsubC rmorphN opprK. Qed. Theorem factor_theorem p a : reflect (exists q, p = q * ('X - a%:P)) (root p a). Proof. apply: (iffP eqP) => [pa0 | [q ->]]; last first. by rewrite hornerM_comm /comm_poly hornerXsubC subrr ?simp. exists (\poly_(i < size p) horner_rec (drop i.+1 p) a). apply/polyP=> i; rewrite mulrBr coefB coefMX coefMC !coef_poly. apply: canRL (addrK _) _; rewrite addrC; have [le_p_i | lt_i_p] := leqP. rewrite nth_default // !simp drop_oversize ?if_same //. exact: leq_trans (leqSpred _). case: i => [|i] in lt_i_p *; last by rewrite ltnW // (drop_nth 0 lt_i_p). by rewrite drop1 /= -{}pa0 /horner; case: (p : seq R) lt_i_p. Qed. Lemma multiplicity_XsubC p a : {m | exists2 q, (p != 0) ==> ~~ root q a & p = q * ('X - a%:P) ^+ m}. Proof. have [n le_p_n] := ubnP (size p); elim: n => // n IHn in p le_p_n *. have [-> | nz_p /=] := eqVneq p 0; first by exists 0%N, 0; rewrite ?mul0r. have [/sig_eqW[p1 Dp] | nz_pa] := altP (factor_theorem p a); last first. by exists 0%N, p; rewrite ?mulr1. have nz_p1: p1 != 0 by apply: contraNneq nz_p => p1_0; rewrite Dp p1_0 mul0r. have /IHn[m /sig2_eqW[q nz_qa Dp1]]: size p1 < n. by rewrite Dp size_Mmonic ?monicXsubC // size_XsubC addn2 in le_p_n. by exists m.+1, q; [rewrite nz_p1 in nz_qa | rewrite exprSr mulrA -Dp1]. Qed. (* Roots of unity. *) Lemma size_Xn_sub_1 n : n > 0 -> size ('X^n - 1 : {poly R}) = n.+1. Proof. by move=> n_gt0; rewrite size_addl size_polyXn // size_opp size_poly1. Qed. Lemma monic_Xn_sub_1 n : n > 0 -> 'X^n - 1 \is monic. Proof. move=> n_gt0; rewrite monicE lead_coefE size_Xn_sub_1 // coefB. by rewrite coefXn coef1 eqxx eqn0Ngt n_gt0 subr0. Qed. Definition root_of_unity n : pred R := root ('X^n - 1). Local Notation "n .-unity_root" := (root_of_unity n) : ring_scope. Lemma unity_rootE n z : n.-unity_root z = (z ^+ n == 1). Proof. by rewrite /root_of_unity rootE hornerD hornerN hornerXn hornerC subr_eq0. Qed. Lemma unity_rootP n z : reflect (z ^+ n = 1) (n.-unity_root z). Proof. by rewrite unity_rootE; apply: eqP. Qed. Definition primitive_root_of_unity n z := (n > 0) && [forall i : 'I_n, i.+1.-unity_root z == (i.+1 == n)]. Local Notation "n .-primitive_root" := (primitive_root_of_unity n) : ring_scope. Lemma prim_order_exists n z : n > 0 -> z ^+ n = 1 -> {m | m.-primitive_root z & (m %| n)}. Proof. move=> n_gt0 zn1. have: exists m, (m > 0) && (z ^+ m == 1) by exists n; rewrite n_gt0 /= zn1. case/ex_minnP=> m /andP[m_gt0 /eqP zm1] m_min. exists m. apply/andP; split=> //; apply/eqfunP=> [[i]] /=. rewrite leq_eqVlt unity_rootE. case: eqP => [-> _ | _]; first by rewrite zm1 eqxx. by apply: contraTF => zi1; rewrite -leqNgt m_min. have: n %% m < m by rewrite ltn_mod. apply: contraLR; rewrite -lt0n -leqNgt => nm_gt0; apply: m_min. by rewrite nm_gt0 /= expr_mod ?zn1. Qed. Section OnePrimitive. Variables (n : nat) (z : R). Hypothesis prim_z : n.-primitive_root z. Lemma prim_order_gt0 : n > 0. Proof. by case/andP: prim_z. Qed. Let n_gt0 := prim_order_gt0. Lemma prim_expr_order : z ^+ n = 1. Proof. case/andP: prim_z => _; rewrite -(prednK n_gt0) => /forallP/(_ ord_max). by rewrite unity_rootE eqxx eqb_id => /eqP. Qed. Lemma prim_expr_mod i : z ^+ (i %% n) = z ^+ i. Proof. exact: expr_mod prim_expr_order. Qed. Lemma prim_order_dvd i : (n %| i) = (z ^+ i == 1). Proof. move: n_gt0; rewrite -prim_expr_mod /dvdn -(ltn_mod i). case: {i}(i %% n)%N => [|i] lt_i; first by rewrite !eqxx. case/andP: prim_z => _ /forallP/(_ (Ordinal (ltnW lt_i)))/eqP. by rewrite unity_rootE eqn_leq andbC leqNgt lt_i. Qed. Lemma eq_prim_root_expr i j : (z ^+ i == z ^+ j) = (i == j %[mod n]). Proof. wlog le_ji: i j / j <= i. move=> IH; case: (leqP j i) => [|/ltnW] /IH //. by rewrite eq_sym (eq_sym (j %% n)%N). rewrite -{1}(subnKC le_ji) exprD -prim_expr_mod eqn_mod_dvd //. rewrite prim_order_dvd; apply/eqP/eqP=> [|->]; last by rewrite mulr1. move/(congr1 ( *%R (z ^+ (n - j %% n)))); rewrite mulrA -exprD. by rewrite subnK ?prim_expr_order ?mul1r // ltnW ?ltn_mod. Qed. Lemma exp_prim_root k : (n %/ gcdn k n).-primitive_root (z ^+ k). Proof. set d := gcdn k n; have d_gt0: (0 < d)%N by rewrite gcdn_gt0 orbC n_gt0. have [d_dv_k d_dv_n]: (d %| k /\ d %| n)%N by rewrite dvdn_gcdl dvdn_gcdr. set q := (n %/ d)%N; rewrite /q.-primitive_root ltn_divRL // n_gt0. apply/forallP=> i; rewrite unity_rootE -exprM -prim_order_dvd. rewrite -(divnK d_dv_n) -/q -(divnK d_dv_k) mulnAC dvdn_pmul2r //. apply/eqP; apply/idP/idP=> [|/eqP->]; last by rewrite dvdn_mull. rewrite Gauss_dvdr; first by rewrite eqn_leq ltn_ord; apply: dvdn_leq. by rewrite /coprime gcdnC -(eqn_pmul2r d_gt0) mul1n muln_gcdl !divnK. Qed. Lemma dvdn_prim_root m : (m %| n)%N -> m.-primitive_root (z ^+ (n %/ m)). Proof. set k := (n %/ m)%N => m_dv_n; rewrite -{1}(mulKn m n_gt0) -divnA // -/k. by rewrite -{1}(@gcdn_idPl k n _) ?exp_prim_root // -(divnK m_dv_n) dvdn_mulr. Qed. End OnePrimitive. Lemma prim_root_exp_coprime n z k : n.-primitive_root z -> n.-primitive_root (z ^+ k) = coprime k n. Proof. move=> prim_z; have n_gt0 := prim_order_gt0 prim_z. apply/idP/idP=> [prim_zk | co_k_n]. set d := gcdn k n; have dv_d_n: (d %| n)%N := dvdn_gcdr _ _. rewrite /coprime -/d -(eqn_pmul2r n_gt0) mul1n -{2}(gcdnMl n d). rewrite -{2}(divnK dv_d_n) (mulnC _ d) -muln_gcdr (gcdn_idPr _) //. rewrite (prim_order_dvd prim_zk) -exprM -(prim_order_dvd prim_z). by rewrite muln_divCA_gcd dvdn_mulr. have zkn_1: z ^+ k ^+ n = 1 by rewrite exprAC (prim_expr_order prim_z) expr1n. have{zkn_1} [m prim_zk dv_m_n]:= prim_order_exists n_gt0 zkn_1. suffices /eqP <-: m == n by []. rewrite eqn_dvd dv_m_n -(@Gauss_dvdr n k m) 1?coprime_sym //=. by rewrite (prim_order_dvd prim_z) exprM (prim_expr_order prim_zk). Qed. (* Lifting a ring predicate to polynomials. *) Implicit Type S : {pred R}. Definition polyOver S := [qualify a p : {poly R} | all (mem S) p]. Fact polyOver_key S : pred_key (polyOver S). Proof. by []. Qed. Canonical polyOver_keyed S := KeyedQualifier (polyOver_key S). Lemma polyOverS (S1 S2 : {pred R}) : {subset S1 <= S2} -> {subset polyOver S1 <= polyOver S2}. Proof. by move=> sS12 p /(all_nthP 0)S1p; apply/(all_nthP 0)=> i /S1p; apply: sS12. Qed. Lemma polyOver0 S : 0 \is a polyOver S. Proof. by rewrite qualifE polyseq0. Qed. Lemma polyOver_poly S n E : (forall i, i < n -> E i \in S) -> \poly_(i < n) E i \is a polyOver S. Proof. move=> S_E; apply/(all_nthP 0)=> i lt_i_p /=; rewrite coef_poly. by case: ifP => [/S_E// | /idP[]]; apply: leq_trans lt_i_p (size_poly n E). Qed. Section PolyOverAdd. Variables (S : {pred R}) (addS : addrPred S) (kS : keyed_pred addS). Lemma polyOverP {p} : reflect (forall i, p`_i \in kS) (p \in polyOver kS). Proof. apply: (iffP (all_nthP 0)) => [Sp i | Sp i _]; last exact: Sp. by have [/Sp // | /(nth_default 0)->] := ltnP i (size p); apply: rpred0. Qed. Lemma polyOverC c : (c%:P \in polyOver kS) = (c \in kS). Proof. by rewrite qualifE polyseqC; case: eqP => [->|] /=; rewrite ?andbT ?rpred0. Qed. Fact polyOver_addr_closed : addr_closed (polyOver kS). Proof. split=> [|p q Sp Sq]; first exact: polyOver0. by apply/polyOverP=> i; rewrite coefD rpredD ?(polyOverP _). Qed. Canonical polyOver_addrPred := AddrPred polyOver_addr_closed. End PolyOverAdd. Fact polyOverNr S (addS : zmodPred S) (kS : keyed_pred addS) : oppr_closed (polyOver kS). Proof. by move=> p /polyOverP Sp; apply/polyOverP=> i; rewrite coefN rpredN. Qed. Canonical polyOver_opprPred S addS kS := OpprPred (@polyOverNr S addS kS). Canonical polyOver_zmodPred S addS kS := ZmodPred (@polyOverNr S addS kS). Section PolyOverSemiring. Variables (S : {pred R}) (ringS : semiringPred S) (kS : keyed_pred ringS). Fact polyOver_mulr_closed : mulr_closed (polyOver kS). Proof. split=> [|p q /polyOverP Sp /polyOverP Sq]; first by rewrite polyOverC rpred1. by apply/polyOverP=> i; rewrite coefM rpred_sum // => j _; apply: rpredM. Qed. Canonical polyOver_mulrPred := MulrPred polyOver_mulr_closed. Canonical polyOver_semiringPred := SemiringPred polyOver_mulr_closed. Lemma polyOverZ : {in kS & polyOver kS, forall c p, c *: p \is a polyOver kS}. Proof. by move=> c p Sc /polyOverP Sp; apply/polyOverP=> i; rewrite coefZ rpredM ?Sp. Qed. Lemma polyOverX : 'X \in polyOver kS. Proof. by rewrite qualifE polyseqX /= rpred0 rpred1. Qed. Lemma rpred_horner : {in polyOver kS & kS, forall p x, p.[x] \in kS}. Proof. move=> p x /polyOverP Sp Sx; rewrite horner_coef rpred_sum // => i _. by rewrite rpredM ?rpredX. Qed. End PolyOverSemiring. Section PolyOverRing. Variables (S : {pred R}) (ringS : subringPred S) (kS : keyed_pred ringS). Canonical polyOver_smulrPred := SmulrPred (polyOver_mulr_closed kS). Canonical polyOver_subringPred := SubringPred (polyOver_mulr_closed kS). Lemma polyOverXsubC c : ('X - c%:P \in polyOver kS) = (c \in kS). Proof. by rewrite rpredBl ?polyOverX ?polyOverC. Qed. End PolyOverRing. (* Single derivative. *) Definition deriv p := \poly_(i < (size p).-1) (p`_i.+1 *+ i.+1). Local Notation "a ^` ()" := (deriv a). Lemma coef_deriv p i : p^`()`_i = p`_i.+1 *+ i.+1. Proof. rewrite coef_poly -subn1 ltn_subRL. by case: leqP => // /(nth_default 0) ->; rewrite mul0rn. Qed. Lemma polyOver_deriv S (ringS : semiringPred S) (kS : keyed_pred ringS) : {in polyOver kS, forall p, p^`() \is a polyOver kS}. Proof. by move=> p /polyOverP Kp; apply/polyOverP=> i; rewrite coef_deriv rpredMn ?Kp. Qed. Lemma derivC c : c%:P^`() = 0. Proof. by apply/polyP=> i; rewrite coef_deriv coef0 coefC mul0rn. Qed. Lemma derivX : ('X)^`() = 1. Proof. by apply/polyP=> [[|i]]; rewrite coef_deriv coef1 coefX ?mul0rn. Qed. Lemma derivXn n : 'X^n^`() = 'X^n.-1 *+ n. Proof. case: n => [|n]; first exact: derivC. apply/polyP=> i; rewrite coef_deriv coefMn !coefXn eqSS. by case: eqP => [-> // | _]; rewrite !mul0rn. Qed. Fact deriv_is_linear : linear deriv. Proof. move=> k p q; apply/polyP=> i. by rewrite !(coef_deriv, coefD, coefZ) mulrnDl mulrnAr. Qed. Canonical deriv_additive := Additive deriv_is_linear. Canonical deriv_linear := Linear deriv_is_linear. Lemma deriv0 : 0^`() = 0. Proof. exact: linear0. Qed. Lemma derivD : {morph deriv : p q / p + q}. Proof. exact: linearD. Qed. Lemma derivN : {morph deriv : p / - p}. Proof. exact: linearN. Qed. Lemma derivB : {morph deriv : p q / p - q}. Proof. exact: linearB. Qed. Lemma derivXsubC (a : R) : ('X - a%:P)^`() = 1. Proof. by rewrite derivB derivX derivC subr0. Qed. Lemma derivMn n p : (p *+ n)^`() = p^`() *+ n. Proof. exact: linearMn. Qed. Lemma derivMNn n p : (p *- n)^`() = p^`() *- n. Proof. exact: linearMNn. Qed. Lemma derivZ c p : (c *: p)^`() = c *: p^`(). Proof. by rewrite linearZ. Qed. Lemma deriv_mulC c p : (c%:P * p)^`() = c%:P * p^`(). Proof. by rewrite !mul_polyC derivZ. Qed. Lemma derivMXaddC p c : (p * 'X + c%:P)^`() = p + p^`() * 'X. Proof. apply/polyP=> i; rewrite raddfD /= derivC addr0 coefD !(coefMX, coef_deriv). by case: i; rewrite ?addr0. Qed. Lemma derivM p q : (p * q)^`() = p^`() * q + p * q^`(). Proof. elim/poly_ind: p => [|p b IHp]; first by rewrite !(mul0r, add0r, derivC). rewrite mulrDl -mulrA -commr_polyX mulrA -[_ * 'X]addr0 raddfD /= !derivMXaddC. by rewrite deriv_mulC IHp !mulrDl -!mulrA !commr_polyX !addrA. Qed. Definition derivE := Eval lazy beta delta [morphism_2 morphism_1] in (derivZ, deriv_mulC, derivC, derivX, derivMXaddC, derivXsubC, derivM, derivB, derivD, derivN, derivXn, derivM, derivMn). (* Iterated derivative. *) Definition derivn n p := iter n deriv p. Local Notation "a ^` ( n )" := (derivn n a) : ring_scope. Lemma derivn0 p : p^`(0) = p. Proof. by []. Qed. Lemma derivn1 p : p^`(1) = p^`(). Proof. by []. Qed. Lemma derivnS p n : p^`(n.+1) = p^`(n)^`(). Proof. by []. Qed. Lemma derivSn p n : p^`(n.+1) = p^`()^`(n). Proof. exact: iterSr. Qed. Lemma coef_derivn n p i : p^`(n)`_i = p`_(n + i) *+ (n + i) ^_ n. Proof. elim: n i => [|n IHn] i; first by rewrite ffactn0 mulr1n. by rewrite derivnS coef_deriv IHn -mulrnA ffactnSr addSnnS addKn. Qed. Lemma polyOver_derivn S (ringS : semiringPred S) (kS : keyed_pred ringS) : {in polyOver kS, forall p n, p^`(n) \is a polyOver kS}. Proof. move=> p /polyOverP Kp /= n; apply/polyOverP=> i. by rewrite coef_derivn rpredMn. Qed. Fact derivn_is_linear n : linear (derivn n). Proof. by elim: n => // n IHn a p q; rewrite derivnS IHn linearP. Qed. Canonical derivn_additive n := Additive (derivn_is_linear n). Canonical derivn_linear n := Linear (derivn_is_linear n). Lemma derivnC c n : c%:P^`(n) = if n == 0%N then c%:P else 0. Proof. by case: n => // n; rewrite derivSn derivC linear0. Qed. Lemma derivnD n : {morph derivn n : p q / p + q}. Proof. exact: linearD. Qed. Lemma derivnB n : {morph derivn n : p q / p - q}. Proof. exact: linearB. Qed. Lemma derivnMn n m p : (p *+ m)^`(n) = p^`(n) *+ m. Proof. exact: linearMn. Qed. Lemma derivnMNn n m p : (p *- m)^`(n) = p^`(n) *- m. Proof. exact: linearMNn. Qed. Lemma derivnN n : {morph derivn n : p / - p}. Proof. exact: linearN. Qed. Lemma derivnZ n : scalable (derivn n). Proof. exact: linearZZ. Qed. Lemma derivnXn m n : 'X^m^`(n) = 'X^(m - n) *+ m ^_ n. Proof. apply/polyP=>i; rewrite coef_derivn coefMn !coefXn. case: (ltnP m n) => [lt_m_n | le_m_n]. by rewrite eqn_leq leqNgt ltn_addr // mul0rn ffact_small. by rewrite -{1 3}(subnKC le_m_n) eqn_add2l; case: eqP => [->|]; rewrite ?mul0rn. Qed. Lemma derivnMXaddC n p c : (p * 'X + c%:P)^`(n.+1) = p^`(n) *+ n.+1 + p^`(n.+1) * 'X. Proof. elim: n => [|n IHn]; first by rewrite derivn1 derivMXaddC. rewrite derivnS IHn derivD derivM derivX mulr1 derivMn -!derivnS. by rewrite addrA addrAC -mulrSr. Qed. Lemma derivn_poly0 p n : size p <= n -> p^`(n) = 0. Proof. move=> le_p_n; apply/polyP=> i; rewrite coef_derivn. rewrite nth_default; first by rewrite mul0rn coef0. exact/(leq_trans le_p_n)/leq_addr. Qed. Lemma lt_size_deriv (p : {poly R}) : p != 0 -> size p^`() < size p. Proof. by move=> /polySpred->; apply: size_poly. Qed. (* A normalising version of derivation to get the division by n! in Taylor *) Definition nderivn n p := \poly_(i < size p - n) (p`_(n + i) *+ 'C(n + i, n)). Local Notation "a ^`N ( n )" := (nderivn n a) : ring_scope. Lemma coef_nderivn n p i : p^`N(n)`_i = p`_(n + i) *+ 'C(n + i, n). Proof. rewrite coef_poly ltn_subRL; case: leqP => // le_p_ni. by rewrite nth_default ?mul0rn. Qed. (* Here is the division by n! *) Lemma nderivn_def n p : p^`(n) = p^`N(n) *+ n`!. Proof. by apply/polyP=> i; rewrite coefMn coef_nderivn coef_derivn -mulrnA bin_ffact. Qed. Lemma polyOver_nderivn S (ringS : semiringPred S) (kS : keyed_pred ringS) : {in polyOver kS, forall p n, p^`N(n) \in polyOver kS}. Proof. move=> p /polyOverP Sp /= n; apply/polyOverP=> i. by rewrite coef_nderivn rpredMn. Qed. Lemma nderivn0 p : p^`N(0) = p. Proof. by rewrite -[p^`N(0)](nderivn_def 0). Qed. Lemma nderivn1 p : p^`N(1) = p^`(). Proof. by rewrite -[p^`N(1)](nderivn_def 1). Qed. Lemma nderivnC c n : (c%:P)^`N(n) = if n == 0%N then c%:P else 0. Proof. apply/polyP=> i; rewrite coef_nderivn. by case: n => [|n]; rewrite ?bin0 // coef0 coefC mul0rn. Qed. Lemma nderivnXn m n : 'X^m^`N(n) = 'X^(m - n) *+ 'C(m, n). Proof. apply/polyP=> i; rewrite coef_nderivn coefMn !coefXn. have [lt_m_n | le_n_m] := ltnP m n. by rewrite eqn_leq leqNgt ltn_addr // mul0rn bin_small. by rewrite -{1 3}(subnKC le_n_m) eqn_add2l; case: eqP => [->|]; rewrite ?mul0rn. Qed. Fact nderivn_is_linear n : linear (nderivn n). Proof. move=> k p q; apply/polyP=> i. by rewrite !(coef_nderivn, coefD, coefZ) mulrnDl mulrnAr. Qed. Canonical nderivn_additive n := Additive(nderivn_is_linear n). Canonical nderivn_linear n := Linear (nderivn_is_linear n). Lemma nderivnD n : {morph nderivn n : p q / p + q}. Proof. exact: linearD. Qed. Lemma nderivnB n : {morph nderivn n : p q / p - q}. Proof. exact: linearB. Qed. Lemma nderivnMn n m p : (p *+ m)^`N(n) = p^`N(n) *+ m. Proof. exact: linearMn. Qed. Lemma nderivnMNn n m p : (p *- m)^`N(n) = p^`N(n) *- m. Proof. exact: linearMNn. Qed. Lemma nderivnN n : {morph nderivn n : p / - p}. Proof. exact: linearN. Qed. Lemma nderivnZ n : scalable (nderivn n). Proof. exact: linearZZ. Qed. Lemma nderivnMXaddC n p c : (p * 'X + c%:P)^`N(n.+1) = p^`N(n) + p^`N(n.+1) * 'X. Proof. apply/polyP=> i; rewrite coef_nderivn !coefD !coefMX coefC. rewrite !addSn /= !coef_nderivn addr0 binS mulrnDr addrC; congr (_ + _). by rewrite addSnnS; case: i; rewrite // addn0 bin_small. Qed. Lemma nderivn_poly0 p n : size p <= n -> p^`N(n) = 0. Proof. move=> le_p_n; apply/polyP=> i; rewrite coef_nderivn. rewrite nth_default; first by rewrite mul0rn coef0. exact/(leq_trans le_p_n)/leq_addr. Qed. Lemma nderiv_taylor p x h : GRing.comm x h -> p.[x + h] = \sum_(i < size p) p^`N(i).[x] * h ^+ i. Proof. move/commrX=> cxh; elim/poly_ind: p => [|p c IHp]. by rewrite size_poly0 big_ord0 horner0. rewrite hornerMXaddC size_MXaddC. have [-> | nz_p] := eqVneq p 0. rewrite horner0 !simp; have [-> | _] := c =P 0; first by rewrite big_ord0. by rewrite size_poly0 big_ord_recl big_ord0 nderivn0 hornerC !simp. rewrite big_ord_recl nderivn0 !simp hornerMXaddC addrAC; congr (_ + _). rewrite mulrDr {}IHp !big_distrl polySpred //= big_ord_recl /= mulr1 -addrA. rewrite nderivn0 /bump /(addn 1) /=; congr (_ + _). rewrite !big_ord_recr /= nderivnMXaddC -mulrA -exprSr -polySpred // !addrA. congr (_ + _); last by rewrite (nderivn_poly0 (leqnn _)) !simp. rewrite addrC -big_split /=; apply: eq_bigr => i _. by rewrite nderivnMXaddC !hornerE_comm /= mulrDl -!mulrA -exprSr cxh. Qed. Lemma nderiv_taylor_wide n p x h : GRing.comm x h -> size p <= n -> p.[x + h] = \sum_(i < n) p^`N(i).[x] * h ^+ i. Proof. move/nderiv_taylor=> -> le_p_n. rewrite (big_ord_widen n (fun i => p^`N(i).[x] * h ^+ i)) // big_mkcond. apply: eq_bigr => i _; case: leqP => // /nderivn_poly0->. by rewrite horner0 simp. Qed. Lemma eq_poly n E1 E2 : E1 =1 E2 -> poly n E1 = poly n E2. Proof. by move=> E; rewrite !poly_def; apply: eq_bigr => i _; rewrite E. Qed. End PolynomialTheory. Prenex Implicits polyC polyCK Poly polyseqK lead_coef root horner polyOver. Arguments monic {R}. Notation "\poly_ ( i < n ) E" := (poly n (fun i => E)) : ring_scope. Notation "c %:P" := (polyC c) : ring_scope. Notation "'X" := (polyX _) : ring_scope. Notation "''X^' n" := ('X ^+ n) : ring_scope. Notation "p .[ x ]" := (horner p x) : ring_scope. Notation "n .-unity_root" := (root_of_unity n) : ring_scope. Notation "n .-primitive_root" := (primitive_root_of_unity n) : ring_scope. Notation "a ^` ()" := (deriv a) : ring_scope. Notation "a ^` ( n )" := (derivn n a) : ring_scope. Notation "a ^`N ( n )" := (nderivn n a) : ring_scope. Arguments monicP {R p}. Arguments rootP {R p x}. Arguments rootPf {R p x}. Arguments rootPt {R p x}. Arguments unity_rootP {R n z}. Arguments polyOverP {R S0 addS kS p} : rename. Arguments polyC_inj {R} [x1 x2] eq_x12P. Arguments eq_poly {R n} [E1] E2 eq_E12. Canonical polynomial_countZmodType (R : countRingType) := [countZmodType of polynomial R]. Canonical poly_countZmodType (R : countRingType) := [countZmodType of {poly R}]. Canonical polynomial_countRingType (R : countRingType) := [countRingType of polynomial R]. Canonical poly_countRingType (R : countRingType) := [countRingType of {poly R}]. (* Container morphism. *) Section MapPoly. Section Definitions. Variables (aR rR : ringType) (f : aR -> rR). Definition map_poly (p : {poly aR}) := \poly_(i < size p) f p`_i. (* Alternative definition; the one above is more convenient because it lets *) (* us use the lemmas on \poly, e.g., size (map_poly p) <= size p is an *) (* instance of size_poly. *) Lemma map_polyE p : map_poly p = Poly (map f p). Proof. rewrite /map_poly unlock; congr Poly. apply: (@eq_from_nth _ 0); rewrite size_mkseq ?size_map // => i lt_i_p. by rewrite (nth_map 0) ?nth_mkseq. Qed. Definition commr_rmorph u := forall x, GRing.comm u (f x). Definition horner_morph u of commr_rmorph u := fun p => (map_poly p).[u]. End Definitions. Variables aR rR : ringType. Section Combinatorial. Variables (iR : ringType) (f : aR -> rR). Local Notation "p ^f" := (map_poly f p) : ring_scope. Lemma map_poly0 : 0^f = 0. Proof. by rewrite map_polyE polyseq0. Qed. Lemma eq_map_poly (g : aR -> rR) : f =1 g -> map_poly f =1 map_poly g. Proof. by move=> eq_fg p; rewrite !map_polyE (eq_map eq_fg). Qed. Lemma map_poly_id g (p : {poly iR}) : {in (p : seq iR), g =1 id} -> map_poly g p = p. Proof. by move=> g_id; rewrite map_polyE map_id_in ?polyseqK. Qed. Lemma coef_map_id0 p i : f 0 = 0 -> (p^f)`_i = f p`_i. Proof. by move=> f0; rewrite coef_poly; case: ltnP => // le_p_i; rewrite nth_default. Qed. Lemma map_Poly_id0 s : f 0 = 0 -> (Poly s)^f = Poly (map f s). Proof. move=> f0; apply/polyP=> j; rewrite coef_map_id0 ?coef_Poly //. have [/(nth_map 0 0)->// | le_s_j] := ltnP j (size s). by rewrite !nth_default ?size_map. Qed. Lemma map_poly_comp_id0 (g : iR -> aR) p : f 0 = 0 -> map_poly (f \o g) p = (map_poly g p)^f. Proof. by move=> f0; rewrite map_polyE map_comp -map_Poly_id0 -?map_polyE. Qed. Lemma size_map_poly_id0 p : f (lead_coef p) != 0 -> size p^f = size p. Proof. by move=> nz_fp; apply: size_poly_eq. Qed. Lemma map_poly_eq0_id0 p : f (lead_coef p) != 0 -> (p^f == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 => /size_map_poly_id0->. Qed. Lemma lead_coef_map_id0 p : f 0 = 0 -> f (lead_coef p) != 0 -> lead_coef p^f = f (lead_coef p). Proof. by move=> f0 nz_fp; rewrite lead_coefE coef_map_id0 ?size_map_poly_id0. Qed. Hypotheses (inj_f : injective f) (f_0 : f 0 = 0). Lemma size_map_inj_poly p : size p^f = size p. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite map_poly0 !size_poly0. by rewrite size_map_poly_id0 // -f_0 (inj_eq inj_f) lead_coef_eq0. Qed. Lemma map_inj_poly : injective (map_poly f). Proof. move=> p q /polyP eq_pq; apply/polyP=> i; apply: inj_f. by rewrite -!coef_map_id0 ?eq_pq. Qed. Lemma lead_coef_map_inj p : lead_coef p^f = f (lead_coef p). Proof. by rewrite !lead_coefE size_map_inj_poly coef_map_id0. Qed. End Combinatorial. Lemma map_polyK (f : aR -> rR) g : cancel g f -> f 0 = 0 -> cancel (map_poly g) (map_poly f). Proof. by move=> gK f_0 p; rewrite /= -map_poly_comp_id0 ?map_poly_id // => x _ //=. Qed. Section Additive. Variables (iR : ringType) (f : {additive aR -> rR}). Local Notation "p ^f" := (map_poly (GRing.Additive.apply f) p) : ring_scope. Lemma coef_map p i : p^f`_i = f p`_i. Proof. exact: coef_map_id0 (raddf0 f). Qed. Lemma map_Poly s : (Poly s)^f = Poly (map f s). Proof. exact: map_Poly_id0 (raddf0 f). Qed. Lemma map_poly_comp (g : iR -> aR) p : map_poly (f \o g) p = map_poly f (map_poly g p). Proof. exact: map_poly_comp_id0 (raddf0 f). Qed. Fact map_poly_is_additive : additive (map_poly f). Proof. by move=> p q; apply/polyP=> i; rewrite !(coef_map, coefB) raddfB. Qed. Canonical map_poly_additive := Additive map_poly_is_additive. Lemma map_polyC a : (a%:P)^f = (f a)%:P. Proof. by apply/polyP=> i; rewrite !(coef_map, coefC) -!mulrb raddfMn. Qed. Lemma lead_coef_map_eq p : f (lead_coef p) != 0 -> lead_coef p^f = f (lead_coef p). Proof. exact: lead_coef_map_id0 (raddf0 f). Qed. End Additive. Variable f : {rmorphism aR -> rR}. Implicit Types p : {poly aR}. Local Notation "p ^f" := (map_poly (GRing.RMorphism.apply f) p) : ring_scope. Fact map_poly_is_rmorphism : rmorphism (map_poly f). Proof. split; first exact: map_poly_is_additive. split=> [p q|]; apply/polyP=> i; last first. by rewrite !(coef_map, coef1) /= rmorph_nat. rewrite coef_map /= !coefM /= !rmorph_sum; apply: eq_bigr => j _. by rewrite !coef_map rmorphM. Qed. Canonical map_poly_rmorphism := RMorphism map_poly_is_rmorphism. Lemma map_polyZ c p : (c *: p)^f = f c *: p^f. Proof. by apply/polyP=> i; rewrite !(coef_map, coefZ) /= rmorphM. Qed. Canonical map_poly_linear := AddLinear (map_polyZ : scalable_for (f \; *:%R) (map_poly f)). Canonical map_poly_lrmorphism := [lrmorphism of map_poly f]. Lemma map_polyX : ('X)^f = 'X. Proof. by apply/polyP=> i; rewrite coef_map !coefX /= rmorph_nat. Qed. Lemma map_polyXn n : ('X^n)^f = 'X^n. Proof. by rewrite rmorphX /= map_polyX. Qed. Lemma monic_map p : p \is monic -> p^f \is monic. Proof. move/monicP=> mon_p; rewrite monicE. by rewrite lead_coef_map_eq mon_p /= rmorph1 ?oner_neq0. Qed. Lemma horner_map p x : p^f.[f x] = f p.[x]. Proof. elim/poly_ind: p => [|p c IHp]; first by rewrite !(rmorph0, horner0). rewrite hornerMXaddC !rmorphD !rmorphM /=. by rewrite map_polyX map_polyC hornerMXaddC IHp. Qed. Lemma map_comm_poly p x : comm_poly p x -> comm_poly p^f (f x). Proof. by rewrite /comm_poly horner_map -!rmorphM // => ->. Qed. Lemma map_comm_coef p x : comm_coef p x -> comm_coef p^f (f x). Proof. by move=> cpx i; rewrite coef_map -!rmorphM ?cpx. Qed. Lemma rmorph_root p x : root p x -> root p^f (f x). Proof. by move/eqP=> px0; rewrite rootE horner_map px0 rmorph0. Qed. Lemma rmorph_unity_root n z : n.-unity_root z -> n.-unity_root (f z). Proof. move/rmorph_root; rewrite rootE rmorphB hornerD hornerN. by rewrite /= map_polyXn rmorph1 hornerC hornerXn subr_eq0 unity_rootE. Qed. Section HornerMorph. Variable u : rR. Hypothesis cfu : commr_rmorph f u. Lemma horner_morphC a : horner_morph cfu a%:P = f a. Proof. by rewrite /horner_morph map_polyC hornerC. Qed. Lemma horner_morphX : horner_morph cfu 'X = u. Proof. by rewrite /horner_morph map_polyX hornerX. Qed. Fact horner_is_lrmorphism : lrmorphism_for (f \; *%R) (horner_morph cfu). Proof. rewrite /horner_morph; split=> [|c p]; last by rewrite linearZ hornerZ. split=> [p q|]; first by rewrite /horner_morph rmorphB hornerD hornerN. split=> [p q|]; last by rewrite /horner_morph rmorph1 hornerC. rewrite /horner_morph rmorphM /= hornerM_comm //. by apply: comm_coef_poly => i; rewrite coef_map cfu. Qed. Canonical horner_additive := Additive horner_is_lrmorphism. Canonical horner_rmorphism := RMorphism horner_is_lrmorphism. Canonical horner_linear := AddLinear horner_is_lrmorphism. Canonical horner_lrmorphism := [lrmorphism of horner_morph cfu]. End HornerMorph. Lemma deriv_map p : p^f^`() = (p^`())^f. Proof. by apply/polyP => i; rewrite !(coef_map, coef_deriv) //= rmorphMn. Qed. Lemma derivn_map p n : p^f^`(n) = (p^`(n))^f. Proof. by apply/polyP => i; rewrite !(coef_map, coef_derivn) //= rmorphMn. Qed. Lemma nderivn_map p n : p^f^`N(n) = (p^`N(n))^f. Proof. by apply/polyP => i; rewrite !(coef_map, coef_nderivn) //= rmorphMn. Qed. End MapPoly. (* Morphisms from the polynomial ring, and the initiality of polynomials *) (* with respect to these. *) Section MorphPoly. Variable (aR rR : ringType) (pf : {rmorphism {poly aR} -> rR}). Lemma poly_morphX_comm : commr_rmorph (pf \o polyC) (pf 'X). Proof. by move=> a; rewrite /GRing.comm /= -!rmorphM // commr_polyX. Qed. Lemma poly_initial : pf =1 horner_morph poly_morphX_comm. Proof. apply: poly_ind => [|p a IHp]; first by rewrite !rmorph0. by rewrite !rmorphD !rmorphM /= -{}IHp horner_morphC ?horner_morphX. Qed. End MorphPoly. Notation "p ^:P" := (map_poly polyC p) : ring_scope. Section PolyCompose. Variable R : ringType. Implicit Types p q : {poly R}. Definition comp_poly q p := p^:P.[q]. Local Notation "p \Po q" := (comp_poly q p) : ring_scope. Lemma size_map_polyC p : size p^:P = size p. Proof. exact/(size_map_inj_poly polyC_inj). Qed. Lemma map_polyC_eq0 p : (p^:P == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 size_map_polyC. Qed. Lemma root_polyC p x : root p^:P x%:P = root p x. Proof. by rewrite rootE horner_map polyC_eq0. Qed. Lemma comp_polyE p q : p \Po q = \sum_(i < size p) p`_i *: q^+i. Proof. by rewrite [p \Po q]horner_poly; apply: eq_bigr => i _; rewrite mul_polyC. Qed. Lemma coef_comp_poly p q n : (p \Po q)`_n = \sum_(i < size p) p`_i * (q ^+ i)`_n. Proof. by rewrite comp_polyE coef_sum; apply: eq_bigr => i; rewrite coefZ. Qed. Lemma polyOver_comp S (ringS : semiringPred S) (kS : keyed_pred ringS) : {in polyOver kS &, forall p q, p \Po q \in polyOver kS}. Proof. move=> p q /polyOverP Sp Sq; rewrite comp_polyE rpred_sum // => i _. by rewrite polyOverZ ?rpredX. Qed. Lemma comp_polyCr p c : p \Po c%:P = p.[c]%:P. Proof. exact: horner_map. Qed. Lemma comp_poly0r p : p \Po 0 = (p`_0)%:P. Proof. by rewrite comp_polyCr horner_coef0. Qed. Lemma comp_polyC c p : c%:P \Po p = c%:P. Proof. by rewrite /(_ \Po p) map_polyC hornerC. Qed. Fact comp_poly_is_linear p : linear (comp_poly p). Proof. move=> a q r. by rewrite /comp_poly rmorphD /= map_polyZ !hornerE_comm mul_polyC. Qed. Canonical comp_poly_additive p := Additive (comp_poly_is_linear p). Canonical comp_poly_linear p := Linear (comp_poly_is_linear p). Lemma comp_poly0 p : 0 \Po p = 0. Proof. exact: raddf0. Qed. Lemma comp_polyD p q r : (p + q) \Po r = (p \Po r) + (q \Po r). Proof. exact: raddfD. Qed. Lemma comp_polyB p q r : (p - q) \Po r = (p \Po r) - (q \Po r). Proof. exact: raddfB. Qed. Lemma comp_polyZ c p q : (c *: p) \Po q = c *: (p \Po q). Proof. exact: linearZZ. Qed. Lemma comp_polyXr p : p \Po 'X = p. Proof. by rewrite -{2}/(idfun p) poly_initial. Qed. Lemma comp_polyX p : 'X \Po p = p. Proof. by rewrite /(_ \Po p) map_polyX hornerX. Qed. Lemma comp_poly_MXaddC c p q : (p * 'X + c%:P) \Po q = (p \Po q) * q + c%:P. Proof. by rewrite /(_ \Po q) rmorphD rmorphM /= map_polyX map_polyC hornerMXaddC. Qed. Lemma comp_polyXaddC_K p z : (p \Po ('X + z%:P)) \Po ('X - z%:P) = p. Proof. have addzK: ('X + z%:P) \Po ('X - z%:P) = 'X. by rewrite raddfD /= comp_polyC comp_polyX subrK. elim/poly_ind: p => [|p c IHp]; first by rewrite !comp_poly0. rewrite comp_poly_MXaddC linearD /= comp_polyC {1}/comp_poly rmorphM /=. by rewrite hornerM_comm /comm_poly -!/(_ \Po _) ?IHp ?addzK ?commr_polyX. Qed. Lemma size_comp_poly_leq p q : size (p \Po q) <= ((size p).-1 * (size q).-1).+1. Proof. rewrite comp_polyE (leq_trans (size_sum _ _ _)) //; apply/bigmax_leqP => i _. rewrite (leq_trans (size_scale_leq _ _)) // (leq_trans (size_exp_leq _ _)) //. by rewrite ltnS mulnC leq_mul // -{2}(subnKC (valP i)) leq_addr. Qed. End PolyCompose. Notation "p \Po q" := (comp_poly q p) : ring_scope. Lemma map_comp_poly (aR rR : ringType) (f : {rmorphism aR -> rR}) p q : map_poly f (p \Po q) = map_poly f p \Po map_poly f q. Proof. elim/poly_ind: p => [|p a IHp]; first by rewrite !raddf0. rewrite comp_poly_MXaddC !rmorphD !rmorphM /= !map_polyC map_polyX. by rewrite comp_poly_MXaddC -IHp. Qed. Section PolynomialComRing. Variable R : comRingType. Implicit Types p q : {poly R}. Fact poly_mul_comm p q : p * q = q * p. Proof. apply/polyP=> i; rewrite coefM coefMr. by apply: eq_bigr => j _; rewrite mulrC. Qed. Canonical poly_comRingType := Eval hnf in ComRingType {poly R} poly_mul_comm. Canonical polynomial_comRingType := Eval hnf in ComRingType (polynomial R) poly_mul_comm. Canonical poly_algType := Eval hnf in CommAlgType R {poly R}. Canonical polynomial_algType := Eval hnf in [algType R of polynomial R for poly_algType]. Canonical poly_comAlgType := Eval hnf in [comAlgType R of {poly R}]. Lemma hornerM p q x : (p * q).[x] = p.[x] * q.[x]. Proof. by rewrite hornerM_comm //; apply: mulrC. Qed. Lemma horner_exp p x n : (p ^+ n).[x] = p.[x] ^+ n. Proof. by rewrite horner_exp_comm //; apply: mulrC. Qed. Lemma horner_prod I r (P : pred I) (F : I -> {poly R}) x : (\prod_(i <- r | P i) F i).[x] = \prod_(i <- r | P i) (F i).[x]. Proof. by elim/big_rec2: _ => [|i _ p _ <-]; rewrite (hornerM, hornerC). Qed. Definition hornerE := (hornerD, hornerN, hornerX, hornerC, horner_cons, simp, hornerCM, hornerZ, hornerM). Definition horner_eval (x : R) := horner^~ x. Lemma horner_evalE x p : horner_eval x p = p.[x]. Proof. by []. Qed. Fact horner_eval_is_lrmorphism x : lrmorphism_for *%R (horner_eval x). Proof. have cxid: commr_rmorph idfun x by apply: mulrC. have evalE : horner_eval x =1 horner_morph cxid. by move=> p; congr _.[x]; rewrite map_poly_id. split=> [|c p]; last by rewrite !evalE /= -linearZ. by do 2?split=> [p q|]; rewrite !evalE (rmorphB, rmorphM, rmorph1). Qed. Canonical horner_eval_additive x := Additive (horner_eval_is_lrmorphism x). Canonical horner_eval_rmorphism x := RMorphism (horner_eval_is_lrmorphism x). Canonical horner_eval_linear x := AddLinear (horner_eval_is_lrmorphism x). Canonical horner_eval_lrmorphism x := [lrmorphism of horner_eval x]. Section HornerAlg. Variable A : algType R. (* For univariate polys, commutativity is not needed *) Section Defs. Variable a : A. Lemma in_alg_comm : commr_rmorph (in_alg A) a. Proof. move=> r /=; by rewrite /GRing.comm comm_alg. Qed. Definition horner_alg := horner_morph in_alg_comm. Lemma horner_algC c : horner_alg c%:P = c%:A. Proof. exact: horner_morphC. Qed. Lemma horner_algX : horner_alg 'X = a. Proof. exact: horner_morphX. Qed. Fact horner_alg_is_lrmorphism : lrmorphism horner_alg. Proof. rewrite /horner_alg; split=> [|c p]; last by rewrite linearZ /= mulr_algl. split=> [p q|]; first by rewrite rmorphB. split=> [p q|]; last by rewrite rmorph1. by rewrite rmorphM. Qed. Canonical horner_alg_additive := Additive horner_alg_is_lrmorphism. Canonical horner_alg_rmorphism := RMorphism horner_alg_is_lrmorphism. Canonical horner_alg_linear := AddLinear horner_alg_is_lrmorphism. Canonical horner_alg_lrmorphism := [lrmorphism of horner_alg]. End Defs. Variable (pf : {lrmorphism {poly R} -> A}). Lemma poly_alg_initial : pf =1 horner_alg (pf 'X). Proof. apply: poly_ind => [|p a IHp]; first by rewrite !rmorph0. rewrite !rmorphD !rmorphM /= -{}IHp horner_algC ?horner_algX. by rewrite -alg_polyC rmorph_alg. Qed. End HornerAlg. Fact comp_poly_multiplicative q : multiplicative (comp_poly q). Proof. split=> [p1 p2|]; last by rewrite comp_polyC. by rewrite /comp_poly rmorphM hornerM_comm //; apply: mulrC. Qed. Canonical comp_poly_rmorphism q := AddRMorphism (comp_poly_multiplicative q). Canonical comp_poly_lrmorphism q := [lrmorphism of comp_poly q]. Lemma comp_polyM p q r : (p * q) \Po r = (p \Po r) * (q \Po r). Proof. exact: rmorphM. Qed. Lemma comp_polyA p q r : p \Po (q \Po r) = (p \Po q) \Po r. Proof. elim/poly_ind: p => [|p c IHp]; first by rewrite !comp_polyC. by rewrite !comp_polyD !comp_polyM !comp_polyX IHp !comp_polyC. Qed. Lemma horner_comp p q x : (p \Po q).[x] = p.[q.[x]]. Proof. by apply: polyC_inj; rewrite -!comp_polyCr comp_polyA. Qed. Lemma root_comp p q x : root (p \Po q) x = root p (q.[x]). Proof. by rewrite !rootE horner_comp. Qed. Lemma deriv_comp p q : (p \Po q) ^`() = (p ^`() \Po q) * q^`(). Proof. elim/poly_ind: p => [|p c IHp]; first by rewrite !(deriv0, comp_poly0) mul0r. rewrite comp_poly_MXaddC derivD derivC derivM IHp derivMXaddC comp_polyD. by rewrite comp_polyM comp_polyX addr0 addrC mulrAC -mulrDl. Qed. Lemma deriv_exp p n : (p ^+ n)^`() = p^`() * p ^+ n.-1 *+ n. Proof. elim: n => [|n IHn]; first by rewrite expr0 mulr0n derivC. by rewrite exprS derivM {}IHn (mulrC p) mulrnAl -mulrA -exprSr mulrS; case n. Qed. Definition derivCE := (derivE, deriv_exp). End PolynomialComRing. Canonical polynomial_countComRingType (R : countComRingType) := [countComRingType of polynomial R]. Canonical poly_countComRingType (R : countComRingType) := [countComRingType of {poly R}]. Section PolynomialIdomain. (* Integral domain structure on poly *) Variable R : idomainType. Implicit Types (a b x y : R) (p q r m : {poly R}). Lemma size_mul p q : p != 0 -> q != 0 -> size (p * q) = (size p + size q).-1. Proof. by move=> nz_p nz_q; rewrite -size_proper_mul ?mulf_neq0 ?lead_coef_eq0. Qed. Fact poly_idomainAxiom p q : p * q = 0 -> (p == 0) || (q == 0). Proof. move=> pq0; apply/norP=> [[p_nz q_nz]]; move/eqP: (size_mul p_nz q_nz). by rewrite eq_sym pq0 size_poly0 (polySpred p_nz) (polySpred q_nz) addnS. Qed. Definition poly_unit : pred {poly R} := fun p => (size p == 1%N) && (p`_0 \in GRing.unit). Definition poly_inv p := if p \in poly_unit then (p`_0)^-1%:P else p. Fact poly_mulVp : {in poly_unit, left_inverse 1 poly_inv *%R}. Proof. move=> p Up; rewrite /poly_inv Up. by case/andP: Up => /size_poly1P[c _ ->]; rewrite coefC -polyCM => /mulVr->. Qed. Fact poly_intro_unit p q : q * p = 1 -> p \in poly_unit. Proof. move=> pq1; apply/andP; split; last first. apply/unitrP; exists q`_0. by rewrite 2!mulrC -!/(coefp 0 _) -rmorphM pq1 rmorph1. have: size (q * p) == 1%N by rewrite pq1 size_poly1. have [-> | nz_p] := eqVneq p 0; first by rewrite mulr0 size_poly0. have [-> | nz_q] := eqVneq q 0; first by rewrite mul0r size_poly0. rewrite size_mul // (polySpred nz_p) (polySpred nz_q) addnS addSn !eqSS. by rewrite addn_eq0 => /andP[]. Qed. Fact poly_inv_out : {in [predC poly_unit], poly_inv =1 id}. Proof. by rewrite /poly_inv => p /negbTE/= ->. Qed. Definition poly_comUnitMixin := ComUnitRingMixin poly_mulVp poly_intro_unit poly_inv_out. Canonical poly_unitRingType := Eval hnf in UnitRingType {poly R} poly_comUnitMixin. Canonical polynomial_unitRingType := Eval hnf in [unitRingType of polynomial R for poly_unitRingType]. Canonical poly_unitAlgType := Eval hnf in [unitAlgType R of {poly R}]. Canonical polynomial_unitAlgType := Eval hnf in [unitAlgType R of polynomial R]. Canonical poly_comUnitRingType := Eval hnf in [comUnitRingType of {poly R}]. Canonical polynomial_comUnitRingType := Eval hnf in [comUnitRingType of polynomial R]. Canonical poly_idomainType := Eval hnf in IdomainType {poly R} poly_idomainAxiom. Canonical polynomial_idomainType := Eval hnf in [idomainType of polynomial R for poly_idomainType]. Lemma poly_unitE p : (p \in GRing.unit) = (size p == 1%N) && (p`_0 \in GRing.unit). Proof. by []. Qed. Lemma poly_invE p : p ^-1 = if p \in GRing.unit then (p`_0)^-1%:P else p. Proof. by []. Qed. Lemma polyCV c : c%:P^-1 = (c^-1)%:P. Proof. have [/rmorphV-> // | nUc] := boolP (c \in GRing.unit). by rewrite !invr_out // poly_unitE coefC (negbTE nUc) andbF. Qed. Lemma rootM p q x : root (p * q) x = root p x || root q x. Proof. by rewrite !rootE hornerM mulf_eq0. Qed. Lemma rootZ x a p : a != 0 -> root (a *: p) x = root p x. Proof. by move=> nz_a; rewrite -mul_polyC rootM rootC (negPf nz_a). Qed. Lemma size_scale a p : a != 0 -> size (a *: p) = size p. Proof. by move/lregP/lreg_size->. Qed. Lemma size_Cmul a p : a != 0 -> size (a%:P * p) = size p. Proof. by rewrite mul_polyC => /size_scale->. Qed. Lemma lead_coefM p q : lead_coef (p * q) = lead_coef p * lead_coef q. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite !(mul0r, lead_coef0). have [-> | nz_q] := eqVneq q 0; first by rewrite !(mulr0, lead_coef0). by rewrite lead_coef_proper_mul // mulf_neq0 ?lead_coef_eq0. Qed. Lemma lead_coefZ a p : lead_coef (a *: p) = a * lead_coef p. Proof. by rewrite -mul_polyC lead_coefM lead_coefC. Qed. Lemma scale_poly_eq0 a p : (a *: p == 0) = (a == 0) || (p == 0). Proof. by rewrite -mul_polyC mulf_eq0 polyC_eq0. Qed. Lemma size_prod (I : finType) (P : pred I) (F : I -> {poly R}) : (forall i, P i -> F i != 0) -> size (\prod_(i | P i) F i) = ((\sum_(i | P i) size (F i)).+1 - #|P|)%N. Proof. move=> nzF; transitivity (\sum_(i | P i) (size (F i)).-1).+1; last first. apply: canRL (addKn _) _; rewrite addnS -sum1_card -big_split /=. by congr _.+1; apply: eq_bigr => i /nzF/polySpred. elim/big_rec2: _ => [|i d p /nzF nzFi IHp]; first by rewrite size_poly1. by rewrite size_mul // -?size_poly_eq0 IHp // addnS polySpred. Qed. Lemma size_prod_seq (I : eqType) (s : seq I) (F : I -> {poly R}) : (forall i, i \in s -> F i != 0) -> size (\prod_(i <- s) F i) = ((\sum_(i <- s) size (F i)).+1 - size s)%N. Proof. move=> nzF; rewrite big_tnth size_prod; last by move=> i; rewrite nzF ?mem_tnth. by rewrite cardT /= size_enum_ord [in RHS]big_tnth. Qed. Lemma size_mul_eq1 p q : (size (p * q) == 1%N) = ((size p == 1%N) && (size q == 1%N)). Proof. have [->|pNZ] := eqVneq p 0; first by rewrite mul0r size_poly0. have [->|qNZ] := eqVneq q 0; first by rewrite mulr0 size_poly0 andbF. rewrite size_mul //. by move: pNZ qNZ; rewrite -!size_poly_gt0; (do 2 case: size) => //= n [|[|]]. Qed. Lemma size_prod_seq_eq1 (I : eqType) (s : seq I) (P : pred I) (F : I -> {poly R}) : reflect (forall i, P i && (i \in s) -> size (F i) = 1%N) (size (\prod_(i <- s | P i) F i) == 1%N). Proof. have -> : (size (\prod_(i <- s | P i) F i) == 1%N) = (all [pred i | P i ==> (size (F i) == 1%N)] s). elim: s => [|a s IHs /=]; first by rewrite big_nil size_poly1. by rewrite big_cons; case: (P a) => //=; rewrite size_mul_eq1 IHs. apply: (iffP allP) => /= [/(_ _ _)/implyP /(_ _)/eqP|] sF_eq1 i. by move=> /andP[Pi si]; rewrite sF_eq1. by move=> si; apply/implyP => Pi; rewrite sF_eq1 ?Pi. Qed. Lemma size_prod_eq1 (I : finType) (P : pred I) (F : I -> {poly R}) : reflect (forall i, P i -> size (F i) = 1%N) (size (\prod_(i | P i) F i) == 1%N). Proof. apply: (iffP (size_prod_seq_eq1 _ _ _)) => Hi i. by move=> Pi; apply: Hi; rewrite Pi /= mem_index_enum. by rewrite mem_index_enum andbT; apply: Hi. Qed. Lemma size_exp p n : (size (p ^+ n)).-1 = ((size p).-1 * n)%N. Proof. elim: n => [|n IHn]; first by rewrite size_poly1 muln0. have [-> | nz_p] := eqVneq p 0; first by rewrite exprS mul0r size_poly0. rewrite exprS size_mul ?expf_neq0 // mulnS -{}IHn. by rewrite polySpred // [size (p ^+ n)]polySpred ?expf_neq0 ?addnS. Qed. Lemma lead_coef_exp p n : lead_coef (p ^+ n) = lead_coef p ^+ n. Proof. elim: n => [|n IHn]; first by rewrite !expr0 lead_coef1. by rewrite !exprS lead_coefM IHn. Qed. Lemma root_prod_XsubC rs x : root (\prod_(a <- rs) ('X - a%:P)) x = (x \in rs). Proof. elim: rs => [|a rs IHrs]; first by rewrite rootE big_nil hornerC oner_eq0. by rewrite big_cons rootM IHrs root_XsubC. Qed. Lemma root_exp_XsubC n a x : root (('X - a%:P) ^+ n.+1) x = (x == a). Proof. by rewrite rootE horner_exp expf_eq0 [_ == 0]root_XsubC. Qed. Lemma size_comp_poly p q : (size (p \Po q)).-1 = ((size p).-1 * (size q).-1)%N. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite comp_poly0 size_poly0. have [/size1_polyC-> | nc_q] := leqP (size q) 1. by rewrite comp_polyCr !size_polyC -!sub1b -!subnS muln0. have nz_q: q != 0 by rewrite -size_poly_eq0 -(subnKC nc_q). rewrite mulnC comp_polyE (polySpred nz_p) /= big_ord_recr /= addrC. rewrite size_addl size_scale ?lead_coef_eq0 ?size_exp //=. rewrite [X in _ < X]polySpred ?expf_neq0 // ltnS size_exp. rewrite (leq_trans (size_sum _ _ _)) //; apply/bigmax_leqP => i _. rewrite (leq_trans (size_scale_leq _ _)) // polySpred ?expf_neq0 //. by rewrite size_exp -(subnKC nc_q) ltn_pmul2l. Qed. Lemma lead_coef_comp p q : size q > 1 -> lead_coef (p \Po q) = (lead_coef p) * lead_coef q ^+ (size p).-1. Proof. move=> q_gt1; rewrite !lead_coefE coef_comp_poly size_comp_poly. have [->|nz_p] := eqVneq p 0; first by rewrite size_poly0 big_ord0 coef0 mul0r. rewrite polySpred //= big_ord_recr /= big1 ?add0r => [|i _]. by rewrite -!lead_coefE -lead_coef_exp !lead_coefE size_exp mulnC. rewrite [X in _ * X]nth_default ?mulr0 ?(leq_trans (size_exp_leq _ _)) //. by rewrite mulnC ltn_mul2r -subn1 subn_gt0 q_gt1 /=. Qed. Lemma comp_poly_eq0 p q : size q > 1 -> (p \Po q == 0) = (p == 0). Proof. move=> sq_gt1; rewrite -!lead_coef_eq0 lead_coef_comp //. rewrite mulf_eq0 expf_eq0 !lead_coef_eq0 -[q == 0]size_poly_leq0. by rewrite [_ <= 0]leqNgt (leq_ltn_trans _ sq_gt1) ?andbF ?orbF. Qed. Lemma size_comp_poly2 p q : size q = 2 -> size (p \Po q) = size p. Proof. move=> sq2; have [->|pN0] := eqVneq p 0; first by rewrite comp_polyC. by rewrite polySpred ?size_comp_poly ?comp_poly_eq0 ?sq2 // muln1 polySpred. Qed. Lemma comp_poly2_eq0 p q : size q = 2 -> (p \Po q == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 => /size_comp_poly2->. Qed. Theorem max_poly_roots p rs : p != 0 -> all (root p) rs -> uniq rs -> size rs < size p. Proof. elim: rs p => [p pn0 _ _ | r rs ihrs p pn0] /=; first by rewrite size_poly_gt0. case/andP => rpr arrs /andP [rnrs urs]; case/factor_theorem: rpr => q epq. have [q0 | ?] := eqVneq q 0; first by move: pn0; rewrite epq q0 mul0r eqxx. have -> : size p = (size q).+1. by rewrite epq size_Mmonic ?monicXsubC // size_XsubC addnC. suff /eq_in_all h : {in rs, root q =1 root p} by apply: ihrs => //; rewrite h. move=> x xrs; rewrite epq rootM root_XsubC orbC; case: (eqVneq x r) => // exr. by move: rnrs; rewrite -exr xrs. Qed. Lemma roots_geq_poly_eq0 p (rs : seq R) : all (root p) rs -> uniq rs -> (size rs >= size p)%N -> p = 0. Proof. by move=> ??; apply: contraTeq => ?; rewrite leqNgt max_poly_roots. Qed. End PolynomialIdomain. Canonical polynomial_countUnitRingType (R : countIdomainType) := [countUnitRingType of polynomial R]. Canonical poly_countUnitRingType (R : countIdomainType) := [countUnitRingType of {poly R}]. Canonical polynomial_countComUnitRingType (R : countIdomainType) := [countComUnitRingType of polynomial R]. Canonical poly_countComUnitRingType (R : countIdomainType) := [countComUnitRingType of {poly R}]. Canonical polynomial_countIdomainType (R : countIdomainType) := [countIdomainType of polynomial R]. Canonical poly_countIdomainType (R : countIdomainType) := [countIdomainType of {poly R}]. Section MapFieldPoly. Variables (F : fieldType) (R : ringType) (f : {rmorphism F -> R}). Local Notation "p ^f" := (map_poly f p) : ring_scope. Lemma size_map_poly p : size p^f = size p. Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite rmorph0 !size_poly0. by rewrite size_poly_eq // fmorph_eq0 // lead_coef_eq0. Qed. Lemma lead_coef_map p : lead_coef p^f = f (lead_coef p). Proof. have [-> | nz_p] := eqVneq p 0; first by rewrite !(rmorph0, lead_coef0). by rewrite lead_coef_map_eq // fmorph_eq0 // lead_coef_eq0. Qed. Lemma map_poly_eq0 p : (p^f == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 size_map_poly. Qed. Lemma map_poly_inj : injective (map_poly f). Proof. move=> p q eqfpq; apply/eqP; rewrite -subr_eq0 -map_poly_eq0. by rewrite rmorphB /= eqfpq subrr. Qed. Lemma map_monic p : (p^f \is monic) = (p \is monic). Proof. by rewrite monicE lead_coef_map fmorph_eq1. Qed. Lemma map_poly_com p x : comm_poly p^f (f x). Proof. exact: map_comm_poly (mulrC x _). Qed. Lemma fmorph_root p x : root p^f (f x) = root p x. Proof. by rewrite rootE horner_map // fmorph_eq0. Qed. Lemma fmorph_unity_root n z : n.-unity_root (f z) = n.-unity_root z. Proof. by rewrite !unity_rootE -(inj_eq (fmorph_inj f)) rmorphX ?rmorph1. Qed. Lemma fmorph_primitive_root n z : n.-primitive_root (f z) = n.-primitive_root z. Proof. by congr (_ && _); apply: eq_forallb => i; rewrite fmorph_unity_root. Qed. End MapFieldPoly. Arguments map_poly_inj {F R} f [p1 p2] : rename. Section MaxRoots. Variable R : unitRingType. Implicit Types (x y : R) (rs : seq R) (p : {poly R}). Definition diff_roots (x y : R) := (x * y == y * x) && (y - x \in GRing.unit). Fixpoint uniq_roots rs := if rs is x :: rs' then all (diff_roots x) rs' && uniq_roots rs' else true. Lemma uniq_roots_prod_XsubC p rs : all (root p) rs -> uniq_roots rs -> exists q, p = q * \prod_(z <- rs) ('X - z%:P). Proof. elim: rs => [|z rs IHrs] /=; first by rewrite big_nil; exists p; rewrite mulr1. case/andP=> rpz rprs /andP[drs urs]; case: IHrs => {urs rprs}// q def_p. have [|q' def_q] := factor_theorem q z _; last first. by exists q'; rewrite big_cons mulrA -def_q. rewrite {p}def_p in rpz. elim/last_ind: rs drs rpz => [|rs t IHrs] /=; first by rewrite big_nil mulr1. rewrite all_rcons => /andP[/andP[/eqP czt Uzt] /IHrs{}IHrs]. rewrite -cats1 big_cat big_seq1 /= mulrA rootE hornerM_comm; last first. by rewrite /comm_poly hornerXsubC mulrBl mulrBr czt. rewrite hornerXsubC -opprB mulrN oppr_eq0 -(mul0r (t - z)). by rewrite (inj_eq (mulIr Uzt)) => /IHrs. Qed. Theorem max_ring_poly_roots p rs : p != 0 -> all (root p) rs -> uniq_roots rs -> size rs < size p. Proof. move=> nz_p _ /(@uniq_roots_prod_XsubC p)[// | q def_p]; rewrite def_p in nz_p *. have nz_q: q != 0 by apply: contraNneq nz_p => ->; rewrite mul0r. rewrite size_Mmonic ?monic_prod_XsubC // (polySpred nz_q) addSn /=. by rewrite size_prod_XsubC leq_addl. Qed. Lemma all_roots_prod_XsubC p rs : size p = (size rs).+1 -> all (root p) rs -> uniq_roots rs -> p = lead_coef p *: \prod_(z <- rs) ('X - z%:P). Proof. move=> size_p /uniq_roots_prod_XsubC def_p Urs. case/def_p: Urs => q -> {p def_p} in size_p *. have [q0 | nz_q] := eqVneq q 0; first by rewrite q0 mul0r size_poly0 in size_p. have{q nz_q size_p} /size_poly1P[c _ ->]: size q == 1%N. rewrite -(eqn_add2r (size rs)) add1n -size_p. by rewrite size_Mmonic ?monic_prod_XsubC // size_prod_XsubC addnS. by rewrite lead_coef_Mmonic ?monic_prod_XsubC // lead_coefC mul_polyC. Qed. End MaxRoots. Section FieldRoots. Variable F : fieldType. Implicit Types (p : {poly F}) (rs : seq F). Lemma poly2_root p : size p = 2 -> {r | root p r}. Proof. case: p => [[|p0 [|p1 []]] //= nz_p1]; exists (- p0 / p1). by rewrite /root addr_eq0 /= mul0r add0r mulrC divfK ?opprK. Qed. Lemma uniq_rootsE rs : uniq_roots rs = uniq rs. Proof. elim: rs => //= r rs ->; congr (_ && _); rewrite -has_pred1 -all_predC. by apply: eq_all => t; rewrite /diff_roots mulrC eqxx unitfE subr_eq0. Qed. Section UnityRoots. Variable n : nat. Lemma max_unity_roots rs : n > 0 -> all n.-unity_root rs -> uniq rs -> size rs <= n. Proof. move=> n_gt0 rs_n_1 Urs; have szPn := size_Xn_sub_1 F n_gt0. by rewrite -ltnS -szPn max_poly_roots -?size_poly_eq0 ?szPn. Qed. Lemma mem_unity_roots rs : n > 0 -> all n.-unity_root rs -> uniq rs -> size rs = n -> n.-unity_root =i rs. Proof. move=> n_gt0 rs_n_1 Urs sz_rs_n x; rewrite -topredE /=. apply/idP/idP=> xn1; last exact: (allP rs_n_1). apply: contraFT (ltnn n) => not_rs_x. by rewrite -{1}sz_rs_n (@max_unity_roots (x :: rs)) //= ?xn1 ?not_rs_x. Qed. (* Showing the existence of a primitive root requires the theory in cyclic. *) Variable z : F. Hypothesis prim_z : n.-primitive_root z. Let zn := [seq z ^+ i | i <- index_iota 0 n]. Lemma factor_Xn_sub_1 : \prod_(0 <= i < n) ('X - (z ^+ i)%:P) = 'X^n - 1. Proof. transitivity (\prod_(w <- zn) ('X - w%:P)); first by rewrite big_map. have n_gt0: n > 0 := prim_order_gt0 prim_z. rewrite (@all_roots_prod_XsubC _ ('X^n - 1) zn); first 1 last. - by rewrite size_Xn_sub_1 // size_map size_iota subn0. - apply/allP=> _ /mapP[i _ ->] /=; rewrite rootE !hornerE hornerXn. by rewrite exprAC (prim_expr_order prim_z) expr1n subrr. - rewrite uniq_rootsE map_inj_in_uniq ?iota_uniq // => i j. rewrite !mem_index_iota => ltin ltjn /eqP. by rewrite (eq_prim_root_expr prim_z) !modn_small // => /eqP. by rewrite (monicP (monic_Xn_sub_1 F n_gt0)) scale1r. Qed. Lemma prim_rootP x : x ^+ n = 1 -> {i : 'I_n | x = z ^+ i}. Proof. move=> xn1; pose logx := [pred i : 'I_n | x == z ^+ i]. case: (pickP logx) => [i /eqP-> | no_i]; first by exists i. case: notF; suffices{no_i}: x \in zn. case/mapP=> i; rewrite mem_index_iota => lt_i_n def_x. by rewrite -(no_i (Ordinal lt_i_n)) /= -def_x. rewrite -root_prod_XsubC big_map factor_Xn_sub_1. by rewrite [root _ x]unity_rootE xn1. Qed. End UnityRoots. End FieldRoots. Section MapPolyRoots. Variables (F : fieldType) (R : unitRingType) (f : {rmorphism F -> R}). Lemma map_diff_roots x y : diff_roots (f x) (f y) = (x != y). Proof. rewrite /diff_roots -rmorphB // fmorph_unit // subr_eq0 //. by rewrite rmorph_comm // eqxx eq_sym. Qed. Lemma map_uniq_roots s : uniq_roots (map f s) = uniq s. Proof. elim: s => //= x s ->; congr (_ && _); elim: s => //= y s ->. by rewrite map_diff_roots -negb_or. Qed. End MapPolyRoots. Section AutPolyRoot. (* The action of automorphisms on roots of unity. *) Variable F : fieldType. Implicit Types u v : {rmorphism F -> F}. Lemma aut_prim_rootP u z n : n.-primitive_root z -> {k | coprime k n & u z = z ^+ k}. Proof. move=> prim_z; have:= prim_z; rewrite -(fmorph_primitive_root u) => prim_uz. have [[k _] /= def_uz] := prim_rootP prim_z (prim_expr_order prim_uz). by exists k; rewrite // -(prim_root_exp_coprime _ prim_z) -def_uz. Qed. Lemma aut_unity_rootP u z n : n > 0 -> z ^+ n = 1 -> {k | u z = z ^+ k}. Proof. by move=> _ /prim_order_exists[// | m /(aut_prim_rootP u)[k]]; exists k. Qed. Lemma aut_unity_rootC u v z n : n > 0 -> z ^+ n = 1 -> u (v z) = v (u z). Proof. move=> n_gt0 /(aut_unity_rootP _ n_gt0) def_z. have [[i def_uz] [j def_vz]] := (def_z u, def_z v). by rewrite !(def_uz, def_vz, rmorphX) exprAC. Qed. End AutPolyRoot. Module UnityRootTheory. Notation "n .-unity_root" := (root_of_unity n) : unity_root_scope. Notation "n .-primitive_root" := (primitive_root_of_unity n) : unity_root_scope. Open Scope unity_root_scope. Definition unity_rootE := unity_rootE. Definition unity_rootP := @unity_rootP. Arguments unity_rootP {R n z}. Definition prim_order_exists := prim_order_exists. Notation prim_order_gt0 := prim_order_gt0. Notation prim_expr_order := prim_expr_order. Definition prim_expr_mod := prim_expr_mod. Definition prim_order_dvd := prim_order_dvd. Definition eq_prim_root_expr := eq_prim_root_expr. Definition rmorph_unity_root := rmorph_unity_root. Definition fmorph_unity_root := fmorph_unity_root. Definition fmorph_primitive_root := fmorph_primitive_root. Definition max_unity_roots := max_unity_roots. Definition mem_unity_roots := mem_unity_roots. Definition prim_rootP := prim_rootP. End UnityRootTheory. Section DecField. Variable F : decFieldType. Lemma dec_factor_theorem (p : {poly F}) : {s : seq F & {q : {poly F} | p = q * \prod_(x <- s) ('X - x%:P) /\ (q != 0 -> forall x, ~~ root q x)}}. Proof. pose polyT (p : seq F) := (foldr (fun c f => f * 'X_0 + c%:T) (0%R)%:T p)%T. have eval_polyT (q : {poly F}) x : GRing.eval [:: x] (polyT q) = q.[x]. by rewrite /horner; elim: (val q) => //= ? ? ->. have [n] := ubnP (size p); elim: n => // n IHn in p *. have /decPcases /= := @satP F [::] ('exists 'X_0, polyT p == 0%T). case: ifP => [_ /sig_eqW[x]|_ noroot]; last first. exists [::], p; rewrite big_nil mulr1; split => // p_neq0 x. by apply/negP=> /rootP rpx; apply: noroot; exists x; rewrite eval_polyT. rewrite eval_polyT => /rootP/factor_theorem/sig_eqW[p1 ->]. have [->|nz_p1] := eqVneq p1 0; first by exists [::], 0; rewrite !mul0r eqxx. rewrite size_Mmonic ?monicXsubC // size_XsubC addn2 => /IHn[s [q [-> irr_q]]]. by exists (rcons s x), q; rewrite -cats1 big_cat big_seq1 mulrA. Qed. End DecField. Module PreClosedField. Section UseAxiom. Variable F : fieldType. Hypothesis closedF : GRing.ClosedField.axiom F. Implicit Type p : {poly F}. Lemma closed_rootP p : reflect (exists x, root p x) (size p != 1%N). Proof. have [-> | nz_p] := eqVneq p 0. by rewrite size_poly0; left; exists 0; rewrite root0. rewrite neq_ltn [in _ < 1]polySpred //=. apply: (iffP idP) => [p_gt1 | [a]]; last exact: root_size_gt1. pose n := (size p).-1; have n_gt0: n > 0 by rewrite -ltnS -polySpred. have [a Dan] := closedF (fun i => - p`_i / lead_coef p) n_gt0. exists a; apply/rootP; rewrite horner_coef polySpred // big_ord_recr /= -/n. rewrite {}Dan mulr_sumr -big_split big1 //= => i _. by rewrite -!mulrA mulrCA mulNr mulVKf ?subrr ?lead_coef_eq0. Qed. Lemma closed_nonrootP p : reflect (exists x, ~~ root p x) (p != 0). Proof. apply: (iffP idP) => [nz_p | [x]]; last first. by apply: contraNneq => ->; apply: root0. have [[x /rootP p1x0]|] := altP (closed_rootP (p - 1)). by exists x; rewrite -[p](subrK 1) /root hornerD p1x0 add0r hornerC oner_eq0. rewrite negbK => /size_poly1P[c _ /(canRL (subrK 1)) Dp]. by exists 0; rewrite Dp -raddfD polyC_eq0 rootC in nz_p *. Qed. End UseAxiom. End PreClosedField. Section ClosedField. Variable F : closedFieldType. Implicit Type p : {poly F}. Let closedF := @solve_monicpoly F. Lemma closed_rootP p : reflect (exists x, root p x) (size p != 1%N). Proof. exact: PreClosedField.closed_rootP. Qed. Lemma closed_nonrootP p : reflect (exists x, ~~ root p x) (p != 0). Proof. exact: PreClosedField.closed_nonrootP. Qed. Lemma closed_field_poly_normal p : {r : seq F | p = lead_coef p *: \prod_(z <- r) ('X - z%:P)}. Proof. apply: sig_eqW; have [r [q [->]]] /= := dec_factor_theorem p. have [->|] := eqVneq; first by exists [::]; rewrite mul0r lead_coef0 scale0r. have [[x rqx ? /(_ isT x) /negP /(_ rqx)] //|] := altP (closed_rootP q). rewrite negbK => /size_poly1P [c c_neq0-> _ _]; exists r. rewrite mul_polyC lead_coefZ (monicP _) ?mulr1 //. by rewrite monic_prod => // i; rewrite monicXsubC. Qed. End ClosedField. Notation "@ 'polyC_add'" := (deprecate polyC_add polyCD) (at level 10, only parsing) : fun_scope. Notation "@ 'polyC_opp'" := (deprecate polyC_opp polyCN) (at level 10, only parsing) : fun_scope. Notation "@ 'polyC_sub'" := (deprecate polyC_sub polyCB) (at level 10, only parsing) : fun_scope. Notation "@ 'polyC_muln'" := (deprecate polyC_muln polyCMn) (at level 10, only parsing) : fun_scope. Notation "@ 'polyC_mul'" := (deprecate polyC_mul polyCM) (at level 10, only parsing) : fun_scope. Notation "@ 'polyC_inv'" := (deprecate polyC_inv polyCV) (at level 10, only parsing) : fun_scope. Notation "@ 'lead_coef_opp'" := (deprecate lead_coef_opp lead_coefN) (at level 10, only parsing) : fun_scope. Notation "@ 'derivn_sub'" := (deprecate derivn_sub derivnB) (at level 10, only parsing) : fun_scope. Notation polyC_add := (@polyC_add _) (only parsing). Notation polyC_opp := (@polyC_opp _) (only parsing). Notation polyC_sub := (@polyC_sub _) (only parsing). Notation polyC_muln := (@polyC_muln _) (only parsing). Notation polyC_mul := (@polyC_mul _) (only parsing). Notation polyC_inv := (@polyC_inv _) (only parsing). Notation lead_coef_opp := (@lead_coef_opp _) (only parsing). Notation derivn_sub := (@derivn_sub _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/polyXY.v000066400000000000000000000435361375767750300221650ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype choice ssrnat seq. From mathcomp Require Import fintype tuple finfun bigop fingroup perm div. From mathcomp Require Import ssralg zmodp matrix mxalgebra. From mathcomp Require Import poly polydiv mxpoly binomial. (******************************************************************************) (* This file provides additional primitives and theory for bivariate *) (* polynomials (polynomials of two variables), represented as polynomials *) (* with (univariate) polynomial coefficients : *) (* 'Y == the (generic) second variable (:= 'X%:P). *) (* p^:P == the bivariate polynomial p['X], for p univariate. *) (* := map_poly polyC p (this notation is defined in poly.v). *) (* u.[x, y] == the bivariate polynomial u evaluated at 'X = x, 'Y = y. *) (* := u.[x%:P].[y]. *) (* sizeY u == the size of u in 'Y (1 + the 'Y-degree of u, if u != 0). *) (* := \max_(i < size u) size u`_i. *) (* swapXY u == the bivariate polynomial u['Y, 'X], for u bivariate. *) (* poly_XaY p == the bivariate polynomial p['X + 'Y], for p univariate. *) (* := p^:P \Po ('X + 'Y). *) (* poly_XmY p == the bivariate polynomial p['X * 'Y], for p univariate. *) (* := P^:P \Po ('X * 'Y). *) (* sub_annihilant p q == for univariate p, q != 0, a nonzero polynomial whose *) (* roots include all the differences of roots of p and q, in *) (* all field extensions (:= resultant (poly_XaY p) q^:P). *) (* div_annihilant p q == for polynomials p != 0, q with q.[0] != 0, a nonzero *) (* polynomial whose roots include all the quotients of roots *) (* of p by roots of q, in all field extensions *) (* (:= resultant (poly_XmY p) q^:P). *) (* The latter two "annhilants" provide uniform witnesses for an alternative *) (* proof of the closure of the algebraicOver predicate (see mxpoly.v). The *) (* fact that the annhilant does not depend on the particular choice of roots *) (* of p and q is crucial for the proof of the Primitive Element Theorem (file *) (* separable.v). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GRing.Theory. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Local Notation eval := horner_eval. Notation "'Y" := 'X%:P : ring_scope. Notation "p ^:P" := (p ^ polyC) (at level 2, format "p ^:P") : ring_scope. Notation "p .[ x , y ]" := (p.[x%:P].[y]) (at level 2, left associativity, format "p .[ x , y ]") : ring_scope. Section PolyXY_Ring. Variable R : ringType. Implicit Types (u : {poly {poly R}}) (p q : {poly R}) (x : R). Fact swapXY_key : unit. Proof. by []. Qed. Definition swapXY_def u : {poly {poly R}} := (u ^ map_poly polyC).['Y]. Definition swapXY := locked_with swapXY_key swapXY_def. Canonical swapXY_unlockable := [unlockable fun swapXY]. Definition sizeY u : nat := \max_(i < size u) (size u`_i). Definition poly_XaY p : {poly {poly R}} := p^:P \Po ('X + 'Y). Definition poly_XmY p : {poly {poly R}} := p^:P \Po ('X * 'Y). Definition sub_annihilant p q := resultant (poly_XaY p) q^:P. Definition div_annihilant p q := resultant (poly_XmY p) q^:P. Lemma swapXY_polyC p : swapXY p%:P = p^:P. Proof. by rewrite unlock map_polyC hornerC. Qed. Lemma swapXY_X : swapXY 'X = 'Y. Proof. by rewrite unlock map_polyX hornerX. Qed. Lemma swapXY_Y : swapXY 'Y = 'X. Proof. by rewrite swapXY_polyC map_polyX. Qed. Lemma swapXY_is_additive : additive swapXY. Proof. by move=> u v; rewrite unlock rmorphB !hornerE. Qed. Canonical swapXY_addf := Additive swapXY_is_additive. Lemma coef_swapXY u i j : (swapXY u)`_i`_j = u`_j`_i. Proof. elim/poly_ind: u => [|u p IHu] in i j *; first by rewrite raddf0 !coef0. rewrite raddfD !coefD /= swapXY_polyC coef_map /= !coefC coefMX. rewrite !(fun_if (fun q : {poly R} => q`_i)) coef0 -IHu; congr (_ + _). by rewrite unlock rmorphM /= map_polyX hornerMX coefMC coefMX. Qed. Lemma swapXYK : involutive swapXY. Proof. by move=> u; apply/polyP=> i; apply/polyP=> j; rewrite !coef_swapXY. Qed. Lemma swapXY_map_polyC p : swapXY p^:P = p%:P. Proof. by rewrite -swapXY_polyC swapXYK. Qed. Lemma swapXY_eq0 u : (swapXY u == 0) = (u == 0). Proof. by rewrite (inv_eq swapXYK) raddf0. Qed. Lemma swapXY_is_multiplicative : multiplicative swapXY. Proof. split=> [u v|]; last by rewrite swapXY_polyC map_polyC. apply/polyP=> i; apply/polyP=> j; rewrite coef_swapXY !coefM !coef_sum. rewrite (eq_bigr _ (fun _ _ => coefM _ _ _)) exchange_big /=. apply: eq_bigr => j1 _; rewrite coefM; apply: eq_bigr=> i1 _. by rewrite !coef_swapXY. Qed. Canonical swapXY_rmorphism := AddRMorphism swapXY_is_multiplicative. Lemma swapXY_is_scalable : scalable_for (map_poly polyC \; *%R) swapXY. Proof. by move=> p u /=; rewrite -mul_polyC rmorphM /= swapXY_polyC. Qed. Canonical swapXY_linear := AddLinear swapXY_is_scalable. Canonical swapXY_lrmorphism := [lrmorphism of swapXY]. Lemma swapXY_comp_poly p u : swapXY (p^:P \Po u) = p^:P \Po swapXY u. Proof. rewrite -horner_map; congr _.[_]; rewrite -!map_poly_comp /=. by apply: eq_map_poly => x; rewrite /= swapXY_polyC map_polyC. Qed. Lemma max_size_coefXY u i : size u`_i <= sizeY u. Proof. have [ltiu | /(nth_default 0)->] := ltnP i (size u); last by rewrite size_poly0. exact: (bigmax_sup (Ordinal ltiu)). Qed. Lemma max_size_lead_coefXY u : size (lead_coef u) <= sizeY u. Proof. by rewrite lead_coefE max_size_coefXY. Qed. Lemma max_size_evalX u : size u.['X] <= sizeY u + (size u).-1. Proof. rewrite horner_coef (leq_trans (size_sum _ _ _)) //; apply/bigmax_leqP=> i _. rewrite (leq_trans (size_mul_leq _ _)) // size_polyXn addnS. by rewrite leq_add ?max_size_coefXY //= -ltnS (leq_trans _ (leqSpred _)). Qed. Lemma max_size_evalC u x : size u.[x%:P] <= sizeY u. Proof. rewrite horner_coef (leq_trans (size_sum _ _ _)) //; apply/bigmax_leqP=> i _. rewrite (leq_trans (size_mul_leq _ _)) // -polyC_exp size_polyC addnC -subn1. by rewrite (leq_trans _ (max_size_coefXY _ i)) // leq_subLR leq_add2r leq_b1. Qed. Lemma sizeYE u : sizeY u = size (swapXY u). Proof. apply/eqP; rewrite eqn_leq; apply/andP; split. apply/bigmax_leqP=> /= i _; apply/leq_sizeP => j /(nth_default 0) u_j_0. by rewrite -coef_swapXY u_j_0 coef0. apply/leq_sizeP=> j le_uY_j; apply/polyP=> i; rewrite coef_swapXY coef0. by rewrite nth_default // (leq_trans _ le_uY_j) ?max_size_coefXY. Qed. Lemma sizeY_eq0 u : (sizeY u == 0%N) = (u == 0). Proof. by rewrite sizeYE size_poly_eq0 swapXY_eq0. Qed. Lemma sizeY_mulX u : sizeY (u * 'X) = sizeY u. Proof. rewrite !sizeYE rmorphM /= swapXY_X rreg_size //. by have /monic_comreg[_ /rreg_lead] := monicX R. Qed. Lemma swapXY_poly_XaY p : swapXY (poly_XaY p) = poly_XaY p. Proof. by rewrite swapXY_comp_poly rmorphD /= swapXY_X swapXY_Y addrC. Qed. Lemma swapXY_poly_XmY p : swapXY (poly_XmY p) = poly_XmY p. Proof. by rewrite swapXY_comp_poly rmorphM /= swapXY_X swapXY_Y commr_polyX. Qed. Lemma poly_XaY0 : poly_XaY 0 = 0. Proof. by rewrite /poly_XaY rmorph0 comp_poly0. Qed. Lemma poly_XmY0 : poly_XmY 0 = 0. Proof. by rewrite /poly_XmY rmorph0 comp_poly0. Qed. End PolyXY_Ring. Prenex Implicits swapXY sizeY poly_XaY poly_XmY sub_annihilant div_annihilant. Prenex Implicits swapXYK. Lemma swapXY_map (R S : ringType) (f : {additive R -> S}) u : swapXY (u ^ map_poly f) = swapXY u ^ map_poly f. Proof. by apply/polyP=> i; apply/polyP=> j; rewrite !(coef_map, coef_swapXY). Qed. Section PolyXY_ComRing. Variable R : comRingType. Implicit Types (u : {poly {poly R}}) (p : {poly R}) (x y : R). Lemma horner_swapXY u x : (swapXY u).[x%:P] = u ^ eval x. Proof. apply/polyP=> i /=; rewrite coef_map /= /eval horner_coef coef_sum -sizeYE. rewrite (horner_coef_wide _ (max_size_coefXY u i)); apply: eq_bigr=> j _. by rewrite -polyC_exp coefMC coef_swapXY. Qed. Lemma horner_polyC u x : u.[x%:P] = swapXY u ^ eval x. Proof. by rewrite -horner_swapXY swapXYK. Qed. Lemma horner2_swapXY u x y : (swapXY u).[x, y] = u.[y, x]. Proof. by rewrite horner_swapXY -{1}(hornerC y x) horner_map. Qed. Lemma horner_poly_XaY p v : (poly_XaY p).[v] = p \Po (v + 'X). Proof. by rewrite horner_comp !hornerE. Qed. Lemma horner_poly_XmY p v : (poly_XmY p).[v] = p \Po (v * 'X). Proof. by rewrite horner_comp !hornerE. Qed. End PolyXY_ComRing. Section PolyXY_Idomain. Variable R : idomainType. Implicit Types (p q : {poly R}) (x y : R). Lemma size_poly_XaY p : size (poly_XaY p) = size p. Proof. by rewrite size_comp_poly2 ?size_XaddC // size_map_polyC. Qed. Lemma poly_XaY_eq0 p : (poly_XaY p == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 size_poly_XaY. Qed. Lemma size_poly_XmY p : size (poly_XmY p) = size p. Proof. by rewrite size_comp_poly2 ?size_XmulC ?polyX_eq0 ?size_map_polyC. Qed. Lemma poly_XmY_eq0 p : (poly_XmY p == 0) = (p == 0). Proof. by rewrite -!size_poly_eq0 size_poly_XmY. Qed. Lemma lead_coef_poly_XaY p : lead_coef (poly_XaY p) = (lead_coef p)%:P. Proof. rewrite lead_coef_comp ?size_XaddC // -['Y]opprK -polyCN lead_coefXsubC. by rewrite expr1n mulr1 lead_coef_map_inj //; apply: polyC_inj. Qed. Lemma sub_annihilant_in_ideal p q : 1 < size p -> 1 < size q -> {uv : {poly {poly R}} * {poly {poly R}} | size uv.1 < size q /\ size uv.2 < size p & forall x y, (sub_annihilant p q).[y] = uv.1.[x, y] * p.[x + y] + uv.2.[x, y] * q.[x]}. Proof. rewrite -size_poly_XaY -(size_map_polyC q) => p1_gt1 q1_gt1. have [uv /= [ub_u ub_v Dr]] := resultant_in_ideal p1_gt1 q1_gt1. exists uv => // x y; rewrite -[r in r.[y]](hornerC _ x%:P) Dr. by rewrite !(hornerE, horner_comp). Qed. Lemma sub_annihilantP p q x y : p != 0 -> q != 0 -> p.[x] = 0 -> q.[y] = 0 -> (sub_annihilant p q).[x - y] = 0. Proof. move=> nz_p nz_q px0 qy0. have p_gt1: size p > 1 by have /rootP/root_size_gt1-> := px0. have q_gt1: size q > 1 by have /rootP/root_size_gt1-> := qy0. have [uv /= _ /(_ y)->] := sub_annihilant_in_ideal p_gt1 q_gt1. by rewrite (addrC y) subrK px0 qy0 !mulr0 addr0. Qed. Lemma sub_annihilant_neq0 p q : p != 0 -> q != 0 -> sub_annihilant p q != 0. Proof. rewrite resultant_eq0; set p1 := poly_XaY p => nz_p nz_q. have [nz_p1 nz_q1]: p1 != 0 /\ q^:P != 0 by rewrite poly_XaY_eq0 map_polyC_eq0. rewrite -leqNgt eq_leq //; apply/eqP/Bezout_coprimepPn=> // [[[u v]]] /=. rewrite !size_poly_gt0 -andbA => /and4P[nz_u ltuq nz_v _] Duv. have /eqP/= := congr1 (size \o (lead_coef \o swapXY)) Duv. rewrite ltn_eqF // !rmorphM !lead_coefM (leq_trans (leq_ltn_trans _ ltuq)) //=. rewrite -{2}[u]swapXYK -sizeYE swapXY_poly_XaY lead_coef_poly_XaY. by rewrite mulrC mul_polyC size_scale ?max_size_lead_coefXY ?lead_coef_eq0. rewrite swapXY_map_polyC lead_coefC size_map_polyC. set v1 := lead_coef _; have nz_v1: v1 != 0 by rewrite lead_coef_eq0 swapXY_eq0. rewrite [in rhs in _ <= rhs]polySpred ?mulf_neq0 // size_mul //. by rewrite (polySpred nz_v1) addnC addnS polySpred // ltnS leq_addr. Qed. Lemma div_annihilant_in_ideal p q : 1 < size p -> 1 < size q -> {uv : {poly {poly R}} * {poly {poly R}} | size uv.1 < size q /\ size uv.2 < size p & forall x y, (div_annihilant p q).[y] = uv.1.[x, y] * p.[x * y] + uv.2.[x, y] * q.[x]}. Proof. rewrite -size_poly_XmY -(size_map_polyC q) => p1_gt1 q1_gt1. have [uv /= [ub_u ub_v Dr]] := resultant_in_ideal p1_gt1 q1_gt1. exists uv => // x y; rewrite -[r in r.[y]](hornerC _ x%:P) Dr. by rewrite !(hornerE, horner_comp). Qed. Lemma div_annihilant_neq0 p q : p != 0 -> q.[0] != 0 -> div_annihilant p q != 0. Proof. have factorX u: u != 0 -> root u 0 -> exists2 v, v != 0 & u = v * 'X. move=> nz_u /factor_theorem[v]; rewrite subr0 => Du; exists v => //. by apply: contraNneq nz_u => v0; rewrite Du v0 mul0r. have nzX: 'X != 0 := monic_neq0 (monicX _); have rootC0 := root_polyC _ 0. rewrite resultant_eq0 -leqNgt -rootE // => nz_p nz_q0; apply/eq_leq/eqP. have nz_q: q != 0 by apply: contraNneq nz_q0 => ->; rewrite root0. apply/Bezout_coprimepPn; rewrite ?map_polyC_eq0 ?poly_XmY_eq0 // => [[uv]]. rewrite !size_poly_gt0 -andbA ltnNge => /and4P[nz_u /negP ltuq nz_v _] Duv. pose u := swapXY uv.1; pose v := swapXY uv.2. suffices{ltuq}: size q <= sizeY u by rewrite sizeYE swapXYK -size_map_polyC. have{nz_u nz_v} [nz_u nz_v Dvu]: [/\ u != 0, v != 0 & q *: v = u * poly_XmY p]. rewrite !swapXY_eq0; split=> //; apply: (can_inj swapXYK). by rewrite linearZ rmorphM /= !swapXYK swapXY_poly_XmY Duv mulrC. have{Duv} [n ltvn]: {n | size v < n} by exists (size v).+1. elim: n {uv} => // n IHn in p (v) (u) nz_u nz_v Dvu nz_p ltvn *. have Dp0: root (poly_XmY p) 0 = root p 0 by rewrite root_comp !hornerE rootC0. have Dv0: root u 0 || root p 0 = root v 0 by rewrite -Dp0 -rootM -Dvu rootZ. have [v0_0 | nz_v0] := boolP (root v 0); last first. have nz_p0: ~~ root p 0 by apply: contra nz_v0; rewrite -Dv0 orbC => ->. apply: (@leq_trans (size (q * v.[0]))). by rewrite size_mul // (polySpred nz_v0) addnS leq_addr. rewrite -hornerZ Dvu !(horner_comp, hornerE) horner_map mulrC size_Cmul //. by rewrite horner_coef0 max_size_coefXY. have [v1 nz_v1 Dv] := factorX _ _ nz_v v0_0; rewrite Dv size_mulX // in ltvn. have /orP[/factorX[//|u1 nz_u1 Du] | p0_0]: root u 0 || root p 0 by rewrite Dv0. rewrite Du sizeY_mulX; apply: IHn nz_u1 nz_v1 _ nz_p ltvn. by apply: (mulIf (nzX _)); rewrite mulrAC -scalerAl -Du -Dv. have /factorX[|v2 nz_v2 Dv1]: root (swapXY v1) 0; rewrite ?swapXY_eq0 //. suffices: root (swapXY v1 * 'Y) 0 by rewrite mulrC mul_polyC rootZ ?polyX_eq0. have: root (swapXY (q *: v)) 0. by rewrite Dvu rmorphM rootM /= swapXY_poly_XmY Dp0 p0_0 orbT. by rewrite linearZ rootM rootC0 (negPf nz_q0) /= Dv rmorphM /= swapXY_X. rewrite ltnS (canRL swapXYK Dv1) -sizeYE sizeY_mulX sizeYE in ltvn. have [p1 nz_p1 Dp] := factorX _ _ nz_p p0_0. apply: IHn nz_u _ _ nz_p1 ltvn; first by rewrite swapXY_eq0. apply: (@mulIf _ ('X * 'Y)); first by rewrite mulf_neq0 ?polyC_eq0 ?nzX. rewrite -scalerAl mulrA mulrAC -{1}swapXY_X -rmorphM /= -Dv1 swapXYK -Dv Dvu. by rewrite /poly_XmY Dp rmorphM /= map_polyX comp_polyM comp_polyX mulrA. Qed. End PolyXY_Idomain. Section PolyXY_Field. Variables (F E : fieldType) (FtoE : {rmorphism F -> E}). Local Notation pFtoE := (map_poly (GRing.RMorphism.apply FtoE)). Lemma div_annihilantP (p q : {poly E}) (x y : E) : p != 0 -> q != 0 -> y != 0 -> p.[x] = 0 -> q.[y] = 0 -> (div_annihilant p q).[x / y] = 0. Proof. move=> nz_p nz_q nz_y px0 qy0. have p_gt1: size p > 1 by have /rootP/root_size_gt1-> := px0. have q_gt1: size q > 1 by have /rootP/root_size_gt1-> := qy0. have [uv /= _ /(_ y)->] := div_annihilant_in_ideal p_gt1 q_gt1. by rewrite (mulrC y) divfK // px0 qy0 !mulr0 addr0. Qed. Lemma map_sub_annihilantP (p q : {poly F}) (x y : E) : p != 0 -> q != 0 ->(p ^ FtoE).[x] = 0 -> (q ^ FtoE).[y] = 0 -> (sub_annihilant p q ^ FtoE).[x - y] = 0. Proof. move=> nz_p nz_q px0 qy0; have pFto0 := map_poly_eq0 FtoE. rewrite map_resultant ?pFto0 ?lead_coef_eq0 ?map_poly_eq0 ?poly_XaY_eq0 //. rewrite map_comp_poly rmorphD /= map_polyC /= !map_polyX -!map_poly_comp /=. by rewrite !(eq_map_poly (map_polyC _)) !map_poly_comp sub_annihilantP ?pFto0. Qed. Lemma map_div_annihilantP (p q : {poly F}) (x y : E) : p != 0 -> q != 0 -> y != 0 -> (p ^ FtoE).[x] = 0 -> (q ^ FtoE).[y] = 0 -> (div_annihilant p q ^ FtoE).[x / y] = 0. Proof. move=> nz_p nz_q nz_y px0 qy0; have pFto0 := map_poly_eq0 FtoE. rewrite map_resultant ?pFto0 ?lead_coef_eq0 ?map_poly_eq0 ?poly_XmY_eq0 //. rewrite map_comp_poly rmorphM /= map_polyC /= !map_polyX -!map_poly_comp /=. by rewrite !(eq_map_poly (map_polyC _)) !map_poly_comp div_annihilantP ?pFto0. Qed. Lemma root_annihilant x p (pEx := (p ^ pFtoE).[x%:P]) : pEx != 0 -> algebraicOver FtoE x -> exists2 r : {poly F}, r != 0 & forall y, root pEx y -> root (r ^ FtoE) y. Proof. move=> nz_px [q nz_q qx0]. have [/size1_polyC Dp | p_gt1] := leqP (size p) 1. by rewrite {}/pEx Dp map_polyC hornerC map_poly_eq0 in nz_px *; exists p`_0. have nz_p: p != 0 by rewrite -size_poly_gt0 ltnW. have [m le_qm] := ubnP (size q); elim: m => // m IHm in q le_qm nz_q qx0 *. have nz_q1: q^:P != 0 by rewrite map_poly_eq0. have sz_q1: size q^:P = size q by rewrite size_map_polyC. have q1_gt1: size q^:P > 1. by rewrite sz_q1 -(size_map_poly FtoE) (root_size_gt1 _ qx0) ?map_poly_eq0. have [uv _ Dr] := resultant_in_ideal p_gt1 q1_gt1; set r := resultant p _ in Dr. have /eqP q1x0: (q^:P ^ pFtoE).[x%:P] == 0. by rewrite -swapXY_polyC -swapXY_map horner_swapXY !map_polyC polyC_eq0. have [|r_nz] := boolP (r == 0); last first. exists r => // y pxy0; rewrite -[r ^ _](hornerC _ x%:P) -map_polyC Dr. by rewrite rmorphD !rmorphM !hornerE q1x0 mulr0 addr0 rootM pxy0 orbT. rewrite resultant_eq0 => /gtn_eqF/Bezout_coprimepPn[]// [q2 p1] /=. rewrite size_poly_gt0 sz_q1 => /andP[/andP[nz_q2 ltq2] _] Dq. pose n := (size (lead_coef q2)).-1; pose q3 := map_poly (coefp n) q2. have nz_q3: q3 != 0 by rewrite map_poly_eq0_id0 ?lead_coef_eq0. apply: (IHm q3); rewrite ?(leq_ltn_trans (size_poly _ _)) ?(leq_trans ltq2) //. have /polyP/(_ n)/eqP: (q2 ^ pFtoE).[x%:P] = 0. apply: (mulIf nz_px); rewrite -hornerM -rmorphM Dq rmorphM hornerM /= q1x0. by rewrite mul0r mulr0. rewrite coef0; congr (_ == 0); rewrite !horner_coef coef_sum. rewrite size_map_poly !size_map_poly_id0 ?map_poly_eq0 ?lead_coef_eq0 //. by apply: eq_bigr => i _; rewrite -rmorphX coefMC !coef_map. Qed. Lemma algebraic_root_polyXY x y : (let pEx p := (p ^ map_poly FtoE).[x%:P] in exists2 p, pEx p != 0 & root (pEx p) y) -> algebraicOver FtoE x -> algebraicOver FtoE y. Proof. by case=> p nz_px pxy0 /(root_annihilant nz_px)[r]; exists r; auto. Qed. End PolyXY_Field. math-comp-mathcomp-1.12.0/mathcomp/algebra/polydiv.v000066400000000000000000003651511375767750300224070ustar00rootroot00000000000000(* (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 poly. (******************************************************************************) (* This file provides a library for the basic theory of Euclidean and pseudo- *) (* Euclidean division for polynomials over ring structures. *) (* The library defines two versions of the pseudo-euclidean division: one for *) (* coefficients in a (not necessarily commutative) ring structure and one for *) (* coefficients equipped with a structure of integral domain. From the latter *) (* we derive the definition of the usual Euclidean division for coefficients *) (* in a field. Only the definition of the pseudo-division for coefficients in *) (* an integral domain is exported by default and benefits from notations. *) (* Also, the only theory exported by default is the one of division for *) (* polynomials with coefficients in a field. *) (* Other definitions and facts are qualified using name spaces indicating the *) (* hypotheses made on the structure of coefficients and the properties of the *) (* polynomial one divides with. *) (* *) (* Pdiv.Field (exported by the present library): *) (* edivp p q == pseudo-division of p by q with p q : {poly R} where *) (* R is an idomainType. *) (* Computes (k, quo, rem) : nat * {poly r} * {poly R}, *) (* such that size rem < size q and: *) (* + if lead_coef q is not a unit, then: *) (* (lead_coef q ^+ k) *: p = q * quo + rem *) (* + else if lead_coef q is a unit, then: *) (* p = q * quo + rem and k = 0 *) (* p %/ q == quotient (second component) computed by (edivp p q). *) (* p %% q == remainder (third component) computed by (edivp p q). *) (* scalp p q == exponent (first component) computed by (edivp p q). *) (* p %| q == tests the nullity of the remainder of the *) (* pseudo-division of p by q. *) (* rgcdp p q == Pseudo-greater common divisor obtained by performing *) (* the Euclidean algorithm on p and q using redivp as *) (* Euclidean division. *) (* p %= q == p and q are associate polynomials, i.e., p %| q and *) (* q %| p, or equivalently, p = c *: q for some nonzero *) (* constant c. *) (* gcdp p q == Pseudo-greater common divisor obtained by performing *) (* the Euclidean algorithm on p and q using edivp as *) (* Euclidean division. *) (* egcdp p q == The pair of Bezout coefficients: if e := egcdp p q, *) (* then size e.1 <= size q, size e.2 <= size p, and *) (* gcdp p q %= e.1 * p + e.2 * q *) (* coprimep p q == p and q are coprime, i.e., (gcdp p q) is a nonzero *) (* constant. *) (* gdcop q p == greatest divisor of p which is coprime to q. *) (* irreducible_poly p <-> p has only trivial (constant) divisors. *) (* *) (* Pdiv.Idomain: theory available for edivp and the related operation under *) (* the sole assumption that the ring of coefficients is canonically an *) (* integral domain (R : idomainType). *) (* *) (* Pdiv.IdomainMonic: theory available for edivp and the related operations *) (* under the assumption that the ring of coefficients is canonically *) (* and integral domain (R : idomainType) an the divisor is monic. *) (* *) (* Pdiv.IdomainUnit: theory available for edivp and the related operations *) (* under the assumption that the ring of coefficients is canonically an *) (* integral domain (R : idomainType) and the leading coefficient of the *) (* divisor is a unit. *) (* *) (* Pdiv.ClosedField: theory available for edivp and the related operation *) (* under the sole assumption that the ring of coefficients is canonically *) (* an algebraically closed field (R : closedField). *) (* *) (* Pdiv.Ring : *) (* redivp p q == pseudo-division of p by q with p q : {poly R} where R is *) (* a ringType. *) (* Computes (k, quo, rem) : nat * {poly r} * {poly R}, *) (* such that if rem = 0 then quo * q = p * (lead_coef q ^+ k) *) (* *) (* rdivp p q == quotient (second component) computed by (redivp p q). *) (* rmodp p q == remainder (third component) computed by (redivp p q). *) (* rscalp p q == exponent (first component) computed by (redivp p q). *) (* rdvdp p q == tests the nullity of the remainder of the pseudo-division *) (* of p by q. *) (* rgcdp p q == analogue of gcdp for coefficients in a ringType. *) (* rgdcop p q == analogue of gdcop for coefficients in a ringType. *) (*rcoprimep p q == analogue of coprimep p q for coefficients in a ringType. *) (* *) (* Pdiv.RingComRreg : theory of the operations defined in Pdiv.Ring, when the *) (* ring of coefficients is canonically commutative (R : comRingType) and *) (* the leading coefficient of the divisor is both right regular and *) (* commutes as a constant polynomial with the divisor itself *) (* *) (* Pdiv.RingMonic : theory of the operations defined in Pdiv.Ring, under the *) (* assumption that the divisor is monic. *) (* *) (* Pdiv.UnitRing: theory of the operations defined in Pdiv.Ring, when the *) (* ring R of coefficients is canonically with units (R : unitRingType). *) (* *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. Reserved Notation "p %= q" (at level 70, no associativity). Local Notation simp := Monoid.simpm. Module Pdiv. Module CommonRing. Section RingPseudoDivision. Variable R : ringType. Implicit Types d p q r : {poly R}. (* Pseudo division, defined on an arbitrary ring *) Definition redivp_rec (q : {poly R}) := let sq := size q in let cq := lead_coef q in fix loop (k : nat) (qq r : {poly R})(n : nat) {struct n} := if size r < sq then (k, qq, r) else let m := (lead_coef r) *: 'X^(size r - sq) in let qq1 := qq * cq%:P + m in let r1 := r * cq%:P - m * q in if n is n1.+1 then loop k.+1 qq1 r1 n1 else (k.+1, qq1, r1). Definition redivp_expanded_def p q := if q == 0 then (0%N, 0, p) else redivp_rec q 0 0 p (size p). Fact redivp_key : unit. Proof. by []. Qed. Definition redivp : {poly R} -> {poly R} -> nat * {poly R} * {poly R} := locked_with redivp_key redivp_expanded_def. Canonical redivp_unlockable := [unlockable fun redivp]. Definition rdivp p q := ((redivp p q).1).2. Definition rmodp p q := (redivp p q).2. Definition rscalp p q := ((redivp p q).1).1. Definition rdvdp p q := rmodp q p == 0. (*Definition rmultp := [rel m d | rdvdp d m].*) Lemma redivp_def p q : redivp p q = (rscalp p q, rdivp p q, rmodp p q). Proof. by rewrite /rscalp /rdivp /rmodp; case: (redivp p q) => [[]] /=. Qed. Lemma rdiv0p p : rdivp 0 p = 0. Proof. rewrite /rdivp unlock; case: ifP => // Hp; rewrite /redivp_rec !size_poly0. by rewrite polySpred ?Hp. Qed. Lemma rdivp0 p : rdivp p 0 = 0. Proof. by rewrite /rdivp unlock eqxx. Qed. Lemma rdivp_small p q : size p < size q -> rdivp p q = 0. Proof. rewrite /rdivp unlock; have [-> | _ ltpq] := eqP; first by rewrite size_poly0. by case: (size p) => [|s]; rewrite /= ltpq. Qed. Lemma leq_rdivp p q : size (rdivp p q) <= size p. Proof. have [/rdivp_small->|] := ltnP (size p) (size q); first by rewrite size_poly0. rewrite /rdivp /rmodp /rscalp unlock. have [->|q0] //= := eqVneq q 0. have: size (0 : {poly R}) <= size p by rewrite size_poly0. move: {2 3 4 6}(size p) (leqnn (size p)) => A. elim: (size p) 0%N (0 : {poly R}) {1 3 4}p (leqnn (size p)) => [|n ihn] k q1 r. by move/size_poly_leq0P->; rewrite /= size_poly0 size_poly_gt0 q0. move=> /= hrn hr hq1 hq; case: ltnP => //= hqr. have sq: 0 < size q by rewrite size_poly_gt0. have sr: 0 < size r by apply: leq_trans sq hqr. apply: ihn => //. - apply/leq_sizeP => j hnj. rewrite coefB -scalerAl coefZ coefXnM ltn_subRL ltnNge. have hj : (size r).-1 <= j by apply: leq_trans hnj; rewrite -ltnS prednK. rewrite [r in r <= _]polySpred -?size_poly_gt0 // coefMC. rewrite (leq_ltn_trans hj) /=; last by rewrite -add1n leq_add2r. move: hj; rewrite leq_eqVlt prednK // => /predU1P [<- | hj]. by rewrite -subn1 subnAC subKn // !subn1 !lead_coefE subrr. have/leq_sizeP-> //: size q <= j - (size r - size q). by rewrite subnBA // leq_psubRL // leq_add2r. by move/leq_sizeP: (hj) => -> //; rewrite mul0r mulr0 subr0. - apply: leq_trans (size_add _ _) _; rewrite geq_max; apply/andP; split. apply: leq_trans (size_mul_leq _ _) _. by rewrite size_polyC lead_coef_eq0 q0 /= addn1. rewrite size_opp; apply: leq_trans (size_mul_leq _ _) _. apply: leq_trans hr; rewrite -subn1 leq_subLR -[in (1 + _)%N](subnK hqr). by rewrite addnA leq_add2r add1n -(@size_polyXn R) size_scale_leq. apply: leq_trans (size_add _ _) _; rewrite geq_max; apply/andP; split. apply: leq_trans (size_mul_leq _ _) _. by rewrite size_polyC lead_coef_eq0 q0 /= addnS addn0. apply: leq_trans (size_scale_leq _ _) _. by rewrite size_polyXn -subSn // leq_subLR -add1n leq_add. Qed. Lemma rmod0p p : rmodp 0 p = 0. Proof. rewrite /rmodp unlock; case: ifP => // Hp; rewrite /redivp_rec !size_poly0. by rewrite polySpred ?Hp. Qed. Lemma rmodp0 p : rmodp p 0 = p. Proof. by rewrite /rmodp unlock eqxx. Qed. Lemma rscalp_small p q : size p < size q -> rscalp p q = 0%N. Proof. rewrite /rscalp unlock; case: eqP => _ // spq. by case sp: (size p) => [| s] /=; rewrite spq. Qed. Lemma ltn_rmodp p q : (size (rmodp p q) < size q) = (q != 0). Proof. rewrite /rdivp /rmodp /rscalp unlock; have [->|q0] := eqVneq q 0. by rewrite /= size_poly0 ltn0. elim: (size p) 0%N 0 {1 3}p (leqnn (size p)) => [|n ihn] k q1 r. move/size_poly_leq0P->. by rewrite /= size_poly0 size_poly_gt0 q0 size_poly0 size_poly_gt0. move=> hr /=; case: (ltnP (size r)) => // hsrq; apply/ihn/leq_sizeP => j hnj. rewrite coefB -scalerAl !coefZ coefXnM coefMC ltn_subRL ltnNge. have sq: 0 < size q by rewrite size_poly_gt0. have sr: 0 < size r by apply: leq_trans hsrq. have hj: (size r).-1 <= j by apply: leq_trans hnj; rewrite -ltnS prednK. move: (leq_add sq hj); rewrite add1n prednK // => -> /=. move: hj; rewrite leq_eqVlt prednK // => /predU1P [<- | hj]. by rewrite -predn_sub subKn // !lead_coefE subrr. have/leq_sizeP -> //: size q <= j - (size r - size q). by rewrite subnBA // leq_subRL ?leq_add2r // (leq_trans hj) // leq_addr. by move/leq_sizeP: hj => -> //; rewrite mul0r mulr0 subr0. Qed. Lemma ltn_rmodpN0 p q : q != 0 -> size (rmodp p q) < size q. Proof. by rewrite ltn_rmodp. Qed. Lemma rmodp1 p : rmodp p 1 = 0. Proof. apply/eqP; have := ltn_rmodp p 1. by rewrite !oner_neq0 -size_poly_eq0 size_poly1 ltnS leqn0. Qed. Lemma rmodp_small p q : size p < size q -> rmodp p q = p. Proof. rewrite /rmodp unlock; have [->|_] := eqP; first by rewrite size_poly0. by case sp: (size p) => [| s] Hs /=; rewrite sp Hs /=. Qed. Lemma leq_rmodp m d : size (rmodp m d) <= size m. Proof. have [/rmodp_small -> //|h] := ltnP (size m) (size d). have [->|d0] := eqVneq d 0; first by rewrite rmodp0. by apply: leq_trans h; apply: ltnW; rewrite ltn_rmodp. Qed. Lemma rmodpC p c : c != 0 -> rmodp p c%:P = 0. Proof. move=> Hc; apply/eqP; rewrite -size_poly_leq0 -ltnS. have -> : 1%N = nat_of_bool (c != 0) by rewrite Hc. by rewrite -size_polyC ltn_rmodp polyC_eq0. Qed. Lemma rdvdp0 d : rdvdp d 0. Proof. by rewrite /rdvdp rmod0p. Qed. Lemma rdvd0p n : rdvdp 0 n = (n == 0). Proof. by rewrite /rdvdp rmodp0. Qed. Lemma rdvd0pP n : reflect (n = 0) (rdvdp 0 n). Proof. by apply: (iffP idP); rewrite rdvd0p; move/eqP. Qed. Lemma rdvdpN0 p q : rdvdp p q -> q != 0 -> p != 0. Proof. by move=> pq hq; apply: contraTneq pq => ->; rewrite rdvd0p. Qed. Lemma rdvdp1 d : rdvdp d 1 = (size d == 1%N). Proof. rewrite /rdvdp; have [->|] := eqVneq d 0. by rewrite rmodp0 size_poly0 (negPf (oner_neq0 _)). rewrite -size_poly_leq0 -ltnS; case: ltngtP => // [|/eqP] hd _. by rewrite rmodp_small ?size_poly1 // oner_eq0. have [c cn0 ->] := size_poly1P _ hd. rewrite /rmodp unlock -size_poly_eq0 size_poly1 /= size_poly1 size_polyC cn0 /=. by rewrite polyC_eq0 (negPf cn0) !lead_coefC !scale1r subrr !size_poly0. Qed. Lemma rdvd1p m : rdvdp 1 m. Proof. by rewrite /rdvdp rmodp1. Qed. Lemma Nrdvdp_small (n d : {poly R}) : n != 0 -> size n < size d -> rdvdp d n = false. Proof. by move=> nn0 hs; rewrite /rdvdp (rmodp_small hs); apply: negPf. Qed. Lemma rmodp_eq0P p q : reflect (rmodp p q = 0) (rdvdp q p). Proof. exact: (iffP eqP). Qed. Lemma rmodp_eq0 p q : rdvdp q p -> rmodp p q = 0. Proof. exact: rmodp_eq0P. Qed. Lemma rdvdp_leq p q : rdvdp p q -> q != 0 -> size p <= size q. Proof. by move=> dvd_pq; rewrite leqNgt; apply: contra => /rmodp_small <-. Qed. Definition rgcdp p q := let: (p1, q1) := if size p < size q then (q, p) else (p, q) in if p1 == 0 then q1 else let fix loop (n : nat) (pp qq : {poly R}) {struct n} := let rr := rmodp pp qq in if rr == 0 then qq else if n is n1.+1 then loop n1 qq rr else rr in loop (size p1) p1 q1. Lemma rgcd0p : left_id 0 rgcdp. Proof. move=> p; rewrite /rgcdp size_poly0 size_poly_gt0 if_neg. case: ifP => /= [_ | nzp]; first by rewrite eqxx. by rewrite polySpred !(rmodp0, nzp) //; case: _.-1 => [|m]; rewrite rmod0p eqxx. Qed. Lemma rgcdp0 : right_id 0 rgcdp. Proof. move=> p; have:= rgcd0p p; rewrite /rgcdp size_poly0 size_poly_gt0. by case: eqVneq => p0; rewrite ?(eqxx, p0) //= eqxx. Qed. Lemma rgcdpE p q : rgcdp p q = if size p < size q then rgcdp (rmodp q p) p else rgcdp (rmodp p q) q. Proof. pose rgcdp_rec := fix rgcdp_rec (n : nat) (pp qq : {poly R}) {struct n} := let rr := rmodp pp qq in if rr == 0 then qq else if n is n1.+1 then rgcdp_rec n1 qq rr else rr. have Irec: forall m n p q, size q <= m -> size q <= n -> size q < size p -> rgcdp_rec m p q = rgcdp_rec n p q. + elim=> [|m Hrec] [|n] //= p1 q1. - move/size_poly_leq0P=> -> _; rewrite size_poly0 size_poly_gt0 rmodp0. by move/negPf->; case: n => [|n] /=; rewrite rmod0p eqxx. - move=> _ /size_poly_leq0P ->; rewrite size_poly0 size_poly_gt0 rmodp0. by move/negPf->; case: m {Hrec} => [|m] /=; rewrite rmod0p eqxx. case: eqVneq => Epq Sm Sn Sq //; have [->|nzq] := eqVneq q1 0. by case: n m {Sm Sn Hrec} => [|m] [|n] //=; rewrite rmod0p eqxx. apply: Hrec; last by rewrite ltn_rmodp. by rewrite -ltnS (leq_trans _ Sm) // ltn_rmodp. by rewrite -ltnS (leq_trans _ Sn) // ltn_rmodp. have [->|nzp] := eqVneq p 0. by rewrite rmod0p rmodp0 rgcd0p rgcdp0 if_same. have [->|nzq] := eqVneq q 0. by rewrite rmod0p rmodp0 rgcd0p rgcdp0 if_same. rewrite /rgcdp -/rgcdp_rec !ltn_rmodp (negPf nzp) (negPf nzq) /=. have [ltpq|leqp] := ltnP; rewrite !(negPf nzp, negPf nzq) //= polySpred //=. have [->|nzqp] := eqVneq. by case: (size p) => [|[|s]]; rewrite /= rmodp0 (negPf nzp) // rmod0p eqxx. apply: Irec => //; last by rewrite ltn_rmodp. by rewrite -ltnS -polySpred // (leq_trans _ ltpq) ?leqW // ltn_rmodp. by rewrite ltnW // ltn_rmodp. have [->|nzpq] := eqVneq. by case: (size q) => [|[|s]]; rewrite /= rmodp0 (negPf nzq) // rmod0p eqxx. apply: Irec => //; last by rewrite ltn_rmodp. by rewrite -ltnS -polySpred // (leq_trans _ leqp) // ltn_rmodp. by rewrite ltnW // ltn_rmodp. Qed. Variant comm_redivp_spec m d : nat * {poly R} * {poly R} -> Type := ComEdivnSpec k (q r : {poly R}) of (GRing.comm d (lead_coef d)%:P -> m * (lead_coef d ^+ k)%:P = q * d + r) & (d != 0 -> size r < size d) : comm_redivp_spec m d (k, q, r). Lemma comm_redivpP m d : comm_redivp_spec m d (redivp m d). Proof. rewrite unlock; have [->|Hd] := eqVneq d 0. by constructor; rewrite !(simp, eqxx). have: GRing.comm d (lead_coef d)%:P -> m * (lead_coef d ^+ 0)%:P = 0 * d + m. by rewrite !simp. elim: (size m) 0%N 0 {1 4 6}m (leqnn (size m)) => [|n IHn] k q r Hr /=. move/size_poly_leq0P: Hr ->. suff hsd: size (0: {poly R}) < size d by rewrite hsd => /= ?; constructor. by rewrite size_poly0 size_poly_gt0. case: ltnP => Hlt Heq; first by constructor. apply/IHn=> [|Cda]; last first. rewrite mulrDl addrAC -addrA subrK exprSr polyCM mulrA Heq //. by rewrite mulrDl -mulrA Cda mulrA. apply/leq_sizeP => j Hj; rewrite coefB coefMC -scalerAl coefZ coefXnM. rewrite ltn_subRL ltnNge (leq_trans Hr) /=; last first. by apply: leq_ltn_trans Hj _; rewrite -add1n leq_add2r size_poly_gt0. move: Hj; rewrite leq_eqVlt; case/predU1P => [<-{j} | Hj]; last first. rewrite !nth_default ?simp ?oppr0 ?(leq_trans Hr) //. by rewrite -{1}(subKn Hlt) leq_sub2r // (leq_trans Hr). move: Hr; rewrite leq_eqVlt ltnS; case/predU1P=> Hqq; last first. by rewrite !nth_default ?simp ?oppr0 // -{1}(subKn Hlt) leq_sub2r. rewrite /lead_coef Hqq polySpred // subSS subKn ?addrN //. by rewrite -subn1 leq_subLR add1n -Hqq. Qed. Lemma rmodpp p : GRing.comm p (lead_coef p)%:P -> rmodp p p = 0. Proof. move=> hC; rewrite /rmodp unlock; have [-> //|] := eqVneq. rewrite -size_poly_eq0 /redivp_rec; case sp: (size p)=> [|n] // _. rewrite sp ltnn subnn expr0 hC alg_polyC !simp subrr. by case: n sp => [|n] sp; rewrite size_polyC /= eqxx. Qed. Definition rcoprimep (p q : {poly R}) := size (rgcdp p q) == 1%N. Fixpoint rgdcop_rec q p n := if n is m.+1 then if rcoprimep p q then p else rgdcop_rec q (rdivp p (rgcdp p q)) m else (q == 0)%:R. Definition rgdcop q p := rgdcop_rec q p (size p). Lemma rgdcop0 q : rgdcop q 0 = (q == 0)%:R. Proof. by rewrite /rgdcop size_poly0. Qed. End RingPseudoDivision. End CommonRing. Module RingComRreg. Import CommonRing. Section ComRegDivisor. Variable R : ringType. Variable d : {poly R}. Hypothesis Cdl : GRing.comm d (lead_coef d)%:P. Hypothesis Rreg : GRing.rreg (lead_coef d). Implicit Types p q r : {poly R}. Lemma redivp_eq q r : size r < size d -> let k := (redivp (q * d + r) d).1.1 in let c := (lead_coef d ^+ k)%:P in redivp (q * d + r) d = (k, q * c, r * c). Proof. move=> lt_rd; case: comm_redivpP=> k q1 r1 /(_ Cdl) Heq. have dn0: d != 0 by case: (size d) lt_rd (size_poly_eq0 d) => // n _ <-. move=> /(_ dn0) Hs. have eC : q * d * (lead_coef d ^+ k)%:P = q * (lead_coef d ^+ k)%:P * d. by rewrite -mulrA polyC_exp (commrX k Cdl) mulrA. suff e1 : q1 = q * (lead_coef d ^+ k)%:P. congr (_, _, _) => //=; move/eqP: Heq. by rewrite [_ + r1]addrC -subr_eq e1 mulrDl addrAC eC subrr add0r; move/eqP. have : (q1 - q * (lead_coef d ^+ k)%:P) * d = r * (lead_coef d ^+ k)%:P - r1. apply: (@addIr _ r1); rewrite subrK. apply: (@addrI _ ((q * (lead_coef d ^+ k)%:P) * d)). by rewrite mulrDl mulNr !addrA [_ + (q1 * d)]addrC addrK -eC -mulrDl. move/eqP; rewrite -[_ == _ - _]subr_eq0 rreg_div0 //. by case/andP; rewrite subr_eq0; move/eqP. rewrite size_opp; apply: (leq_ltn_trans (size_add _ _)); rewrite size_opp. rewrite gtn_max Hs (leq_ltn_trans (size_mul_leq _ _)) //. rewrite size_polyC; case: (_ == _); last by rewrite addnS addn0. by rewrite addn0; apply: leq_ltn_trans lt_rd; case: size. Qed. (* this is a bad name *) Lemma rdivp_eq p : p * (lead_coef d ^+ (rscalp p d))%:P = (rdivp p d) * d + (rmodp p d). Proof. by rewrite /rdivp /rmodp /rscalp; case: comm_redivpP=> k q1 r1 Hc _; apply: Hc. Qed. (* section variables impose an inconvenient order on parameters *) Lemma eq_rdvdp k q1 p: p * ((lead_coef d)^+ k)%:P = q1 * d -> rdvdp d p. Proof. move=> he. have Hnq0 := rreg_lead0 Rreg; set lq := lead_coef d. pose v := rscalp p d; pose m := maxn v k. rewrite /rdvdp -(rreg_polyMC_eq0 _ (@rregX _ _ (m - v) Rreg)). suff: ((rdivp p d) * (lq ^+ (m - v))%:P - q1 * (lq ^+ (m - k))%:P) * d + (rmodp p d) * (lq ^+ (m - v))%:P == 0. rewrite rreg_div0 //; first by case/andP. by rewrite rreg_size ?ltn_rmodp //; exact: rregX. rewrite mulrDl addrAC mulNr -!mulrA polyC_exp -(commrX (m-v) Cdl). rewrite -polyC_exp mulrA -mulrDl -rdivp_eq // [(_ ^+ (m - k))%:P]polyC_exp. rewrite -(commrX (m-k) Cdl) -polyC_exp mulrA -he -!mulrA -!polyCM -/v. by rewrite -!exprD addnC subnK ?leq_maxl // addnC subnK ?subrr ?leq_maxr. Qed. Variant rdvdp_spec p q : {poly R} -> bool -> Type := | Rdvdp k q1 & p * ((lead_coef q)^+ k)%:P = q1 * q : rdvdp_spec p q 0 true | RdvdpN & rmodp p q != 0 : rdvdp_spec p q (rmodp p q) false. (* Is that version useable ? *) Lemma rdvdp_eqP p : rdvdp_spec p d (rmodp p d) (rdvdp d p). Proof. case hdvd: (rdvdp d p); last by apply: RdvdpN; move/rmodp_eq0P/eqP: hdvd. move/rmodp_eq0P: (hdvd)->; apply: (@Rdvdp _ _ (rscalp p d) (rdivp p d)). by rewrite rdivp_eq //; move/rmodp_eq0P: (hdvd)->; rewrite addr0. Qed. Lemma rdvdp_mull p : rdvdp d (p * d). Proof. by apply: (@eq_rdvdp 0%N p); rewrite expr0 mulr1. Qed. Lemma rmodp_mull p : rmodp (p * d) d = 0. Proof. exact/eqP/rdvdp_mull. Qed. Lemma rmodpp : rmodp d d = 0. Proof. by rewrite -[d in rmodp d _]mul1r rmodp_mull. Qed. Lemma rdivpp : rdivp d d = (lead_coef d ^+ rscalp d d)%:P. Proof. have dn0 : d != 0 by rewrite -lead_coef_eq0 rreg_neq0. move: (rdivp_eq d); rewrite rmodpp addr0. suff ->: GRing.comm d (lead_coef d ^+ rscalp d d)%:P by move/(rreg_lead Rreg)->. by rewrite polyC_exp; apply: commrX. Qed. Lemma rdvdpp : rdvdp d d. Proof. exact/eqP/rmodpp. Qed. Lemma rdivpK p : rdvdp d p -> rdivp p d * d = p * (lead_coef d ^+ rscalp p d)%:P. Proof. by rewrite rdivp_eq /rdvdp; move/eqP->; rewrite addr0. Qed. End ComRegDivisor. End RingComRreg. Module RingMonic. Import CommonRing. Import RingComRreg. Section MonicDivisor. Variable R : ringType. Implicit Types p q r : {poly R}. Variable d : {poly R}. Hypothesis mond : d \is monic. Lemma redivp_eq q r : size r < size d -> let k := (redivp (q * d + r) d).1.1 in redivp (q * d + r) d = (k, q, r). Proof. case: (monic_comreg mond)=> Hc Hr /(redivp_eq Hc Hr q). by rewrite (eqP mond) => -> /=; rewrite expr1n !mulr1. Qed. Lemma rdivp_eq p : p = rdivp p d * d + rmodp p d. Proof. rewrite -rdivp_eq (eqP mond); last exact: commr1. by rewrite expr1n mulr1. Qed. Lemma rdivpp : rdivp d d = 1. Proof. by case: (monic_comreg mond) => hc hr; rewrite rdivpp // (eqP mond) expr1n. Qed. Lemma rdivp_addl_mul_small q r : size r < size d -> rdivp (q * d + r) d = q. Proof. by move=> Hd; case: (monic_comreg mond)=> Hc Hr; rewrite /rdivp redivp_eq. Qed. Lemma rdivp_addl_mul q r : rdivp (q * d + r) d = q + rdivp r d. Proof. case: (monic_comreg mond)=> Hc Hr; rewrite [r in _ * _ + r]rdivp_eq addrA. by rewrite -mulrDl rdivp_addl_mul_small // ltn_rmodp monic_neq0. Qed. Lemma rdivpDl q r : rdvdp d q -> rdivp (q + r) d = rdivp q d + rdivp r d. Proof. case: (monic_comreg mond)=> Hc Hr; rewrite [r in q + r]rdivp_eq addrA. rewrite [q in q + _ + _]rdivp_eq; move/rmodp_eq0P->. by rewrite addr0 -mulrDl rdivp_addl_mul_small // ltn_rmodp monic_neq0. Qed. Lemma rdivpDr q r : rdvdp d r -> rdivp (q + r) d = rdivp q d + rdivp r d. Proof. by rewrite addrC; move/rdivpDl->; rewrite addrC. Qed. Lemma rdivp_mull p : rdivp (p * d) d = p. Proof. by rewrite -[p * d]addr0 rdivp_addl_mul rdiv0p addr0. Qed. Lemma rmodp_mull p : rmodp (p * d) d = 0. Proof. by apply: rmodp_mull; rewrite (eqP mond); [apply: commr1 | apply: rreg1]. Qed. Lemma rmodpp : rmodp d d = 0. Proof. by apply: rmodpp; rewrite (eqP mond); [apply: commr1 | apply: rreg1]. Qed. Lemma rmodp_addl_mul_small q r : size r < size d -> rmodp (q * d + r) d = r. Proof. by move=> Hd; case: (monic_comreg mond)=> Hc Hr; rewrite /rmodp redivp_eq. Qed. Lemma rmodpD p q : rmodp (p + q) d = rmodp p d + rmodp q d. Proof. rewrite [p in LHS]rdivp_eq [q in LHS]rdivp_eq addrACA -mulrDl. rewrite rmodp_addl_mul_small //; apply: (leq_ltn_trans (size_add _ _)). by rewrite gtn_max !ltn_rmodp // monic_neq0. Qed. Lemma rmodp_mulmr p q : rmodp (p * (rmodp q d)) d = rmodp (p * q) d. Proof. by rewrite [q in RHS]rdivp_eq mulrDr rmodpD mulrA rmodp_mull add0r. Qed. Lemma rdvdpp : rdvdp d d. Proof. by apply: rdvdpp; rewrite (eqP mond); [apply: commr1 | apply: rreg1]. Qed. (* section variables impose an inconvenient order on parameters *) Lemma eq_rdvdp q1 p : p = q1 * d -> rdvdp d p. Proof. (* this probably means I need to specify impl args for comm_rref_rdvdp *) move=> h; apply: (@eq_rdvdp _ _ _ _ 1%N q1); rewrite (eqP mond). - exact: commr1. - exact: rreg1. by rewrite expr1n mulr1. Qed. Lemma rdvdp_mull p : rdvdp d (p * d). Proof. by apply: rdvdp_mull; rewrite (eqP mond) //; [apply: commr1 | apply: rreg1]. Qed. Lemma rdvdpP p : reflect (exists qq, p = qq * d) (rdvdp d p). Proof. case: (monic_comreg mond)=> Hc Hr; apply: (iffP idP) => [|[qq] /eq_rdvdp //]. by case: rdvdp_eqP=> // k qq; rewrite (eqP mond) expr1n mulr1 => ->; exists qq. Qed. Lemma rdivpK p : rdvdp d p -> (rdivp p d) * d = p. Proof. by move=> dvddp; rewrite [RHS]rdivp_eq rmodp_eq0 ?addr0. Qed. End MonicDivisor. Notation "@ 'rdivp_addl'" := (deprecate rdivp_addl rdivpDl) (at level 10, only parsing) : fun_scope. Notation "@ 'rdivp_addr'" := (deprecate rdivp_addr rdivpDr) (at level 10, only parsing) : fun_scope. Notation "@ 'rmodp_add'" := (deprecate rmodp_add rmodpD) (at level 10, only parsing) : fun_scope. Notation rdivp_addl := (fun d_monic => @rdivp_addl _ _ d_monic _) (only parsing). Notation rdivp_addr := (fun d_monic q => @rdivp_addr _ _ d_monic q _) (only parsing). Notation rmodp_add := (@rmodp_add _ _) (only parsing). End RingMonic. Module Ring. Include CommonRing. Import RingMonic. Section ExtraMonicDivisor. Variable R : ringType. Implicit Types d p q r : {poly R}. Lemma rdivp1 p : rdivp p 1 = p. Proof. by rewrite -[p in LHS]mulr1 rdivp_mull // monic1. Qed. Lemma rdvdp_XsubCl p x : rdvdp ('X - x%:P) p = root p x. Proof. have [HcX Hr] := monic_comreg (monicXsubC x). apply/rmodp_eq0P/factor_theorem => [|[p1 ->]]; last exact/rmodp_mull/monicXsubC. move=> e0; exists (rdivp p ('X - x%:P)). by rewrite [LHS](rdivp_eq (monicXsubC x)) e0 addr0. Qed. Lemma polyXsubCP p x : reflect (p.[x] = 0) (rdvdp ('X - x%:P) p). Proof. by apply: (iffP idP); rewrite rdvdp_XsubCl; move/rootP. Qed. Lemma root_factor_theorem p x : root p x = (rdvdp ('X - x%:P) p). Proof. by rewrite rdvdp_XsubCl. Qed. End ExtraMonicDivisor. End Ring. Module ComRing. Import Ring. Import RingComRreg. Section CommutativeRingPseudoDivision. Variable R : comRingType. Implicit Types d p q m n r : {poly R}. Variant redivp_spec (m d : {poly R}) : nat * {poly R} * {poly R} -> Type := EdivnSpec k (q r: {poly R}) of (lead_coef d ^+ k) *: m = q * d + r & (d != 0 -> size r < size d) : redivp_spec m d (k, q, r). Lemma redivpP m d : redivp_spec m d (redivp m d). Proof. rewrite redivp_def; constructor; last by move=> dn0; rewrite ltn_rmodp. by rewrite -mul_polyC mulrC rdivp_eq //= /GRing.comm mulrC. Qed. Lemma rdivp_eq d p : (lead_coef d ^+ rscalp p d) *: p = rdivp p d * d + rmodp p d. Proof. by rewrite /rdivp /rmodp /rscalp; case: redivpP=> k q1 r1 Hc _; apply: Hc. Qed. Lemma rdvdp_eqP d p : rdvdp_spec p d (rmodp p d) (rdvdp d p). Proof. case hdvd: (rdvdp d p); last by move/rmodp_eq0P/eqP/RdvdpN: hdvd. move/rmodp_eq0P: (hdvd)->; apply: (@Rdvdp _ _ _ (rscalp p d) (rdivp p d)). by rewrite mulrC mul_polyC rdivp_eq; move/rmodp_eq0P: (hdvd)->; rewrite addr0. Qed. Lemma rdvdp_eq q p : rdvdp q p = (lead_coef q ^+ rscalp p q *: p == rdivp p q * q). Proof. rewrite rdivp_eq; apply/rmodp_eq0P/eqP => [->|/eqP]; first by rewrite addr0. by rewrite eq_sym addrC -subr_eq subrr; move/eqP<-. Qed. End CommutativeRingPseudoDivision. End ComRing. Module UnitRing. Import Ring. Section UnitRingPseudoDivision. Variable R : unitRingType. Implicit Type p q r d : {poly R}. Lemma uniq_roots_rdvdp p rs : all (root p) rs -> uniq_roots rs -> rdvdp (\prod_(z <- rs) ('X - z%:P)) p. Proof. move=> rrs /(uniq_roots_prod_XsubC rrs) [q ->]. exact/RingMonic.rdvdp_mull/monic_prod_XsubC. Qed. End UnitRingPseudoDivision. End UnitRing. Module IdomainDefs. Import Ring. Section IDomainPseudoDivisionDefs. Variable R : idomainType. Implicit Type p q r d : {poly R}. Definition edivp_expanded_def p q := let: (k, d, r) as edvpq := redivp p q in if lead_coef q \in GRing.unit then (0%N, (lead_coef q)^-k *: d, (lead_coef q)^-k *: r) else edvpq. Fact edivp_key : unit. Proof. by []. Qed. Definition edivp := locked_with edivp_key edivp_expanded_def. Canonical edivp_unlockable := [unlockable fun edivp]. Definition divp p q := ((edivp p q).1).2. Definition modp p q := (edivp p q).2. Definition scalp p q := ((edivp p q).1).1. Definition dvdp p q := modp q p == 0. Definition eqp p q := (dvdp p q) && (dvdp q p). End IDomainPseudoDivisionDefs. Notation "m %/ d" := (divp m d) : ring_scope. Notation "m %% d" := (modp m d) : ring_scope. Notation "p %| q" := (dvdp p q) : ring_scope. Notation "p %= q" := (eqp p q) : ring_scope. End IdomainDefs. Module WeakIdomain. Import Ring ComRing UnitRing IdomainDefs. Section WeakTheoryForIDomainPseudoDivision. Variable R : idomainType. Implicit Type p q r d : {poly R}. Lemma edivp_def p q : edivp p q = (scalp p q, divp p q, modp p q). Proof. by rewrite /scalp /divp /modp; case: (edivp p q) => [[]] /=. Qed. Lemma edivp_redivp p q : lead_coef q \in GRing.unit = false -> edivp p q = redivp p q. Proof. by move=> hu; rewrite unlock hu; case: (redivp p q) => [[? ?] ?]. Qed. Lemma divpE p q : p %/ q = if lead_coef q \in GRing.unit then lead_coef q ^- rscalp p q *: rdivp p q else rdivp p q. Proof. by case: ifP; rewrite /divp unlock redivp_def => ->. Qed. Lemma modpE p q : p %% q = if lead_coef q \in GRing.unit then lead_coef q ^- rscalp p q *: (rmodp p q) else rmodp p q. Proof. by case: ifP; rewrite /modp unlock redivp_def => ->. Qed. Lemma scalpE p q : scalp p q = if lead_coef q \in GRing.unit then 0%N else rscalp p q. Proof. by case: ifP; rewrite /scalp unlock redivp_def => ->. Qed. Lemma dvdpE p q : p %| q = rdvdp p q. Proof. rewrite /dvdp modpE /rdvdp; case ulcq: (lead_coef p \in GRing.unit)=> //. rewrite -[in LHS]size_poly_eq0 size_scale ?size_poly_eq0 //. by rewrite invr_eq0 expf_neq0 //; apply: contraTneq ulcq => ->; rewrite unitr0. Qed. Lemma lc_expn_scalp_neq0 p q : lead_coef q ^+ scalp p q != 0. Proof. have [->|nzq] := eqVneq q 0; last by rewrite expf_neq0 ?lead_coef_eq0. by rewrite /scalp 2!unlock /= eqxx lead_coef0 unitr0 /= oner_neq0. Qed. Hint Resolve lc_expn_scalp_neq0 : core. Variant edivp_spec (m d : {poly R}) : nat * {poly R} * {poly R} -> bool -> Type := |Redivp_spec k (q r: {poly R}) of (lead_coef d ^+ k) *: m = q * d + r & lead_coef d \notin GRing.unit & (d != 0 -> size r < size d) : edivp_spec m d (k, q, r) false |Fedivp_spec (q r: {poly R}) of m = q * d + r & (lead_coef d \in GRing.unit) & (d != 0 -> size r < size d) : edivp_spec m d (0%N, q, r) true. (* There are several ways to state this fact. The most appropriate statement*) (* might be polished in light of usage. *) Lemma edivpP m d : edivp_spec m d (edivp m d) (lead_coef d \in GRing.unit). Proof. have hC : GRing.comm d (lead_coef d)%:P by rewrite /GRing.comm mulrC. case ud: (lead_coef d \in GRing.unit); last first. rewrite edivp_redivp // redivp_def; constructor; rewrite ?ltn_rmodp // ?ud //. by rewrite rdivp_eq. have cdn0: lead_coef d != 0 by apply: contraTneq ud => ->; rewrite unitr0. rewrite unlock ud redivp_def; constructor => //. rewrite -scalerAl -scalerDr -mul_polyC. have hn0 : (lead_coef d ^+ rscalp m d)%:P != 0. by rewrite polyC_eq0; apply: expf_neq0. apply: (mulfI hn0); rewrite !mulrA -exprVn !polyC_exp -exprMn -polyCM. by rewrite divrr // expr1n mul1r -polyC_exp mul_polyC rdivp_eq. move=> dn0; rewrite size_scale ?ltn_rmodp // -exprVn expf_eq0 negb_and. by rewrite invr_eq0 cdn0 orbT. Qed. Lemma edivp_eq d q r : size r < size d -> lead_coef d \in GRing.unit -> edivp (q * d + r) d = (0%N, q, r). Proof. have hC : GRing.comm d (lead_coef d)%:P by apply: mulrC. move=> hsrd hu; rewrite unlock hu; case et: (redivp _ _) => [[s qq] rr]. have cdn0 : lead_coef d != 0 by case: eqP hu => //= ->; rewrite unitr0. move: (et); rewrite RingComRreg.redivp_eq //; last exact/rregP. rewrite et /= mulrC (mulrC r) !mul_polyC; case=> <- <-. by rewrite !scalerA mulVr ?scale1r // unitrX. Qed. Lemma divp_eq p q : (lead_coef q ^+ scalp p q) *: p = (p %/ q) * q + (p %% q). Proof. rewrite divpE modpE scalpE. case uq: (lead_coef q \in GRing.unit); last by rewrite rdivp_eq. rewrite expr0 scale1r; have [->|qn0] := eqVneq q 0. by rewrite lead_coef0 expr0n /rscalp unlock eqxx invr1 !scale1r rmodp0 !simp. by rewrite -scalerAl -scalerDr -rdivp_eq scalerA mulVr (scale1r, unitrX). Qed. Lemma dvdp_eq q p : (q %| p) = (lead_coef q ^+ scalp p q *: p == (p %/ q) * q). Proof. rewrite dvdpE rdvdp_eq scalpE divpE; case: ifP => ulcq //. rewrite expr0 scale1r -scalerAl; apply/eqP/eqP => [<- | {2}->]. by rewrite scalerA mulVr ?scale1r // unitrX. by rewrite scalerA mulrV ?scale1r // unitrX. Qed. Lemma divpK d p : d %| p -> p %/ d * d = (lead_coef d ^+ scalp p d) *: p. Proof. by rewrite dvdp_eq; move/eqP->. Qed. Lemma divpKC d p : d %| p -> d * (p %/ d) = (lead_coef d ^+ scalp p d) *: p. Proof. by move=> ?; rewrite mulrC divpK. Qed. Lemma dvdpP q p : reflect (exists2 cqq, cqq.1 != 0 & cqq.1 *: p = cqq.2 * q) (q %| p). Proof. rewrite dvdp_eq; apply: (iffP eqP) => [e | [[c qq] cn0 e]]. by exists (lead_coef q ^+ scalp p q, p %/ q) => //=. apply/eqP; rewrite -dvdp_eq dvdpE. have Ecc: c%:P != 0 by rewrite polyC_eq0. have [->|nz_p] := eqVneq p 0; first by rewrite rdvdp0. pose p1 : {poly R} := lead_coef q ^+ rscalp p q *: qq - c *: (rdivp p q). have E1: c *: rmodp p q = p1 * q. rewrite mulrDl mulNr -scalerAl -e scalerA mulrC -scalerA -scalerAl. by rewrite -scalerBr rdivp_eq addrC addKr. suff: p1 * q == 0 by rewrite -E1 -mul_polyC mulf_eq0 (negPf Ecc). rewrite mulf_eq0; apply/norP; case=> p1_nz q_nz; have:= ltn_rmodp p q. by rewrite q_nz -(size_scale _ cn0) E1 size_mul // polySpred // ltnNge leq_addl. Qed. Lemma mulpK p q : q != 0 -> p * q %/ q = lead_coef q ^+ scalp (p * q) q *: p. Proof. move=> qn0; apply: (rregP qn0); rewrite -scalerAl divp_eq. suff -> : (p * q) %% q = 0 by rewrite addr0. rewrite modpE RingComRreg.rmodp_mull ?scaler0 ?if_same //. by red; rewrite mulrC. by apply/rregP; rewrite lead_coef_eq0. Qed. Lemma mulKp p q : q != 0 -> q * p %/ q = lead_coef q ^+ scalp (p * q) q *: p. Proof. by move=> nzq; rewrite mulrC; apply: mulpK. Qed. Lemma divpp p : p != 0 -> p %/ p = (lead_coef p ^+ scalp p p)%:P. Proof. move=> np0; have := divp_eq p p. suff -> : p %% p = 0 by rewrite addr0 -mul_polyC; move/(mulIf np0). rewrite modpE Ring.rmodpp; last by red; rewrite mulrC. by rewrite scaler0 if_same. Qed. End WeakTheoryForIDomainPseudoDivision. Hint Resolve lc_expn_scalp_neq0 : core. End WeakIdomain. Module CommonIdomain. Import Ring ComRing UnitRing IdomainDefs WeakIdomain. Section IDomainPseudoDivision. Variable R : idomainType. Implicit Type p q r d m n : {poly R}. Lemma scalp0 p : scalp p 0 = 0%N. Proof. by rewrite /scalp unlock lead_coef0 unitr0 unlock eqxx. Qed. Lemma divp_small p q : size p < size q -> p %/ q = 0. Proof. move=> spq; rewrite /divp unlock redivp_def /=. by case: ifP; rewrite rdivp_small // scaler0. Qed. Lemma leq_divp p q : (size (p %/ q) <= size p). Proof. rewrite /divp unlock redivp_def /=; case: ifP => ulcq; rewrite ?leq_rdivp //=. rewrite size_scale ?leq_rdivp // -exprVn expf_neq0 // invr_eq0. by case: eqP ulcq => // ->; rewrite unitr0. Qed. Lemma div0p p : 0 %/ p = 0. Proof. by rewrite /divp unlock redivp_def /=; case: ifP; rewrite rdiv0p // scaler0. Qed. Lemma divp0 p : p %/ 0 = 0. Proof. by rewrite /divp unlock redivp_def /=; case: ifP; rewrite rdivp0 // scaler0. Qed. Lemma divp1 m : m %/ 1 = m. Proof. by rewrite divpE lead_coefC unitr1 Ring.rdivp1 expr1n invr1 scale1r. Qed. Lemma modp0 p : p %% 0 = p. Proof. rewrite /modp unlock redivp_def; case: ifP; rewrite rmodp0 //= lead_coef0. by rewrite unitr0. Qed. Lemma mod0p p : 0 %% p = 0. Proof. by rewrite /modp unlock redivp_def /=; case: ifP; rewrite rmod0p // scaler0. Qed. Lemma modp1 p : p %% 1 = 0. Proof. by rewrite /modp unlock redivp_def /=; case: ifP; rewrite rmodp1 // scaler0. Qed. Hint Resolve divp0 divp1 mod0p modp0 modp1 : core. Lemma modp_small p q : size p < size q -> p %% q = p. Proof. move=> spq; rewrite /modp unlock redivp_def; case: ifP; rewrite rmodp_small //. by rewrite /= rscalp_small // expr0 /= invr1 scale1r. Qed. Lemma modpC p c : c != 0 -> p %% c%:P = 0. Proof. move=> cn0; rewrite /modp unlock redivp_def /=; case: ifP; rewrite ?rmodpC //. by rewrite scaler0. Qed. Lemma modp_mull p q : (p * q) %% q = 0. Proof. have [-> | nq0] := eqVneq q 0; first by rewrite modp0 mulr0. have rlcq : GRing.rreg (lead_coef q) by apply/rregP; rewrite lead_coef_eq0. have hC : GRing.comm q (lead_coef q)%:P by red; rewrite mulrC. by rewrite modpE; case: ifP => ulcq; rewrite RingComRreg.rmodp_mull // scaler0. Qed. Lemma modp_mulr d p : (d * p) %% d = 0. Proof. by rewrite mulrC modp_mull. Qed. Lemma modpp d : d %% d = 0. Proof. by rewrite -[d in d %% _]mul1r modp_mull. Qed. Lemma ltn_modp p q : (size (p %% q) < size q) = (q != 0). Proof. rewrite /modp unlock redivp_def /=; case: ifP=> ulcq; rewrite ?ltn_rmodp //=. rewrite size_scale ?ltn_rmodp // -exprVn expf_neq0 // invr_eq0. by case: eqP ulcq => // ->; rewrite unitr0. Qed. Lemma ltn_divpl d q p : d != 0 -> (size (q %/ d) < size p) = (size q < size (p * d)). Proof. move=> dn0. have: (lead_coef d) ^+ (scalp q d) != 0 by apply: lc_expn_scalp_neq0. move/(size_scale q)<-; rewrite divp_eq; have [->|quo0] := eqVneq (q %/ d) 0. rewrite mul0r add0r size_poly0 size_poly_gt0. have [->|pn0] := eqVneq p 0; first by rewrite mul0r size_poly0 ltn0. by rewrite size_mul // (polySpred pn0) addSn ltn_addl // ltn_modp. rewrite size_addl; last first. by rewrite size_mul // (polySpred quo0) addSn /= ltn_addl // ltn_modp. have [->|pn0] := eqVneq p 0; first by rewrite mul0r size_poly0 !ltn0. by rewrite !size_mul ?quo0 // (polySpred dn0) !addnS ltn_add2r. Qed. Lemma leq_divpr d p q : d != 0 -> (size p <= size (q %/ d)) = (size (p * d) <= size q). Proof. by move=> dn0; rewrite leqNgt ltn_divpl // -leqNgt. Qed. Lemma divpN0 d p : d != 0 -> (p %/ d != 0) = (size d <= size p). Proof. move=> dn0. by rewrite -[d in RHS]mul1r -leq_divpr // size_polyC oner_eq0 size_poly_gt0. Qed. Lemma size_divp p q : q != 0 -> size (p %/ q) = (size p - (size q).-1)%N. Proof. move=> nq0; case: (leqP (size q) (size p)) => sqp; last first. move: (sqp); rewrite -{1}(ltn_predK sqp) ltnS -subn_eq0 divp_small //. by move/eqP->; rewrite size_poly0. have np0 : p != 0. by rewrite -size_poly_gt0; apply: leq_trans sqp; rewrite size_poly_gt0. have /= := congr1 (size \o @polyseq R) (divp_eq p q). rewrite size_scale; last by rewrite expf_eq0 lead_coef_eq0 (negPf nq0) andbF. have [->|qq0] := eqVneq (p %/ q) 0. by rewrite mul0r add0r=> es; move: nq0; rewrite -(ltn_modp p) -es ltnNge sqp. rewrite size_addl. by move->; apply/eqP; rewrite size_mul // (polySpred nq0) addnS /= addnK. rewrite size_mul ?qq0 //. move: nq0; rewrite -(ltn_modp p); move/leq_trans; apply. by rewrite (polySpred qq0) addSn /= leq_addl. Qed. Lemma ltn_modpN0 p q : q != 0 -> size (p %% q) < size q. Proof. by rewrite ltn_modp. Qed. Lemma modp_mod p q : (p %% q) %% q = p %% q. Proof. by have [->|qn0] := eqVneq q 0; rewrite ?modp0 // modp_small ?ltn_modp. Qed. Lemma leq_modp m d : size (m %% d) <= size m. Proof. rewrite /modp unlock redivp_def /=; case: ifP; rewrite ?leq_rmodp //. move=> ud; rewrite size_scale ?leq_rmodp // invr_eq0 expf_neq0 //. by apply: contraTneq ud => ->; rewrite unitr0. Qed. Lemma dvdp0 d : d %| 0. Proof. by rewrite /dvdp mod0p. Qed. Hint Resolve dvdp0 : core. Lemma dvd0p p : (0 %| p) = (p == 0). Proof. by rewrite /dvdp modp0. Qed. Lemma dvd0pP p : reflect (p = 0) (0 %| p). Proof. by apply: (iffP idP); rewrite dvd0p; move/eqP. Qed. Lemma dvdpN0 p q : p %| q -> q != 0 -> p != 0. Proof. by move=> pq hq; apply: contraTneq pq => ->; rewrite dvd0p. Qed. Lemma dvdp1 d : (d %| 1) = (size d == 1%N). Proof. rewrite /dvdp modpE; case ud: (lead_coef d \in GRing.unit); last exact: rdvdp1. rewrite -size_poly_eq0 size_scale; first by rewrite size_poly_eq0 -rdvdp1. by rewrite invr_eq0 expf_neq0 //; apply: contraTneq ud => ->; rewrite unitr0. Qed. Lemma dvd1p m : 1 %| m. Proof. by rewrite /dvdp modp1. Qed. Lemma gtNdvdp p q : p != 0 -> size p < size q -> (q %| p) = false. Proof. by move=> nn0 hs; rewrite /dvdp; rewrite (modp_small hs); apply: negPf. Qed. Lemma modp_eq0P p q : reflect (p %% q = 0) (q %| p). Proof. exact: (iffP eqP). Qed. Lemma modp_eq0 p q : (q %| p) -> p %% q = 0. Proof. exact: modp_eq0P. Qed. Lemma leq_divpl d p q : d %| p -> (size (p %/ d) <= size q) = (size p <= size (q * d)). Proof. case: (eqVneq d 0) => [-> /dvd0pP -> | nd0 hd]. by rewrite divp0 size_poly0 !leq0n. rewrite leq_eqVlt ltn_divpl // (leq_eqVlt (size p)). case lhs: (size p < size (q * d)); rewrite ?orbT ?orbF //. have: (lead_coef d) ^+ (scalp p d) != 0 by rewrite expf_neq0 // lead_coef_eq0. move/(size_scale p)<-; rewrite divp_eq; move/modp_eq0P: hd->; rewrite addr0. have [-> | quon0] := eqVneq (p %/ d) 0. rewrite mul0r size_poly0 2!(eq_sym 0%N) !size_poly_eq0. by rewrite mulf_eq0 (negPf nd0) orbF. have [-> | nq0] := eqVneq q 0. by rewrite mul0r size_poly0 !size_poly_eq0 mulf_eq0 (negPf nd0) orbF. by rewrite !size_mul // (polySpred nd0) !addnS /= eqn_add2r. Qed. Lemma dvdp_leq p q : q != 0 -> p %| q -> size p <= size q. Proof. move=> nq0 /modp_eq0P. by case: leqP => // /modp_small -> /eqP; rewrite (negPf nq0). Qed. Lemma eq_dvdp c quo q p : c != 0 -> c *: p = quo * q -> q %| p. Proof. move=> cn0; case: (eqVneq p 0) => [->|nz_quo def_quo] //. pose p1 : {poly R} := lead_coef q ^+ scalp p q *: quo - c *: (p %/ q). have E1: c *: (p %% q) = p1 * q. rewrite mulrDl mulNr -scalerAl -def_quo scalerA mulrC -scalerA. by rewrite -scalerAl -scalerBr divp_eq addrAC subrr add0r. rewrite /dvdp; apply/idPn=> m_nz. have: p1 * q != 0 by rewrite -E1 -mul_polyC mulf_neq0 // polyC_eq0. rewrite mulf_eq0; case/norP=> p1_nz q_nz. have := ltn_modp p q; rewrite q_nz -(size_scale (p %% q) cn0) E1. by rewrite size_mul // polySpred // ltnNge leq_addl. Qed. Lemma dvdpp d : d %| d. Proof. by rewrite /dvdp modpp. Qed. Hint Resolve dvdpp : core. Lemma divp_dvd p q : p %| q -> (q %/ p) %| q. Proof. have [-> | np0] := eqVneq p 0; first by rewrite divp0. rewrite dvdp_eq => /eqP h. apply: (@eq_dvdp ((lead_coef p)^+ (scalp q p)) p); last by rewrite mulrC. by rewrite expf_neq0 // lead_coef_eq0. Qed. Lemma dvdp_mull m d n : d %| n -> d %| m * n. Proof. case: (eqVneq d 0) => [-> /dvd0pP -> | dn0]; first by rewrite mulr0 dvdpp. rewrite dvdp_eq => /eqP e. apply: (@eq_dvdp (lead_coef d ^+ scalp n d) (m * (n %/ d))). by rewrite expf_neq0 // lead_coef_eq0. by rewrite scalerAr e mulrA. Qed. Lemma dvdp_mulr n d m : d %| m -> d %| m * n. Proof. by move=> hdm; rewrite mulrC dvdp_mull. Qed. Hint Resolve dvdp_mull dvdp_mulr : core. Lemma dvdp_mul d1 d2 m1 m2 : d1 %| m1 -> d2 %| m2 -> d1 * d2 %| m1 * m2. Proof. case: (eqVneq d1 0) => [-> /dvd0pP -> | d1n0]; first by rewrite !mul0r dvdpp. case: (eqVneq d2 0) => [-> _ /dvd0pP -> | d2n0]; first by rewrite !mulr0. rewrite dvdp_eq; set c1 := _ ^+ _; set q1 := _ %/ _; move/eqP=> Hq1. rewrite dvdp_eq; set c2 := _ ^+ _; set q2 := _ %/ _; move/eqP=> Hq2. apply: (@eq_dvdp (c1 * c2) (q1 * q2)). by rewrite mulf_neq0 // expf_neq0 // lead_coef_eq0. rewrite -scalerA scalerAr scalerAl Hq1 Hq2 -!mulrA. by rewrite [d1 * (q2 * _)]mulrCA. Qed. Lemma dvdp_addr m d n : d %| m -> (d %| m + n) = (d %| n). Proof. case: (eqVneq d 0) => [-> /dvd0pP -> | dn0]; first by rewrite add0r. rewrite dvdp_eq; set c1 := _ ^+ _; set q1 := _ %/ _; move/eqP=> Eq1. apply/idP/idP; rewrite dvdp_eq; set c2 := _ ^+ _; set q2 := _ %/ _. have sn0 : c1 * c2 != 0. by rewrite !mulf_neq0 // expf_eq0 lead_coef_eq0 (negPf dn0) andbF. move/eqP=> Eq2; apply: (@eq_dvdp _ (c1 *: q2 - c2 *: q1) _ _ sn0). rewrite mulrDl -scaleNr -!scalerAl -Eq1 -Eq2 !scalerA. by rewrite mulNr mulrC scaleNr -scalerBr addrC addKr. have sn0 : c1 * c2 != 0. by rewrite !mulf_neq0 // expf_eq0 lead_coef_eq0 (negPf dn0) andbF. move/eqP=> Eq2; apply: (@eq_dvdp _ (c1 *: q2 + c2 *: q1) _ _ sn0). by rewrite mulrDl -!scalerAl -Eq1 -Eq2 !scalerA mulrC addrC scalerDr. Qed. Lemma dvdp_addl n d m : d %| n -> (d %| m + n) = (d %| m). Proof. by rewrite addrC; apply: dvdp_addr. Qed. Lemma dvdp_add d m n : d %| m -> d %| n -> d %| m + n. Proof. by move/dvdp_addr->. Qed. Lemma dvdp_add_eq d m n : d %| m + n -> (d %| m) = (d %| n). Proof. by move=> ?; apply/idP/idP; [move/dvdp_addr <-| move/dvdp_addl <-]. Qed. Lemma dvdp_subr d m n : d %| m -> (d %| m - n) = (d %| n). Proof. by move=> ?; apply: dvdp_add_eq; rewrite -addrA addNr simp. Qed. Lemma dvdp_subl d m n : d %| n -> (d %| m - n) = (d %| m). Proof. by move/dvdp_addl<-; rewrite subrK. Qed. Lemma dvdp_sub d m n : d %| m -> d %| n -> d %| m - n. Proof. by move=> *; rewrite dvdp_subl. Qed. Lemma dvdp_mod d n m : d %| n -> (d %| m) = (d %| m %% n). Proof. have [-> | nn0] := eqVneq n 0; first by rewrite modp0. case: (eqVneq d 0) => [-> /dvd0pP -> | dn0]; first by rewrite modp0. rewrite dvdp_eq; set c1 := _ ^+ _; set q1 := _ %/ _; move/eqP=> Eq1. apply/idP/idP; rewrite dvdp_eq; set c2 := _ ^+ _; set q2 := _ %/ _. have sn0 : c1 * c2 != 0. by rewrite !mulf_neq0 // expf_eq0 lead_coef_eq0 (negPf dn0) andbF. pose quo := (c1 * lead_coef n ^+ scalp m n) *: q2 - c2 *: (m %/ n) * q1. move/eqP=> Eq2; apply: (@eq_dvdp _ quo _ _ sn0). rewrite mulrDl mulNr -!scalerAl -!mulrA -Eq1 -Eq2 -scalerAr !scalerA. rewrite mulrC [_ * c2]mulrC mulrA -[((_ * _) * _) *: _]scalerA -scalerBr. by rewrite divp_eq addrC addKr. have sn0 : c1 * c2 * lead_coef n ^+ scalp m n != 0. rewrite !mulf_neq0 // expf_eq0 lead_coef_eq0 ?(negPf dn0) ?andbF //. by rewrite (negPf nn0) andbF. move/eqP=> Eq2; apply: (@eq_dvdp _ (c2 *: (m %/ n) * q1 + c1 *: q2) _ _ sn0). rewrite -scalerA divp_eq scalerDr -!scalerA Eq2 scalerAl scalerAr Eq1. by rewrite scalerAl mulrDl mulrA. Qed. Lemma dvdp_trans : transitive (@dvdp R). Proof. move=> n d m. case: (eqVneq d 0) => [-> /dvd0pP -> // | dn0]. case: (eqVneq n 0) => [-> _ /dvd0pP -> // | nn0]. rewrite dvdp_eq; set c1 := _ ^+ _; set q1 := _ %/ _; move/eqP=> Hq1. rewrite dvdp_eq; set c2 := _ ^+ _; set q2 := _ %/ _; move/eqP=> Hq2. have sn0 : c1 * c2 != 0 by rewrite mulf_neq0 // expf_neq0 // lead_coef_eq0. by apply: (@eq_dvdp _ (q2 * q1) _ _ sn0); rewrite -scalerA Hq2 scalerAr Hq1 mulrA. Qed. Lemma dvdp_mulIl p q : p %| p * q. Proof. exact/dvdp_mulr/dvdpp. Qed. Lemma dvdp_mulIr p q : q %| p * q. Proof. exact/dvdp_mull/dvdpp. Qed. Lemma dvdp_mul2r r p q : r != 0 -> (p * r %| q * r) = (p %| q). Proof. move=> nzr. have [-> | pn0] := eqVneq p 0. by rewrite mul0r !dvd0p mulf_eq0 (negPf nzr) orbF. have [-> | qn0] := eqVneq q 0; first by rewrite mul0r !dvdp0. apply/idP/idP; last by move=> ?; rewrite dvdp_mul ?dvdpp. rewrite dvdp_eq; set c := _ ^+ _; set x := _ %/ _; move/eqP=> Hx. apply: (@eq_dvdp c x); first by rewrite expf_neq0 // lead_coef_eq0 mulf_neq0. by apply: (mulIf nzr); rewrite -mulrA -scalerAl. Qed. Lemma dvdp_mul2l r p q: r != 0 -> (r * p %| r * q) = (p %| q). Proof. by rewrite ![r * _]mulrC; apply: dvdp_mul2r. Qed. Lemma ltn_divpr d p q : d %| q -> (size p < size (q %/ d)) = (size (p * d) < size q). Proof. by move=> dv_d_q; rewrite !ltnNge leq_divpl. Qed. Lemma dvdp_exp d k p : 0 < k -> d %| p -> d %| (p ^+ k). Proof. by case: k => // k _ d_dv_m; rewrite exprS dvdp_mulr. Qed. Lemma dvdp_exp2l d k l : k <= l -> d ^+ k %| d ^+ l. Proof. by move/subnK <-; rewrite exprD dvdp_mull // ?lead_coef_exp ?unitrX. Qed. Lemma dvdp_Pexp2l d k l : 1 < size d -> (d ^+ k %| d ^+ l) = (k <= l). Proof. move=> sd; case: leqP => [|gt_n_m]; first exact: dvdp_exp2l. have dn0 : d != 0 by rewrite -size_poly_gt0; apply: ltn_trans sd. rewrite gtNdvdp ?expf_neq0 // polySpred ?expf_neq0 // size_exp /=. rewrite [size (d ^+ k)]polySpred ?expf_neq0 // size_exp ltnS ltn_mul2l. by move: sd; rewrite -subn_gt0 subn1; move->. Qed. Lemma dvdp_exp2r p q k : p %| q -> p ^+ k %| q ^+ k. Proof. case: (eqVneq p 0) => [-> /dvd0pP -> // | pn0]. rewrite dvdp_eq; set c := _ ^+ _; set t := _ %/ _; move/eqP=> e. apply: (@eq_dvdp (c ^+ k) (t ^+ k)); first by rewrite !expf_neq0 ?lead_coef_eq0. by rewrite -exprMn -exprZn; congr (_ ^+ k). Qed. Lemma dvdp_exp_sub p q k l: p != 0 -> (p ^+ k %| q * p ^+ l) = (p ^+ (k - l) %| q). Proof. move=> pn0; case: (leqP k l)=> [|/ltnW] hkl. move: (hkl); rewrite -subn_eq0; move/eqP->; rewrite expr0 dvd1p. exact/dvdp_mull/dvdp_exp2l. by rewrite -[in LHS](subnK hkl) exprD dvdp_mul2r // expf_eq0 (negPf pn0) andbF. Qed. Lemma dvdp_XsubCl p x : ('X - x%:P) %| p = root p x. Proof. by rewrite dvdpE; apply: Ring.rdvdp_XsubCl. Qed. Lemma polyXsubCP p x : reflect (p.[x] = 0) (('X - x%:P) %| p). Proof. by rewrite dvdpE; apply: Ring.polyXsubCP. Qed. Lemma eqp_div_XsubC p c : (p == (p %/ ('X - c%:P)) * ('X - c%:P)) = ('X - c%:P %| p). Proof. by rewrite dvdp_eq lead_coefXsubC expr1n scale1r. Qed. Lemma root_factor_theorem p x : root p x = (('X - x%:P) %| p). Proof. by rewrite dvdp_XsubCl. Qed. Lemma uniq_roots_dvdp p rs : all (root p) rs -> uniq_roots rs -> (\prod_(z <- rs) ('X - z%:P)) %| p. Proof. move=> rrs; case/(uniq_roots_prod_XsubC rrs)=> q ->. by apply: dvdp_mull; rewrite // (eqP (monic_prod_XsubC _)) unitr1. Qed. Lemma root_bigmul x (ps : seq {poly R}) : ~~root (\big[*%R/1]_(p <- ps) p) x = all (fun p => ~~ root p x) ps. Proof. elim: ps => [|p ps ihp]; first by rewrite big_nil root1. by rewrite big_cons /= rootM negb_or ihp. Qed. Lemma eqpP m n : reflect (exists2 c12, (c12.1 != 0) && (c12.2 != 0) & c12.1 *: m = c12.2 *: n) (m %= n). Proof. apply: (iffP idP) => [| [[c1 c2]/andP[nz_c1 nz_c2 eq_cmn]]]; last first. rewrite /eqp (@eq_dvdp c2 c1%:P) -?eq_cmn ?mul_polyC // (@eq_dvdp c1 c2%:P) //. by rewrite eq_cmn mul_polyC. case: (eqVneq m 0) => [-> /andP [/dvd0pP -> _] | m_nz]. by exists (1, 1); rewrite ?scaler0 // oner_eq0. case: (eqVneq n 0) => [-> /andP [_ /dvd0pP ->] | n_nz /andP []]. by exists (1, 1); rewrite ?scaler0 // oner_eq0. rewrite !dvdp_eq; set c1 := _ ^+ _; set c2 := _ ^+ _. set q1 := _ %/ _; set q2 := _ %/ _; move/eqP => Hq1 /eqP Hq2; have Hc1 : c1 != 0 by rewrite expf_eq0 lead_coef_eq0 negb_and m_nz orbT. have Hc2 : c2 != 0 by rewrite expf_eq0 lead_coef_eq0 negb_and n_nz orbT. have def_q12: q1 * q2 = (c1 * c2)%:P. apply: (mulIf m_nz); rewrite mulrAC mulrC -Hq1 -scalerAr -Hq2 scalerA. by rewrite -mul_polyC. have: q1 * q2 != 0 by rewrite def_q12 -size_poly_eq0 size_polyC mulf_neq0. rewrite mulf_eq0; case/norP=> nz_q1 nz_q2. have: size q2 <= 1%N. have:= size_mul nz_q1 nz_q2; rewrite def_q12 size_polyC mulf_neq0 //=. by rewrite polySpred // => ->; rewrite leq_addl. rewrite leq_eqVlt ltnS size_poly_leq0 (negPf nz_q2) orbF. case/size_poly1P=> c cn0 cqe; exists (c2, c); first by rewrite Hc2. by rewrite Hq2 -mul_polyC -cqe. Qed. Lemma eqp_eq p q: p %= q -> (lead_coef q) *: p = (lead_coef p) *: q. Proof. move=> /eqpP [[c1 c2] /= /andP [nz_c1 nz_c2]] eq. have/(congr1 lead_coef) := eq; rewrite !lead_coefZ. move=> eqC; apply/(@mulfI _ c2%:P); rewrite ?polyC_eq0 //. by rewrite !mul_polyC scalerA -eqC mulrC -scalerA eq !scalerA mulrC. Qed. Lemma eqpxx : reflexive (@eqp R). Proof. by move=> p; rewrite /eqp dvdpp. Qed. Hint Resolve eqpxx : core. Lemma eqp_sym : symmetric (@eqp R). Proof. by move=> p q; rewrite /eqp andbC. Qed. Lemma eqp_trans : transitive (@eqp R). Proof. move=> p q r; case/andP=> Dp pD; case/andP=> Dq qD. by rewrite /eqp (dvdp_trans Dp) // (dvdp_trans qD). Qed. Lemma eqp_ltrans : left_transitive (@eqp R). Proof. exact: sym_left_transitive eqp_sym eqp_trans. Qed. Lemma eqp_rtrans : right_transitive (@eqp R). Proof. exact: sym_right_transitive eqp_sym eqp_trans. Qed. Lemma eqp0 p : (p %= 0) = (p == 0). Proof. by apply/idP/eqP => [/andP [_ /dvd0pP] | -> //]. Qed. Lemma eqp01 : 0 %= (1 : {poly R}) = false. Proof. by rewrite eqp_sym eqp0 oner_eq0. Qed. Lemma eqp_scale p c : c != 0 -> c *: p %= p. Proof. move=> c0; apply/eqpP; exists (1, c); first by rewrite c0 oner_eq0. by rewrite scale1r. Qed. Lemma eqp_size p q : p %= q -> size p = size q. Proof. have [->|Eq] := eqVneq q 0; first by rewrite eqp0; move/eqP->. rewrite eqp_sym; have [->|Ep] := eqVneq p 0; first by rewrite eqp0; move/eqP->. by case/andP => Dp Dq; apply: anti_leq; rewrite !dvdp_leq. Qed. Lemma size_poly_eq1 p : (size p == 1%N) = (p %= 1). Proof. apply/size_poly1P/idP=> [[c cn0 ep] |]. by apply/eqpP; exists (1, c); rewrite ?oner_eq0 // alg_polyC scale1r. by move/eqp_size; rewrite size_poly1; move/eqP/size_poly1P. Qed. Lemma polyXsubC_eqp1 (x : R) : ('X - x%:P %= 1) = false. Proof. by rewrite -size_poly_eq1 size_XsubC. Qed. Lemma dvdp_eqp1 p q : p %| q -> q %= 1 -> p %= 1. Proof. move=> dpq hq. have sizeq : size q == 1%N by rewrite size_poly_eq1. have n0q : q != 0 by case: eqP hq => // ->; rewrite eqp01. rewrite -size_poly_eq1 eqn_leq -{1}(eqP sizeq) dvdp_leq //= size_poly_gt0. by apply/eqP => p0; move: dpq n0q; rewrite p0 dvd0p => ->. Qed. Lemma eqp_dvdr q p d: p %= q -> d %| p = (d %| q). Proof. suff Hmn m n: m %= n -> (d %| m) -> (d %| n). by move=> mn; apply/idP/idP; apply: Hmn=> //; rewrite eqp_sym. by rewrite /eqp; case/andP=> pq qp dp; apply: (dvdp_trans dp). Qed. Lemma eqp_dvdl d2 d1 p : d1 %= d2 -> d1 %| p = (d2 %| p). suff Hmn m n: m %= n -> (m %| p) -> (n %| p). by move=> ?; apply/idP/idP; apply: Hmn; rewrite // eqp_sym. by rewrite /eqp; case/andP=> dd' d'd dp; apply: (dvdp_trans d'd). Qed. Lemma dvdpZr c m n : c != 0 -> m %| c *: n = (m %| n). Proof. by move=> cn0; exact/eqp_dvdr/eqp_scale. Qed. Lemma dvdpZl c m n : c != 0 -> (c *: m %| n) = (m %| n). Proof. by move=> cn0; exact/eqp_dvdl/eqp_scale. Qed. Lemma dvdpNl d p : (- d) %| p = (d %| p). Proof. by rewrite -scaleN1r; apply/eqp_dvdl/eqp_scale; rewrite oppr_eq0 oner_neq0. Qed. Lemma dvdpNr d p : d %| (- p) = (d %| p). Proof. by apply: eqp_dvdr; rewrite -scaleN1r eqp_scale ?oppr_eq0 ?oner_eq0. Qed. Lemma eqp_mul2r r p q : r != 0 -> (p * r %= q * r) = (p %= q). Proof. by move=> nz_r; rewrite /eqp !dvdp_mul2r. Qed. Lemma eqp_mul2l r p q: r != 0 -> (r * p %= r * q) = (p %= q). Proof. by move=> nz_r; rewrite /eqp !dvdp_mul2l. Qed. Lemma eqp_mull r p q: q %= r -> p * q %= p * r. Proof. case/eqpP=> [[c d]] /andP [c0 d0 e]; apply/eqpP; exists (c, d); rewrite ?c0 //. by rewrite scalerAr e -scalerAr. Qed. Lemma eqp_mulr q p r : p %= q -> p * r %= q * r. Proof. by move=> epq; rewrite ![_ * r]mulrC eqp_mull. Qed. Lemma eqp_exp p q k : p %= q -> p ^+ k %= q ^+ k. Proof. move=> pq; elim: k=> [|k ihk]; first by rewrite !expr0 eqpxx. by rewrite !exprS (@eqp_trans (q * p ^+ k)) // (eqp_mulr, eqp_mull). Qed. Lemma polyC_eqp1 (c : R) : (c%:P %= 1) = (c != 0). Proof. apply/eqpP/idP => [[[x y]] |nc0] /=. case: (eqVneq c) => [->|] //= /andP [_] /negPf <- /eqP. by rewrite alg_polyC scaler0 eq_sym polyC_eq0. exists (1, c); first by rewrite nc0 /= oner_neq0. by rewrite alg_polyC scale1r. Qed. Lemma dvdUp d p: d %= 1 -> d %| p. Proof. by move/eqp_dvdl->; rewrite dvd1p. Qed. Lemma dvdp_size_eqp p q : p %| q -> size p == size q = (p %= q). Proof. move=> pq; apply/idP/idP; last by move/eqp_size->. have [->|Hq] := eqVneq q 0; first by rewrite size_poly0 size_poly_eq0 eqp0. have [->|Hp] := eqVneq p 0. by rewrite size_poly0 eq_sym size_poly_eq0 eqp_sym eqp0. move: pq; rewrite dvdp_eq; set c := _ ^+ _; set x := _ %/ _; move/eqP=> eqpq. have /= := congr1 (size \o @polyseq R) eqpq. have cn0 : c != 0 by rewrite expf_neq0 // lead_coef_eq0. rewrite (@eqp_size _ q); last exact: eqp_scale. rewrite size_mul ?p0 // => [-> HH|]; last first. apply/eqP=> HH; move: eqpq; rewrite HH mul0r. by move/eqP; rewrite scale_poly_eq0 (negPf Hq) (negPf cn0). suff: size x == 1%N. case/size_poly1P=> y H1y H2y. by apply/eqpP; exists (y, c); rewrite ?H1y // eqpq H2y mul_polyC. case: (size p) HH (size_poly_eq0 p)=> [|n]; first by case: eqP Hp. by rewrite addnS -add1n eqn_add2r; move/eqP->. Qed. Lemma eqp_root p q : p %= q -> root p =1 root q. Proof. move/eqpP=> [[c d]] /andP [c0 d0 e] x; move/negPf:c0=>c0; move/negPf:d0=>d0. by rewrite rootE -[_==_]orFb -c0 -mulf_eq0 -hornerZ e hornerZ mulf_eq0 d0. Qed. Lemma eqp_rmod_mod p q : rmodp p q %= modp p q. Proof. rewrite modpE eqp_sym; case: ifP => ulcq //. apply: eqp_scale; rewrite invr_eq0 //. by apply: expf_neq0; apply: contraTneq ulcq => ->; rewrite unitr0. Qed. Lemma eqp_rdiv_div p q : rdivp p q %= divp p q. Proof. rewrite divpE eqp_sym; case: ifP=> ulcq //; apply: eqp_scale; rewrite invr_eq0 //. by apply: expf_neq0; apply: contraTneq ulcq => ->; rewrite unitr0. Qed. Lemma dvd_eqp_divl d p q (dvd_dp : d %| q) (eq_pq : p %= q) : p %/ d %= q %/ d. Proof. case: (eqVneq q 0) eq_pq=> [->|q_neq0]; first by rewrite eqp0=> /eqP->. have d_neq0: d != 0 by apply: contraTneq dvd_dp=> ->; rewrite dvd0p. move=> eq_pq; rewrite -(@eqp_mul2r d) // !divpK // ?(eqp_dvdr _ eq_pq) //. rewrite (eqp_ltrans (eqp_scale _ _)) ?lc_expn_scalp_neq0 //. by rewrite (eqp_rtrans (eqp_scale _ _)) ?lc_expn_scalp_neq0. Qed. Definition gcdp_rec p q := let: (p1, q1) := if size p < size q then (q, p) else (p, q) in if p1 == 0 then q1 else let fix loop (n : nat) (pp qq : {poly R}) {struct n} := let rr := modp pp qq in if rr == 0 then qq else if n is n1.+1 then loop n1 qq rr else rr in loop (size p1) p1 q1. Definition gcdp := nosimpl gcdp_rec. Lemma gcd0p : left_id 0 gcdp. Proof. move=> p; rewrite /gcdp /gcdp_rec size_poly0 size_poly_gt0 if_neg. case: ifP => /= [_ | nzp]; first by rewrite eqxx. by rewrite polySpred !(modp0, nzp) //; case: _.-1 => [|m]; rewrite mod0p eqxx. Qed. Lemma gcdp0 : right_id 0 gcdp. Proof. move=> p; have:= gcd0p p; rewrite /gcdp /gcdp_rec size_poly0 size_poly_gt0. by case: eqVneq => //= ->; rewrite eqxx. Qed. Lemma gcdpE p q : gcdp p q = if size p < size q then gcdp (modp q p) p else gcdp (modp p q) q. Proof. pose gcdpE_rec := fix gcdpE_rec (n : nat) (pp qq : {poly R}) {struct n} := let rr := modp pp qq in if rr == 0 then qq else if n is n1.+1 then gcdpE_rec n1 qq rr else rr. have Irec: forall k l p q, size q <= k -> size q <= l -> size q < size p -> gcdpE_rec k p q = gcdpE_rec l p q. + elim=> [|m Hrec] [|n] //= p1 q1. - move/size_poly_leq0P=> -> _; rewrite size_poly0 size_poly_gt0 modp0. by move/negPf ->; case: n => [|n] /=; rewrite mod0p eqxx. - move=> _ /size_poly_leq0P ->; rewrite size_poly0 size_poly_gt0 modp0. by move/negPf ->; case: m {Hrec} => [|m] /=; rewrite mod0p eqxx. case: eqP => Epq Sm Sn Sq //; have [->|nzq] := eqVneq q1 0. by case: n m {Sm Sn Hrec} => [|m] [|n] //=; rewrite mod0p eqxx. apply: Hrec; last by rewrite ltn_modp. by rewrite -ltnS (leq_trans _ Sm) // ltn_modp. by rewrite -ltnS (leq_trans _ Sn) // ltn_modp. have [->|nzp] := eqVneq p 0; first by rewrite mod0p modp0 gcd0p gcdp0 if_same. have [->|nzq] := eqVneq q 0; first by rewrite mod0p modp0 gcd0p gcdp0 if_same. rewrite /gcdp /gcdp_rec !ltn_modp !(negPf nzp, negPf nzq) /=. have [ltpq|leqp] := ltnP; rewrite !(negPf nzp, negPf nzq) /= polySpred //. have [->|nzqp] := eqVneq. by case: (size p) => [|[|s]]; rewrite /= modp0 (negPf nzp) // mod0p eqxx. apply: Irec => //; last by rewrite ltn_modp. by rewrite -ltnS -polySpred // (leq_trans _ ltpq) ?leqW // ltn_modp. by rewrite ltnW // ltn_modp. case: eqVneq => [->|nzpq]. by case: (size q) => [|[|s]]; rewrite /= modp0 (negPf nzq) // mod0p eqxx. apply: Irec => //; rewrite ?ltn_modp //. by rewrite -ltnS -polySpred // (leq_trans _ leqp) // ltn_modp. by rewrite ltnW // ltn_modp. Qed. Lemma size_gcd1p p : size (gcdp 1 p) = 1%N. Proof. rewrite gcdpE size_polyC oner_eq0 /= modp1; have [|/size1_polyC ->] := ltnP. by rewrite gcd0p size_polyC oner_eq0. have [->|p00] := eqVneq p`_0 0; first by rewrite modp0 gcdp0 size_poly1. by rewrite modpC // gcd0p size_polyC p00. Qed. Lemma size_gcdp1 p : size (gcdp p 1) = 1%N. Proof. rewrite gcdpE size_polyC oner_eq0 /= modp1 ltnS; case: leqP. by move/size_poly_leq0P->; rewrite gcdp0 modp0 size_polyC oner_eq0. by rewrite gcd0p size_polyC oner_eq0. Qed. Lemma gcdpp : idempotent gcdp. Proof. by move=> p; rewrite gcdpE ltnn modpp gcd0p. Qed. Lemma dvdp_gcdlr p q : (gcdp p q %| p) && (gcdp p q %| q). Proof. have [r] := ubnP (minn (size q) (size p)); elim: r => // r IHr in p q *. have [-> | nz_p] := eqVneq p 0; first by rewrite gcd0p dvdpp andbT. have [-> | nz_q] := eqVneq q 0; first by rewrite gcdp0 dvdpp /=. rewrite ltnS gcdpE; case: leqP => [le_pq | lt_pq] le_qr. suffices /IHr/andP[E1 E2]: minn (size q) (size (p %% q)) < r. by rewrite E2 andbT (dvdp_mod _ E2). by rewrite gtn_min orbC (leq_trans _ le_qr) ?ltn_modp. suffices /IHr/andP[E1 E2]: minn (size p) (size (q %% p)) < r. by rewrite E2 (dvdp_mod _ E2). by rewrite gtn_min orbC (leq_trans _ le_qr) ?ltn_modp. Qed. Lemma dvdp_gcdl p q : gcdp p q %| p. Proof. by case/andP: (dvdp_gcdlr p q). Qed. Lemma dvdp_gcdr p q :gcdp p q %| q. Proof. by case/andP: (dvdp_gcdlr p q). Qed. Lemma leq_gcdpl p q : p != 0 -> size (gcdp p q) <= size p. Proof. by move=> pn0; move: (dvdp_gcdl p q); apply: dvdp_leq. Qed. Lemma leq_gcdpr p q : q != 0 -> size (gcdp p q) <= size q. Proof. by move=> qn0; move: (dvdp_gcdr p q); apply: dvdp_leq. Qed. Lemma dvdp_gcd p m n : p %| gcdp m n = (p %| m) && (p %| n). Proof. apply/idP/andP=> [dv_pmn | []]. by rewrite ?(dvdp_trans dv_pmn) ?dvdp_gcdl ?dvdp_gcdr. have [r] := ubnP (minn (size n) (size m)); elim: r => // r IHr in m n *. have [-> | nz_m] := eqVneq m 0; first by rewrite gcd0p. have [-> | nz_n] := eqVneq n 0; first by rewrite gcdp0. rewrite gcdpE ltnS; case: leqP => [le_nm | lt_mn] le_r dv_m dv_n. apply: IHr => //; last by rewrite -(dvdp_mod _ dv_n). by rewrite gtn_min orbC (leq_trans _ le_r) ?ltn_modp. apply: IHr => //; last by rewrite -(dvdp_mod _ dv_m). by rewrite gtn_min orbC (leq_trans _ le_r) ?ltn_modp. Qed. Lemma gcdpC p q : gcdp p q %= gcdp q p. Proof. by rewrite /eqp !dvdp_gcd !dvdp_gcdl !dvdp_gcdr. Qed. Lemma gcd1p p : gcdp 1 p %= 1. Proof. rewrite -size_poly_eq1 gcdpE size_poly1; case: ltnP. by rewrite modp1 gcd0p size_poly1 eqxx. move/size1_polyC=> e; rewrite e. have [->|p00] := eqVneq p`_0 0; first by rewrite modp0 gcdp0 size_poly1. by rewrite modpC // gcd0p size_polyC p00. Qed. Lemma gcdp1 p : gcdp p 1 %= 1. Proof. by rewrite (eqp_ltrans (gcdpC _ _)) gcd1p. Qed. Lemma gcdp_addl_mul p q r: gcdp r (p * r + q) %= gcdp r q. Proof. suff h m n d : gcdp d n %| gcdp d (m * d + n). apply/andP; split => //. by rewrite {2}(_: q = (-p) * r + (p * r + q)) ?H // mulNr addKr. by rewrite dvdp_gcd dvdp_gcdl /= dvdp_addr ?dvdp_gcdr ?dvdp_mull ?dvdp_gcdl. Qed. Lemma gcdp_addl m n : gcdp m (m + n) %= gcdp m n. Proof. by rewrite -[m in m + _]mul1r gcdp_addl_mul. Qed. Lemma gcdp_addr m n : gcdp m (n + m) %= gcdp m n. Proof. by rewrite addrC gcdp_addl. Qed. Lemma gcdp_mull m n : gcdp n (m * n) %= n. Proof. have [-> | nn0] := eqVneq n 0; first by rewrite gcd0p mulr0 eqpxx. have [-> | mn0] := eqVneq m 0; first by rewrite mul0r gcdp0 eqpxx. rewrite gcdpE modp_mull gcd0p size_mul //; case: leqP; last by rewrite eqpxx. rewrite (polySpred mn0) addSn /= -[n in _ <= n]add0n leq_add2r -ltnS. rewrite -polySpred //= leq_eqVlt ltnS size_poly_leq0 (negPf mn0) orbF. case/size_poly1P=> c cn0 -> {mn0 m}; rewrite mul_polyC. suff -> : n %% (c *: n) = 0 by rewrite gcd0p; apply: eqp_scale. by apply/modp_eq0P; rewrite dvdpZl. Qed. Lemma gcdp_mulr m n : gcdp n (n * m) %= n. Proof. by rewrite mulrC gcdp_mull. Qed. Lemma gcdp_scalel c m n : c != 0 -> gcdp (c *: m) n %= gcdp m n. Proof. move=> cn0; rewrite /eqp dvdp_gcd [gcdp m n %| _]dvdp_gcd !dvdp_gcdr !andbT. apply/andP; split; last first. by apply: dvdp_trans (dvdp_gcdl _ _) _; rewrite dvdpZr. by apply: dvdp_trans (dvdp_gcdl _ _) _; rewrite dvdpZl. Qed. Lemma gcdp_scaler c m n : c != 0 -> gcdp m (c *: n) %= gcdp m n. Proof. move=> cn0; apply: eqp_trans (gcdpC _ _) _. by apply: eqp_trans (gcdp_scalel _ _ _) _ => //; apply: gcdpC. Qed. Lemma dvdp_gcd_idl m n : m %| n -> gcdp m n %= m. Proof. have [-> | mn0] := eqVneq m 0. by rewrite dvd0p => /eqP ->; rewrite gcdp0 eqpxx. rewrite dvdp_eq; move/eqP/(f_equal (gcdp m)) => h. apply: eqp_trans (gcdp_mull (n %/ m) _). by rewrite -h eqp_sym gcdp_scaler // expf_neq0 // lead_coef_eq0. Qed. Lemma dvdp_gcd_idr m n : n %| m -> gcdp m n %= n. Proof. by move/dvdp_gcd_idl; exact/eqp_trans/gcdpC. Qed. Lemma gcdp_exp p k l : gcdp (p ^+ k) (p ^+ l) %= p ^+ minn k l. Proof. case: leqP => [|/ltnW] /subnK <-; rewrite exprD; first exact: gcdp_mull. exact/(eqp_trans (gcdpC _ _))/gcdp_mull. Qed. Lemma gcdp_eq0 p q : gcdp p q == 0 = (p == 0) && (q == 0). Proof. apply/idP/idP; last by case/andP => /eqP -> /eqP ->; rewrite gcdp0. have h m n: gcdp m n == 0 -> (m == 0). by rewrite -(dvd0p m); move/eqP<-; rewrite dvdp_gcdl. by move=> ?; rewrite (h _ q) // (h _ p) // -eqp0 (eqp_ltrans (gcdpC _ _)) eqp0. Qed. Lemma eqp_gcdr p q r : q %= r -> gcdp p q %= gcdp p r. Proof. move=> eqr; rewrite /eqp !(dvdp_gcd, dvdp_gcdl, andbT) /=. by rewrite -(eqp_dvdr _ eqr) dvdp_gcdr (eqp_dvdr _ eqr) dvdp_gcdr. Qed. Lemma eqp_gcdl r p q : p %= q -> gcdp p r %= gcdp q r. Proof. move=> eqr; rewrite /eqp !(dvdp_gcd, dvdp_gcdr, andbT) /=. by rewrite -(eqp_dvdr _ eqr) dvdp_gcdl (eqp_dvdr _ eqr) dvdp_gcdl. Qed. Lemma eqp_gcd p1 p2 q1 q2 : p1 %= p2 -> q1 %= q2 -> gcdp p1 q1 %= gcdp p2 q2. Proof. move=> e1 e2; exact: eqp_trans (eqp_gcdr _ e2) (eqp_gcdl _ e1). Qed. Lemma eqp_rgcd_gcd p q : rgcdp p q %= gcdp p q. Proof. move: {2}(minn (size p) (size q)) (leqnn (minn (size p) (size q))) => n. elim: n p q => [p q|n ihn p q hs]. rewrite leqn0; case: ltnP => _; rewrite size_poly_eq0; move/eqP->. by rewrite gcd0p rgcd0p eqpxx. by rewrite gcdp0 rgcdp0 eqpxx. have [-> | pn0] := eqVneq p 0; first by rewrite gcd0p rgcd0p eqpxx. have [-> | qn0] := eqVneq q 0; first by rewrite gcdp0 rgcdp0 eqpxx. rewrite gcdpE rgcdpE; case: ltnP hs => sp hs. have e := eqp_rmod_mod q p; apply/eqp_trans/ihn: (eqp_gcdl p e). by rewrite (eqp_size e) geq_min -ltnS (leq_trans _ hs) ?ltn_modp. have e := eqp_rmod_mod p q; apply/eqp_trans/ihn: (eqp_gcdl q e). by rewrite (eqp_size e) geq_min -ltnS (leq_trans _ hs) ?ltn_modp. Qed. Lemma gcdp_modl m n : gcdp (m %% n) n %= gcdp m n. Proof. have [/modp_small -> // | lenm] := ltnP (size m) (size n). by rewrite (gcdpE m n) ltnNge lenm. Qed. Lemma gcdp_modr m n : gcdp m (n %% m) %= gcdp m n. Proof. apply: eqp_trans (gcdpC _ _); apply: eqp_trans (gcdp_modl _ _); exact: gcdpC. Qed. Lemma gcdp_def d m n : d %| m -> d %| n -> (forall d', d' %| m -> d' %| n -> d' %| d) -> gcdp m n %= d. Proof. move=> dm dn h; rewrite /eqp dvdp_gcd dm dn !andbT. by apply: h; [apply: dvdp_gcdl | apply: dvdp_gcdr]. Qed. Definition coprimep p q := size (gcdp p q) == 1%N. Lemma coprimep_size_gcd p q : coprimep p q -> size (gcdp p q) = 1%N. Proof. by rewrite /coprimep=> /eqP. Qed. Lemma coprimep_def p q : coprimep p q = (size (gcdp p q) == 1%N). Proof. done. Qed. Lemma coprimepZl c m n : c != 0 -> coprimep (c *: m) n = coprimep m n. Proof. by move=> ?; rewrite !coprimep_def (eqp_size (gcdp_scalel _ _ _)). Qed. Lemma coprimepZr c m n: c != 0 -> coprimep m (c *: n) = coprimep m n. Proof. by move=> ?; rewrite !coprimep_def (eqp_size (gcdp_scaler _ _ _)). Qed. Lemma coprimepp p : coprimep p p = (size p == 1%N). Proof. by rewrite coprimep_def gcdpp. Qed. Lemma gcdp_eqp1 p q : gcdp p q %= 1 = coprimep p q. Proof. by rewrite coprimep_def size_poly_eq1. Qed. Lemma coprimep_sym p q : coprimep p q = coprimep q p. Proof. by rewrite -!gcdp_eqp1; apply: eqp_ltrans; rewrite gcdpC. Qed. Lemma coprime1p p : coprimep 1 p. Proof. by rewrite /coprimep -[1%N](size_poly1 R); exact/eqP/eqp_size/gcd1p. Qed. Lemma coprimep1 p : coprimep p 1. Proof. by rewrite coprimep_sym; apply: coprime1p. Qed. Lemma coprimep0 p : coprimep p 0 = (p %= 1). Proof. by rewrite /coprimep gcdp0 size_poly_eq1. Qed. Lemma coprime0p p : coprimep 0 p = (p %= 1). Proof. by rewrite coprimep_sym coprimep0. Qed. (* This is different from coprimeP in div. shall we keep this? *) Lemma coprimepP p q : reflect (forall d, d %| p -> d %| q -> d %= 1) (coprimep p q). Proof. rewrite /coprimep; apply: (iffP idP) => [/eqP hs d dvddp dvddq | h]. have/dvdp_eqp1: d %| gcdp p q by rewrite dvdp_gcd dvddp dvddq. by rewrite -size_poly_eq1 hs; exact. by rewrite size_poly_eq1; case/andP: (dvdp_gcdlr p q); apply: h. Qed. Lemma coprimepPn p q : p != 0 -> reflect (exists d, (d %| gcdp p q) && ~~ (d %= 1)) (~~ coprimep p q). Proof. move=> p0; apply: (iffP idP). by rewrite -gcdp_eqp1=> ng1; exists (gcdp p q); rewrite dvdpp /=. case=> d /andP [dg]; apply: contra; rewrite -gcdp_eqp1=> g1. by move: dg; rewrite (eqp_dvdr _ g1) dvdp1 size_poly_eq1. Qed. Lemma coprimep_dvdl q p r : r %| q -> coprimep p q -> coprimep p r. Proof. move=> rp /coprimepP cpq'; apply/coprimepP => d dp dr. exact/cpq'/(dvdp_trans dr). Qed. Lemma coprimep_dvdr p q r : r %| p -> coprimep p q -> coprimep r q. Proof. by move=> rp; rewrite ![coprimep _ q]coprimep_sym; apply/coprimep_dvdl. Qed. Lemma coprimep_modl p q : coprimep (p %% q) q = coprimep p q. Proof. rewrite !coprimep_def [in RHS]gcdpE. by case: ltnP => // hpq; rewrite modp_small // gcdpE hpq. Qed. Lemma coprimep_modr q p : coprimep q (p %% q) = coprimep q p. Proof. by rewrite ![coprimep q _]coprimep_sym coprimep_modl. Qed. Lemma rcoprimep_coprimep q p : rcoprimep q p = coprimep q p. Proof. by rewrite /coprimep /rcoprimep (eqp_size (eqp_rgcd_gcd _ _)). Qed. Lemma eqp_coprimepr p q r : q %= r -> coprimep p q = coprimep p r. Proof. by rewrite -!gcdp_eqp1; move/(eqp_gcdr p)/eqp_ltrans. Qed. Lemma eqp_coprimepl p q r : q %= r -> coprimep q p = coprimep r p. Proof. by rewrite !(coprimep_sym _ p); apply: eqp_coprimepr. Qed. (* This should be implemented with an extended remainder sequence *) Fixpoint egcdp_rec p q k {struct k} : {poly R} * {poly R} := if k is k'.+1 then if q == 0 then (1, 0) else let: (u, v) := egcdp_rec q (p %% q) k' in (lead_coef q ^+ scalp p q *: v, (u - v * (p %/ q))) else (1, 0). Definition egcdp p q := if size q <= size p then egcdp_rec p q (size q) else let e := egcdp_rec q p (size p) in (e.2, e.1). (* No provable egcd0p *) Lemma egcdp0 p : egcdp p 0 = (1, 0). Proof. by rewrite /egcdp size_poly0. Qed. Lemma egcdp_recP : forall k p q, q != 0 -> size q <= k -> size q <= size p -> let e := (egcdp_rec p q k) in [/\ size e.1 <= size q, size e.2 <= size p & gcdp p q %= e.1 * p + e.2 * q]. Proof. elim=> [|k ihk] p q /= qn0; first by rewrite size_poly_leq0 (negPf qn0). move=> sqSn qsp; rewrite (negPf qn0). have sp : size p > 0 by apply: leq_trans qsp; rewrite size_poly_gt0. have [r0 | rn0] /= := eqVneq (p %%q) 0. rewrite r0 /egcdp_rec; case: k ihk sqSn => [|n] ihn sqSn /=. rewrite !scaler0 !mul0r subr0 add0r mul1r size_poly0 size_poly1. by rewrite dvdp_gcd_idr /dvdp ?r0. rewrite !eqxx mul0r scaler0 /= mul0r add0r subr0 mul1r size_poly0 size_poly1. by rewrite dvdp_gcd_idr /dvdp ?r0 //. have h1 : size (p %% q) <= k. by rewrite -ltnS; apply: leq_trans sqSn; rewrite ltn_modp. have h2 : size (p %% q) <= size q by rewrite ltnW // ltn_modp. have := ihk q (p %% q) rn0 h1 h2. case: (egcdp_rec _ _)=> u v /= => [[ihn'1 ihn'2 ihn'3]]. rewrite gcdpE ltnNge qsp //= (eqp_ltrans (gcdpC _ _)); split; last first. - apply: (eqp_trans ihn'3). rewrite mulrBl addrCA -scalerAl scalerAr -mulrA -mulrBr. by rewrite divp_eq addrAC subrr add0r eqpxx. - apply: (leq_trans (size_add _ _)). have [-> | vn0] := eqVneq v 0. rewrite mul0r size_opp size_poly0 maxn0; apply: leq_trans ihn'1 _. exact: leq_modp. have [-> | qqn0] := eqVneq (p %/ q) 0. rewrite mulr0 size_opp size_poly0 maxn0; apply: leq_trans ihn'1 _. exact: leq_modp. rewrite geq_max (leq_trans ihn'1) ?leq_modp //= size_opp size_mul //. move: (ihn'2); rewrite (polySpred vn0) (polySpred qn0). rewrite -(ltn_add2r (size (p %/ q))) !addSn /= ltnS; move/leq_trans; apply. rewrite size_divp // addnBA ?addKn //. by apply: leq_trans qsp; apply: leq_pred. - by rewrite size_scale // lc_expn_scalp_neq0. Qed. Lemma egcdpP p q : p != 0 -> q != 0 -> forall (e := egcdp p q), [/\ size e.1 <= size q, size e.2 <= size p & gcdp p q %= e.1 * p + e.2 * q]. Proof. rewrite /egcdp => pn0 qn0; case: (leqP (size q) (size p)) => /= [|/ltnW] hp. exact: egcdp_recP. case: (egcdp_recP pn0 (leqnn (size p)) hp) => h1 h2 h3; split => //. by rewrite (eqp_ltrans (gcdpC _ _)) addrC. Qed. Lemma egcdpE p q (e := egcdp p q) : gcdp p q %= e.1 * p + e.2 * q. Proof. rewrite {}/e; have [-> /= | qn0] := eqVneq q 0. by rewrite gcdp0 egcdp0 mul1r mulr0 addr0. have [-> | pn0] := eqVneq p 0; last by case: (egcdpP pn0 qn0). by rewrite gcd0p /egcdp size_poly0 size_poly_leq0 (negPf qn0) /= !simp. Qed. Lemma Bezoutp p q : exists u, u.1 * p + u.2 * q %= (gcdp p q). Proof. have [-> | pn0] := eqVneq p 0. by rewrite gcd0p; exists (0, 1); rewrite mul0r mul1r add0r. have [-> | qn0] := eqVneq q 0. by rewrite gcdp0; exists (1, 0); rewrite mul0r mul1r addr0. pose e := egcdp p q; exists e; rewrite eqp_sym. by case: (egcdpP pn0 qn0). Qed. Lemma Bezout_coprimepP p q : reflect (exists u, u.1 * p + u.2 * q %= 1) (coprimep p q). Proof. rewrite -gcdp_eqp1; apply: (iffP idP)=> [g1|]. by case: (Bezoutp p q) => [[u v] Puv]; exists (u, v); apply: eqp_trans g1. case=> [[u v]]; rewrite eqp_sym=> Puv; rewrite /eqp (eqp_dvdr _ Puv). by rewrite dvdp_addr dvdp_mull ?dvdp_gcdl ?dvdp_gcdr //= dvd1p. Qed. Lemma coprimep_root p q x : coprimep p q -> root p x -> q.[x] != 0. Proof. case/Bezout_coprimepP=> [[u v] euv] px0. move/eqpP: euv => [[c1 c2]] /andP /= [c1n0 c2n0 e]. suffices: c1 * (v.[x] * q.[x]) != 0. by rewrite !mulf_eq0 !negb_or c1n0 /=; case/andP. have := f_equal (horner^~ x) e; rewrite /= !hornerZ hornerD. by rewrite !hornerM (eqP px0) mulr0 add0r hornerC mulr1; move->. Qed. Lemma Gauss_dvdpl p q d: coprimep d q -> (d %| p * q) = (d %| p). Proof. move/Bezout_coprimepP=>[[u v] Puv]; apply/idP/idP; last exact: dvdp_mulr. move/(eqp_mull p): Puv; rewrite mulr1 mulrDr eqp_sym=> peq dpq. rewrite (eqp_dvdr _ peq) dvdp_addr; first by rewrite mulrA mulrAC dvdp_mulr. by rewrite mulrA dvdp_mull ?dvdpp. Qed. Lemma Gauss_dvdpr p q d: coprimep d q -> (d %| q * p) = (d %| p). Proof. by rewrite mulrC; apply: Gauss_dvdpl. Qed. (* This could be simplified with the introduction of lcmp *) Lemma Gauss_dvdp m n p : coprimep m n -> (m * n %| p) = (m %| p) && (n %| p). Proof. have [-> | mn0] := eqVneq m 0. by rewrite coprime0p => /eqp_dvdl->; rewrite !mul0r dvd0p dvd1p andbT. have [-> | nn0] := eqVneq n 0. by rewrite coprimep0 => /eqp_dvdl->; rewrite !mulr0 dvd1p. move=> hc; apply/idP/idP => [mnmp | /andP [dmp dnp]]. move/Gauss_dvdpl: hc => <-; move: (dvdp_mull m mnmp); rewrite dvdp_mul2l //. move->; move: (dvdp_mulr n mnmp); rewrite dvdp_mul2r // andbT. exact: dvdp_mulr. move: (dnp); rewrite dvdp_eq. set c2 := _ ^+ _; set q2 := _ %/ _; move/eqP=> e2. have/esym := Gauss_dvdpl q2 hc; rewrite -e2. have -> : m %| c2 *: p by rewrite -mul_polyC dvdp_mull. rewrite dvdp_eq; set c3 := _ ^+ _; set q3 := _ %/ _; move/eqP=> e3. apply: (@eq_dvdp (c3 * c2) q3). by rewrite mulf_neq0 // expf_neq0 // lead_coef_eq0. by rewrite mulrA -e3 -scalerAl -e2 scalerA. Qed. Lemma Gauss_gcdpr p m n : coprimep p m -> gcdp p (m * n) %= gcdp p n. Proof. move=> co_pm; apply/eqP; rewrite /eqp !dvdp_gcd !dvdp_gcdl /= andbC. rewrite dvdp_mull ?dvdp_gcdr // -(@Gauss_dvdpl _ m). by rewrite mulrC dvdp_gcdr. apply/coprimepP=> d; rewrite dvdp_gcd; case/andP=> hdp _ hdm. by move/coprimepP: co_pm; apply. Qed. Lemma Gauss_gcdpl p m n : coprimep p n -> gcdp p (m * n) %= gcdp p m. Proof. by move=> co_pn; rewrite mulrC Gauss_gcdpr. Qed. Lemma coprimepMr p q r : coprimep p (q * r) = (coprimep p q && coprimep p r). Proof. apply/coprimepP/andP=> [hp | [/coprimepP-hq hr]]. by split; apply/coprimepP=> d dp dq; rewrite hp //; [apply/dvdp_mulr | apply/dvdp_mull]. move=> d dp dqr; move/(_ _ dp) in hq. rewrite Gauss_dvdpl in dqr; first exact: hq. by move/coprimep_dvdr: hr; apply. Qed. Lemma coprimepMl p q r: coprimep (q * r) p = (coprimep q p && coprimep r p). Proof. by rewrite ![coprimep _ p]coprimep_sym coprimepMr. Qed. Lemma modp_coprime k u n : k != 0 -> (k * u) %% n %= 1 -> coprimep k n. Proof. move=> kn0 hmod; apply/Bezout_coprimepP. exists (((lead_coef n)^+(scalp (k * u) n) *: u), (- (k * u %/ n))). rewrite -scalerAl mulrC (divp_eq (u * k) n) mulNr -addrAC subrr add0r. by rewrite mulrC. Qed. Lemma coprimep_pexpl k m n : 0 < k -> coprimep (m ^+ k) n = coprimep m n. Proof. case: k => // k _; elim: k => [|k IHk]; first by rewrite expr1. by rewrite exprS coprimepMl -IHk andbb. Qed. Lemma coprimep_pexpr k m n : 0 < k -> coprimep m (n ^+ k) = coprimep m n. Proof. by move=> k_gt0; rewrite !(coprimep_sym m) coprimep_pexpl. Qed. Lemma coprimep_expl k m n : coprimep m n -> coprimep (m ^+ k) n. Proof. by case: k => [|k] co_pm; rewrite ?coprime1p // coprimep_pexpl. Qed. Lemma coprimep_expr k m n : coprimep m n -> coprimep m (n ^+ k). Proof. by rewrite !(coprimep_sym m); apply: coprimep_expl. Qed. Lemma gcdp_mul2l p q r : gcdp (p * q) (p * r) %= (p * gcdp q r). Proof. have [->|hp] := eqVneq p 0; first by rewrite !mul0r gcdp0 eqpxx. rewrite /eqp !dvdp_gcd !dvdp_mul2l // dvdp_gcdr dvdp_gcdl !andbT. move: (Bezoutp q r) => [[u v]] huv. rewrite eqp_sym in huv; rewrite (eqp_dvdr _ (eqp_mull _ huv)). rewrite mulrDr ![p * (_ * _)]mulrCA. by apply: dvdp_add; rewrite dvdp_mull// (dvdp_gcdr, dvdp_gcdl). Qed. Lemma gcdp_mul2r q r p : gcdp (q * p) (r * p) %= gcdp q r * p. Proof. by rewrite ![_ * p]mulrC gcdp_mul2l. Qed. Lemma mulp_gcdr p q r : r * (gcdp p q) %= gcdp (r * p) (r * q). Proof. by rewrite eqp_sym gcdp_mul2l. Qed. Lemma mulp_gcdl p q r : (gcdp p q) * r %= gcdp (p * r) (q * r). Proof. by rewrite eqp_sym gcdp_mul2r. Qed. Lemma coprimep_div_gcd p q : (p != 0) || (q != 0) -> coprimep (p %/ (gcdp p q)) (q %/ gcdp p q). Proof. rewrite -negb_and -gcdp_eq0 -gcdp_eqp1 => gpq0. rewrite -(@eqp_mul2r (gcdp p q)) // mul1r (eqp_ltrans (mulp_gcdl _ _ _)). have: gcdp p q %| p by rewrite dvdp_gcdl. have: gcdp p q %| q by rewrite dvdp_gcdr. rewrite !dvdp_eq => /eqP <- /eqP <-. have lcn0 k : (lead_coef (gcdp p q)) ^+ k != 0. by rewrite expf_neq0 ?lead_coef_eq0. by apply: eqp_gcd; rewrite ?eqp_scale. Qed. Lemma divp_eq0 p q : (p %/ q == 0) = [|| p == 0, q ==0 | size p < size q]. Proof. apply/eqP/idP=> [d0|]; last first. case/or3P; [by move/eqP->; rewrite div0p| by move/eqP->; rewrite divp0|]. by move/divp_small. case: eqVneq => // _; case: eqVneq => // qn0. move: (divp_eq p q); rewrite d0 mul0r add0r. move/(f_equal (fun x : {poly R} => size x)). by rewrite size_scale ?lc_expn_scalp_neq0 // => ->; rewrite ltn_modp qn0 !orbT. Qed. Lemma dvdp_div_eq0 p q : q %| p -> (p %/ q == 0) = (p == 0). Proof. move=> dvdp_qp; have [->|p_neq0] := eqVneq p 0; first by rewrite div0p eqxx. rewrite divp_eq0 ltnNge dvdp_leq // (negPf p_neq0) orbF /=. by apply: contraTF dvdp_qp=> /eqP ->; rewrite dvd0p. Qed. Lemma Bezout_coprimepPn p q : p != 0 -> q != 0 -> reflect (exists2 uv : {poly R} * {poly R}, (0 < size uv.1 < size q) && (0 < size uv.2 < size p) & uv.1 * p = uv.2 * q) (~~ (coprimep p q)). Proof. move=> pn0 qn0; apply: (iffP idP); last first. case=> [[u v] /= /andP [/andP [ps1 s1] /andP [ps2 s2]] e]. have: ~~(size (q * p) <= size (u * p)). rewrite -ltnNge !size_mul // -?size_poly_gt0 // (polySpred pn0) !addnS. by rewrite ltn_add2r. apply: contra => ?; apply: dvdp_leq; rewrite ?mulf_neq0 // -?size_poly_gt0 //. by rewrite mulrC Gauss_dvdp // dvdp_mull // e dvdp_mull. rewrite coprimep_def neq_ltn ltnS size_poly_leq0 gcdp_eq0. rewrite (negPf pn0) (negPf qn0) /=. case sg: (size (gcdp p q)) => [|n] //; case: n sg=> [|n] // sg _. move: (dvdp_gcdl p q); rewrite dvdp_eq; set c1 := _ ^+ _; move/eqP=> hu1. move: (dvdp_gcdr p q); rewrite dvdp_eq; set c2 := _ ^+ _; move/eqP=> hv1. exists (c1 *: (q %/ gcdp p q), c2 *: (p %/ gcdp p q)); last first. by rewrite -!scalerAl !scalerAr hu1 hv1 mulrCA. rewrite !size_scale ?lc_expn_scalp_neq0 //= !size_poly_gt0 !divp_eq0. rewrite gcdp_eq0 !(negPf pn0) !(negPf qn0) /= -!leqNgt leq_gcdpl //. rewrite leq_gcdpr //= !ltn_divpl -?size_poly_eq0 ?sg //. rewrite !size_mul // -?size_poly_eq0 ?sg // ![(_ + n.+2)%N]addnS /=. by rewrite -!(addn1 (size _)) !leq_add2l. Qed. Lemma dvdp_pexp2r m n k : k > 0 -> (m ^+ k %| n ^+ k) = (m %| n). Proof. move=> k_gt0; apply/idP/idP; last exact: dvdp_exp2r. have [-> // | nn0] := eqVneq n 0; have [-> | mn0] := eqVneq m 0. move/prednK: k_gt0=> {1}<-; rewrite exprS mul0r //= !dvd0p expf_eq0. by case/andP=> _ ->. set d := gcdp m n; have := dvdp_gcdr m n; rewrite -/d dvdp_eq. set c1 := _ ^+ _; set n' := _ %/ _; move/eqP=> def_n. have := dvdp_gcdl m n; rewrite -/d dvdp_eq. set c2 := _ ^+ _; set m' := _ %/ _; move/eqP=> def_m. have dn0 : d != 0 by rewrite gcdp_eq0 negb_and nn0 orbT. have c1n0 : c1 != 0 by rewrite !expf_neq0 // lead_coef_eq0. have c2n0 : c2 != 0 by rewrite !expf_neq0 // lead_coef_eq0. have c2k_n0 : c2 ^+ k != 0 by rewrite !expf_neq0 // lead_coef_eq0. rewrite -(@dvdpZr (c1 ^+ k)) ?expf_neq0 ?lead_coef_eq0 //. rewrite -(@dvdpZl (c2 ^+ k)) // -!exprZn def_m def_n !exprMn. rewrite dvdp_mul2r ?expf_neq0 //. have: coprimep (m' ^+ k) (n' ^+ k). by rewrite coprimep_pexpl // coprimep_pexpr // coprimep_div_gcd ?mn0. move/coprimepP=> hc hd. have /size_poly1P [c cn0 em'] : size m' == 1%N. case: (eqVneq m' 0) def_m => [-> /eqP | m'_n0 def_m]. by rewrite mul0r scale_poly_eq0 (negPf mn0) (negPf c2n0). have := hc _ (dvdpp _) hd; rewrite -size_poly_eq1. rewrite polySpred; last by rewrite expf_eq0 negb_and m'_n0 orbT. by rewrite size_exp eqSS muln_eq0 orbC eqn0Ngt k_gt0 /= -eqSS -polySpred. rewrite -(@dvdpZl c2) // def_m em' mul_polyC dvdpZl //. by rewrite -(@dvdpZr c1) // def_n dvdp_mull. Qed. Lemma root_gcd p q x : root (gcdp p q) x = root p x && root q x. Proof. rewrite /= !root_factor_theorem; apply/idP/andP=> [dg| [dp dq]]. by split; apply: dvdp_trans dg _; rewrite ?(dvdp_gcdl, dvdp_gcdr). have:= Bezoutp p q => [[[u v]]]; rewrite eqp_sym=> e. by rewrite (eqp_dvdr _ e) dvdp_addl dvdp_mull. Qed. Lemma root_biggcd x (ps : seq {poly R}) : root (\big[gcdp/0]_(p <- ps) p) x = all (fun p => root p x) ps. Proof. elim: ps => [|p ps ihp]; first by rewrite big_nil root0. by rewrite big_cons /= root_gcd ihp. Qed. (* "gdcop Q P" is the Greatest Divisor of P which is coprime to Q *) (* if P null, we pose that gdcop returns 1 if Q null, 0 otherwise*) Fixpoint gdcop_rec q p k := if k is m.+1 then if coprimep p q then p else gdcop_rec q (divp p (gcdp p q)) m else (q == 0)%:R. Definition gdcop q p := gdcop_rec q p (size p). Variant gdcop_spec q p : {poly R} -> Type := GdcopSpec r of (dvdp r p) & ((coprimep r q) || (p == 0)) & (forall d, dvdp d p -> coprimep d q -> dvdp d r) : gdcop_spec q p r. Lemma gdcop0 q : gdcop q 0 = (q == 0)%:R. Proof. by rewrite /gdcop size_poly0. Qed. Lemma gdcop_recP q p k : size p <= k -> gdcop_spec q p (gdcop_rec q p k). Proof. elim: k p => [p | k ihk p] /=. move/size_poly_leq0P->. have [->|q0] := eqVneq; split; rewrite ?coprime1p // ?eqxx ?orbT //. by move=> d _; rewrite coprimep0 dvdp1 size_poly_eq1. move=> hs; case cop : (coprimep _ _); first by split; rewrite ?dvdpp ?cop. have [-> | p0] := eqVneq p 0. by rewrite div0p; apply: ihk; rewrite size_poly0 leq0n. have [-> | q0] := eqVneq q 0. rewrite gcdp0 divpp ?p0 //= => {hs ihk}; case: k=> /=. rewrite eqxx; split; rewrite ?dvd1p ?coprimep0 ?eqpxx //=. by move=> d _; rewrite coprimep0 dvdp1 size_poly_eq1. move=> n; rewrite coprimep0 polyC_eqp1 //; rewrite lc_expn_scalp_neq0. split; first by rewrite (@eqp_dvdl 1) ?dvd1p // polyC_eqp1 lc_expn_scalp_neq0. by rewrite coprimep0 polyC_eqp1 // ?lc_expn_scalp_neq0. by move=> d _; rewrite coprimep0; move/eqp_dvdl->; rewrite dvd1p. move: (dvdp_gcdl p q); rewrite dvdp_eq; move/eqP=> e. have sgp : size (gcdp p q) <= size p. by apply: dvdp_leq; rewrite ?gcdp_eq0 ?p0 ?q0 // dvdp_gcdl. have : p %/ gcdp p q != 0; last move/negPf=>p'n0. apply: dvdpN0 (dvdp_mulIl (p %/ gcdp p q) (gcdp p q)) _. by rewrite -e scale_poly_eq0 negb_or lc_expn_scalp_neq0. have gn0 : gcdp p q != 0. apply: dvdpN0 (dvdp_mulIr (p %/ gcdp p q) (gcdp p q)) _. by rewrite -e scale_poly_eq0 negb_or lc_expn_scalp_neq0. have sp' : size (p %/ (gcdp p q)) <= k. rewrite size_divp ?sgp // leq_subLR (leq_trans hs) // -add1n leq_add2r -subn1. by rewrite ltn_subRL add1n ltn_neqAle eq_sym [_ == _]cop size_poly_gt0 gn0. case (ihk _ sp')=> r' dr'p'; first rewrite p'n0 orbF=> cr'q maxr'. constructor=> //=; rewrite ?(negPf p0) ?orbF //. exact/(dvdp_trans dr'p')/divp_dvd/dvdp_gcdl. move=> d dp cdq; apply: maxr'; last by rewrite cdq. case dpq: (d %| gcdp p q). move: (dpq); rewrite dvdp_gcd dp /= => dq; apply: dvdUp. apply: contraLR cdq => nd1; apply/coprimepPn; last first. by exists d; rewrite dvdp_gcd dvdpp dq nd1. by apply: contraNneq p0 => d0; move: dp; rewrite d0 dvd0p. apply: contraLR dp => ndp'. rewrite (@eqp_dvdr ((lead_coef (gcdp p q) ^+ scalp p (gcdp p q))*:p)). by rewrite e; rewrite Gauss_dvdpl //; apply: (coprimep_dvdl (dvdp_gcdr _ _)). by rewrite eqp_sym eqp_scale // lc_expn_scalp_neq0. Qed. Lemma gdcopP q p : gdcop_spec q p (gdcop q p). Proof. by rewrite /gdcop; apply: gdcop_recP. Qed. Lemma coprimep_gdco p q : (q != 0)%B -> coprimep (gdcop p q) p. Proof. by move=> q_neq0; case: gdcopP=> d; rewrite (negPf q_neq0) orbF. Qed. Lemma size2_dvdp_gdco p q d : p != 0 -> size d = 2%N -> (d %| (gdcop q p)) = (d %| p) && ~~(d %| q). Proof. have [-> | dn0] := eqVneq d 0; first by rewrite size_poly0. move=> p0 sd; apply/idP/idP. case: gdcopP=> r rp crq maxr dr; move/negPf: (p0)=> p0f. rewrite (dvdp_trans dr) //=. apply: contraL crq => dq; rewrite p0f orbF; apply/coprimepPn. by apply: contraNneq p0 => r0; move: rp; rewrite r0 dvd0p. by exists d; rewrite dvdp_gcd dr dq -size_poly_eq1 sd. case/andP=> dp dq; case: gdcopP=> r rp crq maxr; apply: maxr=> //. apply/coprimepP=> x xd xq. move: (dvdp_leq dn0 xd); rewrite leq_eqVlt sd; case/orP; last first. rewrite ltnS leq_eqVlt ltnS size_poly_leq0 orbC. case/predU1P => [x0|]; last by rewrite -size_poly_eq1. by move: xd; rewrite x0 dvd0p (negPf dn0). by rewrite -sd dvdp_size_eqp //; move/(eqp_dvdl q); rewrite xq (negPf dq). Qed. Lemma dvdp_gdco p q : (gdcop p q) %| q. Proof. by case: gdcopP. Qed. Lemma root_gdco p q x : p != 0 -> root (gdcop q p) x = root p x && ~~(root q x). Proof. move=> p0 /=; rewrite !root_factor_theorem. apply: size2_dvdp_gdco; rewrite ?p0 //. by rewrite size_addl size_polyX // size_opp size_polyC ltnS; case: (x != 0). Qed. Lemma dvdp_comp_poly r p q : (p %| q) -> (p \Po r) %| (q \Po r). Proof. have [-> | pn0] := eqVneq p 0. by rewrite comp_poly0 !dvd0p; move/eqP->; rewrite comp_poly0. rewrite dvdp_eq; set c := _ ^+ _; set s := _ %/ _; move/eqP=> Hq. apply: (@eq_dvdp c (s \Po r)); first by rewrite expf_neq0 // lead_coef_eq0. by rewrite -comp_polyZ Hq comp_polyM. Qed. Lemma gcdp_comp_poly r p q : gcdp p q \Po r %= gcdp (p \Po r) (q \Po r). Proof. apply/andP; split. by rewrite dvdp_gcd !dvdp_comp_poly ?dvdp_gcdl ?dvdp_gcdr. case: (Bezoutp p q) => [[u v]] /andP []. move/(dvdp_comp_poly r) => Huv _. rewrite (dvdp_trans _ Huv) // comp_polyD !comp_polyM. by rewrite dvdp_add // dvdp_mull // (dvdp_gcdl,dvdp_gcdr). Qed. Lemma coprimep_comp_poly r p q : coprimep p q -> coprimep (p \Po r) (q \Po r). Proof. rewrite -!gcdp_eqp1 -!size_poly_eq1 -!dvdp1; move/(dvdp_comp_poly r). rewrite comp_polyC => Hgcd. by apply: dvdp_trans Hgcd; case/andP: (gcdp_comp_poly r p q). Qed. Lemma coprimep_addl_mul p q r : coprimep r (p * r + q) = coprimep r q. Proof. by rewrite !coprimep_def (eqp_size (gcdp_addl_mul _ _ _)). Qed. Definition irreducible_poly p := (size p > 1) * (forall q, size q != 1%N -> q %| p -> q %= p) : Prop. Lemma irredp_neq0 p : irreducible_poly p -> p != 0. Proof. by rewrite -size_poly_gt0 => [[/ltnW]]. Qed. Definition apply_irredp p (irr_p : irreducible_poly p) := irr_p.2. Coercion apply_irredp : irreducible_poly >-> Funclass. Lemma modp_XsubC p c : p %% ('X - c%:P) = p.[c]%:P. Proof. have/factor_theorem [q /(canRL (subrK _)) Dp]: root (p - p.[c]%:P) c. by rewrite /root !hornerE subrr. rewrite modpE /= lead_coefXsubC unitr1 expr1n invr1 scale1r [in LHS]Dp. rewrite RingMonic.rmodp_addl_mul_small // ?monicXsubC // size_XsubC size_polyC. by case: (p.[c] == 0). Qed. Lemma coprimep_XsubC p c : coprimep p ('X - c%:P) = ~~ root p c. Proof. rewrite -coprimep_modl modp_XsubC /root -alg_polyC. have [-> | /coprimepZl->] := eqVneq; last exact: coprime1p. by rewrite scale0r /coprimep gcd0p size_XsubC. Qed. Lemma coprimepX p : coprimep p 'X = ~~ root p 0. Proof. by rewrite -['X]subr0 coprimep_XsubC. Qed. Lemma eqp_monic : {in monic &, forall p q, (p %= q) = (p == q)}. Proof. move=> p q monic_p monic_q; apply/idP/eqP=> [|-> //]. case/eqpP=> [[a b] /= /andP[a_neq0 _] eq_pq]. apply: (@mulfI _ a%:P); first by rewrite polyC_eq0. rewrite !mul_polyC eq_pq; congr (_ *: q); apply: (mulIf (oner_neq0 _)). by rewrite -[in LHS](monicP monic_q) -(monicP monic_p) -!lead_coefZ eq_pq. Qed. Lemma dvdp_mul_XsubC p q c : (p %| ('X - c%:P) * q) = ((if root p c then p %/ ('X - c%:P) else p) %| q). Proof. case: ifPn => [| not_pc0]; last by rewrite Gauss_dvdpr ?coprimep_XsubC. rewrite root_factor_theorem -eqp_div_XsubC mulrC => /eqP{1}->. by rewrite dvdp_mul2l ?polyXsubC_eq0. Qed. Lemma dvdp_prod_XsubC (I : Type) (r : seq I) (F : I -> R) p : p %| \prod_(i <- r) ('X - (F i)%:P) -> {m | p %= \prod_(i <- mask m r) ('X - (F i)%:P)}. Proof. elim: r => [|i r IHr] in p *. by rewrite big_nil dvdp1; exists nil; rewrite // big_nil -size_poly_eq1. rewrite big_cons dvdp_mul_XsubC root_factor_theorem -eqp_div_XsubC. case: eqP => [{2}-> | _] /IHr[m Dp]; last by exists (false :: m). by exists (true :: m); rewrite /= mulrC big_cons eqp_mul2l ?polyXsubC_eq0. Qed. Lemma irredp_XsubC (x : R) : irreducible_poly ('X - x%:P). Proof. split=> [|d size_d d_dv_Xx]; first by rewrite size_XsubC. have: ~ d %= 1 by apply/negP; rewrite -size_poly_eq1. have [|m /=] := @dvdp_prod_XsubC _ [:: x] id d; first by rewrite big_seq1. by case: m => [|[] [|_ _] /=]; rewrite (big_nil, big_seq1). Qed. Lemma irredp_XsubCP d p : irreducible_poly p -> d %| p -> {d %= 1} + {d %= p}. Proof. move=> irred_p dvd_dp; have [] := boolP (_ %= 1); first by left. by rewrite -size_poly_eq1=> /irred_p /(_ dvd_dp); right. Qed. End IDomainPseudoDivision. Hint Resolve eqpxx divp0 divp1 mod0p modp0 modp1 dvdp_mull dvdp_mulr dvdpp : core. Hint Resolve dvdp0 : core. Notation "@ 'dvdp_scalel'" := (deprecate dvdp_scalel dvdpZl) (at level 10, only parsing) : fun_scope. Notation "@ 'dvdp_scaler'" := (deprecate dvdp_scaler dvdpZr) (at level 10, only parsing) : fun_scope. Notation "@ 'dvdp_opp'" := (deprecate dvdp_opp dvdpNr) (at level 10, only parsing) : fun_scope. Notation "@ 'coprimep_scalel'" := (deprecate coprimep_scalel coprimepZl) (at level 10, only parsing) : fun_scope. Notation "@ 'coprimep_scaler'" := (deprecate coprimep_scaler coprimepZr) (at level 10, only parsing) : fun_scope. Notation "@ 'coprimep_mull'" := (deprecate coprimep_mull coprimepMl) (at level 10, only parsing) : fun_scope. Notation "@ 'coprimep_mulr'" := (deprecate coprimep_mulr coprimepMr) (at level 10, only parsing) : fun_scope. Notation dvdp_scalel := (@dvdp_scalel _ _) (only parsing). Notation dvdp_scaler := (@dvdp_scaler _ _) (only parsing). Notation dvdp_opp := (@dvdp_opp _) (only parsing). Notation coprimep_scalel := (@coprimep_scalel _ _) (only parsing). Notation coprimep_scaler := (@coprimep_scaler _ _) (only parsing). Notation coprimep_mull := (@coprimep_mull _) (only parsing). Notation coprimep_mulr := (@coprimep_mulr _) (only parsing). End CommonIdomain. Module Idomain. Include IdomainDefs. Export IdomainDefs. Include WeakIdomain. Include CommonIdomain. End Idomain. Module IdomainMonic. Import Ring ComRing UnitRing IdomainDefs Idomain. Section MonicDivisor. Variable R : idomainType. Variable q : {poly R}. Hypothesis monq : q \is monic. Implicit Type p d r : {poly R}. Lemma divpE p : p %/ q = rdivp p q. Proof. by rewrite divpE (eqP monq) unitr1 expr1n invr1 scale1r. Qed. Lemma modpE p : p %% q = rmodp p q. Proof. by rewrite modpE (eqP monq) unitr1 expr1n invr1 scale1r. Qed. Lemma scalpE p : scalp p q = 0%N. Proof. by rewrite scalpE (eqP monq) unitr1. Qed. Lemma divp_eq p : p = (p %/ q) * q + (p %% q). Proof. by rewrite -divp_eq (eqP monq) expr1n scale1r. Qed. Lemma divpp p : q %/ q = 1. Proof. by rewrite divpp ?monic_neq0 // (eqP monq) expr1n. Qed. Lemma dvdp_eq p : (q %| p) = (p == (p %/ q) * q). Proof. by rewrite dvdp_eq (eqP monq) expr1n scale1r. Qed. Lemma dvdpP p : reflect (exists qq, p = qq * q) (q %| p). Proof. apply: (iffP idP); first by rewrite dvdp_eq; move/eqP=> e; exists (p %/ q). by case=> qq ->; rewrite dvdp_mull // dvdpp. Qed. Lemma mulpK p : p * q %/ q = p. Proof. by rewrite mulpK ?monic_neq0 // (eqP monq) expr1n scale1r. Qed. Lemma mulKp p : q * p %/ q = p. Proof. by rewrite mulrC mulpK. Qed. End MonicDivisor. End IdomainMonic. Module IdomainUnit. Import Ring ComRing UnitRing IdomainDefs Idomain. Section UnitDivisor. Variable R : idomainType. Variable d : {poly R}. Hypothesis ulcd : lead_coef d \in GRing.unit. Implicit Type p q r : {poly R}. Lemma divp_eq p : p = (p %/ d) * d + (p %% d). Proof. by have := divp_eq p d; rewrite scalpE ulcd expr0 scale1r. Qed. Lemma edivpP p q r : p = q * d + r -> size r < size d -> q = (p %/ d) /\ r = p %% d. Proof. move=> ep srd; have := divp_eq p; rewrite [LHS]ep. move/eqP; rewrite -subr_eq -addrA addrC eq_sym -subr_eq -mulrBl; move/eqP. have lcdn0 : lead_coef d != 0 by apply: contraTneq ulcd => ->; rewrite unitr0. have [-> /esym /eqP|abs] := eqVneq (p %/ d) q. by rewrite subrr mul0r subr_eq0 => /eqP<-. have hleq : size d <= size ((p %/ d - q) * d). rewrite size_proper_mul; last first. by rewrite mulf_eq0 (negPf lcdn0) orbF lead_coef_eq0 subr_eq0. by move: abs; rewrite -subr_eq0; move/polySpred->; rewrite addSn /= leq_addl. have hlt : size (r - p %% d) < size d. apply: leq_ltn_trans (size_add _ _) _. by rewrite gtn_max srd size_opp ltn_modp -lead_coef_eq0. by move=> e; have:= leq_trans hlt hleq; rewrite e ltnn. Qed. Lemma divpP p q r : p = q * d + r -> size r < size d -> q = (p %/ d). Proof. by move/edivpP=> h; case/h. Qed. Lemma modpP p q r : p = q * d + r -> size r < size d -> r = (p %% d). Proof. by move/edivpP=> h; case/h. Qed. Lemma ulc_eqpP p q : lead_coef q \is a GRing.unit -> reflect (exists2 c : R, c != 0 & p = c *: q) (p %= q). Proof. have [->|] := eqVneq (lead_coef q) 0; first by rewrite unitr0. rewrite lead_coef_eq0 => nz_q ulcq; apply: (iffP idP). have [->|nz_p] := eqVneq p 0; first by rewrite eqp_sym eqp0 (negPf nz_q). move/eqp_eq=> eq; exists (lead_coef p / lead_coef q). by rewrite mulf_neq0 // ?invr_eq0 lead_coef_eq0. by apply/(scaler_injl ulcq); rewrite scalerA mulrCA divrr // mulr1. by case=> c nz_c ->; apply/eqpP; exists (1, c); rewrite ?scale1r ?oner_eq0. Qed. Lemma dvdp_eq p : (d %| p) = (p == p %/ d * d). Proof. apply/eqP/eqP=> [modp0 | ->]; last exact: modp_mull. by rewrite [p in LHS]divp_eq modp0 addr0. Qed. Lemma ucl_eqp_eq p q : lead_coef q \is a GRing.unit -> p %= q -> p = (lead_coef p / lead_coef q) *: q. Proof. move=> ulcq /eqp_eq; move/(congr1 ( *:%R (lead_coef q)^-1 )). by rewrite !scalerA mulrC divrr // scale1r mulrC. Qed. Lemma modpZl c p : (c *: p) %% d = c *: (p %% d). Proof. have [-> | cn0] := eqVneq c 0; first by rewrite !scale0r mod0p. have e : (c *: p) = (c *: (p %/ d)) * d + c *: (p %% d). by rewrite -scalerAl -scalerDr -divp_eq. suff s: size (c *: (p %% d)) < size d by case: (edivpP e s) => _ ->. rewrite -mul_polyC; apply: leq_ltn_trans (size_mul_leq _ _) _. rewrite size_polyC cn0 addSn add0n /= ltn_modp -lead_coef_eq0. by apply: contraTneq ulcd => ->; rewrite unitr0. Qed. Lemma divpZl c p : (c *: p) %/ d = c *: (p %/ d). Proof. have [-> | cn0] := eqVneq c 0; first by rewrite !scale0r div0p. have e : (c *: p) = (c *: (p %/ d)) * d + c *: (p %% d). by rewrite -scalerAl -scalerDr -divp_eq. suff s: size (c *: (p %% d)) < size d by case: (edivpP e s) => ->. rewrite -mul_polyC; apply: leq_ltn_trans (size_mul_leq _ _) _. rewrite size_polyC cn0 addSn add0n /= ltn_modp -lead_coef_eq0. by apply: contraTneq ulcd => ->; rewrite unitr0. Qed. Lemma eqp_modpl p q : p %= q -> (p %% d) %= (q %% d). Proof. case/eqpP=> [[c1 c2]] /andP /= [c1n0 c2n0 e]. by apply/eqpP; exists (c1, c2); rewrite ?c1n0 //= -!modpZl e. Qed. Lemma eqp_divl p q : p %= q -> (p %/ d) %= (q %/ d). Proof. case/eqpP=> [[c1 c2]] /andP /= [c1n0 c2n0 e]. by apply/eqpP; exists (c1, c2); rewrite ?c1n0 // -!divpZl e. Qed. Lemma modpN p : (- p) %% d = - (p %% d). Proof. by rewrite -mulN1r -[RHS]mulN1r -polyCN !mul_polyC modpZl. Qed. Lemma divpN p : (- p) %/ d = - (p %/ d). Proof. by rewrite -mulN1r -[RHS]mulN1r -polyCN !mul_polyC divpZl. Qed. Lemma modpD p q : (p + q) %% d = p %% d + q %% d. Proof. have/edivpP [] // : (p + q) = (p %/ d + q %/ d) * d + (p %% d + q %% d). by rewrite mulrDl addrACA -!divp_eq. apply: leq_ltn_trans (size_add _ _) _. rewrite gtn_max !ltn_modp andbb -lead_coef_eq0. by apply: contraTneq ulcd => ->; rewrite unitr0. Qed. Lemma divpD p q : (p + q) %/ d = p %/ d + q %/ d. Proof. have/edivpP [] // : (p + q) = (p %/ d + q %/ d) * d + (p %% d + q %% d). by rewrite mulrDl addrACA -!divp_eq. apply: leq_ltn_trans (size_add _ _) _. rewrite gtn_max !ltn_modp andbb -lead_coef_eq0. by apply: contraTneq ulcd => ->; rewrite unitr0. Qed. Lemma mulpK q : (q * d) %/ d = q. Proof. case/esym/edivpP: (addr0 (q * d)); rewrite // size_poly0 size_poly_gt0. by rewrite -lead_coef_eq0; apply: contraTneq ulcd => ->; rewrite unitr0. Qed. Lemma mulKp q : (d * q) %/ d = q. Proof. by rewrite mulrC; apply: mulpK. Qed. Lemma divp_addl_mul_small q r : size r < size d -> (q * d + r) %/ d = q. Proof. by move=> srd; rewrite divpD (divp_small srd) addr0 mulpK. Qed. Lemma modp_addl_mul_small q r : size r < size d -> (q * d + r) %% d = r. Proof. by move=> srd; rewrite modpD modp_mull add0r modp_small. Qed. Lemma divp_addl_mul q r : (q * d + r) %/ d = q + r %/ d. Proof. by rewrite divpD mulpK. Qed. Lemma divpp : d %/ d = 1. Proof. by rewrite -[d in d %/ _]mul1r mulpK. Qed. Lemma leq_trunc_divp m : size (m %/ d * d) <= size m. Proof. case: (eqVneq d 0) ulcd => [->|dn0 _]; first by rewrite lead_coef0 unitr0. have [->|q0] := eqVneq (m %/ d) 0; first by rewrite mul0r size_poly0 leq0n. rewrite {2}(divp_eq m) size_addl // size_mul // (polySpred q0) addSn /=. by rewrite ltn_addl // ltn_modp. Qed. Lemma dvdpP p : reflect (exists q, p = q * d) (d %| p). Proof. apply: (iffP idP) => [| [k ->]]; last by apply/eqP; rewrite modp_mull. by rewrite dvdp_eq; move/eqP->; exists (p %/ d). Qed. Lemma divpK p : d %| p -> p %/ d * d = p. Proof. by rewrite dvdp_eq; move/eqP. Qed. Lemma divpKC p : d %| p -> d * (p %/ d) = p. Proof. by move=> ?; rewrite mulrC divpK. Qed. Lemma dvdp_eq_div p q : d %| p -> (q == p %/ d) = (q * d == p). Proof. move/divpK=> {2}<-; apply/eqP/eqP; first by move->. apply/mulIf; rewrite -lead_coef_eq0; apply: contraTneq ulcd => ->. by rewrite unitr0. Qed. Lemma dvdp_eq_mul p q : d %| p -> (p == q * d) = (p %/ d == q). Proof. by move=> dv_d_p; rewrite eq_sym -dvdp_eq_div // eq_sym. Qed. Lemma divp_mulA p q : d %| q -> p * (q %/ d) = p * q %/ d. Proof. move=> hdm; apply/eqP; rewrite eq_sym -dvdp_eq_mul. by rewrite -mulrA divpK. by move/divpK: hdm<-; rewrite mulrA dvdp_mull // dvdpp. Qed. Lemma divp_mulAC m n : d %| m -> m %/ d * n = m * n %/ d. Proof. by move=> hdm; rewrite mulrC (mulrC m); apply: divp_mulA. Qed. Lemma divp_mulCA p q : d %| p -> d %| q -> p * (q %/ d) = q * (p %/ d). Proof. by move=> hdp hdq; rewrite mulrC divp_mulAC // divp_mulA. Qed. Lemma modp_mul p q : (p * (q %% d)) %% d = (p * q) %% d. Proof. by rewrite [q in RHS]divp_eq mulrDr modpD mulrA modp_mull add0r. Qed. End UnitDivisor. Section MoreUnitDivisor. Variable R : idomainType. Variable d : {poly R}. Hypothesis ulcd : lead_coef d \in GRing.unit. Implicit Types p q : {poly R}. Lemma expp_sub m n : n <= m -> (d ^+ (m - n))%N = d ^+ m %/ d ^+ n. Proof. by move/subnK=> {2}<-; rewrite exprD mulpK // lead_coef_exp unitrX. Qed. Lemma divp_pmul2l p q : lead_coef q \in GRing.unit -> d * p %/ (d * q) = p %/ q. Proof. move=> uq; rewrite {1}(divp_eq uq p) mulrDr mulrCA divp_addl_mul //; last first. by rewrite lead_coefM unitrM_comm ?ulcd //; red; rewrite mulrC. have dn0 : d != 0. by rewrite -lead_coef_eq0; apply: contraTneq ulcd => ->; rewrite unitr0. have qn0 : q != 0. by rewrite -lead_coef_eq0; apply: contraTneq uq => ->; rewrite unitr0. have dqn0 : d * q != 0 by rewrite mulf_eq0 negb_or dn0. suff : size (d * (p %% q)) < size (d * q). by rewrite ltnNge -divpN0 // negbK => /eqP ->; rewrite addr0. have [-> | rn0] := eqVneq (p %% q) 0. by rewrite mulr0 size_poly0 size_poly_gt0. by rewrite !size_mul // (polySpred dn0) !addSn /= ltn_add2l ltn_modp. Qed. Lemma divp_pmul2r p q : lead_coef p \in GRing.unit -> q * d %/ (p * d) = q %/ p. Proof. by move=> uq; rewrite -!(mulrC d) divp_pmul2l. Qed. Lemma divp_divl r p q : lead_coef r \in GRing.unit -> lead_coef p \in GRing.unit -> q %/ p %/ r = q %/ (p * r). Proof. move=> ulcr ulcp. have e : q = (q %/ p %/ r) * (p * r) + ((q %/ p) %% r * p + q %% p). by rewrite addrA (mulrC p) mulrA -mulrDl; rewrite -divp_eq //; apply: divp_eq. have pn0 : p != 0. by rewrite -lead_coef_eq0; apply: contraTneq ulcp => ->; rewrite unitr0. have rn0 : r != 0. by rewrite -lead_coef_eq0; apply: contraTneq ulcr => ->; rewrite unitr0. have s : size ((q %/ p) %% r * p + q %% p) < size (p * r). have [-> | qn0] := eqVneq ((q %/ p) %% r) 0. rewrite mul0r add0r size_mul // (polySpred rn0) addnS /=. by apply: leq_trans (leq_addr _ _); rewrite ltn_modp. rewrite size_addl mulrC. by rewrite !size_mul // (polySpred pn0) !addSn /= ltn_add2l ltn_modp. rewrite size_mul // (polySpred qn0) addnS /=. by apply: leq_trans (leq_addr _ _); rewrite ltn_modp. case: (edivpP _ e s) => //; rewrite lead_coefM unitrM_comm ?ulcp //. by red; rewrite mulrC. Qed. Lemma divpAC p q : lead_coef p \in GRing.unit -> q %/ d %/ p = q %/ p %/ d. Proof. by move=> ulcp; rewrite !divp_divl // mulrC. Qed. Lemma modpZr c p : c \in GRing.unit -> p %% (c *: d) = (p %% d). Proof. case: (eqVneq d 0) => [-> | dn0 cn0]; first by rewrite scaler0 !modp0. have e : p = (c^-1 *: (p %/ d)) * (c *: d) + (p %% d). by rewrite scalerCA scalerA mulVr // scale1r -(divp_eq ulcd). suff s : size (p %% d) < size (c *: d). by rewrite (modpP _ e s) // -mul_polyC lead_coefM lead_coefC unitrM cn0. by rewrite size_scale ?ltn_modp //; apply: contraTneq cn0 => ->; rewrite unitr0. Qed. Lemma divpZr c p : c \in GRing.unit -> p %/ (c *: d) = c^-1 *: (p %/ d). Proof. case: (eqVneq d 0) => [-> | dn0 cn0]; first by rewrite scaler0 !divp0 scaler0. have e : p = (c^-1 *: (p %/ d)) * (c *: d) + (p %% d). by rewrite scalerCA scalerA mulVr // scale1r -(divp_eq ulcd). suff s : size (p %% d) < size (c *: d). by rewrite (divpP _ e s) // -mul_polyC lead_coefM lead_coefC unitrM cn0. by rewrite size_scale ?ltn_modp //; apply: contraTneq cn0 => ->; rewrite unitr0. Qed. End MoreUnitDivisor. Notation "@ 'modp_scalel'" := (deprecate modp_scalel modpZl) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_scaler'" := (deprecate modp_scaler modpZr) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_opp'" := (deprecate modp_opp modpN) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_add'" := (deprecate modp_add modpD) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_scalel'" := (deprecate divp_scalel divpZl) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_scaler'" := (deprecate divp_scaler divpZr) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_opp'" := (deprecate divp_opp divpN) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_add'" := (deprecate divp_add divpD) (at level 10, only parsing) : fun_scope. Notation modp_scalel := (@modp_scalel _ _) (only parsing). Notation modp_scaler := (fun d_unit => @modp_scaler _ _ d_unit _) (only parsing). Notation modp_opp := (@modp_opp _ _) (only parsing). Notation modp_add := (@modp_add _ _) (only parsing). Notation divp_scalel := (@divp_scalel _ _) (only parsing). Notation divp_scaler := (fun d_unit => @divp_scaler _ _ d_unit _) (only parsing). Notation divp_opp := (@divp_opp _ _) (only parsing). Notation divp_add := (@divp_add _ _) (only parsing). End IdomainUnit. Module Field. Import Ring ComRing UnitRing. Include IdomainDefs. Export IdomainDefs. Include CommonIdomain. Section FieldDivision. Variable F : fieldType. Implicit Type p q r d : {poly F}. Lemma divp_eq p q : p = (p %/ q) * q + (p %% q). Proof. have [-> | qn0] := eqVneq q 0; first by rewrite modp0 mulr0 add0r. by apply: IdomainUnit.divp_eq; rewrite unitfE lead_coef_eq0. Qed. Lemma divp_modpP p q d r : p = q * d + r -> size r < size d -> q = (p %/ d) /\ r = p %% d. Proof. move=> he hs; apply: IdomainUnit.edivpP => //; rewrite unitfE lead_coef_eq0. by rewrite -size_poly_gt0; apply: leq_trans hs. Qed. Lemma divpP p q d r : p = q * d + r -> size r < size d -> q = (p %/ d). Proof. by move/divp_modpP=> h; case/h. Qed. Lemma modpP p q d r : p = q * d + r -> size r < size d -> r = (p %% d). Proof. by move/divp_modpP=> h; case/h. Qed. Lemma eqpfP p q : p %= q -> p = (lead_coef p / lead_coef q) *: q. Proof. have [->|nz_q] := eqVneq q 0; first by rewrite eqp0 scaler0 => /eqP ->. by apply/IdomainUnit.ucl_eqp_eq; rewrite unitfE lead_coef_eq0. Qed. Lemma dvdp_eq q p : (q %| p) = (p == p %/ q * q). Proof. have [-> | qn0] := eqVneq q 0; first by rewrite dvd0p mulr0 eq_sym. by apply: IdomainUnit.dvdp_eq; rewrite unitfE lead_coef_eq0. Qed. Lemma eqpf_eq p q : reflect (exists2 c, c != 0 & p = c *: q) (p %= q). Proof. apply: (iffP idP); last first. case=> c nz_c ->; apply/eqpP. by exists (1, c); rewrite ?scale1r ?oner_eq0. have [->|nz_q] := eqVneq q 0. by rewrite eqp0=> /eqP ->; exists 1; rewrite ?scale1r ?oner_eq0. case/IdomainUnit.ulc_eqpP; first by rewrite unitfE lead_coef_eq0. by move=> c nz_c ->; exists c. Qed. Lemma modpZl c p q : (c *: p) %% q = c *: (p %% q). Proof. have [-> | qn0] := eqVneq q 0; first by rewrite !modp0. by apply: IdomainUnit.modpZl; rewrite unitfE lead_coef_eq0. Qed. Lemma mulpK p q : q != 0 -> p * q %/ q = p. Proof. by move=> qn0; rewrite IdomainUnit.mulpK // unitfE lead_coef_eq0. Qed. Lemma mulKp p q : q != 0 -> q * p %/ q = p. Proof. by rewrite mulrC; apply: mulpK. Qed. Lemma divpZl c p q : (c *: p) %/ q = c *: (p %/ q). Proof. have [-> | qn0] := eqVneq q 0; first by rewrite !divp0 scaler0. by apply: IdomainUnit.divpZl; rewrite unitfE lead_coef_eq0. Qed. Lemma modpZr c p d : c != 0 -> p %% (c *: d) = (p %% d). Proof. case: (eqVneq d 0) => [-> | dn0 cn0]; first by rewrite scaler0 !modp0. have e : p = (c^-1 *: (p %/ d)) * (c *: d) + (p %% d). by rewrite scalerCA scalerA mulVf // scale1r -divp_eq. suff s : size (p %% d) < size (c *: d) by rewrite (modpP e s). by rewrite size_scale ?ltn_modp. Qed. Lemma divpZr c p d : c != 0 -> p %/ (c *: d) = c^-1 *: (p %/ d). Proof. case: (eqVneq d 0) => [-> | dn0 cn0]; first by rewrite scaler0 !divp0 scaler0. have e : p = (c^-1 *: (p %/ d)) * (c *: d) + (p %% d). by rewrite scalerCA scalerA mulVf // scale1r -divp_eq. suff s : size (p %% d) < size (c *: d) by rewrite (divpP e s). by rewrite size_scale ?ltn_modp. Qed. Lemma eqp_modpl d p q : p %= q -> (p %% d) %= (q %% d). Proof. case/eqpP=> [[c1 c2]] /andP /= [c1n0 c2n0 e]. by apply/eqpP; exists (c1, c2); rewrite ?c1n0 // -!modpZl e. Qed. Lemma eqp_divl d p q : p %= q -> (p %/ d) %= (q %/ d). Proof. case/eqpP=> [[c1 c2]] /andP /= [c1n0 c2n0 e]. by apply/eqpP; exists (c1, c2); rewrite ?c1n0 // -!divpZl e. Qed. Lemma eqp_modpr d p q : p %= q -> (d %% p) %= (d %% q). Proof. case/eqpP=> [[c1 c2]] /andP [c1n0 c2n0 e]. have -> : p = (c1^-1 * c2) *: q by rewrite -scalerA -e scalerA mulVf // scale1r. by rewrite modpZr ?eqpxx // mulf_eq0 negb_or invr_eq0 c1n0. Qed. Lemma eqp_mod p1 p2 q1 q2 : p1 %= p2 -> q1 %= q2 -> p1 %% q1 %= p2 %% q2. Proof. move=> e1 e2; exact: eqp_trans (eqp_modpl _ e1) (eqp_modpr _ e2). Qed. Lemma eqp_divr (d m n : {poly F}) : m %= n -> (d %/ m) %= (d %/ n). Proof. case/eqpP=> [[c1 c2]] /andP [c1n0 c2n0 e]. have -> : m = (c1^-1 * c2) *: n by rewrite -scalerA -e scalerA mulVf // scale1r. by rewrite divpZr ?eqp_scale // ?invr_eq0 mulf_eq0 negb_or invr_eq0 c1n0. Qed. Lemma eqp_div p1 p2 q1 q2 : p1 %= p2 -> q1 %= q2 -> p1 %/ q1 %= p2 %/ q2. Proof. move=> e1 e2; exact: eqp_trans (eqp_divl _ e1) (eqp_divr _ e2). Qed. Lemma eqp_gdcor p q r : q %= r -> gdcop p q %= gdcop p r. Proof. move=> eqr; rewrite /gdcop (eqp_size eqr). move: (size r)=> n; elim: n p q r eqr => [|n ihn] p q r; first by rewrite eqpxx. move=> eqr /=; rewrite (eqp_coprimepl p eqr); case: ifP => _ //. exact/ihn/eqp_div/eqp_gcdl. Qed. Lemma eqp_gdcol p q r : q %= r -> gdcop q p %= gdcop r p. Proof. move=> eqr; rewrite /gdcop; move: (size p)=> n. elim: n p q r eqr {1 3}p (eqpxx p) => [|n ihn] p q r eqr s esp /=. case: (eqVneq q 0) eqr => [-> | nq0 eqr] /=. by rewrite eqp_sym eqp0 => ->; rewrite eqpxx. by case: (eqVneq r 0) eqr nq0 => [->|]; rewrite ?eqpxx // eqp0 => ->. rewrite (eqp_coprimepr _ eqr) (eqp_coprimepl _ esp); case: ifP=> _ //. exact/ihn/eqp_div/eqp_gcd. Qed. Lemma eqp_rgdco_gdco q p : rgdcop q p %= gdcop q p. Proof. rewrite /rgdcop /gdcop; move: (size p)=> n. elim: n p q {1 3}p {1 3}q (eqpxx p) (eqpxx q) => [|n ihn] p q s t /= sp tq. case: (eqVneq t 0) tq => [-> | nt0 etq]. by rewrite eqp_sym eqp0 => ->; rewrite eqpxx. by case: (eqVneq q 0) etq nt0 => [->|]; rewrite ?eqpxx // eqp0 => ->. rewrite rcoprimep_coprimep (eqp_coprimepl t sp) (eqp_coprimepr p tq). case: ifP=> // _; apply: ihn => //; apply: eqp_trans (eqp_rdiv_div _ _) _. by apply: eqp_div => //; apply: eqp_trans (eqp_rgcd_gcd _ _) _; apply: eqp_gcd. Qed. Lemma modpD d p q : (p + q) %% d = p %% d + q %% d. Proof. have [-> | dn0] := eqVneq d 0; first by rewrite !modp0. by apply: IdomainUnit.modpD; rewrite unitfE lead_coef_eq0. Qed. Lemma modpN p q : (- p) %% q = - (p %% q). Proof. by apply/eqP; rewrite -addr_eq0 -modpD addNr mod0p. Qed. Lemma modNp p q : (- p) %% q = - (p %% q). Proof. exact: modpN. Qed. Lemma divpD d p q : (p + q) %/ d = p %/ d + q %/ d. Proof. have [-> | dn0] := eqVneq d 0; first by rewrite !divp0 addr0. by apply: IdomainUnit.divpD; rewrite unitfE lead_coef_eq0. Qed. Lemma divpN p q : (- p) %/ q = - (p %/ q). Proof. by apply/eqP; rewrite -addr_eq0 -divpD addNr div0p. Qed. Lemma divp_addl_mul_small d q r : size r < size d -> (q * d + r) %/ d = q. Proof. move=> srd; rewrite divpD (divp_small srd) addr0 mulpK // -size_poly_gt0. exact: leq_trans srd. Qed. Lemma modp_addl_mul_small d q r : size r < size d -> (q * d + r) %% d = r. Proof. by move=> srd; rewrite modpD modp_mull add0r modp_small. Qed. Lemma divp_addl_mul d q r : d != 0 -> (q * d + r) %/ d = q + r %/ d. Proof. by move=> dn0; rewrite divpD mulpK. Qed. Lemma divpp d : d != 0 -> d %/ d = 1. Proof. by move=> dn0; apply: IdomainUnit.divpp; rewrite unitfE lead_coef_eq0. Qed. Lemma leq_trunc_divp d m : size (m %/ d * d) <= size m. Proof. have [-> | dn0] := eqVneq d 0; first by rewrite mulr0 size_poly0. by apply: IdomainUnit.leq_trunc_divp; rewrite unitfE lead_coef_eq0. Qed. Lemma divpK d p : d %| p -> p %/ d * d = p. Proof. case: (eqVneq d 0) => [-> /dvd0pP -> | dn0]; first by rewrite mulr0. by apply: IdomainUnit.divpK; rewrite unitfE lead_coef_eq0. Qed. Lemma divpKC d p : d %| p -> d * (p %/ d) = p. Proof. by move=> ?; rewrite mulrC divpK. Qed. Lemma dvdp_eq_div d p q : d != 0 -> d %| p -> (q == p %/ d) = (q * d == p). Proof. by move=> dn0; apply: IdomainUnit.dvdp_eq_div; rewrite unitfE lead_coef_eq0. Qed. Lemma dvdp_eq_mul d p q : d != 0 -> d %| p -> (p == q * d) = (p %/ d == q). Proof. by move=> dn0 dv_d_p; rewrite eq_sym -dvdp_eq_div // eq_sym. Qed. Lemma divp_mulA d p q : d %| q -> p * (q %/ d) = p * q %/ d. Proof. case: (eqVneq d 0) => [-> /dvd0pP -> | dn0]; first by rewrite !divp0 mulr0. by apply: IdomainUnit.divp_mulA; rewrite unitfE lead_coef_eq0. Qed. Lemma divp_mulAC d m n : d %| m -> m %/ d * n = m * n %/ d. Proof. by move=> hdm; rewrite mulrC (mulrC m); apply: divp_mulA. Qed. Lemma divp_mulCA d p q : d %| p -> d %| q -> p * (q %/ d) = q * (p %/ d). Proof. by move=> hdp hdq; rewrite mulrC divp_mulAC // divp_mulA. Qed. Lemma expp_sub d m n : d != 0 -> m >= n -> (d ^+ (m - n))%N = d ^+ m %/ d ^+ n. Proof. by move=> dn0 /subnK=> {2}<-; rewrite exprD mulpK // expf_neq0. Qed. Lemma divp_pmul2l d q p : d != 0 -> q != 0 -> d * p %/ (d * q) = p %/ q. Proof. by move=> dn0 qn0; apply: IdomainUnit.divp_pmul2l; rewrite unitfE lead_coef_eq0. Qed. Lemma divp_pmul2r d p q : d != 0 -> p != 0 -> q * d %/ (p * d) = q %/ p. Proof. by move=> dn0 qn0; rewrite -!(mulrC d) divp_pmul2l. Qed. Lemma divp_divl r p q : q %/ p %/ r = q %/ (p * r). Proof. have [-> | rn0] := eqVneq r 0; first by rewrite mulr0 !divp0. have [-> | pn0] := eqVneq p 0; first by rewrite mul0r !divp0 div0p. by apply: IdomainUnit.divp_divl; rewrite unitfE lead_coef_eq0. Qed. Lemma divpAC d p q : q %/ d %/ p = q %/ p %/ d. Proof. by rewrite !divp_divl // mulrC. Qed. Lemma edivp_def p q : edivp p q = (0%N, p %/ q, p %% q). Proof. rewrite Idomain.edivp_def; congr (_, _, _); rewrite /scalp 2!unlock /=. have [-> | qn0] := eqVneq; first by rewrite lead_coef0 unitr0. by rewrite unitfE lead_coef_eq0 qn0 /=; case: (redivp_rec _ _ _ _) => [[]]. Qed. Lemma divpE p q : p %/ q = (lead_coef q)^-(rscalp p q) *: (rdivp p q). Proof. have [-> | qn0] := eqVneq q 0; first by rewrite rdivp0 divp0 scaler0. by rewrite Idomain.divpE unitfE lead_coef_eq0 qn0. Qed. Lemma modpE p q : p %% q = (lead_coef q)^-(rscalp p q) *: (rmodp p q). Proof. have [-> | qn0] := eqVneq q 0. by rewrite rmodp0 modp0 /rscalp unlock eqxx lead_coef0 expr0 invr1 scale1r. by rewrite Idomain.modpE unitfE lead_coef_eq0 qn0. Qed. Lemma scalpE p q : scalp p q = 0%N. Proof. have [-> | qn0] := eqVneq q 0; first by rewrite scalp0. by rewrite Idomain.scalpE unitfE lead_coef_eq0 qn0. Qed. (* Just to have it without importing the weak theory *) Lemma dvdpE p q : p %| q = rdvdp p q. Proof. exact: Idomain.dvdpE. Qed. Variant edivp_spec m d : nat * {poly F} * {poly F} -> Type := EdivpSpec n q r of m = q * d + r & (d != 0) ==> (size r < size d) : edivp_spec m d (n, q, r). Lemma edivpP m d : edivp_spec m d (edivp m d). Proof. rewrite edivp_def; constructor; first exact: divp_eq. by apply/implyP=> dn0; rewrite ltn_modp. Qed. Lemma edivp_eq d q r : size r < size d -> edivp (q * d + r) d = (0%N, q, r). Proof. move=> srd; apply: Idomain.edivp_eq; rewrite // unitfE lead_coef_eq0. by rewrite -size_poly_gt0; apply: leq_trans srd. Qed. Lemma modp_mul p q m : (p * (q %% m)) %% m = (p * q) %% m. Proof. by rewrite [in RHS](divp_eq q m) mulrDr modpD mulrA modp_mull add0r. Qed. Lemma dvdpP p q : reflect (exists qq, p = qq * q) (q %| p). Proof. have [-> | qn0] := eqVneq q 0; last first. by apply: IdomainUnit.dvdpP; rewrite unitfE lead_coef_eq0. by rewrite dvd0p; apply: (iffP eqP) => [->| [? ->]]; [exists 1|]; rewrite mulr0. Qed. Lemma Bezout_eq1_coprimepP p q : reflect (exists u, u.1 * p + u.2 * q = 1) (coprimep p q). Proof. apply: (iffP idP)=> [hpq|]; last first. by case=> [[u v]] /= e; apply/Bezout_coprimepP; exists (u, v); rewrite e eqpxx. case/Bezout_coprimepP: hpq => [[u v]] /=. case/eqpP=> [[c1 c2]] /andP /= [c1n0 c2n0] e. exists (c2^-1 *: (c1 *: u), c2^-1 *: (c1 *: v)); rewrite /= -!scalerAl. by rewrite -!scalerDr e scalerA mulVf // scale1r. Qed. Lemma dvdp_gdcor p q : q != 0 -> p %| (gdcop q p) * (q ^+ size p). Proof. rewrite /gdcop => nz_q; have [n hsp] := ubnPleq (size p). elim: n => [|n IHn] /= in p hsp *; first by rewrite (negPf nz_q) mul0r dvdp0. have [_ | ncop_pq] := ifPn; first by rewrite dvdp_mulr. have g_gt1: 1 < size (gcdp p q). rewrite ltn_neqAle eq_sym ncop_pq size_poly_gt0 gcdp_eq0. by rewrite negb_and nz_q orbT. have [-> | nz_p] := eqVneq p 0. by rewrite div0p exprSr mulrA dvdp_mulr // IHn // size_poly0. have le_d_p: size (p %/ gcdp p q) < size p. rewrite size_divp -?size_poly_eq0 -(subnKC g_gt1) // add2n /=. by rewrite polySpred // ltnS subSS leq_subr. rewrite -[p in p %| _](divpK (dvdp_gcdl p q)) exprSr mulrA. by rewrite dvdp_mul ?IHn ?dvdp_gcdr // -ltnS (leq_trans le_d_p). Qed. Lemma reducible_cubic_root p q : size p <= 4 -> 1 < size q < size p -> q %| p -> {r | root p r}. Proof. move=> p_le4 /andP[]; rewrite leq_eqVlt eq_sym. have [/poly2_root[x qx0] _ _ | _ /= q_gt2 p_gt_q] := size q =P 2. by exists x; rewrite -!dvdp_XsubCl in qx0 *; apply: (dvdp_trans qx0). case/dvdpP/sig_eqW=> r def_p; rewrite def_p. suffices /poly2_root[x rx0]: size r = 2 by exists x; rewrite rootM rx0. have /norP[nz_r nz_q]: ~~ [|| r == 0 | q == 0]. by rewrite -mulf_eq0 -def_p -size_poly_gt0 (leq_ltn_trans _ p_gt_q). rewrite def_p size_mul // -subn1 leq_subLR ltn_subRL in p_gt_q p_le4. by apply/eqP; rewrite -(eqn_add2r (size q)) eqn_leq (leq_trans p_le4). Qed. Lemma cubic_irreducible p : 1 < size p <= 4 -> (forall x, ~~ root p x) -> irreducible_poly p. Proof. move=> /andP[p_gt1 p_le4] root'p; split=> // q sz_q_neq1 q_dv_p. have nz_p: p != 0 by rewrite -size_poly_gt0 ltnW. have nz_q: q != 0 by apply: contraTneq q_dv_p => ->; rewrite dvd0p. have q_gt1: size q > 1 by rewrite ltn_neqAle eq_sym sz_q_neq1 size_poly_gt0. rewrite -dvdp_size_eqp // eqn_leq dvdp_leq //= leqNgt; apply/negP=> p_gt_q. by have [|x /idPn//] := reducible_cubic_root p_le4 _ q_dv_p; rewrite q_gt1. Qed. Section FieldRingMap. Variable rR : ringType. Variable f : {rmorphism F -> rR}. Local Notation "p ^f" := (map_poly f p) : ring_scope. Implicit Type a b : {poly F}. Lemma redivp_map a b : redivp a^f b^f = (rscalp a b, (rdivp a b)^f, (rmodp a b)^f). Proof. rewrite /rdivp /rscalp /rmodp !unlock map_poly_eq0 size_map_poly. have [// | q_nz] := ifPn; rewrite -(rmorph0 (map_poly_rmorphism f)) //. have [m _] := ubnPeq (size a); elim: m 0%N 0 a => [|m IHm] qq r a /=. rewrite -!mul_polyC !size_map_poly !lead_coef_map // -(map_polyXn f). by rewrite -!(map_polyC f) -!rmorphM -rmorphB -rmorphD; case: (_ < _). rewrite -!mul_polyC !size_map_poly !lead_coef_map // -(map_polyXn f). by rewrite -!(map_polyC f) -!rmorphM -rmorphB -rmorphD /= IHm; case: (_ < _). Qed. End FieldRingMap. Section FieldMap. Variable rR : idomainType. Variable f : {rmorphism F -> rR}. Local Notation "p ^f" := (map_poly f p) : ring_scope. Implicit Type a b : {poly F}. Lemma edivp_map a b : edivp a^f b^f = (0%N, (a %/ b)^f, (a %% b)^f). Proof. have [-> | bn0] := eqVneq b 0. rewrite (rmorph0 (map_poly_rmorphism f)) WeakIdomain.edivp_def !modp0 !divp0. by rewrite (rmorph0 (map_poly_rmorphism f)) scalp0. rewrite unlock redivp_map lead_coef_map rmorph_unit; last first. by rewrite unitfE lead_coef_eq0. rewrite modpE divpE !map_polyZ !rmorphV ?rmorphX // unitfE. by rewrite expf_neq0 // lead_coef_eq0. Qed. Lemma scalp_map p q : scalp p^f q^f = scalp p q. Proof. by rewrite /scalp edivp_map edivp_def. Qed. Lemma map_divp p q : (p %/ q)^f = p^f %/ q^f. Proof. by rewrite /divp edivp_map edivp_def. Qed. Lemma map_modp p q : (p %% q)^f = p^f %% q^f. Proof. by rewrite /modp edivp_map edivp_def. Qed. Lemma egcdp_map p q : egcdp (map_poly f p) (map_poly f q) = (map_poly f (egcdp p q).1, map_poly f (egcdp p q).2). Proof. wlog le_qp: p q / size q <= size p. move=> IH; have [/IH// | lt_qp] := leqP (size q) (size p). have /IH := ltnW lt_qp; rewrite /egcdp !size_map_poly ltnW // leqNgt lt_qp /=. by case: (egcdp_rec _ _ _) => u v [-> ->]. rewrite /egcdp !size_map_poly {}le_qp; move: (size q) => n. elim: n => /= [|n IHn] in p q *; first by rewrite rmorph1 rmorph0. rewrite map_poly_eq0; have [_ | nz_q] := ifPn; first by rewrite rmorph1 rmorph0. rewrite -map_modp (IHn q (p %% q)); case: (egcdp_rec _ _ n) => u v /=. by rewrite map_polyZ lead_coef_map -rmorphX scalp_map rmorphB rmorphM -map_divp. Qed. Lemma dvdp_map p q : (p^f %| q^f) = (p %| q). Proof. by rewrite /dvdp -map_modp map_poly_eq0. Qed. Lemma eqp_map p q : (p^f %= q^f) = (p %= q). Proof. by rewrite /eqp !dvdp_map. Qed. Lemma gcdp_map p q : (gcdp p q)^f = gcdp p^f q^f. Proof. wlog lt_p_q: p q / size p < size q. move=> IHpq; case: (ltnP (size p) (size q)) => [|le_q_p]; first exact: IHpq. rewrite gcdpE (gcdpE p^f) !size_map_poly ltnNge le_q_p /= -map_modp. have [-> | q_nz] := eqVneq q 0; first by rewrite rmorph0 !gcdp0. by rewrite IHpq ?ltn_modp. have [m le_q_m] := ubnP (size q); elim: m => // m IHm in p q lt_p_q le_q_m *. rewrite gcdpE (gcdpE p^f) !size_map_poly lt_p_q -map_modp. have [-> | q_nz] := eqVneq p 0; first by rewrite rmorph0 !gcdp0. by rewrite IHm ?(leq_trans lt_p_q) ?ltn_modp. Qed. Lemma coprimep_map p q : coprimep p^f q^f = coprimep p q. Proof. by rewrite -!gcdp_eqp1 -eqp_map rmorph1 gcdp_map. Qed. Lemma gdcop_rec_map p q n : (gdcop_rec p q n)^f = gdcop_rec p^f q^f n. Proof. elim: n p q => [|n IH] => /= p q. by rewrite map_poly_eq0; case: eqP; rewrite ?rmorph1 ?rmorph0. rewrite /coprimep -gcdp_map size_map_poly. by case: eqP => Hq0 //; rewrite -map_divp -IH. Qed. Lemma gdcop_map p q : (gdcop p q)^f = gdcop p^f q^f. Proof. by rewrite /gdcop gdcop_rec_map !size_map_poly. Qed. End FieldMap. End FieldDivision. Notation "@ 'modp_scalel'" := (deprecate modp_scalel modpZl) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_scaler'" := (deprecate modp_scaler modpZr) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_opp'" := (deprecate modp_opp modpN) (at level 10, only parsing) : fun_scope. Notation "@ 'modp_add'" := (deprecate modp_add modpD) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_scalel'" := (deprecate modp_scalel divpZl) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_scaler'" := (deprecate modp_scaler divpZr) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_opp'" := (deprecate modp_opp divpN) (at level 10, only parsing) : fun_scope. Notation "@ 'divp_add'" := (deprecate modp_add divpD) (at level 10, only parsing) : fun_scope. Notation modp_scalel := (@modp_scalel _) (only parsing). Notation modp_scaler := (@modp_scaler _ _) (only parsing). Notation modp_opp := (@modp_opp _) (only parsing). Notation modp_add := (@modp_add _) (only parsing). Notation divp_scalel := (@divp_scalel _) (only parsing). Notation divp_scaler := (@divp_scaler _ _) (only parsing). Notation divp_opp := (@divp_opp _) (only parsing). Notation divp_add := (@divp_add _) (only parsing). End Field. Module ClosedField. Import Field. Section closed. Variable F : closedFieldType. Lemma root_coprimep (p q : {poly F}): (forall x, root p x -> q.[x] != 0) -> coprimep p q. Proof. move=> Ncmn; rewrite -gcdp_eqp1 -size_poly_eq1; apply/closed_rootP. by case=> r; rewrite root_gcd !rootE=> /andP [/Ncmn/negPf->]. Qed. Lemma coprimepP (p q : {poly F}): reflect (forall x, root p x -> q.[x] != 0) (coprimep p q). Proof. by apply: (iffP idP)=> [/coprimep_root|/root_coprimep]. Qed. End closed. End ClosedField. End Pdiv. Export Pdiv.Field. math-comp-mathcomp-1.12.0/mathcomp/algebra/rat.v000066400000000000000000000710351375767750300215020ustar00rootroot00000000000000(* (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 order ssralg countalg div ssrnum. From mathcomp Require Import ssrint. (******************************************************************************) (* This file defines a datatype for rational numbers and equips it with a *) (* structure of archimedean, real field, with int and nat declared as closed *) (* subrings. *) (* rat == the type of rational number, with single constructor Rat *) (* n%:Q == explicit cast from int to rat, ie. the specialization to *) (* rationals of the generic ring morphism n%:~R *) (* numq r == numerator of (r : rat) *) (* denq r == denominator of (r : rat) *) (* x \is a Qint == x is an element of rat whose denominator is equal to 1 *) (* x \is a Qnat == x is a positive element of rat whose denominator is equal *) (* to 1 *) (* ratr x == generic embedding of (r : R) into an arbitrary unitring. *) (******************************************************************************) Import Order.TTheory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Local Notation sgr := Num.sg. Record rat : Set := Rat { valq : (int * int); _ : (0 < valq.2) && coprime `|valq.1| `|valq.2| }. Bind Scope ring_scope with rat. Delimit Scope rat_scope with Q. Definition ratz (n : int) := @Rat (n, 1) (coprimen1 _). (* Coercion ratz (n : int) := @Rat (n, 1) (coprimen1 _). *) Canonical rat_subType := Eval hnf in [subType for valq]. Definition rat_eqMixin := [eqMixin of rat by <:]. Canonical rat_eqType := EqType rat rat_eqMixin. Definition rat_choiceMixin := [choiceMixin of rat by <:]. Canonical rat_choiceType := ChoiceType rat rat_choiceMixin. Definition rat_countMixin := [countMixin of rat by <:]. Canonical rat_countType := CountType rat rat_countMixin. Canonical rat_subCountType := [subCountType of rat]. Definition numq x := nosimpl ((valq x).1). Definition denq x := nosimpl ((valq x).2). 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 := ltW (denq_gt0 x). 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 gt_eqF ?denq_gt0. Qed. Hint Resolve denq_neq0 : core. Lemma denq_eq0 x : (denq x == 0) = false. Proof. exact: negPf (denq_neq0 _). Qed. Lemma coprime_num_den x : coprime `|numq x| `|denq x|. Proof. by rewrite /numq /denq; case: x=> [[a b] /= /andP []]. Qed. Fact RatK x P : @Rat (numq x, denq x) P = x. Proof. by move: x P => [[a b] P'] P; apply: val_inj. Qed. Fact fracq_subproof : forall x : int * int, let n := if x.2 == 0 then 0 else (-1) ^ ((x.2 < 0) (+) (x.1 < 0)) * (`|x.1| %/ gcdn `|x.1| `|x.2|)%:Z in let d := if x.2 == 0 then 1 else (`|x.2| %/ gcdn `|x.1| `|x.2|)%:Z in (0 < d) && (coprime `|n| `|d|). Proof. move=> [m n] /=; have [//|n0] := eqVneq n 0. rewrite ltz_nat divn_gt0 ?gcdn_gt0 ?absz_gt0 ?n0 ?orbT //. rewrite dvdn_leq ?absz_gt0 ?dvdn_gcdr //= !abszM absz_sign mul1n. have [->|m0] := eqVneq m 0; first by rewrite div0n gcd0n divnn absz_gt0 n0. move: n0 m0; rewrite -!absz_gt0 absz_nat. move: `|_|%N `|_|%N => {m n} [|m] [|n] // _ _. rewrite /coprime -(@eqn_pmul2l (gcdn m.+1 n.+1)) ?gcdn_gt0 //. rewrite muln_gcdr; do 2!rewrite muln_divCA ?(dvdn_gcdl, dvdn_gcdr) ?divnn //. by rewrite ?gcdn_gt0 ?muln1. Qed. Definition fracq (x : int * int) := nosimpl (@Rat (_, _) (fracq_subproof x)). Fact ratz_frac n : ratz n = fracq (n, 1). Proof. by apply: val_inj; rewrite /= gcdn1 !divn1 abszE mulr_sign_norm. Qed. 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 lt_gtF ?gt_eqF //= hnd !divn1 mulz_sign_abs abszE gtr0_norm. Qed. Fact scalq_key : unit. Proof. by []. Qed. Definition scalq_def x := sgr x.2 * (gcdn `|x.1| `|x.2|)%:Z. Definition scalq := locked_with scalq_key scalq_def. Canonical scalq_unlockable := [unlockable fun scalq]. Fact scalq_eq0 x : (scalq x == 0) = (x.2 == 0). Proof. case: x => n d; rewrite unlock /= mulf_eq0 sgr_eq0 /= eqz_nat. rewrite -[gcdn _ _ == 0%N]negbK -lt0n gcdn_gt0 ?absz_gt0 [X in ~~ X]orbC. by case: sgrP. Qed. Lemma sgr_scalq x : sgr (scalq x) = sgr x.2. Proof. rewrite unlock sgrM sgr_id -[(gcdn _ _)%:Z]intz sgr_nat. by rewrite -lt0n gcdn_gt0 ?absz_gt0 orbC; case: sgrP; rewrite // mul0r. Qed. Lemma signr_scalq x : (scalq x < 0) = (x.2 < 0). Proof. by rewrite -!sgr_cp0 sgr_scalq. Qed. Lemma scalqE x : x.2 != 0 -> scalq x = (-1) ^+ (x.2 < 0)%R * (gcdn `|x.1| `|x.2|)%:Z. Proof. by rewrite unlock; case: sgrP. Qed. Fact valq_frac x : x.2 != 0 -> x = (scalq x * numq (fracq x), scalq x * denq (fracq x)). Proof. case: x => [n d] /= d_neq0; rewrite /denq /numq scalqE //= (negPf d_neq0). rewrite mulr_signM -mulrA -!PoszM addKb. do 2!rewrite muln_divCA ?(dvdn_gcdl, dvdn_gcdr) // divnn. by rewrite gcdn_gt0 !absz_gt0 d_neq0 orbT !muln1 !mulz_sign_abs. Qed. Definition zeroq := fracq (0, 1). Definition oneq := fracq (1, 1). Fact frac0q x : fracq (0, x) = zeroq. Proof. apply: val_inj; rewrite //= div0n !gcd0n !mulr0 !divnn. by have [//|x_neq0] := eqVneq; rewrite absz_gt0 x_neq0. Qed. Fact fracq0 x : fracq (x, 0) = zeroq. Proof. exact/eqP. Qed. Variant fracq_spec (x : int * int) : int * int -> rat -> Type := | FracqSpecN of x.2 = 0 : fracq_spec x (x.1, 0) zeroq | FracqSpecP k fx of k != 0 : fracq_spec x (k * numq fx, k * denq fx) fx. Fact fracqP x : fracq_spec x x (fracq x). Proof. case: x => n d /=; have [d_eq0 | d_neq0] := eqVneq d 0. by rewrite d_eq0 fracq0; constructor. by rewrite {2}[(_, _)]valq_frac //; constructor; rewrite scalq_eq0. Qed. Lemma rat_eqE x y : (x == y) = (numq x == numq y) && (denq x == denq y). Proof. rewrite -val_eqE [val x]surjective_pairing [val y]surjective_pairing /=. by rewrite xpair_eqE. Qed. Lemma sgr_denq x : sgr (denq x) = 1. Proof. by apply/eqP; rewrite sgr_cp0. Qed. Lemma normr_denq x : `|denq x| = denq x. Proof. by rewrite gtr0_norm. Qed. Lemma absz_denq x : `|denq x|%N = denq x :> int. Proof. by rewrite abszE normr_denq. Qed. Lemma rat_eq x y : (x == y) = (numq x * denq y == numq y * denq x). Proof. symmetry; rewrite rat_eqE andbC. have [->|] /= := eqVneq (denq _); first by rewrite (inj_eq (mulIf _)). apply: contraNF => /eqP hxy; rewrite -absz_denq -[X in _ == X]absz_denq. rewrite eqz_nat /= eqn_dvd. rewrite -(@Gauss_dvdr _ `|numq x|) 1?coprime_sym ?coprime_num_den // andbC. rewrite -(@Gauss_dvdr _ `|numq y|) 1?coprime_sym ?coprime_num_den //. by rewrite -!abszM hxy -{1}hxy !abszM !dvdn_mull ?dvdnn. Qed. Fact fracq_eq x y : x.2 != 0 -> y.2 != 0 -> (fracq x == fracq y) = (x.1 * y.2 == y.1 * x.2). Proof. case: fracqP=> //= u fx u_neq0 _; case: fracqP=> //= v fy v_neq0 _; symmetry. rewrite [X in (_ == X)]mulrC mulrACA [X in (_ == X)]mulrACA. by rewrite [denq _ * _]mulrC (inj_eq (mulfI _)) ?mulf_neq0 // rat_eq. Qed. Fact fracq_eq0 x : (fracq x == zeroq) = (x.1 == 0) || (x.2 == 0). Proof. move: x=> [n d] /=; have [->|d0] := eqVneq d 0. by rewrite fracq0 eqxx orbT. by rewrite orbF fracq_eq ?d0 //= mulr1 mul0r. Qed. Fact fracqMM x n d : x != 0 -> fracq (x * n, x * d) = fracq (n, d). Proof. move=> x_neq0; apply/eqP. have [->|d_neq0] := eqVneq d 0; first by rewrite mulr0 !fracq0. by rewrite fracq_eq ?mulf_neq0 //= mulrCA mulrA. Qed. Definition addq_subdef (x y : int * int) := (x.1 * y.2 + y.1 * x.2, x.2 * y.2). Definition addq (x y : rat) := nosimpl fracq (addq_subdef (valq x) (valq y)). Definition oppq_subdef (x : int * int) := (- x.1, x.2). Definition oppq (x : rat) := nosimpl fracq (oppq_subdef (valq x)). Fact addq_subdefC : commutative addq_subdef. Proof. by move=> x y; rewrite /addq_subdef addrC [_.2 * _]mulrC. Qed. Fact addq_subdefA : associative addq_subdef. Proof. move=> x y z; rewrite /addq_subdef. by rewrite !mulrA !mulrDl addrA ![_ * x.2]mulrC !mulrA. Qed. Fact addq_frac x y : x.2 != 0 -> y.2 != 0 -> (addq (fracq x) (fracq y)) = fracq (addq_subdef x y). Proof. case: fracqP => // u fx u_neq0 _; case: fracqP => // v fy v_neq0 _. rewrite /addq_subdef /= ![(_ * numq _) * _]mulrACA [(_ * denq _) * _]mulrACA. by rewrite [v * _]mulrC -mulrDr fracqMM ?mulf_neq0. Qed. Fact ratzD : {morph ratz : x y / x + y >-> addq x y}. Proof. by move=> x y /=; rewrite !ratz_frac addq_frac // /addq_subdef /= !mulr1. Qed. Fact oppq_frac x : oppq (fracq x) = fracq (oppq_subdef x). Proof. rewrite /oppq_subdef; case: fracqP => /= [|u fx u_neq0]. by rewrite fracq0. by rewrite -mulrN fracqMM. Qed. Fact ratzN : {morph ratz : x / - x >-> oppq x}. Proof. by move=> x /=; rewrite !ratz_frac oppq_frac // /add /= !mulr1. Qed. Fact addqC : commutative addq. Proof. by move=> x y; rewrite /addq /=; rewrite addq_subdefC. Qed. Fact addqA : associative addq. Proof. move=> x y z; rewrite -[x]valqK -[y]valqK -[z]valqK. by rewrite !addq_frac ?mulf_neq0 ?denq_neq0 // addq_subdefA. Qed. Fact add0q : left_id zeroq addq. Proof. move=> x; rewrite -[x]valqK addq_frac ?denq_neq0 // /addq_subdef /=. by rewrite mul0r add0r mulr1 mul1r -surjective_pairing. Qed. Fact addNq : left_inverse (fracq (0, 1)) oppq addq. Proof. move=> x; rewrite -[x]valqK !(addq_frac, oppq_frac) ?denq_neq0 //. rewrite /addq_subdef /oppq_subdef //= mulNr addNr; apply/eqP. by rewrite fracq_eq ?mulf_neq0 ?denq_neq0 //= !mul0r. Qed. Definition rat_ZmodMixin := ZmodMixin addqA addqC add0q addNq. Canonical rat_ZmodType := ZmodType rat rat_ZmodMixin. Definition mulq_subdef (x y : int * int) := nosimpl (x.1 * y.1, x.2 * y.2). Definition mulq (x y : rat) := nosimpl fracq (mulq_subdef (valq x) (valq y)). Fact mulq_subdefC : commutative mulq_subdef. Proof. by move=> x y; rewrite /mulq_subdef mulrC [_ * x.2]mulrC. Qed. Fact mul_subdefA : associative mulq_subdef. Proof. by move=> x y z; rewrite /mulq_subdef !mulrA. Qed. Definition invq_subdef (x : int * int) := nosimpl (x.2, x.1). Definition invq (x : rat) := nosimpl fracq (invq_subdef (valq x)). Fact mulq_frac x y : (mulq (fracq x) (fracq y)) = fracq (mulq_subdef x y). Proof. rewrite /mulq_subdef; case: fracqP => /= [|u fx u_neq0]. by rewrite mul0r fracq0 /mulq /mulq_subdef /= mul0r frac0q. case: fracqP=> /= [|v fy v_neq0]. by rewrite mulr0 fracq0 /mulq /mulq_subdef /= mulr0 frac0q. by rewrite ![_ * (v * _)]mulrACA fracqMM ?mulf_neq0. Qed. Fact ratzM : {morph ratz : x y / x * y >-> mulq x y}. Proof. by move=> x y /=; rewrite !ratz_frac mulq_frac // /= !mulr1. Qed. Fact invq_frac x : x.1 != 0 -> x.2 != 0 -> invq (fracq x) = fracq (invq_subdef x). Proof. by rewrite /invq_subdef; case: fracqP => // k {}x k0; rewrite fracqMM. Qed. Fact mulqC : commutative mulq. Proof. by move=> x y; rewrite /mulq mulq_subdefC. Qed. Fact mulqA : associative mulq. Proof. by move=> x y z; rewrite -[x]valqK -[y]valqK -[z]valqK !mulq_frac mul_subdefA. Qed. Fact mul1q : left_id oneq mulq. Proof. move=> x; rewrite -[x]valqK; rewrite mulq_frac /mulq_subdef. by rewrite !mul1r -surjective_pairing. Qed. Fact mulq_addl : left_distributive mulq addq. Proof. move=> x y z; rewrite -[x]valqK -[y]valqK -[z]valqK /=. rewrite !(mulq_frac, addq_frac) ?mulf_neq0 ?denq_neq0 //=. apply/eqP; rewrite fracq_eq ?mulf_neq0 ?denq_neq0 //= !mulrDl; apply/eqP. by rewrite !mulrA ![_ * (valq z).1]mulrC !mulrA ![_ * (valq x).2]mulrC !mulrA. Qed. Fact nonzero1q : oneq != zeroq. Proof. by []. Qed. Definition rat_comRingMixin := ComRingMixin mulqA mulqC mul1q mulq_addl nonzero1q. Canonical rat_Ring := Eval hnf in RingType rat rat_comRingMixin. Canonical rat_comRing := Eval hnf in ComRingType rat mulqC. Fact mulVq x : x != 0 -> mulq (invq x) x = 1. Proof. rewrite -[x]valqK fracq_eq ?denq_neq0 //= mulr1 mul0r=> nx0. rewrite !(mulq_frac, invq_frac) ?denq_neq0 //. by apply/eqP; rewrite fracq_eq ?mulf_neq0 ?denq_neq0 //= mulr1 mul1r mulrC. Qed. Fact invq0 : invq 0 = 0. Proof. exact/eqP. Qed. Definition RatFieldUnitMixin := FieldUnitMixin mulVq invq0. Canonical rat_unitRing := Eval hnf in UnitRingType rat RatFieldUnitMixin. Canonical rat_comUnitRing := Eval hnf in [comUnitRingType of rat]. Fact rat_field_axiom : GRing.Field.mixin_of rat_unitRing. Proof. exact. Qed. Definition RatFieldIdomainMixin := (FieldIdomainMixin rat_field_axiom). Canonical rat_idomainType := Eval hnf in IdomainType rat (FieldIdomainMixin rat_field_axiom). Canonical rat_fieldType := FieldType rat rat_field_axiom. Canonical rat_countZmodType := [countZmodType of rat]. Canonical rat_countRingType := [countRingType of rat]. Canonical rat_countComRingType := [countComRingType of rat]. Canonical rat_countUnitRingType := [countUnitRingType of rat]. Canonical rat_countComUnitRingType := [countComUnitRingType of rat]. Canonical rat_countIdomainType := [countIdomainType of rat]. Canonical rat_countFieldType := [countFieldType of rat]. Lemma numq_eq0 x : (numq x == 0) = (x == 0). Proof. rewrite -[x]valqK fracq_eq0; case: fracqP=> /= [|k {}x k0]. by rewrite eqxx orbT. by rewrite !mulf_eq0 (negPf k0) /= denq_eq0 orbF. Qed. Notation "n %:Q" := ((n : int)%:~R : rat) (at level 2, left associativity, format "n %:Q") : ring_scope. Hint Resolve denq_neq0 denq_gt0 denq_ge0 : core. Definition subq (x y : rat) : rat := (addq x (oppq y)). Definition divq (x y : rat) : rat := (mulq x (invq y)). Notation "0" := zeroq : rat_scope. Notation "1" := oneq : rat_scope. Infix "+" := addq : rat_scope. Notation "- x" := (oppq x) : rat_scope. Infix "*" := mulq : rat_scope. Notation "x ^-1" := (invq x) : rat_scope. Infix "-" := subq : rat_scope. Infix "/" := divq : rat_scope. (* ratz should not be used, %:Q should be used instead *) Lemma ratzE n : ratz n = n%:Q. Proof. elim: n=> [|n ihn|n ihn]; first by rewrite mulr0z ratz_frac. by rewrite intS mulrzDl ratzD ihn. by rewrite intS opprD mulrzDl ratzD ihn. Qed. Lemma numq_int n : numq n%:Q = n. Proof. by rewrite -ratzE. Qed. Lemma denq_int n : denq n%:Q = 1. Proof. by rewrite -ratzE. Qed. Lemma rat0 : 0%:Q = 0. Proof. by []. Qed. 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 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 gt_eqF // abszN hab divn1 gtz0_abs. Qed. (* Will be subsumed by pnatr_eq0 *) Fact intq_eq0 n : (n%:~R == 0 :> rat) = (n == 0)%N. Proof. by rewrite -ratzE /ratz rat_eqE /numq /denq /= mulr0 eqxx andbT. Qed. (* fracq should never appear, its canonical form is _%:Q / _%:Q *) Lemma fracqE x : fracq x = x.1%:Q / x.2%:Q. Proof. move: x => [m n] /=. case n0: (n == 0); first by rewrite (eqP n0) fracq0 rat0 invr0 mulr0. rewrite -[m%:Q]valqK -[n%:Q]valqK. rewrite [_^-1]invq_frac ?(denq_neq0, numq_eq0, n0, intq_eq0) //. rewrite [_ / _]mulq_frac /= /invq_subdef /mulq_subdef /=. by rewrite -!/(numq _) -!/(denq _) !numq_int !denq_int mul1r mulr1. Qed. Lemma divq_num_den x : (numq x)%:Q / (denq x)%:Q = x. Proof. by rewrite -{3}[x]valqK [valq _]surjective_pairing /= fracqE. Qed. Variant divq_spec (n d : int) : int -> int -> rat -> Type := | DivqSpecN of d = 0 : divq_spec n d n 0 0 | DivqSpecP k x of k != 0 : divq_spec n d (k * numq x) (k * denq x) x. (* replaces fracqP *) Lemma divqP n d : divq_spec n d n d (n%:Q / d%:Q). Proof. set x := (n, d); rewrite -[n]/x.1 -[d]/x.2 -fracqE. by case: fracqP => [_|k fx k_neq0] /=; constructor. Qed. Lemma divq_eq (nx dx ny dy : rat) : dx != 0 -> dy != 0 -> (nx / dx == ny / dy) = (nx * dy == ny * dx). Proof. move=> dx_neq0 dy_neq0; rewrite -(inj_eq (@mulIf _ (dx * dy) _)) ?mulf_neq0 //. by rewrite mulrA divfK // mulrCA divfK // [dx * _ ]mulrC. Qed. Variant rat_spec (* (x : rat) *) : rat -> int -> int -> Type := Rat_spec (n : int) (d : nat) & coprime `|n| d.+1 : rat_spec (* x *) (n%:Q / d.+1%:Q) n d.+1. Lemma ratP x : rat_spec x (numq x) (denq x). Proof. rewrite -{1}[x](divq_num_den); case hd: denq => [p|n]. have: 0 < p%:Z by rewrite -hd denq_gt0. case: p hd=> //= n hd; constructor; rewrite -?hd ?divq_num_den //. by rewrite -[n.+1]/`|n.+1|%N -hd coprime_num_den. by move: (denq_gt0 x); rewrite hd. Qed. Lemma coprimeq_num n d : coprime `|n| `|d| -> numq (n%:~R / d%:~R) = sgr d * n. Proof. move=> cnd /=; have <- := fracqE (n, d). rewrite /numq /= (eqP (cnd : _ == 1%N)) divn1. have [|d_gt0|d_lt0] := sgrP d; by rewrite (mul0r, mul1r, mulN1r) //= ?[_ ^ _]signrN ?mulNr mulz_sign_abs. Qed. Lemma coprimeq_den n d : coprime `|n| `|d| -> denq (n%:~R / d%:~R) = (if d == 0 then 1 else `|d|). Proof. move=> cnd; have <- := fracqE (n, d). by rewrite /denq /= (eqP (cnd : _ == 1%N)) divn1; case: d {cnd}. Qed. Lemma denqVz (i : int) : i != 0 -> denq (i%:~R^-1) = `|i|. Proof. move=> h; rewrite -div1r -[1]/(1%:~R). by rewrite coprimeq_den /= ?coprime1n // (negPf h). Qed. Lemma numqE x : (numq x)%:~R = x * (denq x)%:~R. Proof. by rewrite -{2}[x]divq_num_den divfK // intq_eq0 denq_eq0. Qed. Lemma denqP x : {d | denq x = d.+1}. Proof. by rewrite /denq; case: x => [[_ [[|d]|]] //= _]; exists d. Qed. Definition normq (x : rat) : rat := `|numq x|%:~R / (denq x)%:~R. Definition le_rat (x y : rat) := numq x * denq y <= numq y * denq x. Definition lt_rat (x y : rat) := numq x * denq y < numq y * denq x. Lemma gt_rat0 x : lt_rat 0 x = (0 < numq x). Proof. by rewrite /lt_rat mul0r mulr1. Qed. Lemma lt_rat0 x : lt_rat x 0 = (numq x < 0). Proof. by rewrite /lt_rat mul0r mulr1. Qed. Lemma ge_rat0 x : le_rat 0 x = (0 <= numq x). Proof. by rewrite /le_rat mul0r mulr1. Qed. Lemma le_rat0 x : le_rat x 0 = (numq x <= 0). Proof. by rewrite /le_rat mul0r mulr1. Qed. Fact le_rat0D x y : le_rat 0 x -> le_rat 0 y -> le_rat 0 (x + y). 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 !le_gtF ?mulr_ge0. Qed. Fact le_rat0M x y : le_rat 0 x -> le_rat 0 y -> le_rat 0 (x * y). 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 !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 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. Proof. set x := (n, d); rewrite -[n]/x.1 -[d]/x.2 -fracqE. case: fracqP => [|k fx k_neq0] /=; first by rewrite mulr0. by rewrite !sgrM mulrACA -expr2 sqr_sg k_neq0 sgr_denq mulr1 mul1r. Qed. Fact subq_ge0 x y : le_rat 0 (y - x) = le_rat x y. 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 !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: 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. Fact numq_div_lt0 n d : n != 0 -> d != 0 -> (numq (n%:~R / d%:~R) < 0)%R = (n < 0)%R (+) (d < 0)%R. Proof. move=> n0 d0; rewrite -sgr_cp0 sgr_numq_div !sgr_def n0 d0. by rewrite !mulr1n -signr_addb; case: (_ (+) _). Qed. Lemma normr_num_div n d : `|numq (n%:~R / d%:~R)| = numq (`|n|%:~R / `|d|%:~R). Proof. rewrite (normrEsg n) (normrEsg d) !rmorphM /= invfM mulrACA !sgr_def. have [->|n_neq0] := eqVneq; first by rewrite mul0r mulr0. have [->|d_neq0] := eqVneq; first by rewrite invr0 !mulr0. rewrite !intr_sign invr_sign -signr_addb numq_sign_mul -numq_div_lt0 //. by apply: (canRL (signrMK _)); rewrite mulz_sign_abs. Qed. Fact norm_ratN x : normq (- x) = normq x. Proof. by rewrite /normq numqN denqN normrN. Qed. Fact ge_rat0_norm x : le_rat 0 x -> normq x = x. Proof. rewrite ge_rat0; case: ratP=> [] // n d cnd n_ge0. 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 lt_def rat_eq. Qed. 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_distrLatticeType := DistrLatticeType rat ratLeMixin. Canonical rat_orderType := OrderType rat le_rat_total. Canonical rat_numDomainType := NumDomainType rat ratLeMixin. Canonical rat_normedZmodType := NormedZmodType rat rat ratLeMixin. Canonical rat_numFieldType := [numFieldType of rat]. Canonical rat_realDomainType := [realDomainType of rat]. Canonical rat_realFieldType := [realFieldType of rat]. Lemma numq_ge0 x : (0 <= numq x) = (0 <= x). Proof. by case: ratP => n d cnd; rewrite ?pmulr_lge0 ?invr_gt0 (ler0z, ltr0z). Qed. 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 !ltNge numq_le0. Qed. Lemma numq_lt0 x : (numq x < 0) = (x < 0). Proof. by rewrite !ltNge numq_ge0. Qed. Lemma sgr_numq x : sgz (numq x) = sgz x. Proof. apply/eqP; case: (sgzP x); rewrite sgz_cp0 ?(numq_gt0, numq_lt0) //. by move->. Qed. Lemma denq_mulr_sign (b : bool) x : denq ((-1) ^+ b * x) = denq x. Proof. by case: b; rewrite ?(mul1r, mulN1r) // denqN. Qed. Lemma denq_norm x : denq `|x| = denq x. 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 //. by rewrite -intr_norm ler1n absz_gt0 denq_eq0. Qed. Canonical archiType := ArchiFieldType rat rat_archimedean. Section QintPred. Definition Qint := [qualify a x : rat | denq x == 1]. Fact Qint_key : pred_key Qint. Proof. by []. Qed. Canonical Qint_keyed := KeyedQualifier Qint_key. Lemma Qint_def x : (x \is a Qint) = (denq x == 1). Proof. by []. Qed. Lemma numqK : {in Qint, cancel (fun x => numq x) intr}. Proof. by move=> x /(_ =P 1 :> int) Zx; rewrite numqE Zx rmorph1 mulr1. Qed. Lemma QintP x : reflect (exists z, x = z%:~R) (x \in Qint). Proof. apply: (iffP idP) => [/numqK <- | [z ->]]; first by exists (numq x). by rewrite Qint_def denq_int. Qed. Fact Qint_subring_closed : subring_closed Qint. Proof. split=> // _ _ /QintP[x ->] /QintP[y ->]; apply/QintP. by exists (x - y); rewrite -rmorphB. by exists (x * y); rewrite -rmorphM. Qed. Canonical Qint_opprPred := OpprPred Qint_subring_closed. Canonical Qint_addrPred := AddrPred Qint_subring_closed. Canonical Qint_mulrPred := MulrPred Qint_subring_closed. Canonical Qint_zmodPred := ZmodPred Qint_subring_closed. Canonical Qint_semiringPred := SemiringPred Qint_subring_closed. Canonical Qint_smulrPred := SmulrPred Qint_subring_closed. Canonical Qint_subringPred := SubringPred Qint_subring_closed. End QintPred. Section QnatPred. Definition Qnat := [qualify a x : rat | (x \is a Qint) && (0 <= x)]. Fact Qnat_key : pred_key Qnat. Proof. by []. Qed. Canonical Qnat_keyed := KeyedQualifier Qnat_key. Lemma Qnat_def x : (x \is a Qnat) = (x \is a Qint) && (0 <= x). Proof. by []. Qed. Lemma QnatP x : reflect (exists n : nat, x = n%:R) (x \in Qnat). Proof. rewrite Qnat_def; apply: (iffP idP) => [/andP []|[n ->]]; last first. by rewrite Qint_def pmulrn denq_int eqxx ler0z. by move=> /QintP [] [] n ->; rewrite ?ler0z // => _; exists n. Qed. Fact Qnat_semiring_closed : semiring_closed Qnat. Proof. do 2?split; move=> // x y; rewrite !Qnat_def => /andP[xQ hx] /andP[yQ hy]. by rewrite rpredD // addr_ge0. by rewrite rpredM // mulr_ge0. Qed. Canonical Qnat_addrPred := AddrPred Qnat_semiring_closed. Canonical Qnat_mulrPred := MulrPred Qnat_semiring_closed. Canonical Qnat_semiringPred := SemiringPred Qnat_semiring_closed. End QnatPred. Lemma natq_div m n : n %| m -> (m %/ n)%:R = m%:R / n%:R :> rat. Proof. exact/char0_natf_div/char_num. Qed. Section InRing. Variable R : unitRingType. Definition ratr x : R := (numq x)%:~R / (denq x)%:~R. Lemma ratr_int z : ratr z%:~R = z%:~R. Proof. by rewrite /ratr numq_int denq_int divr1. Qed. Lemma ratr_nat n : ratr n%:R = n%:R. Proof. exact: (ratr_int n). Qed. Lemma rpred_rat (S : {pred R}) (ringS : divringPred S) (kS : keyed_pred ringS) a : ratr a \in kS. Proof. by rewrite rpred_div ?rpred_int. Qed. End InRing. Section Fmorph. Implicit Type rR : unitRingType. Lemma fmorph_rat (aR : fieldType) rR (f : {rmorphism aR -> rR}) a : f (ratr _ a) = ratr _ a. Proof. by rewrite fmorph_div !rmorph_int. Qed. Lemma fmorph_eq_rat rR (f : {rmorphism rat -> rR}) : f =1 ratr _. Proof. by move=> a; rewrite -{1}[a]divq_num_den fmorph_div !rmorph_int. Qed. End Fmorph. Section Linear. Implicit Types (U V : lmodType rat) (A B : lalgType rat). Lemma rat_linear U V (f : U -> V) : additive f -> linear f. Proof. move=> fB a u v; pose phi := Additive fB; rewrite [f _](raddfD phi). congr (_ + _); rewrite -{2}[a]divq_num_den mulrC -scalerA. apply: canRL (scalerK _) _; first by rewrite intr_eq0 denq_neq0. by rewrite !scaler_int -raddfMz scalerMzl -mulrzr -numqE scaler_int raddfMz. Qed. Lemma rat_lrmorphism A B (f : A -> B) : rmorphism f -> lrmorphism f. Proof. by case=> /rat_linear fZ fM; do ?split=> //; apply: fZ. Qed. End Linear. Section InPrealField. Variable F : numFieldType. Fact ratr_is_rmorphism : rmorphism (@ratr F). Proof. have injZtoQ: @injective rat int intr by apply: intr_inj. have nz_den x: (denq x)%:~R != 0 :> F by rewrite intr_eq0 denq_eq0. do 2?split; rewrite /ratr ?divr1 // => x y; last first. rewrite mulrC mulrAC; apply: canLR (mulKf (nz_den _)) _; rewrite !mulrA. do 2!apply: canRL (mulfK (nz_den _)) _; rewrite -!rmorphM; congr _%:~R. apply: injZtoQ; rewrite !rmorphM [x * y]lock /= !numqE -lock. by rewrite -!mulrA mulrA mulrCA -!mulrA (mulrCA y). apply: (canLR (mulfK (nz_den _))); apply: (mulIf (nz_den x)). rewrite mulrAC mulrBl divfK ?nz_den // mulrAC -!rmorphM. apply: (mulIf (nz_den y)); rewrite mulrAC mulrBl divfK ?nz_den //. rewrite -!(rmorphM, rmorphB); congr _%:~R; apply: injZtoQ. rewrite !(rmorphM, rmorphB) [_ - _]lock /= -lock !numqE. by rewrite (mulrAC y) -!mulrBl -mulrA mulrAC !mulrA. Qed. Canonical ratr_additive := Additive ratr_is_rmorphism. Canonical ratr_rmorphism := RMorphism ratr_is_rmorphism. Lemma ler_rat : {mono (@ratr F) : x y / x <= y}. Proof. move=> x y /=; case: (ratP x) => nx dx cndx; case: (ratP y) => ny dy cndy. rewrite !fmorph_div /= !ratr_int !ler_pdivl_mulr ?ltr0z //. by rewrite ![_ / _ * _]mulrAC !ler_pdivr_mulr ?ltr0z // -!rmorphM /= !ler_int. Qed. Lemma ltr_rat : {mono (@ratr F) : x y / x < y}. 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. Lemma lerq0 x : (ratr F x <= 0) = (x <= 0). Proof. by rewrite (_ : 0 = ratr F 0) ?ler_rat ?rmorph0. Qed. Lemma ltr0q x : (0 < ratr F x) = (0 < x). Proof. by rewrite (_ : 0 = ratr F 0) ?ltr_rat ?rmorph0. Qed. Lemma ltrq0 x : (ratr F x < 0) = (x < 0). Proof. by rewrite (_ : 0 = ratr F 0) ?ltr_rat ?rmorph0. Qed. Lemma ratr_sg x : ratr F (sgr x) = sgr (ratr F x). Proof. by rewrite !sgr_def fmorph_eq0 ltrq0 rmorphMn rmorph_sign. Qed. Lemma ratr_norm x : ratr F `|x| = `|ratr F x|. Proof. by rewrite {2}[x]numEsign rmorphMsign normrMsign [`|ratr F _|]ger0_norm ?ler0q. Qed. End InPrealField. Arguments ratr {R}. (* Conntecting rationals to the ring an field tactics *) Ltac rat_to_ring := rewrite -?[0%Q]/(0 : rat)%R -?[1%Q]/(1 : rat)%R -?[(_ - _)%Q]/(_ - _ : rat)%R -?[(_ / _)%Q]/(_ / _ : rat)%R -?[(_ + _)%Q]/(_ + _ : rat)%R -?[(_ * _)%Q]/(_ * _ : rat)%R -?[(- _)%Q]/(- _ : rat)%R -?[(_ ^-1)%Q]/(_ ^-1 : rat)%R /=. Ltac ring_to_rat := rewrite -?[0%R]/0%Q -?[1%R]/1%Q -?[(_ - _)%R]/(_ - _)%Q -?[(_ / _)%R]/(_ / _)%Q -?[(_ + _)%R]/(_ + _)%Q -?[(_ * _)%R]/(_ * _)%Q -?[(- _)%R]/(- _)%Q -?[(_ ^-1)%R]/(_ ^-1)%Q /=. Lemma rat_ring_theory : (ring_theory 0%Q 1%Q addq mulq subq oppq eq). Proof. split => * //; rat_to_ring; by rewrite ?(add0r, addrA, mul1r, mulrA, mulrDl, subrr) // (addrC, mulrC). Qed. Require setoid_ring.Field_theory setoid_ring.Field_tac. Lemma rat_field_theory : Field_theory.field_theory 0%Q 1%Q addq mulq subq oppq divq invq eq. Proof. split => //; first exact: rat_ring_theory. by move=> p /eqP p_neq0; rat_to_ring; rewrite mulVf. Qed. Add Field rat_field : rat_field_theory. math-comp-mathcomp-1.12.0/mathcomp/algebra/ring_quotient.v000066400000000000000000000643711375767750300236100ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect eqtype choice ssreflect ssrbool ssrnat. From mathcomp Require Import ssrfun seq ssralg generic_quotient. (******************************************************************************) (* This file describes quotients of algebraic structures. *) (* *) (* It defines a join hierarchy mxing the structures defined in file ssralg *) (* (up to unit ring type) and the quotType quotient structure defined in *) (* file generic_quotient. Every structure in that (join) hierarchy is *) (* parametrized by a base type T and the constants and operations on the *) (* base type that will be used to confer its algebraic structure to the *) (* quotient. Note that T itself is in general not an instance of an *) (* algebraic structure. The canonical surjection from T onto its quotient *) (* should be compatible with the parameter operations. *) (* *) (* The second part of the file provides a definition of (non trivial) *) (* decidable ideals (resp. prime ideals) of an arbitrary instance of ring *) (* structure and a construction of the quotient of a ring by such an ideal. *) (* These definitions extend the hierarchy of sub-structures defined in file *) (* ssralg (see Module Pred in ssralg), following a similar methodology. *) (* Although the definition of the (structure of) quotient of a ring by an *) (* ideal is a general one, we do not provide infrastructure for the case of *) (* non commutative ring and left or two-sided ideals. *) (* *) (* The file defines the following Structures: *) (* zmodQuotType T e z n a == Z-module obtained by quotienting type T *) (* with the relation e and whose neutral, *) (* opposite and addition are the images in the *) (* quotient of the parameters z, n and a, *) (* respectively. *) (* ringQuotType T e z n a o m == ring obtained by quotienting type T with *) (* the relation e and whose zero opposite, *) (* addition, one, and multiplication are the *) (* images in the quotient of the parameters *) (* z, n, a, o, m, respectively. *) (* unitRingQuotType ... u i == As in the previous cases, instance of unit *) (* ring whose unit predicate is obtained from *) (* u and the inverse from i. *) (* idealr R S == S : {pred R} is a non-trivial, decidable, *) (* right ideal of the ring R. *) (* prime_idealr R S == S : {pred R} is a non-trivial, decidable, *) (* right, prime ideal of the ring R. *) (* *) (* The formalization of ideals features the following constructions: *) (* proper_ideal S == the collective predicate (S : pred R) on the *) (* ring R is stable by the ring product and does *) (* contain R's one. *) (* prime_idealr_closed S := u * v \in S -> (u \in S) || (v \in S) *) (* idealr_closed S == the collective predicate (S : pred R) on the *) (* ring R represents a (right) ideal. This *) (* implies its being a proper_ideal. *) (* *) (* MkIdeal idealS == packs idealS : proper_ideal S into an idealr S *) (* interface structure associating the *) (* idealr_closed property to the canonical *) (* pred_key S (see ssrbool), which must already *) (* be a zmodPred (see ssralg). *) (* MkPrimeIdeal pidealS == packs pidealS : prime_idealr_closed S into a *) (* prime_idealr S interface structure associating *) (* the prime_idealr_closed property to the *) (* canonical pred_key S (see ssrbool), which must *) (* already be an idealr (see above). *) (* {ideal_quot kI} == quotient by the keyed (right) ideal predicate *) (* kI of a commutative ring R. Note that we only *) (* provide canonical structures of ring quotients *) (* for commutative rings, in which a right ideal *) (* is obviously a two-sided ideal. *) (* *) (* Note : *) (* if (I : pred R) is a predicate over a ring R and (ideal : idealr I) is an *) (* instance of (right) ideal, in order to quantify over an arbitrary (keyed) *) (* predicate describing ideal, use type (keyed_pred ideal), as in: *) (* forall (kI : keyed_pred ideal),... *) (******************************************************************************) Import GRing.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Local Open Scope quotient_scope. Reserved Notation "{ideal_quot I }" (at level 0, format "{ideal_quot I }"). Reserved Notation "m = n %[mod_ideal I ]" (at level 70, n at next level, format "'[hv ' m '/' = n '/' %[mod_ideal I ] ']'"). Reserved Notation "m == n %[mod_ideal I ]" (at level 70, n at next level, format "'[hv ' m '/' == n '/' %[mod_ideal I ] ']'"). Reserved Notation "m <> n %[mod_ideal I ]" (at level 70, n at next level, format "'[hv ' m '/' <> n '/' %[mod_ideal I ] ']'"). Reserved Notation "m != n %[mod_ideal I ]" (at level 70, n at next level, format "'[hv ' m '/' != n '/' %[mod_ideal I ] ']'"). Section ZmodQuot. Variable (T : Type). Variable eqT : rel T. Variables (zeroT : T) (oppT : T -> T) (addT : T -> T -> T). Record zmod_quot_mixin_of (Q : Type) (qc : quot_class_of T Q) (zc : GRing.Zmodule.class_of Q) := ZmodQuotMixinPack { zmod_eq_quot_mixin :> eq_quot_mixin_of eqT qc zc; _ : \pi_(QuotTypePack qc) zeroT = 0 :> GRing.Zmodule.Pack zc; _ : {morph \pi_(QuotTypePack qc) : x / oppT x >-> @GRing.opp (GRing.Zmodule.Pack zc) x}; _ : {morph \pi_(QuotTypePack qc) : x y / addT x y >-> @GRing.add (GRing.Zmodule.Pack zc) x y} }. Record zmod_quot_class_of (Q : Type) : Type := ZmodQuotClass { zmod_quot_quot_class :> quot_class_of T Q; zmod_quot_zmod_class :> GRing.Zmodule.class_of Q; zmod_quot_mixin :> zmod_quot_mixin_of zmod_quot_quot_class zmod_quot_zmod_class }. Structure zmodQuotType : Type := ZmodQuotTypePack { zmod_quot_sort :> Type; _ : zmod_quot_class_of zmod_quot_sort; }. Implicit Type zqT : zmodQuotType. Definition zmod_quot_class zqT : zmod_quot_class_of zqT := let: ZmodQuotTypePack _ cT as qT' := zqT return zmod_quot_class_of qT' in cT. Definition zmod_eq_quot_class zqT (zqc : zmod_quot_class_of zqT) : eq_quot_class_of eqT zqT := EqQuotClass zqc. Canonical zmodQuotType_eqType zqT := Equality.Pack (zmod_quot_class zqT). Canonical zmodQuotType_choiceType zqT := Choice.Pack (zmod_quot_class zqT). Canonical zmodQuotType_zmodType zqT := GRing.Zmodule.Pack (zmod_quot_class zqT). Canonical zmodQuotType_quotType zqT := QuotTypePack (zmod_quot_class zqT). Canonical zmodQuotType_eqQuotType zqT := EqQuotTypePack (zmod_eq_quot_class (zmod_quot_class zqT)). Coercion zmodQuotType_eqType : zmodQuotType >-> eqType. Coercion zmodQuotType_choiceType : zmodQuotType >-> choiceType. Coercion zmodQuotType_zmodType : zmodQuotType >-> zmodType. Coercion zmodQuotType_quotType : zmodQuotType >-> quotType. Coercion zmodQuotType_eqQuotType : zmodQuotType >-> eqQuotType. Definition ZmodQuotType_pack Q := fun (qT : quotType T) (zT : zmodType) qc zc of phant_id (quot_class qT) qc & phant_id (GRing.Zmodule.class zT) zc => fun m => ZmodQuotTypePack (@ZmodQuotClass Q qc zc m). Definition ZmodQuotMixin_pack Q := fun (qT : eqQuotType eqT) (qc : eq_quot_class_of eqT Q) of phant_id (eq_quot_class qT) qc => fun (zT : zmodType) zc of phant_id (GRing.Zmodule.class zT) zc => fun e m0 mN mD => @ZmodQuotMixinPack Q qc zc e m0 mN mD. Definition ZmodQuotType_clone (Q : Type) qT cT of phant_id (zmod_quot_class qT) cT := @ZmodQuotTypePack Q cT. Lemma zmod_quot_mixinP zqT : zmod_quot_mixin_of (zmod_quot_class zqT) (zmod_quot_class zqT). Proof. by case: zqT => [] ? [] ? ? []. Qed. Lemma pi_zeror zqT : \pi_zqT zeroT = 0. Proof. by case: zqT => [] ? [] ? ? []. Qed. Lemma pi_oppr zqT : {morph \pi_zqT : x / oppT x >-> - x}. Proof. by case: zqT => [] ? [] ? ? []. Qed. Lemma pi_addr zqT : {morph \pi_zqT : x y / addT x y >-> x + y}. Proof. by case: zqT => [] ? [] ? ? []. Qed. Canonical pi_zero_quot_morph zqT := PiMorph (pi_zeror zqT). Canonical pi_opp_quot_morph zqT := PiMorph1 (pi_oppr zqT). Canonical pi_add_quot_morph zqT := PiMorph2 (pi_addr zqT). End ZmodQuot. Notation ZmodQuotType z o a Q m := (@ZmodQuotType_pack _ _ z o a Q _ _ _ _ id id m). Notation "[ 'zmodQuotType' z , o & a 'of' Q ]" := (@ZmodQuotType_clone _ _ z o a Q _ _ id) (at level 0, format "[ 'zmodQuotType' z , o & a 'of' Q ]") : form_scope. Notation ZmodQuotMixin Q m0 mN mD := (@ZmodQuotMixin_pack _ _ _ _ _ Q _ _ id _ _ id (pi_eq_quot _) m0 mN mD). Section PiAdditive. Variables (V : zmodType) (equivV : rel V) (zeroV : V). Variable Q : @zmodQuotType V equivV zeroV -%R +%R. Lemma pi_is_additive : additive \pi_Q. Proof. by move=> x y /=; rewrite !piE. Qed. Canonical pi_additive := Additive pi_is_additive. End PiAdditive. Section RingQuot. Variable (T : Type). Variable eqT : rel T. Variables (zeroT : T) (oppT : T -> T) (addT : T -> T -> T). Variables (oneT : T) (mulT : T -> T -> T). Record ring_quot_mixin_of (Q : Type) (qc : quot_class_of T Q) (rc : GRing.Ring.class_of Q) := RingQuotMixinPack { ring_zmod_quot_mixin :> zmod_quot_mixin_of eqT zeroT oppT addT qc rc; _ : \pi_(QuotTypePack qc) oneT = 1 :> GRing.Ring.Pack rc; _ : {morph \pi_(QuotTypePack qc) : x y / mulT x y >-> @GRing.mul (GRing.Ring.Pack rc) x y} }. Record ring_quot_class_of (Q : Type) : Type := RingQuotClass { ring_quot_quot_class :> quot_class_of T Q; ring_quot_ring_class :> GRing.Ring.class_of Q; ring_quot_mixin :> ring_quot_mixin_of ring_quot_quot_class ring_quot_ring_class }. Structure ringQuotType : Type := RingQuotTypePack { ring_quot_sort :> Type; _ : ring_quot_class_of ring_quot_sort; }. Implicit Type rqT : ringQuotType. Definition ring_quot_class rqT : ring_quot_class_of rqT := let: RingQuotTypePack _ cT as qT' := rqT return ring_quot_class_of qT' in cT. Definition ring_zmod_quot_class rqT (rqc : ring_quot_class_of rqT) : zmod_quot_class_of eqT zeroT oppT addT rqT := ZmodQuotClass rqc. Definition ring_eq_quot_class rqT (rqc : ring_quot_class_of rqT) : eq_quot_class_of eqT rqT := EqQuotClass rqc. Canonical ringQuotType_eqType rqT := Equality.Pack (ring_quot_class rqT). Canonical ringQuotType_choiceType rqT := Choice.Pack (ring_quot_class rqT). Canonical ringQuotType_zmodType rqT := GRing.Zmodule.Pack (ring_quot_class rqT). Canonical ringQuotType_ringType rqT := GRing.Ring.Pack (ring_quot_class rqT). Canonical ringQuotType_quotType rqT := QuotTypePack (ring_quot_class rqT). Canonical ringQuotType_eqQuotType rqT := EqQuotTypePack (ring_eq_quot_class (ring_quot_class rqT)). Canonical ringQuotType_zmodQuotType rqT := ZmodQuotTypePack (ring_zmod_quot_class (ring_quot_class rqT)). Coercion ringQuotType_eqType : ringQuotType >-> eqType. Coercion ringQuotType_choiceType : ringQuotType >-> choiceType. Coercion ringQuotType_zmodType : ringQuotType >-> zmodType. Coercion ringQuotType_ringType : ringQuotType >-> ringType. Coercion ringQuotType_quotType : ringQuotType >-> quotType. Coercion ringQuotType_eqQuotType : ringQuotType >-> eqQuotType. Coercion ringQuotType_zmodQuotType : ringQuotType >-> zmodQuotType. Definition RingQuotType_pack Q := fun (qT : quotType T) (zT : ringType) qc rc of phant_id (quot_class qT) qc & phant_id (GRing.Ring.class zT) rc => fun m => RingQuotTypePack (@RingQuotClass Q qc rc m). Definition RingQuotMixin_pack Q := fun (qT : zmodQuotType eqT zeroT oppT addT) => fun (qc : zmod_quot_class_of eqT zeroT oppT addT Q) of phant_id (zmod_quot_class qT) qc => fun (rT : ringType) rc of phant_id (GRing.Ring.class rT) rc => fun mZ m1 mM => @RingQuotMixinPack Q qc rc mZ m1 mM. Definition RingQuotType_clone (Q : Type) qT cT of phant_id (ring_quot_class qT) cT := @RingQuotTypePack Q cT. Lemma ring_quot_mixinP rqT : ring_quot_mixin_of (ring_quot_class rqT) (ring_quot_class rqT). Proof. by case: rqT => [] ? [] ? ? []. Qed. Lemma pi_oner rqT : \pi_rqT oneT = 1. Proof. by case: rqT => [] ? [] ? ? []. Qed. Lemma pi_mulr rqT : {morph \pi_rqT : x y / mulT x y >-> x * y}. Proof. by case: rqT => [] ? [] ? ? []. Qed. Canonical pi_one_quot_morph rqT := PiMorph (pi_oner rqT). Canonical pi_mul_quot_morph rqT := PiMorph2 (pi_mulr rqT). End RingQuot. Notation RingQuotType o mul Q mix := (@RingQuotType_pack _ _ _ _ _ o mul Q _ _ _ _ id id mix). Notation "[ 'ringQuotType' o & m 'of' Q ]" := (@RingQuotType_clone _ _ _ _ _ o m Q _ _ id) (at level 0, format "[ 'ringQuotType' o & m 'of' Q ]") : form_scope. Notation RingQuotMixin Q m1 mM := (@RingQuotMixin_pack _ _ _ _ _ _ _ Q _ _ id _ _ id (zmod_quot_mixinP _) m1 mM). Section PiRMorphism. Variables (R : ringType) (equivR : rel R) (zeroR : R). Variable Q : @ringQuotType R equivR zeroR -%R +%R 1 *%R. Lemma pi_is_multiplicative : multiplicative \pi_Q. Proof. by split; do ?move=> x y /=; rewrite !piE. Qed. Canonical pi_rmorphism := AddRMorphism pi_is_multiplicative. End PiRMorphism. Section UnitRingQuot. Variable (T : Type). Variable eqT : rel T. Variables (zeroT : T) (oppT : T -> T) (addT : T -> T -> T). Variables (oneT : T) (mulT : T -> T -> T). Variables (unitT : pred T) (invT : T -> T). Record unit_ring_quot_mixin_of (Q : Type) (qc : quot_class_of T Q) (rc : GRing.UnitRing.class_of Q) := UnitRingQuotMixinPack { unit_ring_zmod_quot_mixin :> ring_quot_mixin_of eqT zeroT oppT addT oneT mulT qc rc; _ : {mono \pi_(QuotTypePack qc) : x / unitT x >-> x \in @GRing.unit (GRing.UnitRing.Pack rc)}; _ : {morph \pi_(QuotTypePack qc) : x / invT x >-> @GRing.inv (GRing.UnitRing.Pack rc) x} }. Record unit_ring_quot_class_of (Q : Type) : Type := UnitRingQuotClass { unit_ring_quot_quot_class :> quot_class_of T Q; unit_ring_quot_ring_class :> GRing.UnitRing.class_of Q; unit_ring_quot_mixin :> unit_ring_quot_mixin_of unit_ring_quot_quot_class unit_ring_quot_ring_class }. Structure unitRingQuotType : Type := UnitRingQuotTypePack { unit_ring_quot_sort :> Type; _ : unit_ring_quot_class_of unit_ring_quot_sort; }. Implicit Type rqT : unitRingQuotType. Definition unit_ring_quot_class rqT : unit_ring_quot_class_of rqT := let: UnitRingQuotTypePack _ cT as qT' := rqT return unit_ring_quot_class_of qT' in cT. Definition unit_ring_ring_quot_class rqT (rqc : unit_ring_quot_class_of rqT) : ring_quot_class_of eqT zeroT oppT addT oneT mulT rqT := RingQuotClass rqc. Definition unit_ring_zmod_quot_class rqT (rqc : unit_ring_quot_class_of rqT) : zmod_quot_class_of eqT zeroT oppT addT rqT := ZmodQuotClass rqc. Definition unit_ring_eq_quot_class rqT (rqc : unit_ring_quot_class_of rqT) : eq_quot_class_of eqT rqT := EqQuotClass rqc. Canonical unitRingQuotType_eqType rqT := Equality.Pack (unit_ring_quot_class rqT). Canonical unitRingQuotType_choiceType rqT := Choice.Pack (unit_ring_quot_class rqT). Canonical unitRingQuotType_zmodType rqT := GRing.Zmodule.Pack (unit_ring_quot_class rqT). Canonical unitRingQuotType_ringType rqT := GRing.Ring.Pack (unit_ring_quot_class rqT). Canonical unitRingQuotType_unitRingType rqT := GRing.UnitRing.Pack (unit_ring_quot_class rqT). Canonical unitRingQuotType_quotType rqT := QuotTypePack (unit_ring_quot_class rqT). Canonical unitRingQuotType_eqQuotType rqT := EqQuotTypePack (unit_ring_eq_quot_class (unit_ring_quot_class rqT)). Canonical unitRingQuotType_zmodQuotType rqT := ZmodQuotTypePack (unit_ring_zmod_quot_class (unit_ring_quot_class rqT)). Canonical unitRingQuotType_ringQuotType rqT := RingQuotTypePack (unit_ring_ring_quot_class (unit_ring_quot_class rqT)). Coercion unitRingQuotType_eqType : unitRingQuotType >-> eqType. Coercion unitRingQuotType_choiceType : unitRingQuotType >-> choiceType. Coercion unitRingQuotType_zmodType : unitRingQuotType >-> zmodType. Coercion unitRingQuotType_ringType : unitRingQuotType >-> ringType. Coercion unitRingQuotType_unitRingType : unitRingQuotType >-> unitRingType. Coercion unitRingQuotType_quotType : unitRingQuotType >-> quotType. Coercion unitRingQuotType_eqQuotType : unitRingQuotType >-> eqQuotType. Coercion unitRingQuotType_zmodQuotType : unitRingQuotType >-> zmodQuotType. Coercion unitRingQuotType_ringQuotType : unitRingQuotType >-> ringQuotType. Definition UnitRingQuotType_pack Q := fun (qT : quotType T) (rT : unitRingType) qc rc of phant_id (quot_class qT) qc & phant_id (GRing.UnitRing.class rT) rc => fun m => UnitRingQuotTypePack (@UnitRingQuotClass Q qc rc m). Definition UnitRingQuotMixin_pack Q := fun (qT : ringQuotType eqT zeroT oppT addT oneT mulT) => fun (qc : ring_quot_class_of eqT zeroT oppT addT oneT mulT Q) of phant_id (zmod_quot_class qT) qc => fun (rT : unitRingType) rc of phant_id (GRing.UnitRing.class rT) rc => fun mR mU mV => @UnitRingQuotMixinPack Q qc rc mR mU mV. Definition UnitRingQuotType_clone (Q : Type) qT cT of phant_id (unit_ring_quot_class qT) cT := @UnitRingQuotTypePack Q cT. Lemma unit_ring_quot_mixinP rqT : unit_ring_quot_mixin_of (unit_ring_quot_class rqT) (unit_ring_quot_class rqT). Proof. by case: rqT => [] ? [] ? ? []. Qed. Lemma pi_unitr rqT : {mono \pi_rqT : x / unitT x >-> x \in GRing.unit}. Proof. by case: rqT => [] ? [] ? ? []. Qed. Lemma pi_invr rqT : {morph \pi_rqT : x / invT x >-> x^-1}. Proof. by case: rqT => [] ? [] ? ? []. Qed. Canonical pi_unit_quot_morph rqT := PiMono1 (pi_unitr rqT). Canonical pi_inv_quot_morph rqT := PiMorph1 (pi_invr rqT). End UnitRingQuot. Notation UnitRingQuotType u i Q mix := (@UnitRingQuotType_pack _ _ _ _ _ _ _ u i Q _ _ _ _ id id mix). Notation "[ 'unitRingQuotType' u & i 'of' Q ]" := (@UnitRingQuotType_clone _ _ _ _ _ _ _ u i Q _ _ id) (at level 0, format "[ 'unitRingQuotType' u & i 'of' Q ]") : form_scope. Notation UnitRingQuotMixin Q mU mV := (@UnitRingQuotMixin_pack _ _ _ _ _ _ _ _ _ Q _ _ id _ _ id (zmod_quot_mixinP _) mU mV). Section IdealDef. Definition proper_ideal (R : ringType) (S : {pred R}) : Prop := 1 \notin S /\ forall a, {in S, forall u, a * u \in S}. Definition prime_idealr_closed (R : ringType) (S : {pred R}) : Prop := forall u v, u * v \in S -> (u \in S) || (v \in S). Definition idealr_closed (R : ringType) (S : {pred R}) := [/\ 0 \in S, 1 \notin S & forall a, {in S &, forall u v, a * u + v \in S}]. Lemma idealr_closed_nontrivial R S : @idealr_closed R S -> proper_ideal S. Proof. by case=> S0 S1 hS; split => // a x xS; rewrite -[_ * _]addr0 hS. Qed. Lemma idealr_closedB R S : @idealr_closed R S -> zmod_closed S. Proof. by case=> S0 _ hS; split=> // x y xS yS; rewrite -mulN1r addrC hS. Qed. Coercion idealr_closedB : idealr_closed >-> zmod_closed. Coercion idealr_closed_nontrivial : idealr_closed >-> proper_ideal. Structure idealr (R : ringType) (S : {pred R}) := MkIdeal { idealr_zmod :> zmodPred S; _ : proper_ideal S }. Structure prime_idealr (R : ringType) (S : {pred R}) := MkPrimeIdeal { prime_idealr_zmod :> idealr S; _ : prime_idealr_closed S }. Definition Idealr (R : ringType) (I : {pred R}) (zmodI : zmodPred I) (kI : keyed_pred zmodI) : proper_ideal I -> idealr I. Proof. by move=> kI1; split => //. Qed. Section IdealTheory. Variables (R : ringType) (I : {pred R}) (idealrI : idealr I) (kI : keyed_pred idealrI). Lemma idealr1 : 1 \in kI = false. Proof. by apply: negPf; case: idealrI kI => ? /= [? _] [] /= _ ->. Qed. Lemma idealMr a u : u \in kI -> a * u \in kI. Proof. by case: idealrI kI=> ? /= [? hI] [] /= ? hkI; rewrite !hkI; apply: hI. Qed. Lemma idealr0 : 0 \in kI. Proof. exact: rpred0. Qed. End IdealTheory. Section PrimeIdealTheory. Variables (R : comRingType) (I : {pred R}) (pidealrI : prime_idealr I) (kI : keyed_pred pidealrI). Lemma prime_idealrM u v : (u * v \in kI) = (u \in kI) || (v \in kI). Proof. apply/idP/idP; last by case/orP => /idealMr hI; rewrite // mulrC. by case: pidealrI kI=> ? /= hI [] /= ? hkI; rewrite !hkI; apply: hI. Qed. End PrimeIdealTheory. End IdealDef. Module Quotient. Section ZmodQuotient. Variables (R : zmodType) (I : {pred R}) (zmodI : zmodPred I) (kI : keyed_pred zmodI). Definition equiv (x y : R) := (x - y) \in kI. Lemma equivE x y : (equiv x y) = (x - y \in kI). Proof. by []. Qed. Lemma equiv_is_equiv : equiv_class_of equiv. Proof. split=> [x|x y|y x z]; rewrite !equivE ?subrr ?rpred0 //. by rewrite -opprB rpredN. by move=> *; rewrite -[x](addrNK y) -addrA rpredD. Qed. Canonical equiv_equiv := EquivRelPack equiv_is_equiv. Canonical equiv_encModRel := defaultEncModRel equiv. Definition type := {eq_quot equiv}. Definition type_of of phant R := type. Canonical rquot_quotType := [quotType of type]. Canonical rquot_eqType := [eqType of type]. Canonical rquot_choiceType := [choiceType of type]. Canonical rquot_eqQuotType := [eqQuotType equiv of type]. Lemma idealrBE x y : (x - y) \in kI = (x == y %[mod type]). Proof. by rewrite piE equivE. Qed. Lemma idealrDE x y : (x + y) \in kI = (x == - y %[mod type]). Proof. by rewrite -idealrBE opprK. Qed. Definition zero : type := lift_cst type 0. Definition add := lift_op2 type +%R. Definition opp := lift_op1 type -%R. Canonical pi_zero_morph := PiConst zero. Lemma pi_opp : {morph \pi : x / - x >-> opp x}. Proof. move=> x; unlock opp; apply/eqP; rewrite piE equivE. by rewrite -opprD rpredN idealrDE opprK reprK. Qed. Canonical pi_opp_morph := PiMorph1 pi_opp. Lemma pi_add : {morph \pi : x y / x + y >-> add x y}. Proof. move=> x y /=; unlock add; apply/eqP; rewrite piE equivE. rewrite opprD addrAC addrA -addrA. by rewrite rpredD // (idealrBE, idealrDE) ?pi_opp ?reprK. Qed. Canonical pi_add_morph := PiMorph2 pi_add. Lemma addqA: associative add. Proof. by move=> x y z; rewrite -[x]reprK -[y]reprK -[z]reprK !piE addrA. Qed. Lemma addqC: commutative add. Proof. by move=> x y; rewrite -[x]reprK -[y]reprK !piE addrC. Qed. Lemma add0q: left_id zero add. Proof. by move=> x; rewrite -[x]reprK !piE add0r. Qed. Lemma addNq: left_inverse zero opp add. Proof. by move=> x; rewrite -[x]reprK !piE addNr. Qed. Definition rquot_zmodMixin := ZmodMixin addqA addqC add0q addNq. Canonical rquot_zmodType := Eval hnf in ZmodType type rquot_zmodMixin. Definition rquot_zmodQuotMixin := ZmodQuotMixin type (lock _) pi_opp pi_add. Canonical rquot_zmodQuotType := ZmodQuotType 0 -%R +%R type rquot_zmodQuotMixin. End ZmodQuotient. Notation "{quot I }" := (@type_of _ _ _ I (Phant _)). Section RingQuotient. Variables (R : comRingType) (I : {pred R}) (idealI : idealr I) (kI : keyed_pred idealI). Local Notation type := {quot kI}. Definition one: type := lift_cst type 1. Definition mul := lift_op2 type *%R. Canonical pi_one_morph := PiConst one. Lemma pi_mul: {morph \pi : x y / x * y >-> mul x y}. Proof. move=> x y; unlock mul; apply/eqP; rewrite piE equivE. rewrite -[_ * _](addrNK (x * repr (\pi_type y))) -mulrBr. rewrite -addrA -mulrBl rpredD //. by rewrite idealMr // idealrDE opprK reprK. by rewrite mulrC idealMr // idealrDE opprK reprK. Qed. Canonical pi_mul_morph := PiMorph2 pi_mul. Lemma mulqA: associative mul. Proof. by move=> x y z; rewrite -[x]reprK -[y]reprK -[z]reprK !piE mulrA. Qed. Lemma mulqC: commutative mul. Proof. by move=> x y; rewrite -[x]reprK -[y]reprK !piE mulrC. Qed. Lemma mul1q: left_id one mul. Proof. by move=> x; rewrite -[x]reprK !piE mul1r. Qed. Lemma mulq_addl: left_distributive mul +%R. Proof. move=> x y z; rewrite -[x]reprK -[y]reprK -[z]reprK. by apply/eqP; rewrite piE /= mulrDl equiv_refl. Qed. Lemma nonzero1q: one != 0. Proof. by rewrite piE equivE subr0 idealr1. Qed. Definition rquot_comRingMixin := ComRingMixin mulqA mulqC mul1q mulq_addl nonzero1q. Canonical rquot_ringType := Eval hnf in RingType type rquot_comRingMixin. Canonical rquot_comRingType := Eval hnf in ComRingType type mulqC. Definition rquot_ringQuotMixin := RingQuotMixin type (lock _) pi_mul. Canonical rquot_ringQuotType := RingQuotType 1 *%R type rquot_ringQuotMixin. End RingQuotient. Section IDomainQuotient. Variables (R : comRingType) (I : {pred R}) (pidealI : prime_idealr I) (kI : keyed_pred pidealI). Lemma rquot_IdomainAxiom (x y : {quot kI}): x * y = 0 -> (x == 0) || (y == 0). Proof. by move=> /eqP; rewrite -[x]reprK -[y]reprK !piE !equivE !subr0 prime_idealrM. Qed. End IDomainQuotient. End Quotient. Notation "{ideal_quot I }" := (@Quotient.type_of _ _ _ I (Phant _)). Notation "x == y %[mod_ideal I ]" := (x == y %[mod {ideal_quot I}]) : quotient_scope. Notation "x = y %[mod_ideal I ]" := (x = y %[mod {ideal_quot I}]) : quotient_scope. Notation "x != y %[mod_ideal I ]" := (x != y %[mod {ideal_quot I}]) : quotient_scope. Notation "x <> y %[mod_ideal I ]" := (x <> y %[mod {ideal_quot I}]) : quotient_scope. Canonical Quotient.rquot_eqType. Canonical Quotient.rquot_choiceType. Canonical Quotient.rquot_zmodType. Canonical Quotient.rquot_ringType. Canonical Quotient.rquot_comRingType. Canonical Quotient.rquot_quotType. Canonical Quotient.rquot_eqQuotType. Canonical Quotient.rquot_zmodQuotType. Canonical Quotient.rquot_ringQuotType. math-comp-mathcomp-1.12.0/mathcomp/algebra/ssralg.v000066400000000000000000007623321375767750300222160ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq. From mathcomp Require Import choice fintype finfun bigop prime binomial. (******************************************************************************) (* The algebraic part of the Algebraic Hierarchy, as described in *) (* ``Packaging mathematical structures'', TPHOLs09, by *) (* Francois Garillot, Georges Gonthier, Assia Mahboubi, Laurence Rideau *) (* *) (* This file defines for each Structure (Zmodule, Ring, etc ...) its type, *) (* its packers and its canonical properties : *) (* *) (* * Zmodule (additive abelian groups): *) (* zmodType == interface type for Zmodule structure. *) (* ZmodMixin addA addC add0x addNx == builds the mixin for a Zmodule from the *) (* algebraic properties of its operations. *) (* ZmodType V m == packs the mixin m to build a Zmodule of type *) (* zmodType. The carrier type V must have a *) (* choiceType canonical structure. *) (* [zmodType of V for S] == V-clone of the zmodType structure S: a copy of S *) (* where the sort carrier has been replaced by V, *) (* and which is therefore a zmodType structure on V. *) (* The sort carrier for S must be convertible to V. *) (* [zmodType of V] == clone of a canonical zmodType structure on V. *) (* Similar to the above, except S is inferred, but *) (* possibly with a syntactically different carrier. *) (* 0 == the zero (additive identity) of a Zmodule. *) (* x + y == the sum of x and y (in a Zmodule). *) (* - x == the opposite (additive inverse) of x. *) (* x - y == the difference of x and y; this is only notation *) (* for x + (- y). *) (* x *+ n == n times x, with n in nat (non-negative), i.e., *) (* x + (x + .. (x + x)..) (n terms); x *+ 1 is thus *) (* convertible to x, and x *+ 2 to x + x. *) (* x *- n == notation for - (x *+ n), the opposite of x *+ n. *) (* \sum_ e == iterated sum for a Zmodule (cf bigop.v). *) (* e`_i == nth 0 e i, when e : seq M and M has a zmodType *) (* structure. *) (* support f == 0.-support f, i.e., [pred x | f x != 0]. *) (* oppr_closed S <-> collective predicate S is closed under opposite. *) (* addr_closed S <-> collective predicate S is closed under finite *) (* sums (0 and x + y in S, for x, y in S). *) (* zmod_closed S <-> collective predicate S is closed under zmodType *) (* operations (0 and x - y in S, for x, y in S). *) (* This property coerces to oppr_pred and addr_pred. *) (* OpprPred oppS == packs oppS : oppr_closed S into an opprPred S *) (* interface structure associating this property to *) (* the canonical pred_key S, i.e. the k for which S *) (* has a Canonical keyed_pred k structure (see file *) (* ssrbool.v). *) (* AddrPred addS == packs addS : addr_closed S into an addrPred S *) (* interface structure associating this property to *) (* the canonical pred_key S (see above). *) (* ZmodPred oppS == packs oppS : oppr_closed S into an zmodPred S *) (* interface structure associating the zmod_closed *) (* property to the canonical pred_key S (see above), *) (* which must already be an addrPred. *) (* [zmodMixin of M by <:] == zmodType mixin for a subType whose base type is *) (* a zmodType and whose predicate's canonical *) (* pred_key is a zmodPred. *) (* --> Coq can be made to behave as if all predicates had canonical zmodPred *) (* keys by executing Import DefaultKeying GRing.DefaultPred. The required *) (* oppr_closed and addr_closed assumptions will be either abstracted, *) (* resolved or issued as separate proof obligations by the ssreflect *) (* plugin abstraction and Prop-irrelevance functions. *) (* * Ring (non-commutative rings): *) (* ringType == interface type for a Ring structure. *) (* RingMixin mulA mul1x mulx1 mulDx mulxD == builds the mixin for a Ring from *) (* the algebraic properties of its multiplicative *) (* operators; the carrier type must have a zmodType *) (* structure. *) (* RingType R m == packs the ring mixin m into a ringType. *) (* R^c == the converse Ring for R: R^c is convertible to R *) (* but when R has a canonical ringType structure *) (* R^c has the converse one: if x y : R^c, then *) (* x * y = (y : R) * (x : R). *) (* [ringType of R for S] == R-clone of the ringType structure S. *) (* [ringType of R] == clone of a canonical ringType structure on R. *) (* 1 == the multiplicative identity element of a Ring. *) (* n%:R == the ring image of an n in nat; this is just *) (* notation for 1 *+ n, so 1%:R is convertible to 1 *) (* and 2%:R to 1 + 1. *) (* x * y == the ring product of x and y. *) (* \prod_ e == iterated product for a ring (cf bigop.v). *) (* x ^+ n == x to the nth power with n in nat (non-negative), *) (* i.e., x * (x * .. (x * x)..) (n factors); x ^+ 1 *) (* is thus convertible to x, and x ^+ 2 to x * x. *) (* GRing.sign R b := (-1) ^+ b in R : ringType, with b : bool. *) (* This is a parsing-only helper notation, to be *) (* used for defining more specific instances. *) (* GRing.comm x y <-> x and y commute, i.e., x * y = y * x. *) (* GRing.lreg x <-> x if left-regular, i.e., *%R x is injective. *) (* GRing.rreg x <-> x if right-regular, i.e., *%R x is injective. *) (* [char R] == the characteristic of R, defined as the set of *) (* prime numbers p such that p%:R = 0 in R. The set *) (* [char R] has at most one element, and is *) (* implemented as a pred_nat collective predicate *) (* (see prime.v); thus the statement p \in [char R] *) (* can be read as `R has characteristic p', while *) (* [char R] =i pred0 means `R has characteristic 0' *) (* when R is a field. *) (* Frobenius_aut chRp == the Frobenius automorphism mapping x in R to *) (* x ^+ p, where chRp : p \in [char R] is a proof *) (* that R has (non-zero) characteristic p. *) (* mulr_closed S <-> collective predicate S is closed under finite *) (* products (1 and x * y in S for x, y in S). *) (* smulr_closed S <-> collective predicate S is closed under products *) (* and opposite (-1 and x * y in S for x, y in S). *) (* semiring_closed S <-> collective predicate S is closed under semiring *) (* operations (0, 1, x + y and x * y in S). *) (* subring_closed S <-> collective predicate S is closed under ring *) (* operations (1, x - y and x * y in S). *) (* MulrPred mulS == packs mulS : mulr_closed S into a mulrPred S, *) (* SmulrPred mulS smulrPred S, semiringPred S, or subringPred S *) (* SemiringPred mulS interface structure, corresponding to the above *) (* SubRingPred mulS properties, respectively, provided S already has *) (* the supplementary zmodType closure properties. *) (* The properties above coerce to subproperties so, *) (* e.g., ringS : subring_closed S can be used for *) (* the proof obligations of all prerequisites. *) (* [ringMixin of R by <:] == ringType mixin for a subType whose base type is *) (* a ringType and whose predicate's canonical key *) (* is a SubringPred. *) (* --> As for zmodType predicates, Import DefaultKeying GRing.DefaultPred *) (* turns unresolved GRing.Pred unification constraints into proof *) (* obligations for basic closure assumptions. *) (* *) (* * ComRing (commutative Rings): *) (* comRingType == interface type for commutative ring structure. *) (* ComRingType R mulC == packs mulC into a comRingType; the carrier type *) (* R must have a ringType canonical structure. *) (* ComRingMixin mulA mulC mul1x mulDx == builds the mixin for a Ring (i.e., a *) (* *non commutative* ring), using the commutativity *) (* to reduce the number of proof obligations. *) (* [comRingType of R for S] == R-clone of the comRingType structure S. *) (* [comRingType of R] == clone of a canonical comRingType structure on R. *) (* [comRingMixin of R by <:] == comutativity mixin axiom for R when it is a *) (* subType of a commutative ring. *) (* *) (* * UnitRing (Rings whose units have computable inverses): *) (* unitRingType == interface type for the UnitRing structure. *) (* UnitRingMixin mulVr mulrV unitP inv0id == builds the mixin for a UnitRing *) (* from the properties of the inverse operation and *) (* the boolean test for being a unit (invertible). *) (* The inverse of a non-unit x is constrained to be *) (* x itself (property inv0id). The carrier type *) (* must have a ringType canonical structure. *) (* UnitRingType R m == packs the unit ring mixin m into a unitRingType. *) (* WARNING: while it is possible to omit R for most of the *) (* XxxType functions, R MUST be explicitly given *) (* when UnitRingType is used with a mixin produced *) (* by ComUnitRingMixin, in a Canonical definition, *) (* otherwise the resulting structure will have the *) (* WRONG sort key and will NOT BE USED during type *) (* inference. *) (* [unitRingType of R for S] == R-clone of the unitRingType structure S. *) (* [unitRingType of R] == clones a canonical unitRingType structure on R. *) (* x \is a GRing.unit <=> x is a unit (i.e., has an inverse). *) (* x^-1 == the ring inverse of x, if x is a unit, else x. *) (* x / y == x divided by y (notation for x * y^-1). *) (* x ^- n := notation for (x ^+ n)^-1, the inverse of x ^+ n. *) (* invr_closed S <-> collective predicate S is closed under inverse. *) (* divr_closed S <-> collective predicate S is closed under division *) (* (1 and x / y in S). *) (* sdivr_closed S <-> collective predicate S is closed under division *) (* and opposite (-1 and x / y in S, for x, y in S). *) (* divring_closed S <-> collective predicate S is closed under unitRing *) (* operations (1, x - y and x / y in S). *) (* DivrPred invS == packs invS : mulr_closed S into a divrPred S, *) (* SdivrPred invS sdivrPred S or divringPred S interface structure, *) (* DivringPred invS corresponding to the above properties, resp., *) (* provided S already has the supplementary ringType *) (* closure properties. The properties above coerce *) (* to subproperties, as explained above. *) (* [unitRingMixin of R by <:] == unitRingType mixin for a subType whose base *) (* type is a unitRingType and whose predicate's *) (* canonical key is a divringPred and whose ring *) (* structure is compatible with the base type's. *) (* *) (* * ComUnitRing (commutative rings with computable inverses): *) (* comUnitRingType == interface type for ComUnitRing structure. *) (* ComUnitRingMixin mulVr unitP inv0id == builds the mixin for a UnitRing (a *) (* *non commutative* unit ring, using commutativity *) (* to simplify the proof obligations; the carrier *) (* type must have a comRingType structure. *) (* WARNING: ALWAYS give an explicit type argument *) (* to UnitRingType along with a mixin produced by *) (* ComUnitRingMixin (see above). *) (* [comUnitRingType of R] == a comUnitRingType structure for R created by *) (* merging canonical comRingType and unitRingType *) (* structures on R. *) (* *) (* * IntegralDomain (integral, commutative, ring with partial inverses): *) (* idomainType == interface type for the IntegralDomain structure. *) (* IdomainType R mulf_eq0 == packs the integrality property into an *) (* idomainType integral domain structure; R must *) (* have a comUnitRingType canonical structure. *) (* [idomainType of R for S] == R-clone of the idomainType structure S. *) (* [idomainType of R] == clone of a canonical idomainType structure on R. *) (* [idomainMixin of R by <:] == mixin axiom for a idomain subType. *) (* *) (* * Field (commutative fields): *) (* fieldType == interface type for fields. *) (* GRing.Field.mixin_of R == the field property: x != 0 -> x \is a unit, for *) (* x : R; R must be or coerce to a unitRingType. *) (* GRing.Field.axiom inv == the field axiom: x != 0 -> inv x * x = 1 for all *) (* x. This is equivalent to the property above, but *) (* does not require a unitRingType as inv is an *) (* explicit argument. *) (* FieldUnitMixin mulVf inv0 == a *non commutative unit ring* mixin, using an *) (* inverse function that satisfies the field axiom *) (* and fixes 0 (arguments mulVf and inv0, resp.), *) (* and x != 0 as the Ring.unit predicate. The *) (* carrier type must be a canonical comRingType. *) (* FieldIdomainMixin m == an *idomain* mixin derived from a field mixin m. *) (* GRing.Field.IdomainType mulVf inv0 == an idomainType incorporating the two *) (* mixins above, where FieldIdomainMixin is applied *) (* to the trivial field mixin for FieldUnitMixin. *) (* FieldMixin mulVf inv0 == the (trivial) field mixin for Field.IdomainType. *) (* FieldType R m == packs the field mixin M into a fieldType. The *) (* carrier type R must be an idomainType. *) (* --> Given proofs mulVf and inv0 as above, a non-Canonical instances *) (* of fieldType can be created with FieldType _ (FieldMixin mulVf inv0). *) (* For Canonical instances one should always specify the first (sort) *) (* argument of FieldType and other instance constructors, as well as pose *) (* Definitions for unit ring, field, and idomain mixins (in that order). *) (* [fieldType of F for S] == F-clone of the fieldType structure S. *) (* [fieldType of F] == clone of a canonical fieldType structure on F. *) (* [fieldMixin of R by <:] == mixin axiom for a field subType. *) (* *) (* * DecidableField (fields with a decidable first order theory): *) (* decFieldType == interface type for DecidableField structure. *) (* DecFieldMixin satP == builds the mixin for a DecidableField from the *) (* correctness of its satisfiability predicate. The *) (* carrier type must have a unitRingType structure. *) (* DecFieldType F m == packs the decidable field mixin m into a *) (* decFieldType; the carrier type F must have a *) (* fieldType structure. *) (* [decFieldType of F for S] == F-clone of the decFieldType structure S. *) (* [decFieldType of F] == clone of a canonical decFieldType structure on F *) (* GRing.term R == the type of formal expressions in a unit ring R *) (* with formal variables 'X_k, k : nat, and *) (* manifest constants x%:T, x : R. The notation of *) (* all the ring operations is redefined for terms, *) (* in scope %T. *) (* GRing.formula R == the type of first order formulas over R; the %T *) (* scope binds the logical connectives /\, \/, ~, *) (* ==>, ==, and != to formulae; GRing.True/False *) (* and GRing.Bool b denote constant formulae, and *) (* quantifiers are written 'forall/'exists 'X_k, f. *) (* GRing.Unit x tests for ring units *) (* GRing.If p_f t_f e_f emulates if-then-else *) (* GRing.Pick p_f t_f e_f emulates fintype.pick *) (* foldr GRing.Exists/Forall q_f xs can be used *) (* to write iterated quantifiers. *) (* GRing.eval e t == the value of term t with valuation e : seq R *) (* (e maps 'X_i to e`_i). *) (* GRing.same_env e1 e2 <-> environments e1 and e2 are extensionally equal. *) (* GRing.qf_form f == f is quantifier-free. *) (* GRing.holds e f == the intuitionistic CiC interpretation of the *) (* formula f holds with valuation e. *) (* GRing.qf_eval e f == the value (in bool) of a quantifier-free f. *) (* GRing.sat e f == valuation e satisfies f (only in a decField). *) (* GRing.sol n f == a sequence e of size n such that e satisfies f, *) (* if one exists, or [::] if there is no such e. *) (* QEdecFieldMixin wfP okP == a decidable field Mixin built from a quantifier *) (* eliminator p and proofs wfP : GRing.wf_QE_proj p *) (* and okP : GRing.valid_QE_proj p that p returns *) (* well-formed and valid formulae, i.e., p i (u, v) *) (* is a quantifier-free formula equivalent to *) (* 'exists 'X_i, u1 == 0 /\ ... /\ u_m == 0 /\ v1 != 0 ... /\ v_n != 0 *) (* *) (* * ClosedField (algebraically closed fields): *) (* closedFieldType == interface type for the ClosedField structure. *) (* ClosedFieldType F m == packs the closed field mixin m into a *) (* closedFieldType. The carrier F must have a *) (* decFieldType structure. *) (* [closedFieldType of F on S] == F-clone of a closedFieldType structure S. *) (* [closedFieldType of F] == clone of a canonicalclosedFieldType structure *) (* on F. *) (* *) (* * Lmodule (module with left multiplication by external scalars). *) (* lmodType R == interface type for an Lmodule structure with *) (* scalars of type R; R must have a ringType *) (* structure. *) (* LmodMixin scalA scal1v scalxD scalDv == builds an Lmodule mixin from the *) (* algebraic properties of the scaling operation; *) (* the module carrier type must have a zmodType *) (* structure, and the scalar carrier must have a *) (* ringType structure. *) (* LmodType R V m == packs the mixin v to build an Lmodule of type *) (* lmodType R. The carrier type V must have a *) (* zmodType structure. *) (* [lmodType R of V for S] == V-clone of an lmodType R structure S. *) (* [lmodType R of V] == clone of a canonical lmodType R structure on V. *) (* a *: v == v scaled by a, when v is in an Lmodule V and a *) (* is in the scalar Ring of V. *) (* scaler_closed S <-> collective predicate S is closed under scaling. *) (* linear_closed S <-> collective predicate S is closed under linear *) (* combinations (a *: u + v in S when u, v in S). *) (* submod_closed S <-> collective predicate S is closed under lmodType *) (* operations (0 and a *: u + v in S). *) (* SubmodPred scaleS == packs scaleS : scaler_closed S in a submodPred S *) (* interface structure corresponding to the above *) (* property, provided S's key is a zmodPred; *) (* submod_closed coerces to all the prerequisites. *) (* [lmodMixin of V by <:] == mixin for a subType of an lmodType, whose *) (* predicate's key is a submodPred. *) (* *) (* * Lalgebra (left algebra, ring with scaling that associates on the left): *) (* lalgType R == interface type for Lalgebra structures with *) (* scalars in R; R must have ringType structure. *) (* LalgType R V scalAl == packs scalAl : k (x y) = (k x) y into an *) (* Lalgebra of type lalgType R. The carrier type V *) (* must have both lmodType R and ringType canonical *) (* structures. *) (* R^o == the regular algebra of R: R^o is convertible to *) (* R, but when R has a ringType structure then R^o *) (* extends it to an lalgType structure by letting R *) (* act on itself: if x : R and y : R^o then *) (* x *: y = x * (y : R). *) (* k%:A == the image of the scalar k in an L-algebra; this *) (* is simply notation for k *: 1. *) (* [lalgType R of V for S] == V-clone the lalgType R structure S. *) (* [lalgType R of V] == clone of a canonical lalgType R structure on V. *) (* subalg_closed S <-> collective predicate S is closed under lalgType *) (* operations (1, a *: u + v and u * v in S). *) (* SubalgPred scaleS == packs scaleS : scaler_closed S in a subalgPred S *) (* interface structure corresponding to the above *) (* property, provided S's key is a subringPred; *) (* subalg_closed coerces to all the prerequisites. *) (* [lalgMixin of V by <:] == mixin axiom for a subType of an lalgType. *) (* *) (* * Algebra (ring with scaling that associates both left and right): *) (* algType R == type for Algebra structure with scalars in R. *) (* R should be a commutative ring. *) (* AlgType R A scalAr == packs scalAr : k (x y) = x (k y) into an Algebra *) (* Structure of type algType R. The carrier type A *) (* must have an lalgType R structure. *) (* CommAlgType R A == creates an Algebra structure for an A that has *) (* both lalgType R and comRingType structures. *) (* [algType R of V for S] == V-clone of an algType R structure on S. *) (* [algType R of V] == clone of a canonical algType R structure on V. *) (* [algMixin of V by <:] == mixin axiom for a subType of an algType. *) (* *) (* * UnitAlgebra (algebra with computable inverses): *) (* unitAlgType R == interface type for UnitAlgebra structure with *) (* scalars in R; R should have a unitRingType *) (* structure. *) (* [unitAlgType R of V] == a unitAlgType R structure for V created by *) (* merging canonical algType and unitRingType on V. *) (* divalg_closed S <-> collective predicate S is closed under all *) (* unitAlgType operations (1, a *: u + v and u / v *) (* are in S fo u, v in S). *) (* DivalgPred scaleS == packs scaleS : scaler_closed S in a divalgPred S *) (* interface structure corresponding to the above *) (* property, provided S's key is a divringPred; *) (* divalg_closed coerces to all the prerequisites. *) (* *) (* * ComAlgebra (commutative algebra): *) (* comAlgType R == interface type for ComAlgebra structure with *) (* scalars in R; R should have a comRingType *) (* structure. *) (* [comAlgType R of V] == a comAlgType R structure for V created by *) (* merging canonical algType and comRingType on V. *) (* *) (* * ComUnitAlgebra (commutative algebra with computable inverses): *) (* comUnitAlgType R == interface type for ComUnitAlgebra structure with *) (* scalars in R; R should have a comUnitRingType *) (* structure. *) (* [comUnitAlgType R of V] == a comUnitAlgType R structure for V created by *) (* merging canonical comAlgType and *) (* unitRingType on V. *) (* *) (* In addition to this structure hierarchy, we also develop a separate, *) (* parallel hierarchy for morphisms linking these structures: *) (* *) (* * Additive (additive functions): *) (* additive f <-> f of type U -> V is additive, i.e., f maps the *) (* Zmodule structure of U to that of V, 0 to 0, *) (* - to - and + to + (equivalently, binary - to -). *) (* := {morph f : u v / u + v}. *) (* {additive U -> V} == the interface type for a Structure (keyed on *) (* a function f : U -> V) that encapsulates the *) (* additive property; both U and V must have *) (* zmodType canonical structures. *) (* Additive add_f == packs add_f : additive f into an additive *) (* function structure of type {additive U -> V}. *) (* [additive of f as g] == an f-clone of the additive structure on the *) (* function g -- f and g must be convertible. *) (* [additive of f] == a clone of an existing additive structure on f. *) (* *) (* * RMorphism (ring morphisms): *) (* multiplicative f <-> f of type R -> S is multiplicative, i.e., f *) (* maps 1 and * in R to 1 and * in S, respectively, *) (* R ans S must have canonical ringType structures. *) (* rmorphism f <-> f is a ring morphism, i.e., f is both additive *) (* and multiplicative. *) (* {rmorphism R -> S} == the interface type for ring morphisms, i.e., *) (* a Structure that encapsulates the rmorphism *) (* property for functions f : R -> S; both R and S *) (* must have ringType structures. *) (* RMorphism morph_f == packs morph_f : rmorphism f into a Ring morphism *) (* structure of type {rmorphism R -> S}. *) (* AddRMorphism mul_f == packs mul_f : multiplicative f into an rmorphism *) (* structure of type {rmorphism R -> S}; f must *) (* already have an {additive R -> S} structure. *) (* [rmorphism of f as g] == an f-clone of the rmorphism structure of g. *) (* [rmorphism of f] == a clone of an existing additive structure on f. *) (* -> If R and S are UnitRings the f also maps units to units and inverses *) (* of units to inverses; if R is a field then f is a field isomorphism *) (* between R and its image. *) (* -> As rmorphism coerces to both additive and multiplicative, all *) (* structures for f can be built from a single proof of rmorphism f. *) (* -> Additive properties (raddf_suffix, see below) are duplicated and *) (* specialised for RMorphism (as rmorph_suffix). This allows more *) (* precise rewriting and cleaner chaining: although raddf lemmas will *) (* recognize RMorphism functions, the converse will not hold (we cannot *) (* add reverse inheritance rules because of incomplete backtracking in *) (* the Canonical Projection unification), so one would have to insert a *) (* /= every time one switched from additive to multiplicative rules. *) (* -> The property duplication also means that it is not strictly necessary *) (* to declare all Additive instances. *) (* *) (* * Linear (linear functions): *) (* scalable f <-> f of type U -> V is scalable, i.e., f morphs *) (* scaling on U to scaling on V, a *: _ to a *: _. *) (* U and V must both have lmodType R structures, *) (* for the same ringType R. *) (* scalable_for s f <-> f is scalable for scaling operator s, i.e., *) (* f morphs a *: _ to s a _; the range of f only *) (* need to be a zmodType. The scaling operator s *) (* should be one of *:%R (see scalable, above), *%R *) (* or a combination nu \; *%R or nu \; *:%R with *) (* nu : {rmorphism _}; otherwise some of the theory *) (* (e.g., the linearZ rule) will not apply. *) (* linear f <-> f of type U -> V is linear, i.e., f morphs *) (* linear combinations a *: u + v in U to similar *) (* linear combinations in V; U and V must both have *) (* lmodType R structures, for the same ringType R. *) (* := forall a, {morph f: u v / a *: u + v}. *) (* scalar f <-> f of type U -> R is a scalar function, i.e., *) (* f (a *: u + v) = a * f u + f v. *) (* linear_for s f <-> f is linear for the scaling operator s, i.e., *) (* f (a *: u + v) = s a (f u) + f v. The range of f *) (* only needs to be a zmodType, but s MUST be of *) (* the form described in in scalable_for paragraph *) (* for this predicate to type check. *) (* lmorphism f <-> f is both additive and scalable. This is in *) (* fact equivalent to linear f, although somewhat *) (* less convenient to prove. *) (* lmorphism_for s f <-> f is both additive and scalable for s. *) (* {linear U -> V} == the interface type for linear functions, i.e., a *) (* Structure that encapsulates the linear property *) (* for functions f : U -> V; both U and V must have *) (* lmodType R structures, for the same R. *) (* {scalar U} == the interface type for scalar functions, of type *) (* U -> R where U has an lmodType R structure. *) (* {linear U -> V | s} == the interface type for functions linear for s. *) (* Linear lin_f == packs lin_f : lmorphism_for s f into a linear *) (* function structure of type {linear U -> V | s}. *) (* As linear_for s f coerces to lmorphism_for s f, *) (* Linear can be used with lin_f : linear_for s f *) (* (indeed, that is the recommended usage). Note *) (* that as linear f, scalar f, {linear U -> V} and *) (* {scalar U} are simply notation for corresponding *) (* generic "_for" forms, Linear can be used for any *) (* of these special cases, transparently. *) (* AddLinear scal_f == packs scal_f : scalable_for s f into a *) (* {linear U -> V | s} structure; f must already *) (* have an additive structure; as with Linear, *) (* AddLinear can be used with lin_f : linear f, etc *) (* [linear of f as g] == an f-clone of the linear structure of g. *) (* [linear of f] == a clone of an existing linear structure on f. *) (* (a *: u)%Rlin == transient forms that simplify to a *: u, a * u, *) (* (a * u)%Rlin nu a *: u, and nu a * u, respectively, and are *) (* (a *:^nu u)%Rlin created by rewriting with the linearZ lemma. The *) (* (a *^nu u)%Rlin forms allows the RHS of linearZ to be matched *) (* reliably, using the GRing.Scale.law structure. *) (* -> Similarly to Ring morphisms, additive properties are specialized for *) (* linear functions. *) (* -> Although {scalar U} is convertible to {linear U -> R^o}, it does not *) (* actually use R^o, so that rewriting preserves the canonical structure *) (* of the range of scalar functions. *) (* -> The generic linearZ lemma uses a set of bespoke interface structures to *) (* ensure that both left-to-right and right-to-left rewriting work even in *) (* the presence of scaling functions that simplify non-trivially (e.g., *) (* idfun \; *%R). Because most of the canonical instances and projections *) (* are coercions the machinery will be mostly invisible (with only the *) (* {linear ...} structure and %Rlin notations showing), but users should *) (* beware that in (a *: f u)%Rlin, a actually occurs in the f u subterm. *) (* -> The simpler linear_LR, or more specialized linearZZ and scalarZ rules *) (* should be used instead of linearZ if there are complexity issues, as *) (* well as for explicit forward and backward application, as the main *) (* parameter of linearZ is a proper sub-interface of {linear fUV | s}. *) (* *) (* * LRMorphism (linear ring morphisms, i.e., algebra morphisms): *) (* lrmorphism f <-> f of type A -> B is a linear Ring (Algebra) *) (* morphism: f is both additive, multiplicative and *) (* scalable. A and B must both have lalgType R *) (* canonical structures, for the same ringType R. *) (* lrmorphism_for s f <-> f a linear Ring morphism for the scaling *) (* operator s: f is additive, multiplicative and *) (* scalable for s. A must be an lalgType R, but B *) (* only needs to have a ringType structure. *) (* {lrmorphism A -> B} == the interface type for linear morphisms, i.e., a *) (* Structure that encapsulates the lrmorphism *) (* property for functions f : A -> B; both A and B *) (* must have lalgType R structures, for the same R. *) (* {lrmorphism A -> B | s} == the interface type for morphisms linear for s. *) (* LRmorphism lrmorph_f == packs lrmorph_f : lrmorphism_for s f into a *) (* linear morphism structure of type *) (* {lrmorphism A -> B | s}. Like Linear, LRmorphism *) (* can be used transparently for lrmorphism f. *) (* AddLRmorphism scal_f == packs scal_f : scalable_for s f into a linear *) (* morphism structure of type *) (* {lrmorphism A -> B | s}; f must already have an *) (* {rmorphism A -> B} structure, and AddLRmorphism *) (* can be applied to a linear_for s f, linear f, *) (* scalar f, etc argument, like AddLinear. *) (* [lrmorphism of f] == creates an lrmorphism structure from existing *) (* rmorphism and linear structures on f; this is *) (* the preferred way of creating lrmorphism *) (* structures. *) (* -> Linear and rmorphism properties do not need to be specialized for *) (* as we supply inheritance join instances in both directions. *) (* Finally we supply some helper notation for morphisms: *) (* x^f == the image of x under some morphism. This *) (* notation is only reserved (not defined) here; *) (* it is bound locally in sections where some *) (* morphism is used heavily (e.g., the container *) (* morphism in the parametricity sections of poly *) (* and matrix, or the Frobenius section here). *) (* \0 == the constant null function, which has a *) (* canonical linear structure, and simplifies on *) (* application (see ssrfun.v). *) (* f \+ g == the additive composition of f and g, i.e., the *) (* function x |-> f x + g x; f \+ g is canonically *) (* linear when f and g are, and simplifies on *) (* application (see ssrfun.v). *) (* f \- g == the function x |-> f x - g x, canonically *) (* linear when f and g are, and simplifies on *) (* application. *) (* k \*: f == the function x |-> k *: f x, which is *) (* canonically linear when f is and simplifies on *) (* application (this is a shorter alternative to *) (* *:%R k \o f). *) (* GRing.in_alg A == the ring morphism that injects R into A, where A *) (* has an lalgType R structure; GRing.in_alg A k *) (* simplifies to k%:A. *) (* a \*o f == the function x |-> a * f x, canonically linear *) (* linear when f is and its codomain is an algType *) (* and which simplifies on application. *) (* a \o* f == the function x |-> f x * a, canonically linear *) (* linear when f is and its codomain is an lalgType *) (* and which simplifies on application. *) (* The Lemmas about these structures are contained in both the GRing module *) (* and in the submodule GRing.Theory, which can be imported when unqualified *) (* access to the theory is needed (GRing.Theory also allows the unqualified *) (* use of additive, linear, Linear, etc). The main GRing module should NOT be *) (* imported. *) (* Notations are defined in scope ring_scope (delimiter %R), except term *) (* and formula notations, which are in term_scope (delimiter %T). *) (* This library also extends the conventional suffixes described in library *) (* ssrbool.v with the following: *) (* 0 -- ring 0, as in addr0 : x + 0 = x. *) (* 1 -- ring 1, as in mulr1 : x * 1 = x. *) (* D -- ring addition, as in linearD : f (u + v) = f u + f v. *) (* B -- ring subtraction, as in opprB : - (x - y) = y - x. *) (* M -- ring multiplication, as in invfM : (x * y)^-1 = x^-1 * y^-1. *) (* Mn -- ring by nat multiplication, as in raddfMn : f (x *+ n) = f x *+ n. *) (* N -- ring opposite, as in mulNr : (- x) * y = - (x * y). *) (* V -- ring inverse, as in mulVr : x^-1 * x = 1. *) (* X -- ring exponentiation, as in rmorphX : f (x ^+ n) = f x ^+ n. *) (* Z -- (left) module scaling, as in linearZ : f (a *: v) = s *: f v. *) (* The operator suffixes D, B, M and X are also used for the corresponding *) (* operations on nat, as in natrX : (m ^ n)%:R = m%:R ^+ n. For the binary *) (* power operator, a trailing "n" suffix is used to indicate the operator *) (* suffix applies to the left-hand ring argument, as in *) (* expr1n : 1 ^+ n = 1 vs. expr1 : x ^+ 1 = x. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope ring_scope. Declare Scope term_scope. Declare Scope linear_ring_scope. Reserved Notation "+%R" (at level 0). Reserved Notation "-%R" (at level 0). Reserved Notation "*%R" (at level 0, format " *%R"). Reserved Notation "*:%R" (at level 0, format " *:%R"). Reserved Notation "n %:R" (at level 2, left associativity, format "n %:R"). Reserved Notation "k %:A" (at level 2, left associativity, format "k %:A"). Reserved Notation "[ 'char' F ]" (at level 0, format "[ 'char' F ]"). Reserved Notation "x %:T" (at level 2, left associativity, format "x %:T"). Reserved Notation "''X_' i" (at level 8, i at level 2, format "''X_' i"). (* Patch for recurring Coq parser bug: Coq seg faults when a level 200 *) (* notation is used as a pattern. *) Reserved Notation "''exists' ''X_' i , f" (at level 199, i at level 2, right associativity, format "'[hv' ''exists' ''X_' i , '/ ' f ']'"). Reserved Notation "''forall' ''X_' i , f" (at level 199, i at level 2, right associativity, format "'[hv' ''forall' ''X_' i , '/ ' f ']'"). Reserved Notation "x ^f" (at level 2, left associativity, format "x ^f"). Reserved Notation "\0" (at level 0). Reserved Notation "f \+ g" (at level 50, left associativity). Reserved Notation "f \- g" (at level 50, left associativity). Reserved Notation "a \*o f" (at level 40). Reserved Notation "a \o* f" (at level 40). Reserved Notation "a \*: f" (at level 40). Delimit Scope ring_scope with R. Delimit Scope term_scope with T. Local Open Scope ring_scope. Module Import GRing. Import Monoid.Theory. Module Zmodule. Record mixin_of (V : Type) : Type := Mixin { zero : V; opp : V -> V; add : V -> V -> V; _ : associative add; _ : commutative add; _ : left_id zero add; _ : left_inverse zero opp add }. Section ClassDef. Set Primitive Projections. Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of T }. Unset Primitive Projections. Local Coercion base : class_of >-> Choice.class_of. 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. Definition clone c of phant_id class c := @Pack T c. Definition pack m := fun bT b & phant_id (Choice.class bT) b => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Choice.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Notation zmodType := type. Notation ZmodType T m := (@pack T m _ _ id). Notation ZmodMixin := Mixin. Notation "[ 'zmodType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'zmodType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'zmodType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'zmodType' 'of' T ]") : form_scope. End Exports. End Zmodule. Import Zmodule.Exports. Definition zero V := Zmodule.zero (Zmodule.class V). Definition opp V := Zmodule.opp (Zmodule.class V). Definition add V := Zmodule.add (Zmodule.class V). Local Notation "0" := (zero _) : ring_scope. Local Notation "-%R" := (@opp _) : ring_scope. Local Notation "- x" := (opp x) : ring_scope. Local Notation "+%R" := (@add _) : ring_scope. Local Notation "x + y" := (add x y) : ring_scope. Local Notation "x - y" := (x + - y) : ring_scope. Definition natmul V x n := nosimpl iterop _ n +%R x (zero V). Local Notation "x *+ n" := (natmul x n) : ring_scope. Local Notation "x *- n" := (- (x *+ n)) : ring_scope. Local Notation "\sum_ ( i <- r | P ) F" := (\big[+%R/0]_(i <- r | P) F). Local Notation "\sum_ ( m <= i < n ) F" := (\big[+%R/0]_(m <= i < n) F). Local Notation "\sum_ ( i < n ) F" := (\big[+%R/0]_(i < n) F). Local Notation "\sum_ ( i 'in' A ) F" := (\big[+%R/0]_(i in A) F). Local Notation "s `_ i" := (nth 0 s i) : ring_scope. Section ZmoduleTheory. Variable V : zmodType. Implicit Types x y : V. Lemma addrA : @associative V +%R. Proof. by case V => T [? []]. Qed. Lemma addrC : @commutative V V +%R. Proof. by case V => T [? []]. Qed. Lemma add0r : @left_id V V 0 +%R. Proof. by case V => T [? []]. Qed. Lemma addNr : @left_inverse V V V 0 -%R +%R. Proof. by case V => T [? []]. Qed. Lemma addr0 : @right_id V V 0 +%R. Proof. by move=> x; rewrite addrC add0r. Qed. Lemma addrN : @right_inverse V V V 0 -%R +%R. Proof. by move=> x; rewrite addrC addNr. Qed. Definition subrr := addrN. Canonical add_monoid := Monoid.Law addrA add0r addr0. Canonical add_comoid := Monoid.ComLaw addrC. Lemma addrCA : @left_commutative V V +%R. Proof. exact: mulmCA. Qed. Lemma addrAC : @right_commutative V V +%R. Proof. exact: mulmAC. Qed. Lemma addrACA : @interchange V +%R +%R. Proof. exact: mulmACA. Qed. Lemma addKr : @left_loop V V -%R +%R. Proof. by move=> x y; rewrite addrA addNr add0r. Qed. Lemma addNKr : @rev_left_loop V V -%R +%R. Proof. by move=> x y; rewrite addrA addrN add0r. Qed. Lemma addrK : @right_loop V V -%R +%R. Proof. by move=> x y; rewrite -addrA addrN addr0. Qed. Lemma addrNK : @rev_right_loop V V -%R +%R. Proof. by move=> x y; rewrite -addrA addNr addr0. Qed. Definition subrK := addrNK. Lemma subKr x : involutive (fun y => x - y). Proof. by move=> y; apply: (canLR (addrK _)); rewrite addrC subrK. Qed. Lemma addrI : @right_injective V V V +%R. Proof. by move=> x; apply: can_inj (addKr x). Qed. Lemma addIr : @left_injective V V V +%R. Proof. by move=> y; apply: can_inj (addrK y). Qed. Lemma subrI : right_injective (fun x y => x - y). Proof. by move=> x; apply: can_inj (subKr x). Qed. Lemma subIr : left_injective (fun x y => x - y). Proof. by move=> y; apply: addIr. Qed. Lemma opprK : @involutive V -%R. Proof. by move=> x; apply: (@subIr x); rewrite addNr addrN. Qed. Lemma oppr_inj : @injective V V -%R. Proof. exact: inv_inj opprK. Qed. Lemma oppr0 : -0 = 0 :> V. Proof. by rewrite -[-0]add0r subrr. Qed. Lemma oppr_eq0 x : (- x == 0) = (x == 0). Proof. by rewrite (inv_eq opprK) oppr0. Qed. Lemma subr0 x : x - 0 = x. Proof. by rewrite oppr0 addr0. Qed. Lemma sub0r x : 0 - x = - x. Proof. by rewrite add0r. Qed. Lemma opprB x y : - (x - y) = y - x. Proof. by apply: (canRL (addrK x)); rewrite addrC subKr. Qed. Lemma opprD : {morph -%R: x y / x + y : V}. Proof. by move=> x y; rewrite -[y in LHS]opprK opprB addrC. Qed. Lemma addrKA z x y : (x + z) - (z + y) = x - y. Proof. by rewrite opprD addrA addrK. Qed. Lemma subrKA z x y : (x - z) + (z + y) = x + y. Proof. by rewrite addrA addrNK. Qed. Lemma addr0_eq x y : x + y = 0 -> - x = y. Proof. by rewrite -[-x]addr0 => <-; rewrite addKr. Qed. Lemma subr0_eq x y : x - y = 0 -> x = y. Proof. by move/addr0_eq/oppr_inj. Qed. Lemma subr_eq x y z : (x - z == y) = (x == y + z). Proof. exact: can2_eq (subrK z) (addrK z) x y. Qed. Lemma subr_eq0 x y : (x - y == 0) = (x == y). Proof. by rewrite subr_eq add0r. Qed. Lemma addr_eq0 x y : (x + y == 0) = (x == - y). Proof. by rewrite -[y in LHS]opprK subr_eq0. Qed. Lemma eqr_opp x y : (- x == - y) = (x == y). Proof. exact: can_eq opprK x y. Qed. Lemma eqr_oppLR x y : (- x == y) = (x == - y). Proof. exact: inv_eq opprK x y. Qed. Lemma mulr0n x : x *+ 0 = 0. Proof. by []. Qed. Lemma mulr1n x : x *+ 1 = x. Proof. by []. Qed. Lemma mulr2n x : x *+ 2 = x + x. Proof. by []. Qed. Lemma mulrS x n : x *+ n.+1 = x + x *+ n. Proof. by case: n => //=; rewrite addr0. Qed. Lemma mulrSr x n : x *+ n.+1 = x *+ n + x. Proof. by rewrite addrC mulrS. Qed. Lemma mulrb x (b : bool) : x *+ b = (if b then x else 0). Proof. by case: b. Qed. Lemma mul0rn n : 0 *+ n = 0 :> V. Proof. by elim: n => // n IHn; rewrite mulrS add0r. Qed. Lemma mulNrn x n : (- x) *+ n = x *- n. Proof. by elim: n => [|n IHn]; rewrite ?oppr0 // !mulrS opprD IHn. Qed. Lemma mulrnDl n : {morph (fun x => x *+ n) : x y / x + y}. Proof. move=> x y; elim: n => [|n IHn]; rewrite ?addr0 // !mulrS. by rewrite addrCA -!addrA -IHn -addrCA. Qed. Lemma mulrnDr x m n : x *+ (m + n) = x *+ m + x *+ n. Proof. elim: m => [|m IHm]; first by rewrite add0r. by rewrite !mulrS IHm addrA. Qed. Lemma mulrnBl n : {morph (fun x => x *+ n) : x y / x - y}. Proof. move=> x y; elim: n => [|n IHn]; rewrite ?subr0 // !mulrS -!addrA; congr(_ + _). by rewrite addrC IHn -!addrA opprD [_ - y]addrC. Qed. Lemma mulrnBr x m n : n <= m -> x *+ (m - n) = x *+ m - x *+ n. Proof. elim: m n => [|m IHm] [|n le_n_m]; rewrite ?subr0 // {}IHm //. by rewrite mulrSr mulrS opprD addrA addrK. Qed. Lemma mulrnA x m n : x *+ (m * n) = x *+ m *+ n. Proof. by rewrite mulnC; elim: n => //= n IHn; rewrite mulrS mulrnDr IHn. Qed. Lemma mulrnAC x m n : x *+ m *+ n = x *+ n *+ m. Proof. by rewrite -!mulrnA mulnC. Qed. Lemma iter_addr n x y : iter n (+%R x) y = x *+ n + y. Proof. by elim: n => [|n ih]; rewrite ?add0r //= ih mulrS addrA. Qed. Lemma iter_addr_0 n x : iter n (+%R x) 0 = x *+ n. Proof. by rewrite iter_addr addr0. Qed. Lemma sumrN I r P (F : I -> V) : (\sum_(i <- r | P i) - F i = - (\sum_(i <- r | P i) F i)). Proof. by rewrite (big_morph _ opprD oppr0). Qed. Lemma sumrB I r (P : pred I) (F1 F2 : I -> V) : \sum_(i <- r | P i) (F1 i - F2 i) = \sum_(i <- r | P i) F1 i - \sum_(i <- r | P i) F2 i. Proof. by rewrite -sumrN -big_split /=. Qed. Lemma sumrMnl I r P (F : I -> V) n : \sum_(i <- r | P i) F i *+ n = (\sum_(i <- r | P i) F i) *+ n. Proof. by rewrite (big_morph _ (mulrnDl n) (mul0rn _)). Qed. Lemma sumrMnr x I r P (F : I -> nat) : \sum_(i <- r | P i) x *+ F i = x *+ (\sum_(i <- r | P i) F i). Proof. by rewrite (big_morph _ (mulrnDr x) (erefl _)). Qed. Lemma sumr_const (I : finType) (A : pred I) x : \sum_(i in A) x = x *+ #|A|. Proof. by rewrite big_const -iteropE. Qed. Lemma sumr_const_nat m n x : \sum_(n <= i < m) x = x *+ (m - n). Proof. by rewrite big_const_nat iter_addr_0. Qed. Lemma telescope_sumr n m (f : nat -> V) : n <= m -> \sum_(n <= k < m) (f k.+1 - f k) = f m - f n. Proof. rewrite leq_eqVlt => /predU1P[-> | ]; first by rewrite subrr big_geq. case: m => // m lenm; rewrite sumrB big_nat_recr // big_nat_recl //=. by rewrite addrC opprD addrA subrK addrC. Qed. Section ClosedPredicates. Variable S : {pred V}. Definition addr_closed := 0 \in S /\ {in S &, forall u v, u + v \in S}. Definition oppr_closed := {in S, forall u, - u \in S}. Definition subr_2closed := {in S &, forall u v, u - v \in S}. Definition zmod_closed := 0 \in S /\ subr_2closed. Lemma zmod_closedN : zmod_closed -> oppr_closed. Proof. by case=> S0 SB y Sy; rewrite -sub0r !SB. Qed. Lemma zmod_closedD : zmod_closed -> addr_closed. Proof. by case=> S0 SB; split=> // y z Sy Sz; rewrite -[z]opprK -[- z]sub0r !SB. Qed. End ClosedPredicates. End ZmoduleTheory. Arguments addrI {V} y [x1 x2]. Arguments addIr {V} x [x1 x2]. Arguments opprK {V}. Arguments oppr_inj {V} [x1 x2]. Module Ring. Record mixin_of (R : zmodType) : Type := Mixin { one : R; mul : R -> R -> R; _ : associative mul; _ : left_id one mul; _ : right_id one mul; _ : left_distributive mul +%R; _ : right_distributive mul +%R; _ : one != 0 }. Definition EtaMixin R one mul mulA mul1x mulx1 mul_addl mul_addr nz1 := let _ := @Mixin R one mul mulA mul1x mulx1 mul_addl mul_addr nz1 in @Mixin (Zmodule.Pack (Zmodule.class R)) _ _ mulA mul1x mulx1 mul_addl mul_addr nz1. Section ClassDef. Set Primitive Projections. Record class_of (R : Type) : Type := Class { base : Zmodule.class_of R; mixin : mixin_of (Zmodule.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> Zmodule.class_of. 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. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : mixin_of (@Zmodule.Pack T b0)) := fun bT b & phant_id (Zmodule.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Zmodule.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Notation ringType := type. Notation RingType T m := (@pack T _ m _ _ id _ id). Notation RingMixin := Mixin. Notation "[ 'ringType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'ringType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'ringType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'ringType' 'of' T ]") : form_scope. End Exports. End Ring. Import Ring.Exports. Definition one (R : ringType) : R := Ring.one (Ring.class R). Definition mul (R : ringType) : R -> R -> R := Ring.mul (Ring.class R). Definition exp R x n := nosimpl iterop _ n (@mul R) x (one R). Notation sign R b := (exp (- one R) (nat_of_bool b)) (only parsing). Definition comm R x y := @mul R x y = mul y x. Definition lreg R x := injective (@mul R x). Definition rreg R x := injective ((@mul R)^~ x). Local Notation "1" := (one _) : ring_scope. Local Notation "- 1" := (- (1)) : ring_scope. Local Notation "n %:R" := (1 *+ n) : ring_scope. Local Notation "*%R" := (@mul _). Local Notation "x * y" := (mul x y) : ring_scope. Local Notation "x ^+ n" := (exp x n) : ring_scope. Local Notation "\prod_ ( i <- r | P ) F" := (\big[*%R/1]_(i <- r | P) F). Local Notation "\prod_ ( i | P ) F" := (\big[*%R/1]_(i | P) F). Local Notation "\prod_ ( i 'in' A ) F" := (\big[*%R/1]_(i in A) F). Local Notation "\prod_ ( m <= i < n ) F" := (\big[*%R/1%R]_(m <= i < n) F%R). (* The ``field'' characteristic; the definition, and many of the theorems, *) (* has to apply to rings as well; indeed, we need the Frobenius automorphism *) (* results for a non commutative ring in the proof of Gorenstein 2.6.3. *) Definition char (R : Ring.type) of phant R : nat_pred := [pred p | prime p & p%:R == 0 :> R]. Local Notation "[ 'char' R ]" := (char (Phant R)) : ring_scope. (* Converse ring tag. *) Definition converse R : Type := R. Local Notation "R ^c" := (converse R) (at level 2, format "R ^c") : type_scope. Section RingTheory. Variable R : ringType. Implicit Types x y : R. Lemma mulrA : @associative R *%R. Proof. by case R => T [? []]. Qed. Lemma mul1r : @left_id R R 1 *%R. Proof. by case R => T [? []]. Qed. Lemma mulr1 : @right_id R R 1 *%R. Proof. by case R => T [? []]. Qed. Lemma mulrDl : @left_distributive R R *%R +%R. Proof. by case R => T [? []]. Qed. Lemma mulrDr : @right_distributive R R *%R +%R. Proof. by case R => T [? []]. Qed. Lemma oner_neq0 : 1 != 0 :> R. Proof. by case R => T [? []]. Qed. Lemma oner_eq0 : (1 == 0 :> R) = false. Proof. exact: negbTE oner_neq0. Qed. Lemma mul0r : @left_zero R R 0 *%R. Proof. by move=> x; apply: (addIr (1 * x)); rewrite -mulrDl !add0r mul1r. Qed. Lemma mulr0 : @right_zero R R 0 *%R. Proof. by move=> x; apply: (addIr (x * 1)); rewrite -mulrDr !add0r mulr1. Qed. Lemma mulrN x y : x * (- y) = - (x * y). Proof. by apply: (addrI (x * y)); rewrite -mulrDr !subrr mulr0. Qed. Lemma mulNr x y : (- x) * y = - (x * y). Proof. by apply: (addrI (x * y)); rewrite -mulrDl !subrr mul0r. Qed. Lemma mulrNN x y : (- x) * (- y) = x * y. Proof. by rewrite mulrN mulNr opprK. Qed. Lemma mulN1r x : -1 * x = - x. Proof. by rewrite mulNr mul1r. Qed. Lemma mulrN1 x : x * -1 = - x. Proof. by rewrite mulrN mulr1. Qed. Canonical mul_monoid := Monoid.Law mulrA mul1r mulr1. Canonical muloid := Monoid.MulLaw mul0r mulr0. Canonical addoid := Monoid.AddLaw mulrDl mulrDr. Lemma mulr_suml I r P (F : I -> R) x : (\sum_(i <- r | P i) F i) * x = \sum_(i <- r | P i) F i * x. Proof. exact: big_distrl. Qed. Lemma mulr_sumr I r P (F : I -> R) x : x * (\sum_(i <- r | P i) F i) = \sum_(i <- r | P i) x * F i. Proof. exact: big_distrr. Qed. Lemma mulrBl x y z : (y - z) * x = y * x - z * x. Proof. by rewrite mulrDl mulNr. Qed. Lemma mulrBr x y z : x * (y - z) = x * y - x * z. Proof. by rewrite mulrDr mulrN. Qed. Lemma mulrnAl x y n : (x *+ n) * y = (x * y) *+ n. Proof. by elim: n => [|n IHn]; rewrite ?mul0r // !mulrS mulrDl IHn. Qed. Lemma mulrnAr x y n : x * (y *+ n) = (x * y) *+ n. Proof. by elim: n => [|n IHn]; rewrite ?mulr0 // !mulrS mulrDr IHn. Qed. Lemma mulr_natl x n : n%:R * x = x *+ n. Proof. by rewrite mulrnAl mul1r. Qed. Lemma mulr_natr x n : x * n%:R = x *+ n. Proof. by rewrite mulrnAr mulr1. Qed. Lemma natrD m n : (m + n)%:R = m%:R + n%:R :> R. Proof. exact: mulrnDr. Qed. Lemma natrB m n : n <= m -> (m - n)%:R = m%:R - n%:R :> R. Proof. exact: mulrnBr. Qed. Definition natr_sum := big_morph (natmul 1) natrD (mulr0n 1). Lemma natrM m n : (m * n)%:R = m%:R * n%:R :> R. Proof. by rewrite mulrnA -mulr_natr. Qed. Lemma expr0 x : x ^+ 0 = 1. Proof. by []. Qed. Lemma expr1 x : x ^+ 1 = x. Proof. by []. Qed. Lemma expr2 x : x ^+ 2 = x * x. Proof. by []. Qed. Lemma exprS x n : x ^+ n.+1 = x * x ^+ n. Proof. by case: n => //; rewrite mulr1. Qed. Lemma expr0n n : 0 ^+ n = (n == 0%N)%:R :> R. Proof. by case: n => // n; rewrite exprS mul0r. Qed. Lemma expr1n n : 1 ^+ n = 1 :> R. Proof. by elim: n => // n IHn; rewrite exprS mul1r. Qed. Lemma exprD x m n : x ^+ (m + n) = x ^+ m * x ^+ n. Proof. by elim: m => [|m IHm]; rewrite ?mul1r // !exprS -mulrA -IHm. Qed. Lemma exprSr x n : x ^+ n.+1 = x ^+ n * x. Proof. by rewrite -addn1 exprD expr1. Qed. Lemma expr_sum x (I : Type) (s : seq I) (P : pred I) F : x ^+ (\sum_(i <- s | P i) F i) = \prod_(i <- s | P i) x ^+ F i :> R. Proof. exact: (big_morph _ (exprD _)). Qed. Lemma commr_sym x y : comm x y -> comm y x. Proof. by []. Qed. Lemma commr_refl x : comm x x. Proof. by []. Qed. Lemma commr0 x : comm x 0. Proof. by rewrite /comm mulr0 mul0r. Qed. Lemma commr1 x : comm x 1. Proof. by rewrite /comm mulr1 mul1r. Qed. Lemma commrN x y : comm x y -> comm x (- y). Proof. by move=> com_xy; rewrite /comm mulrN com_xy mulNr. Qed. Lemma commrN1 x : comm x (-1). Proof. exact/commrN/commr1. Qed. Lemma commrD x y z : comm x y -> comm x z -> comm x (y + z). Proof. by rewrite /comm mulrDl mulrDr => -> ->. Qed. Lemma commrB x y z : comm x y -> comm x z -> comm x (y - z). Proof. by move=> com_xy com_xz; apply: commrD => //; apply: commrN. Qed. Lemma commr_sum (I : Type) (s : seq I) (P : pred I) (F : I -> R) x : (forall i, P i -> comm x (F i)) -> comm x (\sum_(i <- s | P i) F i). Proof. move=> comm_x_F; rewrite /comm mulr_suml mulr_sumr. by apply: eq_bigr => i /comm_x_F. Qed. Lemma commrMn x y n : comm x y -> comm x (y *+ n). Proof. rewrite /comm => com_xy. by elim: n => [|n IHn]; rewrite ?commr0 // mulrS commrD. Qed. Lemma commrM x y z : comm x y -> comm x z -> comm x (y * z). Proof. by move=> com_xy; rewrite /comm mulrA com_xy -!mulrA => ->. Qed. Lemma commr_prod (I : Type) (s : seq I) (P : pred I) (F : I -> R) x : (forall i, P i -> comm x (F i)) -> comm x (\prod_(i <- s | P i) F i). Proof. exact: (big_ind _ (commr1 x) (@commrM x)). Qed. Lemma commr_nat x n : comm x n%:R. Proof. exact/commrMn/commr1. Qed. Lemma commrX x y n : comm x y -> comm x (y ^+ n). Proof. rewrite /comm => com_xy. by elim: n => [|n IHn]; rewrite ?commr1 // exprS commrM. Qed. Lemma exprMn_comm x y n : comm x y -> (x * y) ^+ n = x ^+ n * y ^+ n. Proof. move=> com_xy; elim: n => /= [|n IHn]; first by rewrite mulr1. by rewrite !exprS IHn !mulrA; congr (_ * _); rewrite -!mulrA -commrX. Qed. Lemma commr_sign x n : comm x ((-1) ^+ n). Proof. exact: (commrX n (commrN1 x)). Qed. Lemma exprMn_n x m n : (x *+ m) ^+ n = x ^+ n *+ (m ^ n) :> R. Proof. elim: n => [|n IHn]; first by rewrite mulr1n. rewrite exprS IHn -mulr_natr -mulrA -commr_nat mulr_natr -mulrnA -expnSr. by rewrite -mulr_natr mulrA -exprS mulr_natr. Qed. Lemma exprM x m n : x ^+ (m * n) = x ^+ m ^+ n. Proof. elim: m => [|m IHm]; first by rewrite expr1n. by rewrite mulSn exprD IHm exprS exprMn_comm //; apply: commrX. Qed. Lemma exprAC x m n : (x ^+ m) ^+ n = (x ^+ n) ^+ m. Proof. by rewrite -!exprM mulnC. Qed. Lemma expr_mod n x i : x ^+ n = 1 -> x ^+ (i %% n) = x ^+ i. Proof. move=> xn1; rewrite {2}(divn_eq i n) exprD mulnC exprM xn1. by rewrite expr1n mul1r. Qed. Lemma expr_dvd n x i : x ^+ n = 1 -> n %| i -> x ^+ i = 1. Proof. by move=> xn1 dvd_n_i; rewrite -(expr_mod i xn1) (eqnP dvd_n_i). Qed. Lemma natrX n k : (n ^ k)%:R = n%:R ^+ k :> R. Proof. by rewrite exprMn_n expr1n. Qed. Lemma signr_odd n : (-1) ^+ (odd n) = (-1) ^+ n :> R. Proof. elim: n => //= n IHn; rewrite exprS -{}IHn. by case/odd: n; rewrite !mulN1r ?opprK. Qed. Lemma signr_eq0 n : ((-1) ^+ n == 0 :> R) = false. Proof. by rewrite -signr_odd; case: odd; rewrite ?oppr_eq0 oner_eq0. Qed. Lemma mulr_sign (b : bool) x : (-1) ^+ b * x = (if b then - x else x). Proof. by case: b; rewrite ?mulNr mul1r. Qed. Lemma signr_addb b1 b2 : (-1) ^+ (b1 (+) b2) = (-1) ^+ b1 * (-1) ^+ b2 :> R. Proof. by rewrite mulr_sign; case: b1 b2 => [] []; rewrite ?opprK. Qed. Lemma signrE (b : bool) : (-1) ^+ b = 1 - b.*2%:R :> R. Proof. by case: b; rewrite ?subr0 // opprD addNKr. Qed. Lemma signrN b : (-1) ^+ (~~ b) = - (-1) ^+ b :> R. Proof. by case: b; rewrite ?opprK. Qed. Lemma mulr_signM (b1 b2 : bool) x1 x2 : ((-1) ^+ b1 * x1) * ((-1) ^+ b2 * x2) = (-1) ^+ (b1 (+) b2) * (x1 * x2). Proof. by rewrite signr_addb -!mulrA; congr (_ * _); rewrite !mulrA commr_sign. Qed. Lemma exprNn x n : (- x) ^+ n = (-1) ^+ n * x ^+ n :> R. Proof. by rewrite -mulN1r exprMn_comm // /comm mulN1r mulrN mulr1. Qed. Lemma sqrrN x : (- x) ^+ 2 = x ^+ 2. Proof. exact: mulrNN. Qed. Lemma sqrr_sign n : ((-1) ^+ n) ^+ 2 = 1 :> R. Proof. by rewrite exprAC sqrrN !expr1n. Qed. Lemma signrMK n : @involutive R ( *%R ((-1) ^+ n)). Proof. by move=> x; rewrite mulrA -expr2 sqrr_sign mul1r. Qed. Lemma lastr_eq0 (s : seq R) x : x != 0 -> (last x s == 0) = (last 1 s == 0). Proof. by case: s => [|y s] /negPf // ->; rewrite oner_eq0. Qed. Lemma mulrI_eq0 x y : lreg x -> (x * y == 0) = (y == 0). Proof. by move=> reg_x; rewrite -{1}(mulr0 x) (inj_eq reg_x). Qed. Lemma lreg_neq0 x : lreg x -> x != 0. Proof. by move=> reg_x; rewrite -[x]mulr1 mulrI_eq0 ?oner_eq0. Qed. Lemma mulrI0_lreg x : (forall y, x * y = 0 -> y = 0) -> lreg x. Proof. move=> reg_x y z eq_xy_xz; apply/eqP; rewrite -subr_eq0 [y - z]reg_x //. by rewrite mulrBr eq_xy_xz subrr. Qed. Lemma lregN x : lreg x -> lreg (- x). Proof. by move=> reg_x y z; rewrite !mulNr => /oppr_inj/reg_x. Qed. Lemma lreg1 : lreg (1 : R). Proof. by move=> x y; rewrite !mul1r. Qed. Lemma lregM x y : lreg x -> lreg y -> lreg (x * y). Proof. by move=> reg_x reg_y z t; rewrite -!mulrA => /reg_x/reg_y. Qed. Lemma lregX x n : lreg x -> lreg (x ^+ n). Proof. by move=> reg_x; elim: n => [|n]; [apply: lreg1 | rewrite exprS; apply: lregM]. Qed. Lemma lreg_sign n : lreg ((-1) ^+ n : R). Proof. exact/lregX/lregN/lreg1. Qed. Lemma iter_mulr n x y : iter n ( *%R x) y = x ^+ n * y. Proof. by elim: n => [|n ih]; rewrite ?expr0 ?mul1r //= ih exprS -mulrA. Qed. Lemma iter_mulr_1 n x : iter n ( *%R x) 1 = x ^+ n. Proof. by rewrite iter_mulr mulr1. Qed. Lemma prodr_const (I : finType) (A : pred I) x : \prod_(i in A) x = x ^+ #|A|. Proof. by rewrite big_const -iteropE. Qed. Lemma prodr_const_nat n m x : \prod_(n <= i < m) x = x ^+ (m - n). Proof. by rewrite big_const_nat -iteropE. Qed. Lemma prodrXr x I r P (F : I -> nat) : \prod_(i <- r | P i) x ^+ F i = x ^+ (\sum_(i <- r | P i) F i). Proof. by rewrite (big_morph _ (exprD _) (erefl _)). Qed. Lemma prodrN (I : finType) (A : pred I) (F : I -> R) : \prod_(i in A) - F i = (- 1) ^+ #|A| * \prod_(i in A) F i. Proof. rewrite -sum1_card; elim/big_rec3: _ => [|i x n _ _ ->]; first by rewrite mulr1. by rewrite exprS !mulrA mulN1r !mulNr commrX //; apply: commrN1. Qed. Lemma prodr_natmul (I : Type) (s : seq I) (P : pred I) (F : I -> R) (g : I -> nat) : \prod_(i <- s | P i) (F i *+ g i) = \prod_(i <- s | P i) (F i) *+ \prod_(i <- s | P i) g i. Proof. by elim/big_rec3: _ => // i y1 y2 y3 _ ->; rewrite mulrnAr mulrnAl -mulrnA. Qed. Lemma prodrMn_const n (I : finType) (A : pred I) (F : I -> R) : \prod_(i in A) (F i *+ n) = \prod_(i in A) F i *+ n ^ #|A|. Proof. by rewrite prodr_natmul prod_nat_const. Qed. Lemma natr_prod I r P (F : I -> nat) : (\prod_(i <- r | P i) F i)%:R = \prod_(i <- r | P i) (F i)%:R :> R. Proof. exact: (big_morph _ natrM). Qed. Lemma exprDn_comm x y n (cxy : comm x y) : (x + y) ^+ n = \sum_(i < n.+1) (x ^+ (n - i) * y ^+ i) *+ 'C(n, i). Proof. elim: n => [|n IHn]; rewrite big_ord_recl mulr1 ?big_ord0 ?addr0 //=. rewrite exprS {}IHn /= mulrDl !big_distrr /= big_ord_recl mulr1 subn0. rewrite !big_ord_recr /= !binn !subnn !mul1r !subn0 bin0 !exprS -addrA. congr (_ + _); rewrite addrA -big_split /=; congr (_ + _). apply: eq_bigr => i _; rewrite !mulrnAr !mulrA -exprS -subSn ?(valP i) //. by rewrite subSS (commrX _ (commr_sym cxy)) -mulrA -exprS -mulrnDr. Qed. Lemma exprBn_comm x y n (cxy : comm x y) : (x - y) ^+ n = \sum_(i < n.+1) ((-1) ^+ i * x ^+ (n - i) * y ^+ i) *+ 'C(n, i). Proof. rewrite exprDn_comm; last exact: commrN. by apply: eq_bigr => i _; congr (_ *+ _); rewrite -commr_sign -mulrA -exprNn. Qed. Lemma subrXX_comm x y n (cxy : comm x y) : x ^+ n - y ^+ n = (x - y) * (\sum_(i < n) x ^+ (n.-1 - i) * y ^+ i). Proof. case: n => [|n]; first by rewrite big_ord0 mulr0 subrr. rewrite mulrBl !big_distrr big_ord_recl big_ord_recr /= subnn mulr1 mul1r. rewrite subn0 -!exprS opprD -!addrA; congr (_ + _); rewrite addrA -sumrB. rewrite big1 ?add0r // => i _; rewrite !mulrA -exprS -subSn ?(valP i) //. by rewrite subSS (commrX _ (commr_sym cxy)) -mulrA -exprS subrr. Qed. Lemma exprD1n x n : (x + 1) ^+ n = \sum_(i < n.+1) x ^+ i *+ 'C(n, i). Proof. rewrite addrC (exprDn_comm n (commr_sym (commr1 x))). by apply: eq_bigr => i _; rewrite expr1n mul1r. Qed. Lemma subrX1 x n : x ^+ n - 1 = (x - 1) * (\sum_(i < n) x ^+ i). Proof. rewrite -!(opprB 1) mulNr -{1}(expr1n n). rewrite (subrXX_comm _ (commr_sym (commr1 x))); congr (- (_ * _)). by apply: eq_bigr => i _; rewrite expr1n mul1r. Qed. Lemma sqrrD1 x : (x + 1) ^+ 2 = x ^+ 2 + x *+ 2 + 1. Proof. rewrite exprD1n !big_ord_recr big_ord0 /= add0r. by rewrite addrC addrA addrAC. Qed. Lemma sqrrB1 x : (x - 1) ^+ 2 = x ^+ 2 - x *+ 2 + 1. Proof. by rewrite -sqrrN opprB addrC sqrrD1 sqrrN mulNrn. Qed. Lemma subr_sqr_1 x : x ^+ 2 - 1 = (x - 1) * (x + 1). Proof. by rewrite subrX1 !big_ord_recr big_ord0 /= addrAC add0r. Qed. Definition Frobenius_aut p of p \in [char R] := fun x => x ^+ p. Section FrobeniusAutomorphism. Variable p : nat. Hypothesis charFp : p \in [char R]. Lemma charf0 : p%:R = 0 :> R. Proof. by apply/eqP; case/andP: charFp. Qed. Lemma charf_prime : prime p. Proof. by case/andP: charFp. Qed. Hint Resolve charf_prime : core. Lemma mulrn_char x : x *+ p = 0. Proof. by rewrite -mulr_natl charf0 mul0r. Qed. Lemma natr_mod_char n : (n %% p)%:R = n%:R :> R. Proof. by rewrite {2}(divn_eq n p) natrD mulrnA mulrn_char add0r. Qed. Lemma dvdn_charf n : (p %| n)%N = (n%:R == 0 :> R). Proof. apply/idP/eqP=> [/dvdnP[n' ->]|n0]; first by rewrite natrM charf0 mulr0. apply/idPn; rewrite -prime_coprime // => /eqnP pn1. have [a _ /dvdnP[b]] := Bezoutl n (prime_gt0 charf_prime). move/(congr1 (fun m => m%:R : R))/eqP. by rewrite natrD !natrM charf0 n0 !mulr0 pn1 addr0 oner_eq0. Qed. Lemma charf_eq : [char R] =i (p : nat_pred). Proof. move=> q; apply/andP/eqP=> [[q_pr q0] | ->]; last by rewrite charf0. by apply/eqP; rewrite eq_sym -dvdn_prime2 // dvdn_charf. Qed. Lemma bin_lt_charf_0 k : 0 < k < p -> 'C(p, k)%:R = 0 :> R. Proof. by move=> lt0kp; apply/eqP; rewrite -dvdn_charf prime_dvd_bin. Qed. Local Notation "x ^f" := (Frobenius_aut charFp x). Lemma Frobenius_autE x : x^f = x ^+ p. Proof. by []. Qed. Local Notation fE := Frobenius_autE. Lemma Frobenius_aut0 : 0^f = 0. Proof. by rewrite fE -(prednK (prime_gt0 charf_prime)) exprS mul0r. Qed. Lemma Frobenius_aut1 : 1^f = 1. Proof. by rewrite fE expr1n. Qed. Lemma Frobenius_autD_comm x y (cxy : comm x y) : (x + y)^f = x^f + y^f. Proof. have defp := prednK (prime_gt0 charf_prime). rewrite !fE exprDn_comm // big_ord_recr subnn -defp big_ord_recl /= defp. rewrite subn0 mulr1 mul1r bin0 binn big1 ?addr0 // => i _. by rewrite -mulr_natl bin_lt_charf_0 ?mul0r //= -{2}defp ltnS (valP i). Qed. Lemma Frobenius_autMn x n : (x *+ n)^f = x^f *+ n. Proof. elim: n => [|n IHn]; first exact: Frobenius_aut0. by rewrite !mulrS Frobenius_autD_comm ?IHn //; apply: commrMn. Qed. Lemma Frobenius_aut_nat n : (n%:R)^f = n%:R. Proof. by rewrite Frobenius_autMn Frobenius_aut1. Qed. Lemma Frobenius_autM_comm x y : comm x y -> (x * y)^f = x^f * y^f. Proof. exact: exprMn_comm. Qed. Lemma Frobenius_autX x n : (x ^+ n)^f = x^f ^+ n. Proof. by rewrite !fE -!exprM mulnC. Qed. Lemma Frobenius_autN x : (- x)^f = - x^f. Proof. apply/eqP; rewrite -subr_eq0 opprK addrC. by rewrite -(Frobenius_autD_comm (commrN _)) // subrr Frobenius_aut0. Qed. Lemma Frobenius_autB_comm x y : comm x y -> (x - y)^f = x^f - y^f. Proof. by move/commrN/Frobenius_autD_comm->; rewrite Frobenius_autN. Qed. End FrobeniusAutomorphism. Lemma exprNn_char x n : [char R].-nat n -> (- x) ^+ n = - (x ^+ n). Proof. pose p := pdiv n; have [|n_gt1 charRn] := leqP n 1; first by case: (n) => [|[]]. have charRp: p \in [char R] by rewrite (pnatPpi charRn) // pi_pdiv. have /p_natP[e ->]: p.-nat n by rewrite -(eq_pnat _ (charf_eq charRp)). elim: e => // e IHe; rewrite expnSr !exprM {}IHe. by rewrite -Frobenius_autE Frobenius_autN. Qed. Section Char2. Hypothesis charR2 : 2 \in [char R]. Lemma addrr_char2 x : x + x = 0. Proof. by rewrite -mulr2n mulrn_char. Qed. Lemma oppr_char2 x : - x = x. Proof. by apply/esym/eqP; rewrite -addr_eq0 addrr_char2. Qed. Lemma subr_char2 x y : x - y = x + y. Proof. by rewrite oppr_char2. Qed. Lemma addrK_char2 x : involutive (+%R^~ x). Proof. by move=> y; rewrite /= -subr_char2 addrK. Qed. Lemma addKr_char2 x : involutive (+%R x). Proof. by move=> y; rewrite -{1}[x]oppr_char2 addKr. Qed. End Char2. Canonical converse_eqType := [eqType of R^c]. Canonical converse_choiceType := [choiceType of R^c]. Canonical converse_zmodType := [zmodType of R^c]. Definition converse_ringMixin := let mul' x y := y * x in let mulrA' x y z := esym (mulrA z y x) in let mulrDl' x y z := mulrDr z x y in let mulrDr' x y z := mulrDl y z x in @Ring.Mixin converse_zmodType 1 mul' mulrA' mulr1 mul1r mulrDl' mulrDr' oner_neq0. Canonical converse_ringType := RingType R^c converse_ringMixin. Section ClosedPredicates. Variable S : {pred R}. Definition mulr_2closed := {in S &, forall u v, u * v \in S}. Definition mulr_closed := 1 \in S /\ mulr_2closed. Definition smulr_closed := -1 \in S /\ mulr_2closed. Definition semiring_closed := addr_closed S /\ mulr_closed. Definition subring_closed := [/\ 1 \in S, subr_2closed S & mulr_2closed]. Lemma smulr_closedM : smulr_closed -> mulr_closed. Proof. by case=> SN1 SM; split=> //; rewrite -[1]mulr1 -mulrNN SM. Qed. Lemma smulr_closedN : smulr_closed -> oppr_closed S. Proof. by case=> SN1 SM x Sx; rewrite -mulN1r SM. Qed. Lemma semiring_closedD : semiring_closed -> addr_closed S. Proof. by case. Qed. Lemma semiring_closedM : semiring_closed -> mulr_closed. Proof. by case. Qed. Lemma subring_closedB : subring_closed -> zmod_closed S. Proof. by case=> S1 SB _; split; rewrite // -(subrr 1) SB. Qed. Lemma subring_closedM : subring_closed -> smulr_closed. Proof. by case=> S1 SB SM; split; rewrite ?(zmod_closedN (subring_closedB _)). Qed. Lemma subring_closed_semi : subring_closed -> semiring_closed. Proof. by move=> ringS; split; [apply/zmod_closedD/subring_closedB | case: ringS]. Qed. End ClosedPredicates. End RingTheory. Section RightRegular. Variable R : ringType. Implicit Types x y : R. Let Rc := converse_ringType R. Lemma mulIr_eq0 x y : rreg x -> (y * x == 0) = (y == 0). Proof. exact: (@mulrI_eq0 Rc). Qed. Lemma mulIr0_rreg x : (forall y, y * x = 0 -> y = 0) -> rreg x. Proof. exact: (@mulrI0_lreg Rc). Qed. Lemma rreg_neq0 x : rreg x -> x != 0. Proof. exact: (@lreg_neq0 Rc). Qed. Lemma rregN x : rreg x -> rreg (- x). Proof. exact: (@lregN Rc). Qed. Lemma rreg1 : rreg (1 : R). Proof. exact: (@lreg1 Rc). Qed. Lemma rregM x y : rreg x -> rreg y -> rreg (x * y). Proof. by move=> reg_x reg_y; apply: (@lregM Rc). Qed. Lemma revrX x n : (x : Rc) ^+ n = (x : R) ^+ n. Proof. by elim: n => // n IHn; rewrite exprS exprSr IHn. Qed. Lemma rregX x n : rreg x -> rreg (x ^+ n). Proof. by move/(@lregX Rc x n); rewrite revrX. Qed. End RightRegular. Module Lmodule. Structure mixin_of (R : ringType) (V : zmodType) : Type := Mixin { scale : R -> V -> V; _ : forall a b v, scale a (scale b v) = scale (a * b) v; _ : left_id 1 scale; _ : right_distributive scale +%R; _ : forall v, {morph scale^~ v: a b / a + b} }. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of V := Class { base : Zmodule.class_of V; mixin : mixin_of R (Zmodule.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> Zmodule.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack phR T c. Definition pack b0 (m0 : mixin_of R (@Zmodule.Pack T b0)) := fun bT b & phant_id (Zmodule.class bT) b => fun m & phant_id m0 m => Pack phR (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. End ClassDef. Module Import Exports. Coercion base : class_of >-> Zmodule.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Notation lmodType R := (type (Phant R)). Notation LmodType R T m := (@pack _ (Phant R) T _ m _ _ id _ id). Notation LmodMixin := Mixin. Notation "[ 'lmodType' R 'of' T 'for' cT ]" := (@clone _ (Phant R) T cT _ idfun) (at level 0, format "[ 'lmodType' R 'of' T 'for' cT ]") : form_scope. Notation "[ 'lmodType' R 'of' T ]" := (@clone _ (Phant R) T _ _ id) (at level 0, format "[ 'lmodType' R 'of' T ]") : form_scope. End Exports. End Lmodule. Import Lmodule.Exports. Definition scale (R : ringType) (V : lmodType R) : R -> V -> V := Lmodule.scale (Lmodule.class V). Local Notation "*:%R" := (@scale _ _). Local Notation "a *: v" := (scale a v) : ring_scope. Section LmoduleTheory. Variables (R : ringType) (V : lmodType R). Implicit Types (a b c : R) (u v : V). Local Notation "*:%R" := (@scale R V). Lemma scalerA a b v : a *: (b *: v) = a * b *: v. Proof. by case: V v => ? [] ? []. Qed. Lemma scale1r : @left_id R V 1 *:%R. Proof. by case: V => ? [] ? []. Qed. Lemma scalerDr a : {morph *:%R a : u v / u + v}. Proof. by case: V a => ? [] ? []. Qed. Lemma scalerDl v : {morph *:%R^~ v : a b / a + b}. Proof. by case: V v => ? [] ? []. Qed. Lemma scale0r v : 0 *: v = 0. Proof. by apply: (addIr (1 *: v)); rewrite -scalerDl !add0r. Qed. Lemma scaler0 a : a *: 0 = 0 :> V. Proof. by rewrite -{1}(scale0r 0) scalerA mulr0 scale0r. Qed. Lemma scaleNr a v : - a *: v = - (a *: v). Proof. by apply: (addIr (a *: v)); rewrite -scalerDl !addNr scale0r. Qed. Lemma scaleN1r v : (- 1) *: v = - v. Proof. by rewrite scaleNr scale1r. Qed. Lemma scalerN a v : a *: (- v) = - (a *: v). Proof. by apply: (addIr (a *: v)); rewrite -scalerDr !addNr scaler0. Qed. Lemma scalerBl a b v : (a - b) *: v = a *: v - b *: v. Proof. by rewrite scalerDl scaleNr. Qed. Lemma scalerBr a u v : a *: (u - v) = a *: u - a *: v. Proof. by rewrite scalerDr scalerN. Qed. Lemma scaler_nat n v : n%:R *: v = v *+ n. Proof. elim: n => /= [|n ]; first by rewrite scale0r. by rewrite !mulrS scalerDl ?scale1r => ->. Qed. Lemma scaler_sign (b : bool) v: (-1) ^+ b *: v = (if b then - v else v). Proof. by case: b; rewrite ?scaleNr scale1r. Qed. Lemma signrZK n : @involutive V ( *:%R ((-1) ^+ n)). Proof. by move=> u; rewrite scalerA -expr2 sqrr_sign scale1r. Qed. Lemma scalerMnl a v n : a *: v *+ n = (a *+ n) *: v. Proof. elim: n => [|n IHn]; first by rewrite !mulr0n scale0r. by rewrite !mulrSr IHn scalerDl. Qed. Lemma scalerMnr a v n : a *: v *+ n = a *: (v *+ n). Proof. elim: n => [|n IHn]; first by rewrite !mulr0n scaler0. by rewrite !mulrSr IHn scalerDr. Qed. Lemma scaler_suml v I r (P : pred I) F : (\sum_(i <- r | P i) F i) *: v = \sum_(i <- r | P i) F i *: v. Proof. exact: (big_morph _ (scalerDl v) (scale0r v)). Qed. Lemma scaler_sumr a I r (P : pred I) (F : I -> V) : a *: (\sum_(i <- r | P i) F i) = \sum_(i <- r | P i) a *: F i. Proof. exact: big_endo (scalerDr a) (scaler0 a) I r P F. Qed. Section ClosedPredicates. Variable S : {pred V}. Definition scaler_closed := forall a, {in S, forall v, a *: v \in S}. Definition linear_closed := forall a, {in S &, forall u v, a *: u + v \in S}. Definition submod_closed := 0 \in S /\ linear_closed. Lemma linear_closedB : linear_closed -> subr_2closed S. Proof. by move=> Slin u v Su Sv; rewrite addrC -scaleN1r Slin. Qed. Lemma submod_closedB : submod_closed -> zmod_closed S. Proof. by case=> S0 /linear_closedB. Qed. Lemma submod_closedZ : submod_closed -> scaler_closed. Proof. by case=> S0 Slin a v Sv; rewrite -[a *: v]addr0 Slin. Qed. End ClosedPredicates. End LmoduleTheory. Module Lalgebra. Definition axiom (R : ringType) (V : lmodType R) (mul : V -> V -> V) := forall a u v, a *: mul u v = mul (a *: u) v. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of (T : Type) : Type := Class { base : Ring.class_of T; mixin : Lmodule.mixin_of R (Zmodule.Pack base); ext : @axiom R (Lmodule.Pack _ (Lmodule.Class mixin)) (Ring.mul base) }. Unset Primitive Projections. Definition base2 R m := Lmodule.Class (@mixin R m). Local Coercion base : class_of >-> Ring.class_of. Local Coercion base2 : class_of >-> Lmodule.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack phR T c. 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 => Pack (Phant R) (@Class T b m ax). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lmod_ringType := @Lmodule.Pack R phR ringType class. End ClassDef. Module Exports. Coercion base : class_of >-> Ring.class_of. Coercion base2 : class_of >-> Lmodule.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Canonical lmod_ringType. Notation lalgType R := (type (Phant R)). Notation LalgType R T a := (@pack _ (Phant R) T _ _ a _ _ id _ _ id _ id). Notation "[ 'lalgType' R 'of' T 'for' cT ]" := (@clone _ (Phant R) T cT _ idfun) (at level 0, format "[ 'lalgType' R 'of' T 'for' cT ]") : form_scope. Notation "[ 'lalgType' R 'of' T ]" := (@clone _ (Phant R) T _ _ id) (at level 0, format "[ 'lalgType' R 'of' T ]") : form_scope. End Exports. End Lalgebra. Import Lalgebra.Exports. (* Scalar injection (see the definition of in_alg A below). *) Local Notation "k %:A" := (k *: 1) : ring_scope. (* Regular ring algebra tag. *) Definition regular R : Type := R. Local Notation "R ^o" := (regular R) (at level 2, format "R ^o") : type_scope. Section LalgebraTheory. Variables (R : ringType) (A : lalgType R). Implicit Types x y : A. Lemma scalerAl k (x y : A) : k *: (x * y) = k *: x * y. Proof. by case: A k x y => ? []. Qed. Lemma mulr_algl a x : a%:A * x = a *: x. Proof. by rewrite -scalerAl mul1r. Qed. Canonical regular_eqType := [eqType of R^o]. Canonical regular_choiceType := [choiceType of R^o]. Canonical regular_zmodType := [zmodType of R^o]. Canonical regular_ringType := [ringType of R^o]. Definition regular_lmodMixin := let mkMixin := @Lmodule.Mixin R regular_zmodType (@mul R) in mkMixin (@mulrA R) (@mul1r R) (@mulrDr R) (fun v a b => mulrDl a b v). Canonical regular_lmodType := LmodType R R^o regular_lmodMixin. Canonical regular_lalgType := LalgType R R^o (@mulrA regular_ringType). Section ClosedPredicates. Variable S : {pred A}. Definition subalg_closed := [/\ 1 \in S, linear_closed S & mulr_2closed S]. Lemma subalg_closedZ : subalg_closed -> submod_closed S. Proof. by case=> S1 Slin _; split; rewrite // -(subrr 1) linear_closedB. Qed. Lemma subalg_closedBM : subalg_closed -> subring_closed S. Proof. by case=> S1 Slin SM; split=> //; apply: linear_closedB. Qed. End ClosedPredicates. End LalgebraTheory. (* Morphism hierarchy. *) Module Additive. Section ClassDef. Variables U V : zmodType. Definition axiom (f : U -> V) := {morph f : x y / x - y}. Structure map (phUV : phant (U -> V)) := Pack {apply; _ : axiom apply}. Local Coercion apply : map >-> Funclass. Variables (phUV : phant (U -> V)) (f g : U -> V) (cF : map phUV). Definition class := let: Pack _ c as cF' := cF return axiom cF' in c. Definition clone fA of phant_id g (apply cF) & phant_id fA class := @Pack phUV f fA. End ClassDef. Module Exports. Notation additive f := (axiom f). Coercion apply : map >-> Funclass. Notation Additive fA := (Pack (Phant _) fA). Notation "{ 'additive' fUV }" := (map (Phant fUV)) (at level 0, format "{ 'additive' fUV }") : ring_scope. Notation "[ 'additive' 'of' f 'as' g ]" := (@clone _ _ _ f g _ _ idfun id) (at level 0, format "[ 'additive' 'of' f 'as' g ]") : form_scope. Notation "[ 'additive' 'of' f ]" := (@clone _ _ _ f f _ _ id id) (at level 0, format "[ 'additive' 'of' f ]") : form_scope. End Exports. End Additive. Include Additive.Exports. (* Allows GRing.additive to resolve conflicts. *) (* Lifted additive operations. *) Section LiftedZmod. Variables (U : Type) (V : zmodType). Definition null_fun_head (phV : phant V) of U : V := let: Phant := phV in 0. Definition add_fun (f g : U -> V) x := f x + g x. Definition sub_fun (f g : U -> V) x := f x - g x. End LiftedZmod. (* Lifted multiplication. *) Section LiftedRing. Variables (R : ringType) (T : Type). Implicit Type f : T -> R. Definition mull_fun a f x := a * f x. Definition mulr_fun a f x := f x * a. End LiftedRing. (* Lifted linear operations. *) Section LiftedScale. Variables (R : ringType) (U : Type) (V : lmodType R) (A : lalgType R). Definition scale_fun a (f : U -> V) x := a *: f x. Definition in_alg_head (phA : phant A) k : A := let: Phant := phA in k%:A. End LiftedScale. Notation null_fun V := (null_fun_head (Phant V)) (only parsing). (* The real in_alg notation is declared after GRing.Theory so that at least *) (* in Coq 8.2 it gets precedence when GRing.Theory is not imported. *) Local Notation in_alg_loc A := (in_alg_head (Phant A)) (only parsing). Local Notation "\0" := (null_fun _) : ring_scope. Local Notation "f \+ g" := (add_fun f g) : ring_scope. Local Notation "f \- g" := (sub_fun f g) : ring_scope. Local Notation "a \*: f" := (scale_fun a f) : ring_scope. Local Notation "x \*o f" := (mull_fun x f) : ring_scope. Local Notation "x \o* f" := (mulr_fun x f) : ring_scope. Arguments add_fun {_ _} f g _ /. Arguments sub_fun {_ _} f g _ /. Arguments mull_fun {_ _} a f _ /. Arguments mulr_fun {_ _} a f _ /. Arguments scale_fun {_ _ _} a f _ /. Section AdditiveTheory. Section Properties. Variables (U V : zmodType) (k : unit) (f : {additive U -> V}). Lemma raddfB : {morph f : x y / x - y}. Proof. exact: Additive.class. Qed. Lemma raddf0 : f 0 = 0. Proof. by rewrite -[0]subr0 raddfB subrr. Qed. Lemma raddf_eq0 x : injective f -> (f x == 0) = (x == 0). Proof. by move=> /inj_eq <-; rewrite raddf0. Qed. Lemma raddf_inj : (forall x, f x = 0 -> x = 0) -> injective f. Proof. by move=> fI x y eqxy; apply/subr0_eq/fI; rewrite raddfB eqxy subrr. Qed. Lemma raddfN : {morph f : x / - x}. Proof. by move=> x /=; rewrite -sub0r raddfB raddf0 sub0r. Qed. Lemma raddfD : {morph f : x y / x + y}. Proof. by move=> x y; rewrite -[y]opprK raddfB -raddfN. Qed. Lemma raddfMn n : {morph f : x / x *+ n}. Proof. by elim: n => [|n IHn] x /=; rewrite ?raddf0 // !mulrS raddfD IHn. Qed. Lemma raddfMNn n : {morph f : x / x *- n}. Proof. by move=> x /=; rewrite raddfN raddfMn. Qed. Lemma raddf_sum I r (P : pred I) E : f (\sum_(i <- r | P i) E i) = \sum_(i <- r | P i) f (E i). Proof. exact: (big_morph f raddfD raddf0). Qed. Lemma can2_additive f' : cancel f f' -> cancel f' f -> additive f'. Proof. by move=> fK f'K x y /=; apply: (canLR fK); rewrite raddfB !f'K. Qed. Lemma bij_additive : bijective f -> exists2 f' : {additive V -> U}, cancel f f' & cancel f' f. Proof. by case=> f' fK f'K; exists (Additive (can2_additive fK f'K)). Qed. Fact locked_is_additive : additive (locked_with k (f : U -> V)). Proof. by case: k f => [] []. Qed. Canonical locked_additive := Additive locked_is_additive. End Properties. Section RingProperties. Variables (R S : ringType) (f : {additive R -> S}). Lemma raddfMnat n x : f (n%:R * x) = n%:R * f x. Proof. by rewrite !mulr_natl raddfMn. Qed. Lemma raddfMsign n x : f ((-1) ^+ n * x) = (-1) ^+ n * f x. Proof. by rewrite !(mulr_sign, =^~ signr_odd) (fun_if f) raddfN. Qed. Variables (U : lmodType R) (V : lmodType S) (h : {additive U -> V}). Lemma raddfZnat n u : h (n%:R *: u) = n%:R *: h u. Proof. by rewrite !scaler_nat raddfMn. Qed. Lemma raddfZsign n u : h ((-1) ^+ n *: u) = (-1) ^+ n *: h u. Proof. by rewrite !(scaler_sign, =^~ signr_odd) (fun_if h) raddfN. Qed. End RingProperties. Section AddFun. Variables (U V W : zmodType) (f g : {additive V -> W}) (h : {additive U -> V}). Fact idfun_is_additive : additive (@idfun U). Proof. by []. Qed. Canonical idfun_additive := Additive idfun_is_additive. Fact comp_is_additive : additive (f \o h). Proof. by move=> x y /=; rewrite !raddfB. Qed. Canonical comp_additive := Additive comp_is_additive. Fact opp_is_additive : additive (-%R : U -> U). Proof. by move=> x y; rewrite /= opprD. Qed. Canonical opp_additive := Additive opp_is_additive. Fact null_fun_is_additive : additive (\0 : U -> V). Proof. by move=> /=; rewrite subr0. Qed. Canonical null_fun_additive := Additive null_fun_is_additive. Fact add_fun_is_additive : additive (f \+ g). Proof. by move=> x y /=; rewrite !raddfB addrCA -!addrA addrCA -opprD. Qed. Canonical add_fun_additive := Additive add_fun_is_additive. Fact sub_fun_is_additive : additive (f \- g). Proof. by move=> x y /=; rewrite !raddfB addrAC -!addrA -!opprD addrAC addrA. Qed. Canonical sub_fun_additive := Additive sub_fun_is_additive. End AddFun. Section MulFun. Variables (R : ringType) (U : zmodType). Variables (a : R) (f : {additive U -> R}). Fact mull_fun_is_additive : additive (a \*o f). Proof. by move=> x y /=; rewrite raddfB mulrBr. Qed. Canonical mull_fun_additive := Additive mull_fun_is_additive. Fact mulr_fun_is_additive : additive (a \o* f). Proof. by move=> x y /=; rewrite raddfB mulrBl. Qed. Canonical mulr_fun_additive := Additive mulr_fun_is_additive. End MulFun. Section ScaleFun. Variables (R : ringType) (U : zmodType) (V : lmodType R). Variables (a : R) (f : {additive U -> V}). Canonical scale_additive := Additive (@scalerBr R V a). Canonical scale_fun_additive := [additive of a \*: f as f \; *:%R a]. End ScaleFun. End AdditiveTheory. Module RMorphism. Section ClassDef. Variables R S : ringType. Definition mixin_of (f : R -> S) := {morph f : x y / x * y}%R * (f 1 = 1) : Prop. Record class_of f : Prop := Class {base : additive f; mixin : mixin_of f}. Local Coercion base : class_of >-> additive. Structure map (phRS : phant (R -> S)) := Pack {apply; _ : class_of apply}. Local Coercion apply : map >-> Funclass. Variables (phRS : phant (R -> S)) (f g : R -> S) (cF : map phRS). Definition class := let: Pack _ c as cF' := cF return class_of cF' in c. Definition clone fM of phant_id g (apply cF) & phant_id fM class := @Pack phRS f fM. Definition pack (fM : mixin_of f) := fun (bF : Additive.map phRS) fA & phant_id (Additive.class bF) fA => Pack phRS (Class fA fM). Canonical additive := Additive.Pack phRS class. End ClassDef. Module Exports. Notation multiplicative f := (mixin_of f). Notation rmorphism f := (class_of f). Coercion base : rmorphism >-> Additive.axiom. Coercion mixin : rmorphism >-> multiplicative. Coercion apply : map >-> Funclass. Notation RMorphism fM := (Pack (Phant _) fM). Notation AddRMorphism fM := (pack fM id). Notation "{ 'rmorphism' fRS }" := (map (Phant fRS)) (at level 0, format "{ 'rmorphism' fRS }") : ring_scope. Notation "[ 'rmorphism' 'of' f 'as' g ]" := (@clone _ _ _ f g _ _ idfun id) (at level 0, format "[ 'rmorphism' 'of' f 'as' g ]") : form_scope. Notation "[ 'rmorphism' 'of' f ]" := (@clone _ _ _ f f _ _ id id) (at level 0, format "[ 'rmorphism' 'of' f ]") : form_scope. Coercion additive : map >-> Additive.map. Canonical additive. End Exports. End RMorphism. Include RMorphism.Exports. Section RmorphismTheory. Section Properties. Variables (R S : ringType) (k : unit) (f : {rmorphism R -> S}). Lemma rmorph0 : f 0 = 0. Proof. exact: raddf0. Qed. Lemma rmorphN : {morph f : x / - x}. Proof. exact: raddfN. Qed. Lemma rmorphD : {morph f : x y / x + y}. Proof. exact: raddfD. Qed. Lemma rmorphB : {morph f: x y / x - y}. Proof. exact: raddfB. Qed. Lemma rmorphMn n : {morph f : x / x *+ n}. Proof. exact: raddfMn. Qed. Lemma rmorphMNn n : {morph f : x / x *- n}. Proof. exact: raddfMNn. Qed. Lemma rmorph_sum I r (P : pred I) E : f (\sum_(i <- r | P i) E i) = \sum_(i <- r | P i) f (E i). Proof. exact: raddf_sum. Qed. Lemma rmorphMsign n : {morph f : x / (- 1) ^+ n * x}. Proof. exact: raddfMsign. Qed. Lemma rmorphismP : rmorphism f. Proof. exact: RMorphism.class. Qed. Lemma rmorphismMP : multiplicative f. Proof. exact: rmorphismP. Qed. Lemma rmorph1 : f 1 = 1. Proof. by case: rmorphismMP. Qed. Lemma rmorphM : {morph f: x y / x * y}. Proof. by case: rmorphismMP. Qed. Lemma rmorph_prod I r (P : pred I) E : f (\prod_(i <- r | P i) E i) = \prod_(i <- r | P i) f (E i). Proof. exact: (big_morph f rmorphM rmorph1). Qed. Lemma rmorphX n : {morph f: x / x ^+ n}. Proof. by elim: n => [|n IHn] x; rewrite ?rmorph1 // !exprS rmorphM IHn. Qed. Lemma rmorph_nat n : f n%:R = n%:R. Proof. by rewrite rmorphMn rmorph1. Qed. Lemma rmorphN1 : f (- 1) = (- 1). Proof. by rewrite rmorphN rmorph1. Qed. Lemma rmorph_sign n : f ((- 1) ^+ n) = (- 1) ^+ n. Proof. by rewrite rmorphX rmorphN1. Qed. Lemma rmorph_char p : p \in [char R] -> p \in [char S]. Proof. by rewrite !inE -rmorph_nat => /andP[-> /= /eqP->]; rewrite rmorph0. Qed. Lemma rmorph_eq_nat x n : injective f -> (f x == n%:R) = (x == n%:R). Proof. by move/inj_eq <-; rewrite rmorph_nat. Qed. Lemma rmorph_eq1 x : injective f -> (f x == 1) = (x == 1). Proof. exact: rmorph_eq_nat 1%N. Qed. Lemma can2_rmorphism f' : cancel f f' -> cancel f' f -> rmorphism f'. Proof. move=> fK f'K; split; first exact: can2_additive fK f'K. by split=> [x y|]; apply: (canLR fK); rewrite /= (rmorphM, rmorph1) ?f'K. Qed. Lemma bij_rmorphism : bijective f -> exists2 f' : {rmorphism S -> R}, cancel f f' & cancel f' f. Proof. by case=> f' fK f'K; exists (RMorphism (can2_rmorphism fK f'K)). Qed. Fact locked_is_multiplicative : multiplicative (locked_with k (f : R -> S)). Proof. by case: k f => [] [? []]. Qed. Canonical locked_rmorphism := AddRMorphism locked_is_multiplicative. End Properties. Section Projections. Variables (R S T : ringType) (f : {rmorphism S -> T}) (g : {rmorphism R -> S}). Fact idfun_is_multiplicative : multiplicative (@idfun R). Proof. by []. Qed. Canonical idfun_rmorphism := AddRMorphism idfun_is_multiplicative. Fact comp_is_multiplicative : multiplicative (f \o g). Proof. by split=> [x y|] /=; rewrite ?rmorph1 ?rmorphM. Qed. Canonical comp_rmorphism := AddRMorphism comp_is_multiplicative. End Projections. Section InAlgebra. Variables (R : ringType) (A : lalgType R). Fact in_alg_is_rmorphism : rmorphism (in_alg_loc A). Proof. split=> [x y|]; first exact: scalerBl. by split=> [x y|] /=; rewrite ?scale1r // -scalerAl mul1r scalerA. Qed. Canonical in_alg_additive := Additive in_alg_is_rmorphism. Canonical in_alg_rmorphism := RMorphism in_alg_is_rmorphism. Lemma in_algE a : in_alg_loc A a = a%:A. Proof. by []. Qed. End InAlgebra. End RmorphismTheory. Module Scale. Section ScaleLaw. Structure law (R : ringType) (V : zmodType) (s : R -> V -> V) := Law { op : R -> V -> V; _ : op = s; _ : op (-1) =1 -%R; _ : forall a, additive (op a) }. Definition mul_law R := Law (erefl *%R) (@mulN1r R) (@mulrBr R). Definition scale_law R U := Law (erefl *:%R) (@scaleN1r R U) (@scalerBr R U). Variables (R : ringType) (V : zmodType) (s : R -> V -> V) (s_law : law s). Local Notation s_op := (op s_law). Lemma opE : s_op = s. Proof. by case: s_law. Qed. Lemma N1op : s_op (-1) =1 -%R. Proof. by case: s_law. Qed. Fact opB a : additive (s_op a). Proof. by case: s_law. Qed. Definition op_additive a := Additive (opB a). Variables (aR : ringType) (nu : {rmorphism aR -> R}). Fact comp_opE : nu \; s_op = nu \; s. Proof. exact: congr1 opE. Qed. Fact compN1op : (nu \; s_op) (-1) =1 -%R. Proof. by move=> v; rewrite /= rmorphN1 N1op. Qed. Definition comp_law : law (nu \; s) := Law comp_opE compN1op (fun a => opB _). End ScaleLaw. End Scale. Module Linear. Section ClassDef. Variables (R : ringType) (U : lmodType R) (V : zmodType) (s : R -> V -> V). Implicit Type phUV : phant (U -> V). Local Coercion Scale.op : Scale.law >-> Funclass. Definition axiom (f : U -> V) (s_law : Scale.law s) of s = s_law := forall a, {morph f : u v / a *: u + v >-> s a u + v}. Definition mixin_of (f : U -> V) := forall a, {morph f : v / a *: v >-> s a v}. Record class_of f : Prop := Class {base : additive f; mixin : mixin_of f}. Local Coercion base : class_of >-> additive. Lemma class_of_axiom f s_law Ds : @axiom f s_law Ds -> class_of f. Proof. move=> fL; have fB: additive f. by move=> x y /=; rewrite -scaleN1r addrC fL Ds Scale.N1op addrC. by split=> // a v /=; rewrite -[a *: v](addrK v) fB fL addrK Ds. Qed. Structure map (phUV : phant (U -> V)) := Pack {apply; _ : class_of apply}. Local Coercion apply : map >-> Funclass. Variables (phUV : phant (U -> V)) (f g : U -> V) (cF : map phUV). Definition class := let: Pack _ c as cF' := cF return class_of cF' in c. Definition clone fL of phant_id g (apply cF) & phant_id fL class := @Pack phUV f fL. Definition pack (fZ : mixin_of f) := fun (bF : Additive.map phUV) fA & phant_id (Additive.class bF) fA => Pack phUV (Class fA fZ). Canonical additive := Additive.Pack phUV class. (* Support for right-to-left rewriting with the generic linearZ rule. *) Notation mapUV := (map (Phant (U -> V))). Definition map_class := mapUV. Definition map_at (a : R) := mapUV. Structure map_for a s_a := MapFor {map_for_map : mapUV; _ : s a = s_a}. Definition unify_map_at a (f : map_at a) := MapFor f (erefl (s a)). Structure wrapped := Wrap {unwrap : mapUV}. Definition wrap (f : map_class) := Wrap f. End ClassDef. Module Exports. Canonical Scale.mul_law. Canonical Scale.scale_law. Canonical Scale.comp_law. Canonical Scale.op_additive. Delimit Scope linear_ring_scope with linR. Notation "a *: u" := (@Scale.op _ _ *:%R _ a u) : linear_ring_scope. Notation "a * u" := (@Scale.op _ _ *%R _ a u) : linear_ring_scope. Notation "a *:^ nu u" := (@Scale.op _ _ (nu \; *:%R) _ a u) (at level 40, nu at level 1, format "a *:^ nu u") : linear_ring_scope. Notation "a *^ nu u" := (@Scale.op _ _ (nu \; *%R) _ a u) (at level 40, nu at level 1, format "a *^ nu u") : linear_ring_scope. Notation scalable_for s f := (mixin_of s f). Notation scalable f := (scalable_for *:%R f). Notation linear_for s f := (axiom f (erefl s)). Notation linear f := (linear_for *:%R f). Notation scalar f := (linear_for *%R f). Notation lmorphism_for s f := (class_of s f). Notation lmorphism f := (lmorphism_for *:%R f). Coercion class_of_axiom : axiom >-> lmorphism_for. Coercion base : lmorphism_for >-> Additive.axiom. Coercion mixin : lmorphism_for >-> scalable. Coercion apply : map >-> Funclass. Notation Linear fL := (Pack (Phant _) fL). Notation AddLinear fZ := (pack fZ id). Notation "{ 'linear' fUV | s }" := (map s (Phant fUV)) (at level 0, format "{ 'linear' fUV | s }") : ring_scope. Notation "{ 'linear' fUV }" := {linear fUV | *:%R} (at level 0, format "{ 'linear' fUV }") : ring_scope. Notation "{ 'scalar' U }" := {linear U -> _ | *%R} (at level 0, format "{ 'scalar' U }") : ring_scope. Notation "[ 'linear' 'of' f 'as' g ]" := (@clone _ _ _ _ _ f g _ _ idfun id) (at level 0, format "[ 'linear' 'of' f 'as' g ]") : form_scope. Notation "[ 'linear' 'of' f ]" := (@clone _ _ _ _ _ f f _ _ id id) (at level 0, format "[ 'linear' 'of' f ]") : form_scope. Coercion additive : map >-> Additive.map. Canonical additive. (* Support for right-to-left rewriting with the generic linearZ rule. *) Coercion map_for_map : map_for >-> map. Coercion unify_map_at : map_at >-> map_for. Canonical unify_map_at. Coercion unwrap : wrapped >-> map. Coercion wrap : map_class >-> wrapped. Canonical wrap. End Exports. End Linear. Include Linear.Exports. Section LinearTheory. Variable R : ringType. Section GenericProperties. Variables (U : lmodType R) (V : zmodType) (s : R -> V -> V) (k : unit). Variable f : {linear U -> V | s}. Lemma linear0 : f 0 = 0. Proof. exact: raddf0. Qed. Lemma linearN : {morph f : x / - x}. Proof. exact: raddfN. Qed. Lemma linearD : {morph f : x y / x + y}. Proof. exact: raddfD. Qed. Lemma linearB : {morph f : x y / x - y}. Proof. exact: raddfB. Qed. Lemma linearMn n : {morph f : x / x *+ n}. Proof. exact: raddfMn. Qed. Lemma linearMNn n : {morph f : x / x *- n}. Proof. exact: raddfMNn. Qed. Lemma linear_sum I r (P : pred I) E : f (\sum_(i <- r | P i) E i) = \sum_(i <- r | P i) f (E i). Proof. exact: raddf_sum. Qed. Lemma linearZ_LR : scalable_for s f. Proof. by case: f => ? []. Qed. Lemma linearP a : {morph f : u v / a *: u + v >-> s a u + v}. Proof. by move=> u v /=; rewrite linearD linearZ_LR. Qed. Fact locked_is_scalable : scalable_for s (locked_with k (f : U -> V)). Proof. by case: k f => [] [? []]. Qed. Canonical locked_linear := AddLinear locked_is_scalable. End GenericProperties. Section BidirectionalLinearZ. Variables (U : lmodType R) (V : zmodType) (s : R -> V -> V). (* The general form of the linearZ lemma uses some bespoke interfaces to *) (* allow right-to-left rewriting when a composite scaling operation such as *) (* conjC \; *%R has been expanded, say in a^* * f u. This redex is matched *) (* by using the Scale.law interface to recognize a "head" scaling operation *) (* h (here *%R), stow away its "scalar" c, then reconcile h c and s a, once *) (* s is known, that is, once the Linear.map structure for f has been found. *) (* In general, s and a need not be equal to h and c; indeed they need not *) (* have the same type! The unification is performed by the unify_map_at *) (* default instance for the Linear.map_for U s a h_c sub-interface of *) (* Linear.map; the h_c pattern uses the Scale.law structure to insure it is *) (* inferred when rewriting right-to-left. *) (* The wrap on the rhs allows rewriting f (a *: b *: u) into a *: b *: f u *) (* with rewrite !linearZ /= instead of rewrite linearZ /= linearZ /=. *) (* Without it, the first rewrite linearZ would produce *) (* (a *: apply (map_for_map (@check_map_at .. a f)) (b *: u)%R)%Rlin *) (* and matching the second rewrite LHS would bypass the unify_map_at default *) (* instance for b, reuse the one for a, and subsequently fail to match the *) (* b *: u argument. The extra wrap / unwrap ensures that this can't happen. *) (* In the RL direction, the wrap / unwrap will be inserted on the redex side *) (* as needed, without causing unnecessary delta-expansion: using an explicit *) (* identity function would have Coq normalize the redex to head normal, then *) (* reduce the identity to expose the map_for_map projection, and the *) (* expanded Linear.map structure would then be exposed in the result. *) (* Most of this machinery will be invisible to a casual user, because all *) (* the projections and default instances involved are declared as coercions. *) Variables (S : ringType) (h : S -> V -> V) (h_law : Scale.law h). Lemma linearZ c a (h_c := Scale.op h_law c) (f : Linear.map_for U s a h_c) u : f (a *: u) = h_c (Linear.wrap f u). Proof. by rewrite linearZ_LR; case: f => f /= ->. Qed. End BidirectionalLinearZ. Section LmodProperties. Variables (U V : lmodType R) (f : {linear U -> V}). Lemma linearZZ : scalable f. Proof. exact: linearZ_LR. Qed. Lemma linearPZ : linear f. Proof. exact: linearP. Qed. Lemma can2_linear f' : cancel f f' -> cancel f' f -> linear f'. Proof. by move=> fK f'K a x y /=; apply: (canLR fK); rewrite linearP !f'K. Qed. Lemma bij_linear : bijective f -> exists2 f' : {linear V -> U}, cancel f f' & cancel f' f. Proof. by case=> f' fK f'K; exists (Linear (can2_linear fK f'K)). Qed. End LmodProperties. Section ScalarProperties. Variable (U : lmodType R) (f : {scalar U}). Lemma scalarZ : scalable_for *%R f. Proof. exact: linearZ_LR. Qed. Lemma scalarP : scalar f. Proof. exact: linearP. Qed. End ScalarProperties. Section LinearLmod. Variables (W U : lmodType R) (V : zmodType) (s : R -> V -> V). Variables (f : {linear U -> V | s}) (h : {linear W -> U}). Lemma idfun_is_scalable : scalable (@idfun U). Proof. by []. Qed. Canonical idfun_linear := AddLinear idfun_is_scalable. Lemma opp_is_scalable : scalable (-%R : U -> U). Proof. by move=> a v /=; rewrite scalerN. Qed. Canonical opp_linear := AddLinear opp_is_scalable. Lemma comp_is_scalable : scalable_for s (f \o h). Proof. by move=> a v /=; rewrite !linearZ_LR. Qed. Canonical comp_linear := AddLinear comp_is_scalable. Variables (s_law : Scale.law s) (g : {linear U -> V | Scale.op s_law}). Let Ds : s =1 Scale.op s_law. Proof. by rewrite Scale.opE. Qed. Lemma null_fun_is_scalable : scalable_for (Scale.op s_law) (\0 : U -> V). Proof. by move=> a v /=; rewrite raddf0. Qed. Canonical null_fun_linear := AddLinear null_fun_is_scalable. Lemma add_fun_is_scalable : scalable_for s (f \+ g). Proof. by move=> a u; rewrite /= !linearZ_LR !Ds raddfD. Qed. Canonical add_fun_linear := AddLinear add_fun_is_scalable. Lemma sub_fun_is_scalable : scalable_for s (f \- g). Proof. by move=> a u; rewrite /= !linearZ_LR !Ds raddfB. Qed. Canonical sub_fun_linear := AddLinear sub_fun_is_scalable. End LinearLmod. Section LinearLalg. Variables (A : lalgType R) (U : lmodType R). Variables (a : A) (f : {linear U -> A}). Fact mulr_fun_is_scalable : scalable (a \o* f). Proof. by move=> k x /=; rewrite linearZ scalerAl. Qed. Canonical mulr_fun_linear := AddLinear mulr_fun_is_scalable. End LinearLalg. End LinearTheory. Module LRMorphism. Section ClassDef. Variables (R : ringType) (A : lalgType R) (B : ringType) (s : R -> B -> B). Record class_of (f : A -> B) : Prop := Class {base : rmorphism f; mixin : scalable_for s f}. Local Coercion base : class_of >-> rmorphism. Definition base2 f (fLM : class_of f) := Linear.Class fLM (mixin fLM). Local Coercion base2 : class_of >-> lmorphism. Structure map (phAB : phant (A -> B)) := Pack {apply; _ : class_of apply}. Local Coercion apply : map >-> Funclass. Variables (phAB : phant (A -> B)) (f : A -> B) (cF : map phAB). Definition class := let: Pack _ c as cF' := cF return class_of cF' in c. Definition clone := fun (g : RMorphism.map phAB) fM & phant_id (RMorphism.class g) fM => fun (h : Linear.map s phAB) fZ & phant_id (Linear.mixin (Linear.class h)) fZ => Pack phAB (@Class f fM fZ). Definition pack (fZ : scalable_for s f) := fun (g : RMorphism.map phAB) fM & phant_id (RMorphism.class g) fM => Pack phAB (Class fM fZ). Canonical additive := Additive.Pack phAB class. Canonical rmorphism := RMorphism.Pack phAB class. Canonical linear := Linear.Pack phAB class. Canonical join_rmorphism := @RMorphism.Pack _ _ phAB linear class. Canonical join_linear := @Linear.Pack R A B s phAB rmorphism class. End ClassDef. Module Exports. Notation lrmorphism_for s f := (class_of s f). Notation lrmorphism f := (lrmorphism_for *:%R f). Coercion base : lrmorphism_for >-> RMorphism.class_of. Coercion base2 : lrmorphism_for >-> lmorphism_for. Coercion apply : map >-> Funclass. Notation LRMorphism f_lrM := (Pack (Phant _) (Class f_lrM f_lrM)). Notation AddLRMorphism fZ := (pack fZ id). Notation "{ 'lrmorphism' fAB | s }" := (map s (Phant fAB)) (at level 0, format "{ 'lrmorphism' fAB | s }") : ring_scope. Notation "{ 'lrmorphism' fAB }" := {lrmorphism fAB | *:%R} (at level 0, format "{ 'lrmorphism' fAB }") : ring_scope. Notation "[ 'lrmorphism' 'of' f ]" := (@clone _ _ _ _ _ f _ _ id _ _ id) (at level 0, format "[ 'lrmorphism' 'of' f ]") : form_scope. Coercion additive : map >-> Additive.map. Canonical additive. Coercion rmorphism : map >-> RMorphism.map. Canonical rmorphism. Coercion linear : map >-> Linear.map. Canonical linear. Canonical join_rmorphism. Canonical join_linear. End Exports. End LRMorphism. Include LRMorphism.Exports. Section LRMorphismTheory. Variables (R : ringType) (A B : lalgType R) (C : ringType) (s : R -> C -> C). Variables (k : unit) (f : {lrmorphism A -> B}) (g : {lrmorphism B -> C | s}). Definition idfun_lrmorphism := [lrmorphism of @idfun A]. Definition comp_lrmorphism := [lrmorphism of g \o f]. Definition locked_lrmorphism := [lrmorphism of locked_with k (f : A -> B)]. Lemma rmorph_alg a : f a%:A = a%:A. Proof. by rewrite linearZ rmorph1. Qed. Lemma lrmorphismP : lrmorphism f. Proof. exact: LRMorphism.class. Qed. Lemma can2_lrmorphism f' : cancel f f' -> cancel f' f -> lrmorphism f'. Proof. by move=> fK f'K; split; [apply: (can2_rmorphism fK) | apply: (can2_linear fK)]. Qed. Lemma bij_lrmorphism : bijective f -> exists2 f' : {lrmorphism B -> A}, cancel f f' & cancel f' f. Proof. by case/bij_rmorphism=> f' fK f'K; exists (AddLRMorphism (can2_linear fK f'K)). Qed. End LRMorphismTheory. Module ComRing. Definition RingMixin R one mul mulA mulC mul1x mul_addl := let mulx1 := Monoid.mulC_id mulC mul1x in let mul_addr := Monoid.mulC_dist mulC mul_addl in @Ring.EtaMixin R one mul mulA mul1x mulx1 mul_addl mul_addr. Section ClassDef. Set Primitive Projections. Record class_of R := Class {base : Ring.class_of R; mixin : commutative (Ring.mul base)}. Unset Primitive Projections. Local Coercion base : class_of >-> Ring.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c. Definition pack mul0 (m0 : @commutative T T mul0) := fun bT b & phant_id (Ring.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Ring.class_of. Arguments mixin [R]. Coercion mixin : class_of >-> commutative. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Notation comRingType := type. Notation ComRingType T m := (@pack T _ m _ _ id _ id). Notation ComRingMixin := RingMixin. Notation "[ 'comRingType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'comRingType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'comRingType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'comRingType' 'of' T ]") : form_scope. End Exports. End ComRing. Import ComRing.Exports. Section ComRingTheory. Variable R : comRingType. Implicit Types x y : R. Lemma mulrC : @commutative R R *%R. Proof. by case: R => T []. Qed. Canonical mul_comoid := Monoid.ComLaw mulrC. Lemma mulrCA : @left_commutative R R *%R. Proof. exact: mulmCA. Qed. Lemma mulrAC : @right_commutative R R *%R. Proof. exact: mulmAC. Qed. Lemma mulrACA : @interchange R *%R *%R. Proof. exact: mulmACA. Qed. Lemma exprMn n : {morph (fun x => x ^+ n) : x y / x * y}. Proof. by move=> x y; exact/exprMn_comm/mulrC. Qed. Lemma prodrXl n I r (P : pred I) (F : I -> R) : \prod_(i <- r | P i) F i ^+ n = (\prod_(i <- r | P i) F i) ^+ n. Proof. by rewrite (big_morph _ (exprMn n) (expr1n _ n)). Qed. Lemma prodr_undup_exp_count (I : eqType) r (P : pred I) (F : I -> R) : \prod_(i <- undup r | P i) F i ^+ count_mem i r = \prod_(i <- r | P i) F i. Proof. exact: big_undup_iterop_count. Qed. Lemma exprDn x y n : (x + y) ^+ n = \sum_(i < n.+1) (x ^+ (n - i) * y ^+ i) *+ 'C(n, i). Proof. by rewrite exprDn_comm //; apply: mulrC. Qed. Lemma exprBn x y n : (x - y) ^+ n = \sum_(i < n.+1) ((-1) ^+ i * x ^+ (n - i) * y ^+ i) *+ 'C(n, i). Proof. by rewrite exprBn_comm //; apply: mulrC. Qed. Lemma subrXX x y n : x ^+ n - y ^+ n = (x - y) * (\sum_(i < n) x ^+ (n.-1 - i) * y ^+ i). Proof. by rewrite -subrXX_comm //; apply: mulrC. Qed. Lemma sqrrD x y : (x + y) ^+ 2 = x ^+ 2 + x * y *+ 2 + y ^+ 2. Proof. by rewrite exprDn !big_ord_recr big_ord0 /= add0r mulr1 mul1r. Qed. Lemma sqrrB x y : (x - y) ^+ 2 = x ^+ 2 - x * y *+ 2 + y ^+ 2. Proof. by rewrite sqrrD mulrN mulNrn sqrrN. Qed. Lemma subr_sqr x y : x ^+ 2 - y ^+ 2 = (x - y) * (x + y). Proof. by rewrite subrXX !big_ord_recr big_ord0 /= add0r mulr1 mul1r. Qed. Lemma subr_sqrDB x y : (x + y) ^+ 2 - (x - y) ^+ 2 = x * y *+ 4. Proof. rewrite sqrrD sqrrB -!(addrAC _ (y ^+ 2)) opprB. by rewrite addrC addrA subrK -mulrnDr. Qed. Section FrobeniusAutomorphism. Variables (p : nat) (charRp : p \in [char R]). Lemma Frobenius_aut_is_rmorphism : rmorphism (Frobenius_aut charRp). Proof. split=> [x y|]; first exact: Frobenius_autB_comm (mulrC _ _). split=> [x y|]; first exact: Frobenius_autM_comm (mulrC _ _). exact: Frobenius_aut1. Qed. Canonical Frobenius_aut_additive := Additive Frobenius_aut_is_rmorphism. Canonical Frobenius_aut_rmorphism := RMorphism Frobenius_aut_is_rmorphism. End FrobeniusAutomorphism. Lemma exprDn_char x y n : [char R].-nat n -> (x + y) ^+ n = x ^+ n + y ^+ n. Proof. pose p := pdiv n; have [|n_gt1 charRn] := leqP n 1; first by case: (n) => [|[]]. have charRp: p \in [char R] by rewrite (pnatPpi charRn) ?pi_pdiv. have{charRn} /p_natP[e ->]: p.-nat n by rewrite -(eq_pnat _ (charf_eq charRp)). by elim: e => // e IHe; rewrite !expnSr !exprM IHe -Frobenius_autE rmorphD. Qed. Lemma rmorph_comm (S : ringType) (f : {rmorphism R -> S}) x y : comm (f x) (f y). Proof. by red; rewrite -!rmorphM mulrC. Qed. Section ScaleLinear. Variables (U V : lmodType R) (b : R) (f : {linear U -> V}). Lemma scale_is_scalable : scalable ( *:%R b : V -> V). Proof. by move=> a v /=; rewrite !scalerA mulrC. Qed. Canonical scale_linear := AddLinear scale_is_scalable. Lemma scale_fun_is_scalable : scalable (b \*: f). Proof. by move=> a v /=; rewrite !linearZ. Qed. Canonical scale_fun_linear := AddLinear scale_fun_is_scalable. End ScaleLinear. End ComRingTheory. Module Algebra. Section Mixin. Variables (R : ringType) (A : lalgType R). Definition axiom := forall k (x y : A), k *: (x * y) = x * (k *: y). Lemma comm_axiom : phant A -> commutative (@mul A) -> axiom. Proof. by move=> _ commA k x y; rewrite commA scalerAl commA. Qed. End Mixin. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of (T : Type) : Type := Class { base : Lalgebra.class_of R T; mixin : axiom (Lalgebra.Pack _ base) }. Unset Primitive Projections. Local Coercion base : class_of >-> Lalgebra.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack phR T c. Definition pack b0 (ax0 : @axiom R b0) := fun bT b & phant_id (@Lalgebra.class R phR bT) b => fun ax & phant_id ax0 ax => Pack phR (@Class T b ax). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @Lalgebra.Pack R phR cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Lalgebra.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Notation algType R := (type (Phant R)). Notation AlgType R A ax := (@pack _ (Phant R) A _ ax _ _ id _ id). Notation CommAlgType R A := (AlgType R A (comm_axiom (Phant A) (@mulrC _))). Notation "[ 'algType' R 'of' T 'for' cT ]" := (@clone _ (Phant R) T cT _ idfun) (at level 0, format "[ 'algType' R 'of' T 'for' cT ]") : form_scope. Notation "[ 'algType' R 'of' T ]" := (@clone _ (Phant R) T _ _ id) (at level 0, format "[ 'algType' R 'of' T ]") : form_scope. End Exports. End Algebra. Import Algebra.Exports. Module ComAlgebra. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of (T : Type) : Type := Class { base : Algebra.class_of R T; mixin : commutative (Ring.mul base) }. Unset Primitive Projections. Definition base2 R m := ComRing.Class (@mixin R m). Local Coercion base : class_of >-> Algebra.class_of. Local Coercion base2 : class_of >-> ComRing.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition pack := fun bT b & phant_id (@Algebra.class R phR bT) (b : Algebra.class_of R T) => fun mT m & phant_id (ComRing.mixin (ComRing.class mT)) m => Pack (Phant R) (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @Lalgebra.Pack R phR cT class. Definition algType := @Algebra.Pack R phR cT class. Definition lmod_comRingType := @Lmodule.Pack R phR comRingType class. Definition lalg_comRingType := @Lalgebra.Pack R phR comRingType class. Definition alg_comRingType := @Algebra.Pack R phR comRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> Algebra.class_of. Coercion base2 : class_of >-> ComRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Coercion algType : type >-> Algebra.type. Canonical algType. Canonical lmod_comRingType. Canonical lalg_comRingType. Canonical alg_comRingType. Notation comAlgType R := (type (Phant R)). Notation "[ 'comAlgType' R 'of' T ]" := (@pack _ (Phant R) T _ _ id _ _ id) (at level 0, format "[ 'comAlgType' R 'of' T ]") : form_scope. End Exports. End ComAlgebra. Import ComAlgebra.Exports. Section AlgebraTheory. Variables (R : comRingType) (A : algType R). Implicit Types (k : R) (x y : A). Lemma scalerAr k x y : k *: (x * y) = x * (k *: y). Proof. by case: A k x y => T []. Qed. Lemma scalerCA k x y : k *: x * y = x * (k *: y). Proof. by rewrite -scalerAl scalerAr. Qed. Lemma mulr_algr a x : x * a%:A = a *: x. Proof. by rewrite -scalerAr mulr1. Qed. Lemma comm_alg a x : comm a%:A x. Proof. by rewrite /comm mulr_algr mulr_algl. Qed. Lemma exprZn k x n : (k *: x) ^+ n = k ^+ n *: x ^+ n. Proof. elim: n => [|n IHn]; first by rewrite !expr0 scale1r. by rewrite !exprS IHn -scalerA scalerAr scalerAl. Qed. Lemma scaler_prod I r (P : pred I) (F : I -> R) (G : I -> A) : \prod_(i <- r | P i) (F i *: G i) = \prod_(i <- r | P i) F i *: \prod_(i <- r | P i) G i. Proof. elim/big_rec3: _ => [|i x a _ _ ->]; first by rewrite scale1r. by rewrite -scalerAl -scalerAr scalerA. Qed. Lemma scaler_prodl (I : finType) (S : pred I) (F : I -> A) k : \prod_(i in S) (k *: F i) = k ^+ #|S| *: \prod_(i in S) F i. Proof. by rewrite scaler_prod prodr_const. Qed. Lemma scaler_prodr (I : finType) (S : pred I) (F : I -> R) x : \prod_(i in S) (F i *: x) = \prod_(i in S) F i *: x ^+ #|S|. Proof. by rewrite scaler_prod prodr_const. Qed. Canonical regular_comRingType := [comRingType of R^o]. Canonical regular_algType := CommAlgType R R^o. Canonical regular_comAlgType := [comAlgType R of R^o]. Variables (U : lmodType R) (a : A) (f : {linear U -> A}). Lemma mull_fun_is_scalable : scalable (a \*o f). Proof. by move=> k x /=; rewrite linearZ scalerAr. Qed. Canonical mull_fun_linear := AddLinear mull_fun_is_scalable. End AlgebraTheory. Module UnitRing. Record mixin_of (R : ringType) : Type := Mixin { unit : pred R; inv : R -> R; _ : {in unit, left_inverse 1 inv *%R}; _ : {in unit, right_inverse 1 inv *%R}; _ : forall x y, y * x = 1 /\ x * y = 1 -> unit x; _ : {in [predC unit], inv =1 id} }. Definition EtaMixin R unit inv mulVr mulrV unitP inv_out := let _ := @Mixin R unit inv mulVr mulrV unitP inv_out in @Mixin (Ring.Pack (Ring.class R)) unit inv mulVr mulrV unitP inv_out. Section ClassDef. Set Primitive Projections. Record class_of (R : Type) : Type := Class { base : Ring.class_of R; mixin : mixin_of (Ring.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> Ring.class_of. 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. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : mixin_of (@Ring.Pack T b0)) := fun bT b & phant_id (Ring.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Ring.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Notation unitRingType := type. Notation UnitRingType T m := (@pack T _ m _ _ id _ id). Notation UnitRingMixin := EtaMixin. Notation "[ 'unitRingType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'unitRingType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'unitRingType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'unitRingType' 'of' T ]") : form_scope. End Exports. End UnitRing. Import UnitRing.Exports. Definition unit {R : unitRingType} := [qualify a u : R | UnitRing.unit (UnitRing.class R) u]. Fact unit_key R : pred_key (@unit R). Proof. by []. Qed. Canonical unit_keyed R := KeyedQualifier (@unit_key R). Definition inv {R : unitRingType} : R -> R := UnitRing.inv (UnitRing.class R). Local Notation "x ^-1" := (inv x). Local Notation "x / y" := (x * y^-1). Local Notation "x ^- n" := ((x ^+ n)^-1). Section UnitRingTheory. Variable R : unitRingType. Implicit Types x y : R. Lemma divrr : {in unit, right_inverse 1 (@inv R) *%R}. Proof. by case: R => T [? []]. Qed. Definition mulrV := divrr. Lemma mulVr : {in unit, left_inverse 1 (@inv R) *%R}. Proof. by case: R => T [? []]. Qed. Lemma invr_out x : x \isn't a unit -> x^-1 = x. Proof. by case: R x => T [? []]. Qed. Lemma unitrP x : reflect (exists y, y * x = 1 /\ x * y = 1) (x \is a unit). Proof. apply: (iffP idP) => [Ux | []]; last by case: R x => T [? []]. by exists x^-1; rewrite divrr ?mulVr. Qed. Lemma mulKr : {in unit, left_loop (@inv R) *%R}. Proof. by move=> x Ux y; rewrite mulrA mulVr ?mul1r. Qed. Lemma mulVKr : {in unit, rev_left_loop (@inv R) *%R}. Proof. by move=> x Ux y; rewrite mulrA mulrV ?mul1r. Qed. Lemma mulrK : {in unit, right_loop (@inv R) *%R}. Proof. by move=> x Ux y; rewrite -mulrA divrr ?mulr1. Qed. Lemma mulrVK : {in unit, rev_right_loop (@inv R) *%R}. Proof. by move=> x Ux y; rewrite -mulrA mulVr ?mulr1. Qed. Definition divrK := mulrVK. Lemma mulrI : {in @unit R, right_injective *%R}. Proof. by move=> x Ux; apply: can_inj (mulKr Ux). Qed. Lemma mulIr : {in @unit R, left_injective *%R}. Proof. by move=> x Ux; apply: can_inj (mulrK Ux). Qed. (* Due to noncommutativity, fractions are inverted. *) Lemma telescope_prodr n m (f : nat -> R) : (forall k, n < k < m -> f k \is a unit) -> n < m -> \prod_(n <= k < m) (f k / f k.+1) = f n / f m. Proof. move=> Uf /subnK-Dm; do [rewrite -{}Dm; move: {m}(m - _)%N => m] in Uf *. rewrite unlock /index_iota -addSnnS addnK /= -mulrA; congr (_ * _). have{Uf}: all [preim f of unit] (iota n.+1 m). by apply/allP=> k; rewrite mem_iota addnC => /Uf. elim: m n => [|m IHm] n /=; first by rewrite mulr1. by rewrite -mulrA addSnnS => /andP[/mulKr-> /IHm]. Qed. Lemma commrV x y : comm x y -> comm x y^-1. Proof. have [Uy cxy | /invr_out-> //] := boolP (y \in unit). by apply: (canLR (mulrK Uy)); rewrite -mulrA cxy mulKr. Qed. Lemma unitrE x : (x \is a unit) = (x / x == 1). Proof. apply/idP/eqP=> [Ux | xx1]; first exact: divrr. by apply/unitrP; exists x^-1; rewrite -commrV. Qed. Lemma invrK : involutive (@inv R). Proof. move=> x; case Ux: (x \in unit); last by rewrite !invr_out ?Ux. rewrite -(mulrK Ux _^-1) -mulrA commrV ?mulKr //. by apply/unitrP; exists x; rewrite divrr ?mulVr. Qed. Lemma invr_inj : injective (@inv R). Proof. exact: inv_inj invrK. Qed. Lemma unitrV x : (x^-1 \in unit) = (x \in unit). Proof. by rewrite !unitrE invrK commrV. Qed. Lemma unitr1 : 1 \in @unit R. Proof. by apply/unitrP; exists 1; rewrite mulr1. Qed. Lemma invr1 : 1^-1 = 1 :> R. Proof. by rewrite -{2}(mulVr unitr1) mulr1. Qed. Lemma div1r x : 1 / x = x^-1. Proof. by rewrite mul1r. Qed. Lemma divr1 x : x / 1 = x. Proof. by rewrite invr1 mulr1. Qed. Lemma natr_div m d : d %| m -> d%:R \is a @unit R -> (m %/ d)%:R = m%:R / d%:R :> R. Proof. by rewrite dvdn_eq => /eqP def_m unit_d; rewrite -{2}def_m natrM mulrK. Qed. Lemma divrI : {in unit, right_injective (fun x y => x / y)}. Proof. by move=> x /mulrI/inj_comp; apply; apply: invr_inj. Qed. Lemma divIr : {in unit, left_injective (fun x y => x / y)}. Proof. by move=> x; rewrite -unitrV => /mulIr. Qed. Lemma unitr0 : (0 \is a @unit R) = false. Proof. by apply/unitrP=> [[x [_ /esym/eqP]]]; rewrite mul0r oner_eq0. Qed. Lemma invr0 : 0^-1 = 0 :> R. Proof. by rewrite invr_out ?unitr0. Qed. Lemma unitrN1 : -1 \is a @unit R. Proof. by apply/unitrP; exists (-1); rewrite mulrNN mulr1. Qed. Lemma invrN1 : (-1)^-1 = -1 :> R. Proof. by rewrite -{2}(divrr unitrN1) mulN1r opprK. Qed. Lemma invr_sign n : ((-1) ^- n) = (-1) ^+ n :> R. Proof. by rewrite -signr_odd; case: (odd n); rewrite (invr1, invrN1). Qed. Lemma unitrMl x y : y \is a unit -> (x * y \is a unit) = (x \is a unit). Proof. move=> Uy; wlog Ux: x y Uy / x \is a unit => [WHxy|]. by apply/idP/idP=> Ux; first rewrite -(mulrK Uy x); rewrite WHxy ?unitrV. rewrite Ux; apply/unitrP; exists (y^-1 * x^-1). by rewrite -!mulrA mulKr ?mulrA ?mulrK ?divrr ?mulVr. Qed. Lemma unitrMr x y : x \is a unit -> (x * y \is a unit) = (y \is a unit). Proof. move=> Ux; apply/idP/idP=> [Uxy | Uy]; last by rewrite unitrMl. by rewrite -(mulKr Ux y) unitrMl ?unitrV. Qed. Lemma invrM : {in unit &, forall x y, (x * y)^-1 = y^-1 * x^-1}. Proof. move=> x y Ux Uy; have Uxy: (x * y \in unit) by rewrite unitrMl. by apply: (mulrI Uxy); rewrite divrr ?mulrA ?mulrK ?divrr. Qed. Lemma unitrM_comm x y : comm x y -> (x * y \is a unit) = (x \is a unit) && (y \is a unit). Proof. move=> cxy; apply/idP/andP=> [Uxy | [Ux Uy]]; last by rewrite unitrMl. suffices Ux: x \in unit by rewrite unitrMr in Uxy. apply/unitrP; case/unitrP: Uxy => z [zxy xyz]; exists (y * z). rewrite mulrA xyz -{1}[y]mul1r -{1}zxy cxy -!mulrA (mulrA x) (mulrA _ z) xyz. by rewrite mul1r -cxy. Qed. Lemma unitrX x n : x \is a unit -> x ^+ n \is a unit. Proof. by move=> Ux; elim: n => [|n IHn]; rewrite ?unitr1 // exprS unitrMl. Qed. Lemma unitrX_pos x n : n > 0 -> (x ^+ n \in unit) = (x \in unit). Proof. case: n => // n _; rewrite exprS unitrM_comm; last exact: commrX. by case Ux: (x \is a unit); rewrite // unitrX. Qed. Lemma exprVn x n : x^-1 ^+ n = x ^- n. Proof. elim: n => [|n IHn]; first by rewrite !expr0 ?invr1. case Ux: (x \is a unit); first by rewrite exprSr exprS IHn -invrM // unitrX. by rewrite !invr_out ?unitrX_pos ?Ux. Qed. Lemma exprB m n x : n <= m -> x \is a unit -> x ^+ (m - n) = x ^+ m / x ^+ n. Proof. by move/subnK=> {2}<- Ux; rewrite exprD mulrK ?unitrX. Qed. Lemma invr_neq0 x : x != 0 -> x^-1 != 0. Proof. move=> nx0; case Ux: (x \is a unit); last by rewrite invr_out ?Ux. by apply/eqP=> x'0; rewrite -unitrV x'0 unitr0 in Ux. Qed. Lemma invr_eq0 x : (x^-1 == 0) = (x == 0). Proof. by apply: negb_inj; apply/idP/idP; move/invr_neq0; rewrite ?invrK. Qed. Lemma invr_eq1 x : (x^-1 == 1) = (x == 1). Proof. by rewrite (inv_eq invrK) invr1. Qed. Lemma rev_unitrP (x y : R^c) : y * x = 1 /\ x * y = 1 -> x \is a unit. Proof. by case=> [yx1 xy1]; apply/unitrP; exists y. Qed. Definition converse_unitRingMixin := @UnitRing.Mixin _ (unit : {pred R^c}) _ mulrV mulVr rev_unitrP invr_out. Canonical converse_unitRingType := UnitRingType R^c converse_unitRingMixin. Canonical regular_unitRingType := [unitRingType of R^o]. Section ClosedPredicates. Variables S : {pred R}. Definition invr_closed := {in S, forall x, x^-1 \in S}. Definition divr_2closed := {in S &, forall x y, x / y \in S}. Definition divr_closed := 1 \in S /\ divr_2closed. Definition sdivr_closed := -1 \in S /\ divr_2closed. Definition divring_closed := [/\ 1 \in S, subr_2closed S & divr_2closed]. Lemma divr_closedV : divr_closed -> invr_closed. Proof. by case=> S1 Sdiv x Sx; rewrite -[x^-1]mul1r Sdiv. Qed. Lemma divr_closedM : divr_closed -> mulr_closed S. Proof. by case=> S1 Sdiv; split=> // x y Sx Sy; rewrite -[y]invrK -[y^-1]mul1r !Sdiv. Qed. Lemma sdivr_closed_div : sdivr_closed -> divr_closed. Proof. by case=> SN1 Sdiv; split; rewrite // -(divrr unitrN1) Sdiv. Qed. Lemma sdivr_closedM : sdivr_closed -> smulr_closed S. Proof. by move=> Sdiv; have [_ SM] := divr_closedM (sdivr_closed_div Sdiv); case: Sdiv. Qed. Lemma divring_closedBM : divring_closed -> subring_closed S. Proof. by case=> S1 SB Sdiv; split=> //; case: divr_closedM. Qed. Lemma divring_closed_div : divring_closed -> sdivr_closed. Proof. case=> S1 SB Sdiv; split; rewrite ?zmod_closedN //. exact/subring_closedB/divring_closedBM. Qed. End ClosedPredicates. End UnitRingTheory. Arguments invrK {R}. Arguments invr_inj {R} [x1 x2]. Section UnitRingMorphism. Variables (R S : unitRingType) (f : {rmorphism R -> S}). Lemma rmorph_unit x : x \in unit -> f x \in unit. Proof. case/unitrP=> y [yx1 xy1]; apply/unitrP. by exists (f y); rewrite -!rmorphM // yx1 xy1 rmorph1. Qed. Lemma rmorphV : {in unit, {morph f: x / x^-1}}. Proof. move=> x Ux; rewrite /= -[(f x)^-1]mul1r. by apply: (canRL (mulrK (rmorph_unit Ux))); rewrite -rmorphM mulVr ?rmorph1. Qed. Lemma rmorph_div x y : y \in unit -> f (x / y) = f x / f y. Proof. by move=> Uy; rewrite rmorphM rmorphV. Qed. End UnitRingMorphism. Module ComUnitRing. Section Mixin. Variables (R : comRingType) (unit : pred R) (inv : R -> R). Hypothesis mulVx : {in unit, left_inverse 1 inv *%R}. Hypothesis unitPl : forall x y, y * x = 1 -> unit x. Fact mulC_mulrV : {in unit, right_inverse 1 inv *%R}. Proof. by move=> x Ux /=; rewrite mulrC mulVx. Qed. Fact mulC_unitP x y : y * x = 1 /\ x * y = 1 -> unit x. Proof. by case=> yx _; apply: unitPl yx. Qed. Definition Mixin := UnitRingMixin mulVx mulC_mulrV mulC_unitP. End Mixin. Section ClassDef. Set Primitive Projections. Record class_of (R : Type) : Type := Class { base : ComRing.class_of R; mixin : UnitRing.mixin_of (Ring.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> ComRing.class_of. Definition base2 R m := UnitRing.Class (@mixin R m). Local Coercion base2 : class_of >-> UnitRing.class_of. 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. Definition pack := fun bT b & phant_id (ComRing.class bT) (b : ComRing.class_of T) => fun mT m & phant_id (UnitRing.class mT) (@UnitRing.Class T b m) => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition com_unitRingType := @UnitRing.Pack comRingType class. End ClassDef. Module Import Exports. Coercion base : class_of >-> ComRing.class_of. Coercion mixin : class_of >-> UnitRing.mixin_of. Coercion base2 : class_of >-> UnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Canonical com_unitRingType. Notation comUnitRingType := type. Notation ComUnitRingMixin := Mixin. Notation "[ 'comUnitRingType' 'of' T ]" := (@pack T _ _ id _ _ id) (at level 0, format "[ 'comUnitRingType' 'of' T ]") : form_scope. End Exports. End ComUnitRing. Import ComUnitRing.Exports. Module UnitAlgebra. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of (T : Type) : Type := Class { base : Algebra.class_of R T; mixin : GRing.UnitRing.mixin_of (Ring.Pack base) }. Unset Primitive Projections. Definition base2 R m := UnitRing.Class (@mixin R m). Local Coercion base : class_of >-> Algebra.class_of. Local Coercion base2 : class_of >-> UnitRing.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition pack := fun bT b & phant_id (@Algebra.class R phR bT) (b : Algebra.class_of R T) => fun mT m & phant_id (UnitRing.mixin (UnitRing.class mT)) m => Pack (Phant R) (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @Lalgebra.Pack R phR cT class. Definition algType := @Algebra.Pack R phR cT class. Definition lmod_unitRingType := @Lmodule.Pack R phR unitRingType class. Definition lalg_unitRingType := @Lalgebra.Pack R phR unitRingType class. Definition alg_unitRingType := @Algebra.Pack R phR unitRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> Algebra.class_of. Coercion base2 : class_of >-> UnitRing.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Coercion algType : type >-> Algebra.type. Canonical algType. Canonical lmod_unitRingType. Canonical lalg_unitRingType. Canonical alg_unitRingType. Notation unitAlgType R := (type (Phant R)). Notation "[ 'unitAlgType' R 'of' T ]" := (@pack _ (Phant R) T _ _ id _ _ id) (at level 0, format "[ 'unitAlgType' R 'of' T ]") : form_scope. End Exports. End UnitAlgebra. Import UnitAlgebra.Exports. Module ComUnitAlgebra. Section ClassDef. Variable R : ringType. Set Primitive Projections. Record class_of (T : Type) : Type := Class { base : ComAlgebra.class_of R T; mixin : GRing.UnitRing.mixin_of (ComRing.Pack base) }. Unset Primitive Projections. Definition base2 R m := UnitAlgebra.Class (@mixin R m). Definition base3 R m := ComUnitRing.Class (@mixin R m). Local Coercion base : class_of >-> ComAlgebra.class_of. Local Coercion base2 : class_of >-> UnitAlgebra.class_of. Local Coercion base3 : class_of >-> ComUnitRing.class_of. Structure type (phR : phant R) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phR : phant R) (T : Type) (cT : type phR). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition pack := fun bT b & phant_id (@ComAlgebra.class R phR bT) (b : ComAlgebra.class_of R T) => fun mT m & phant_id (UnitRing.mixin (UnitRing.class mT)) m => Pack (Phant R) (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @Lalgebra.Pack R phR cT class. Definition algType := @Algebra.Pack R phR cT class. Definition comAlgType := @ComAlgebra.Pack R phR cT class. Definition unitAlgType := @UnitAlgebra.Pack R phR cT class. Definition comalg_unitRingType := @ComAlgebra.Pack R phR unitRingType class. Definition comalg_comUnitRingType := @ComAlgebra.Pack R phR comUnitRingType class. Definition comalg_unitAlgType := @ComAlgebra.Pack R phR unitAlgType class. Definition unitalg_comRingType := @UnitAlgebra.Pack R phR comRingType class. Definition unitalg_comUnitRingType := @UnitAlgebra.Pack R phR comUnitRingType class. Definition lmod_comUnitRingType := @Lmodule.Pack R phR comUnitRingType class. Definition lalg_comUnitRingType := @Lalgebra.Pack R phR comUnitRingType class. Definition alg_comUnitRingType := @Algebra.Pack R phR comUnitRingType class. End ClassDef. Module Exports. Coercion base : class_of >-> ComAlgebra.class_of. Coercion base2 : class_of >-> UnitAlgebra.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Coercion algType : type >-> Algebra.type. Canonical algType. Coercion comAlgType : type >-> ComAlgebra.type. Canonical comAlgType. Coercion unitAlgType : type >-> UnitAlgebra.type. Canonical unitAlgType. Canonical comalg_unitRingType. Canonical comalg_comUnitRingType. Canonical comalg_unitAlgType. Canonical unitalg_comRingType. Canonical unitalg_comUnitRingType. Canonical lmod_comUnitRingType. Canonical lalg_comUnitRingType. Canonical alg_comUnitRingType. Notation comUnitAlgType R := (type (Phant R)). Notation "[ 'comUnitAlgType' R 'of' T ]" := (@pack _ (Phant R) T _ _ id _ _ id) (at level 0, format "[ 'comUnitAlgType' R 'of' T ]") : form_scope. End Exports. End ComUnitAlgebra. Import ComUnitAlgebra.Exports. Section ComUnitRingTheory. Variable R : comUnitRingType. Implicit Types x y : R. Lemma unitrM x y : (x * y \in unit) = (x \in unit) && (y \in unit). Proof. exact/unitrM_comm/mulrC. Qed. Lemma unitrPr x : reflect (exists y, x * y = 1) (x \in unit). Proof. by apply: (iffP (unitrP x)) => [[y []] | [y]]; exists y; rewrite // mulrC. Qed. Lemma mulr1_eq x y : x * y = 1 -> x^-1 = y. Proof. by move=> xy_eq1; rewrite -[LHS]mulr1 -xy_eq1; apply/mulKr/unitrPr; exists y. Qed. Lemma divr1_eq x y : x / y = 1 -> x = y. Proof. by move/mulr1_eq/invr_inj. Qed. Lemma divKr x : x \is a unit -> {in unit, involutive (fun y => x / y)}. Proof. by move=> Ux y Uy; rewrite /= invrM ?unitrV // invrK mulrC divrK. Qed. Lemma expr_div_n x y n : (x / y) ^+ n = x ^+ n / y ^+ n. Proof. by rewrite exprMn exprVn. Qed. Canonical regular_comUnitRingType := [comUnitRingType of R^o]. Canonical regular_unitAlgType := [unitAlgType R of R^o]. Canonical regular_comUnitAlgType := [comUnitAlgType R of R^o]. End ComUnitRingTheory. Section UnitAlgebraTheory. Variable (R : comUnitRingType) (A : unitAlgType R). Implicit Types (k : R) (x y : A). Lemma scaler_injl : {in unit, @right_injective R A A *:%R}. Proof. move=> k Uk x1 x2 Hx1x2. by rewrite -[x1]scale1r -(mulVr Uk) -scalerA Hx1x2 scalerA mulVr // scale1r. Qed. Lemma scaler_unit k x : k \in unit -> (k *: x \in unit) = (x \in unit). Proof. move=> Uk; apply/idP/idP=> [Ukx | Ux]; apply/unitrP; last first. exists (k^-1 *: x^-1). by rewrite -!scalerAl -!scalerAr !scalerA !mulVr // !mulrV // scale1r. exists (k *: (k *: x)^-1); split. apply: (mulrI Ukx). by rewrite mulr1 mulrA -scalerAr mulrV // -scalerAl mul1r. apply: (mulIr Ukx). by rewrite mul1r -mulrA -scalerAl mulVr // -scalerAr mulr1. Qed. Lemma invrZ k x : k \in unit -> x \in unit -> (k *: x)^-1 = k^-1 *: x^-1. Proof. move=> Uk Ux; have Ukx: (k *: x \in unit) by rewrite scaler_unit. apply: (mulIr Ukx). by rewrite mulVr // -scalerAl -scalerAr scalerA !mulVr // scale1r. Qed. Section ClosedPredicates. Variables S : {pred A}. Definition divalg_closed := [/\ 1 \in S, linear_closed S & divr_2closed S]. Lemma divalg_closedBdiv : divalg_closed -> divring_closed S. Proof. by case=> S1 /linear_closedB. Qed. Lemma divalg_closedZ : divalg_closed -> subalg_closed S. Proof. by case=> S1 Slin Sdiv; split=> //; have [] := @divr_closedM A S. Qed. End ClosedPredicates. End UnitAlgebraTheory. (* Interface structures for algebraically closed predicates. *) Module Pred. Structure opp V S := Opp {opp_key : pred_key S; _ : @oppr_closed V S}. Structure add V S := Add {add_key : pred_key S; _ : @addr_closed V S}. Structure mul R S := Mul {mul_key : pred_key S; _ : @mulr_closed R S}. Structure zmod V S := Zmod {zmod_add : add S; _ : @oppr_closed V S}. Structure semiring R S := Semiring {semiring_add : add S; _ : @mulr_closed R S}. Structure smul R S := Smul {smul_opp : opp S; _ : @mulr_closed R S}. Structure div R S := Div {div_mul : mul S; _ : @invr_closed R S}. Structure submod R V S := Submod {submod_zmod : zmod S; _ : @scaler_closed R V S}. Structure subring R S := Subring {subring_zmod : zmod S; _ : @mulr_closed R S}. Structure sdiv R S := Sdiv {sdiv_smul : smul S; _ : @invr_closed R S}. Structure subalg (R : ringType) (A : lalgType R) S := Subalg {subalg_ring : subring S; _ : @scaler_closed R A S}. Structure divring R S := Divring {divring_ring : subring S; _ : @invr_closed R S}. Structure divalg (R : ringType) (A : unitAlgType R) S := Divalg {divalg_ring : divring S; _ : @scaler_closed R A S}. Section Subtyping. Ltac done := case=> *; assumption. Fact zmod_oppr R S : @zmod R S -> oppr_closed S. Proof. by []. Qed. Fact semiring_mulr R S : @semiring R S -> mulr_closed S. Proof. by []. Qed. Fact smul_mulr R S : @smul R S -> mulr_closed S. Proof. by []. Qed. Fact submod_scaler R V S : @submod R V S -> scaler_closed S. Proof. by []. Qed. Fact subring_mulr R S : @subring R S -> mulr_closed S. Proof. by []. Qed. Fact sdiv_invr R S : @sdiv R S -> invr_closed S. Proof. by []. Qed. Fact subalg_scaler R A S : @subalg R A S -> scaler_closed S. Proof. by []. Qed. Fact divring_invr R S : @divring R S -> invr_closed S. Proof. by []. Qed. Fact divalg_scaler R A S : @divalg R A S -> scaler_closed S. Proof. by []. Qed. Definition zmod_opp R S (addS : @zmod R S) := Opp (add_key (zmod_add addS)) (zmod_oppr addS). Definition semiring_mul R S (ringS : @semiring R S) := Mul (add_key (semiring_add ringS)) (semiring_mulr ringS). Definition smul_mul R S (mulS : @smul R S) := Mul (opp_key (smul_opp mulS)) (smul_mulr mulS). Definition subring_semi R S (ringS : @subring R S) := Semiring (zmod_add (subring_zmod ringS)) (subring_mulr ringS). Definition subring_smul R S (ringS : @subring R S) := Smul (zmod_opp (subring_zmod ringS)) (subring_mulr ringS). Definition sdiv_div R S (divS : @sdiv R S) := Div (smul_mul (sdiv_smul divS)) (sdiv_invr divS). Definition subalg_submod R A S (algS : @subalg R A S) := Submod (subring_zmod (subalg_ring algS)) (subalg_scaler algS). Definition divring_sdiv R S (ringS : @divring R S) := Sdiv (subring_smul (divring_ring ringS)) (divring_invr ringS). Definition divalg_alg R A S (algS : @divalg R A S) := Subalg (divring_ring (divalg_ring algS)) (divalg_scaler algS). End Subtyping. Section Extensionality. (* This could be avoided by exploiting the Coq 8.4 eta-convertibility. *) Lemma opp_ext (U : zmodType) S k (kS : @keyed_pred U S k) : oppr_closed kS -> oppr_closed S. Proof. by move=> oppS x; rewrite -!(keyed_predE kS); apply: oppS. Qed. Lemma add_ext (U : zmodType) S k (kS : @keyed_pred U S k) : addr_closed kS -> addr_closed S. Proof. by case=> S0 addS; split=> [|x y]; rewrite -!(keyed_predE kS) //; apply: addS. Qed. Lemma mul_ext (R : ringType) S k (kS : @keyed_pred R S k) : mulr_closed kS -> mulr_closed S. Proof. by case=> S1 mulS; split=> [|x y]; rewrite -!(keyed_predE kS) //; apply: mulS. Qed. Lemma scale_ext (R : ringType) (U : lmodType R) S k (kS : @keyed_pred U S k) : scaler_closed kS -> scaler_closed S. Proof. by move=> linS a x; rewrite -!(keyed_predE kS); apply: linS. Qed. Lemma inv_ext (R : unitRingType) S k (kS : @keyed_pred R S k) : invr_closed kS -> invr_closed S. Proof. by move=> invS x; rewrite -!(keyed_predE kS); apply: invS. Qed. End Extensionality. Module Default. Definition opp V S oppS := @Opp V S (DefaultPredKey S) oppS. Definition add V S addS := @Add V S (DefaultPredKey S) addS. Definition mul R S mulS := @Mul R S (DefaultPredKey S) mulS. Definition zmod V S addS oppS := @Zmod V S (add addS) oppS. Definition semiring R S addS mulS := @Semiring R S (add addS) mulS. Definition smul R S oppS mulS := @Smul R S (opp oppS) mulS. Definition div R S mulS invS := @Div R S (mul mulS) invS. Definition submod R V S addS oppS linS := @Submod R V S (zmod addS oppS) linS. Definition subring R S addS oppS mulS := @Subring R S (zmod addS oppS) mulS. Definition sdiv R S oppS mulS invS := @Sdiv R S (smul oppS mulS) invS. Definition subalg R A S addS oppS mulS linS := @Subalg R A S (subring addS oppS mulS) linS. Definition divring R S addS oppS mulS invS := @Divring R S (subring addS oppS mulS) invS. Definition divalg R A S addS oppS mulS invS linS := @Divalg R A S (divring addS oppS mulS invS) linS. End Default. Module Exports. Notation oppr_closed := oppr_closed. Notation addr_closed := addr_closed. Notation mulr_closed := mulr_closed. Notation zmod_closed := zmod_closed. Notation smulr_closed := smulr_closed. Notation invr_closed := invr_closed. Notation divr_closed := divr_closed. Notation scaler_closed := scaler_closed. Notation linear_closed := linear_closed. Notation submod_closed := submod_closed. Notation semiring_closed := semiring_closed. Notation subring_closed := subring_closed. Notation sdivr_closed := sdivr_closed. Notation subalg_closed := subalg_closed. Notation divring_closed := divring_closed. Notation divalg_closed := divalg_closed. Coercion zmod_closedD : zmod_closed >-> addr_closed. Coercion zmod_closedN : zmod_closed >-> oppr_closed. Coercion smulr_closedN : smulr_closed >-> oppr_closed. Coercion smulr_closedM : smulr_closed >-> mulr_closed. Coercion divr_closedV : divr_closed >-> invr_closed. Coercion divr_closedM : divr_closed >-> mulr_closed. Coercion submod_closedZ : submod_closed >-> scaler_closed. Coercion submod_closedB : submod_closed >-> zmod_closed. Coercion semiring_closedD : semiring_closed >-> addr_closed. Coercion semiring_closedM : semiring_closed >-> mulr_closed. Coercion subring_closedB : subring_closed >-> zmod_closed. Coercion subring_closedM : subring_closed >-> smulr_closed. Coercion subring_closed_semi : subring_closed >-> semiring_closed. Coercion sdivr_closedM : sdivr_closed >-> smulr_closed. Coercion sdivr_closed_div : sdivr_closed >-> divr_closed. Coercion subalg_closedZ : subalg_closed >-> submod_closed. Coercion subalg_closedBM : subalg_closed >-> subring_closed. Coercion divring_closedBM : divring_closed >-> subring_closed. Coercion divring_closed_div : divring_closed >-> sdivr_closed. Coercion divalg_closedZ : divalg_closed >-> subalg_closed. Coercion divalg_closedBdiv : divalg_closed >-> divring_closed. Coercion opp_key : opp >-> pred_key. Coercion add_key : add >-> pred_key. Coercion mul_key : mul >-> pred_key. Coercion zmod_opp : zmod >-> opp. Canonical zmod_opp. Coercion zmod_add : zmod >-> add. Coercion semiring_add : semiring >-> add. Coercion semiring_mul : semiring >-> mul. Canonical semiring_mul. Coercion smul_opp : smul >-> opp. Coercion smul_mul : smul >-> mul. Canonical smul_mul. Coercion div_mul : div >-> mul. Coercion submod_zmod : submod >-> zmod. Coercion subring_zmod : subring >-> zmod. Coercion subring_semi : subring >-> semiring. Canonical subring_semi. Coercion subring_smul : subring >-> smul. Canonical subring_smul. Coercion sdiv_smul : sdiv >-> smul. Coercion sdiv_div : sdiv >-> div. Canonical sdiv_div. Coercion subalg_submod : subalg >-> submod. Canonical subalg_submod. Coercion subalg_ring : subalg >-> subring. Coercion divring_ring : divring >-> subring. Coercion divring_sdiv : divring >-> sdiv. Canonical divring_sdiv. Coercion divalg_alg : divalg >-> subalg. Canonical divalg_alg. Coercion divalg_ring : divalg >-> divring. Notation opprPred := opp. Notation addrPred := add. Notation mulrPred := mul. Notation zmodPred := zmod. Notation semiringPred := semiring. Notation smulrPred := smul. Notation divrPred := div. Notation submodPred := submod. Notation subringPred := subring. Notation sdivrPred := sdiv. Notation subalgPred := subalg. Notation divringPred := divring. Notation divalgPred := divalg. Definition OpprPred U S k kS NkS := Opp k (@opp_ext U S k kS NkS). Definition AddrPred U S k kS DkS := Add k (@add_ext U S k kS DkS). Definition MulrPred R S k kS MkS := Mul k (@mul_ext R S k kS MkS). Definition ZmodPred U S k kS NkS := Zmod k (@opp_ext U S k kS NkS). Definition SemiringPred R S k kS MkS := Semiring k (@mul_ext R S k kS MkS). Definition SmulrPred R S k kS MkS := Smul k (@mul_ext R S k kS MkS). Definition DivrPred R S k kS VkS := Div k (@inv_ext R S k kS VkS). Definition SubmodPred R U S k kS ZkS := Submod k (@scale_ext R U S k kS ZkS). Definition SubringPred R S k kS MkS := Subring k (@mul_ext R S k kS MkS). Definition SdivrPred R S k kS VkS := Sdiv k (@inv_ext R S k kS VkS). Definition SubalgPred (R : ringType) (A : lalgType R) S k kS ZkS := Subalg k (@scale_ext R A S k kS ZkS). Definition DivringPred R S k kS VkS := Divring k (@inv_ext R S k kS VkS). Definition DivalgPred (R : ringType) (A : unitAlgType R) S k kS ZkS := Divalg k (@scale_ext R A S k kS ZkS). End Exports. End Pred. Import Pred.Exports. Module DefaultPred. Canonical Pred.Default.opp. Canonical Pred.Default.add. Canonical Pred.Default.mul. Canonical Pred.Default.zmod. Canonical Pred.Default.semiring. Canonical Pred.Default.smul. Canonical Pred.Default.div. Canonical Pred.Default.submod. Canonical Pred.Default.subring. Canonical Pred.Default.sdiv. Canonical Pred.Default.subalg. Canonical Pred.Default.divring. Canonical Pred.Default.divalg. End DefaultPred. Section ZmodulePred. Variables (V : zmodType) (S : {pred V}). Section Add. Variables (addS : addrPred S) (kS : keyed_pred addS). Lemma rpred0D : addr_closed kS. Proof. by split=> [|x y]; rewrite !keyed_predE; case: addS => _ [_]//; apply. Qed. Lemma rpred0 : 0 \in kS. Proof. by case: rpred0D. Qed. Lemma rpredD : {in kS &, forall u v, u + v \in kS}. Proof. by case: rpred0D. Qed. Lemma rpred_sum I r (P : pred I) F : (forall i, P i -> F i \in kS) -> \sum_(i <- r | P i) F i \in kS. Proof. by move=> IH; elim/big_ind: _; [apply: rpred0 | apply: rpredD |]. Qed. Lemma rpredMn n : {in kS, forall u, u *+ n \in kS}. Proof. by move=> u Su; rewrite -(card_ord n) -sumr_const rpred_sum. Qed. End Add. Section Opp. Variables (oppS : opprPred S) (kS : keyed_pred oppS). Lemma rpredNr : oppr_closed kS. Proof. by move=> x; rewrite !keyed_predE; case: oppS => _; apply. Qed. Lemma rpredN : {mono -%R: u / u \in kS}. Proof. by move=> u; apply/idP/idP=> /rpredNr; rewrite ?opprK; apply. Qed. End Opp. Section Sub. Variables (subS : zmodPred S) (kS : keyed_pred subS). Lemma rpredB : {in kS &, forall u v, u - v \in kS}. Proof. by move=> u v Su Sv; rewrite /= rpredD ?rpredN. Qed. Lemma rpredBC u v : u - v \in kS = (v - u \in kS). Proof. by rewrite -rpredN opprB. Qed. Lemma rpredMNn n : {in kS, forall u, u *- n \in kS}. Proof. by move=> u Su; rewrite /= rpredN rpredMn. Qed. Lemma rpredDr x y : x \in kS -> (y + x \in kS) = (y \in kS). Proof. move=> Sx; apply/idP/idP=> [Sxy | /rpredD-> //]. by rewrite -(addrK x y) rpredB. Qed. Lemma rpredDl x y : x \in kS -> (x + y \in kS) = (y \in kS). Proof. by rewrite addrC; apply: rpredDr. Qed. Lemma rpredBr x y : x \in kS -> (y - x \in kS) = (y \in kS). Proof. by rewrite -rpredN; apply: rpredDr. Qed. Lemma rpredBl x y : x \in kS -> (x - y \in kS) = (y \in kS). Proof. by rewrite -(rpredN _ y); apply: rpredDl. Qed. End Sub. End ZmodulePred. Section RingPred. Variables (R : ringType) (S : {pred R}). Lemma rpredMsign (oppS : opprPred S) (kS : keyed_pred oppS) n x : ((-1) ^+ n * x \in kS) = (x \in kS). Proof. by rewrite -signr_odd mulr_sign; case: ifP => // _; rewrite rpredN. Qed. Section Mul. Variables (mulS : mulrPred S) (kS : keyed_pred mulS). Lemma rpred1M : mulr_closed kS. Proof. by split=> [|x y]; rewrite !keyed_predE; case: mulS => _ [_] //; apply. Qed. Lemma rpred1 : 1 \in kS. Proof. by case: rpred1M. Qed. Lemma rpredM : {in kS &, forall u v, u * v \in kS}. Proof. by case: rpred1M. Qed. Lemma rpred_prod I r (P : pred I) F : (forall i, P i -> F i \in kS) -> \prod_(i <- r | P i) F i \in kS. Proof. by move=> IH; elim/big_ind: _; [apply: rpred1 | apply: rpredM |]. Qed. Lemma rpredX n : {in kS, forall u, u ^+ n \in kS}. Proof. by move=> u Su; rewrite -(card_ord n) -prodr_const rpred_prod. Qed. End Mul. Lemma rpred_nat (rngS : semiringPred S) (kS : keyed_pred rngS) n : n%:R \in kS. Proof. by rewrite rpredMn ?rpred1. Qed. Lemma rpredN1 (mulS : smulrPred S) (kS : keyed_pred mulS) : -1 \in kS. Proof. by rewrite rpredN rpred1. Qed. Lemma rpred_sign (mulS : smulrPred S) (kS : keyed_pred mulS) n : (-1) ^+ n \in kS. Proof. by rewrite rpredX ?rpredN1. Qed. End RingPred. Section LmodPred. Variables (R : ringType) (V : lmodType R) (S : {pred V}). Lemma rpredZsign (oppS : opprPred S) (kS : keyed_pred oppS) n u : ((-1) ^+ n *: u \in kS) = (u \in kS). Proof. by rewrite -signr_odd scaler_sign fun_if if_arg rpredN if_same. Qed. Lemma rpredZnat (addS : addrPred S) (kS : keyed_pred addS) n : {in kS, forall u, n%:R *: u \in kS}. Proof. by move=> u Su; rewrite /= scaler_nat rpredMn. Qed. Lemma rpredZ (linS : submodPred S) (kS : keyed_pred linS) : scaler_closed kS. Proof. by move=> a u; rewrite !keyed_predE; case: {kS}linS => _; apply. Qed. End LmodPred. Section UnitRingPred. Variable R : unitRingType. Section Div. Variables (S : {pred R}) (divS : divrPred S) (kS : keyed_pred divS). Lemma rpredVr x : x \in kS -> x^-1 \in kS. Proof. by rewrite !keyed_predE; case: divS x. Qed. Lemma rpredV x : (x^-1 \in kS) = (x \in kS). Proof. by apply/idP/idP=> /rpredVr; rewrite ?invrK. Qed. Lemma rpred_div : {in kS &, forall x y, x / y \in kS}. Proof. by move=> x y Sx Sy; rewrite /= rpredM ?rpredV. Qed. Lemma rpredXN n : {in kS, forall x, x ^- n \in kS}. Proof. by move=> x Sx; rewrite /= rpredV rpredX. Qed. Lemma rpredMl x y : x \in kS -> x \is a unit-> (x * y \in kS) = (y \in kS). Proof. move=> Sx Ux; apply/idP/idP=> [Sxy | /(rpredM Sx)-> //]. by rewrite -(mulKr Ux y); rewrite rpredM ?rpredV. Qed. Lemma rpredMr x y : x \in kS -> x \is a unit -> (y * x \in kS) = (y \in kS). Proof. move=> Sx Ux; apply/idP/idP=> [Sxy | /rpredM-> //]. by rewrite -(mulrK Ux y); rewrite rpred_div. Qed. Lemma rpred_divr x y : x \in kS -> x \is a unit -> (y / x \in kS) = (y \in kS). Proof. by rewrite -rpredV -unitrV; apply: rpredMr. Qed. Lemma rpred_divl x y : x \in kS -> x \is a unit -> (x / y \in kS) = (y \in kS). Proof. by rewrite -(rpredV y); apply: rpredMl. Qed. End Div. Fact unitr_sdivr_closed : @sdivr_closed R unit. Proof. by split=> [|x y Ux Uy]; rewrite ?unitrN1 // unitrMl ?unitrV. Qed. Canonical unit_opprPred := OpprPred unitr_sdivr_closed. Canonical unit_mulrPred := MulrPred unitr_sdivr_closed. Canonical unit_divrPred := DivrPred unitr_sdivr_closed. Canonical unit_smulrPred := SmulrPred unitr_sdivr_closed. Canonical unit_sdivrPred := SdivrPred unitr_sdivr_closed. Implicit Type x : R. Lemma unitrN x : (- x \is a unit) = (x \is a unit). Proof. exact: rpredN. Qed. Lemma invrN x : (- x)^-1 = - x^-1. Proof. have [Ux | U'x] := boolP (x \is a unit); last by rewrite !invr_out ?unitrN. by rewrite -mulN1r invrM ?unitrN1 // invrN1 mulrN1. Qed. Lemma invr_signM n x : ((-1) ^+ n * x)^-1 = (-1) ^+ n * x^-1. Proof. by rewrite -signr_odd !mulr_sign; case: ifP => // _; rewrite invrN. Qed. Lemma divr_signM (b1 b2 : bool) x1 x2: ((-1) ^+ b1 * x1) / ((-1) ^+ b2 * x2) = (-1) ^+ (b1 (+) b2) * (x1 / x2). Proof. by rewrite invr_signM mulr_signM. Qed. End UnitRingPred. (* Reification of the theory of rings with units, in named style *) Section TermDef. Variable R : Type. Inductive term : Type := | Var of nat | Const of R | NatConst of nat | Add of term & term | Opp of term | NatMul of term & nat | Mul of term & term | Inv of term | Exp of term & nat. Inductive formula : Type := | Bool of bool | Equal of term & term | Unit of term | And of formula & formula | Or of formula & formula | Implies of formula & formula | Not of formula | Exists of nat & formula | Forall of nat & formula. End TermDef. Bind Scope term_scope with term. Bind Scope term_scope with formula. Arguments Add {R} t1%T t2%T. Arguments Opp {R} t1%T. Arguments NatMul {R} t1%T n%N. Arguments Mul {R} t1%T t2%T. Arguments Inv {R} t1%T. Arguments Exp {R} t1%T n%N. Arguments Equal {R} t1%T t2%T. Arguments Unit {R} t1%T. Arguments And {R} f1%T f2%T. Arguments Or {R} f1%T f2%T. Arguments Implies {R} f1%T f2%T. Arguments Not {R} f1%T. Arguments Exists {R} i%N f1%T. Arguments Forall {R} i%N f1%T. Arguments Bool {R} b. Arguments Const {R} x. Notation True := (Bool true). Notation False := (Bool false). Local Notation "''X_' i" := (Var _ i) : term_scope. Local Notation "n %:R" := (NatConst _ n) : term_scope. Local Notation "x %:T" := (Const x) : term_scope. Local Notation "0" := 0%:R%T : term_scope. Local Notation "1" := 1%:R%T : term_scope. Local Infix "+" := Add : term_scope. Local Notation "- t" := (Opp t) : term_scope. Local Notation "t - u" := (Add t (- u)) : term_scope. Local Infix "*" := Mul : term_scope. Local Infix "*+" := NatMul : term_scope. Local Notation "t ^-1" := (Inv t) : term_scope. Local Notation "t / u" := (Mul t u^-1) : term_scope. Local Infix "^+" := Exp : term_scope. Local Infix "==" := Equal : term_scope. Local Infix "/\" := And : term_scope. Local Infix "\/" := Or : term_scope. Local Infix "==>" := Implies : term_scope. Local Notation "~ f" := (Not f) : term_scope. Local Notation "x != y" := (Not (x == y)) : term_scope. Local Notation "''exists' ''X_' i , f" := (Exists i f) : term_scope. Local Notation "''forall' ''X_' i , f" := (Forall i f) : term_scope. Section Substitution. Variable R : Type. Fixpoint tsubst (t : term R) (s : nat * term R) := match t with | 'X_i => if i == s.1 then s.2 else t | _%:T | _%:R => t | t1 + t2 => tsubst t1 s + tsubst t2 s | - t1 => - tsubst t1 s | t1 *+ n => tsubst t1 s *+ n | t1 * t2 => tsubst t1 s * tsubst t2 s | t1^-1 => (tsubst t1 s)^-1 | t1 ^+ n => tsubst t1 s ^+ n end%T. Fixpoint fsubst (f : formula R) (s : nat * term R) := match f with | Bool _ => f | t1 == t2 => tsubst t1 s == tsubst t2 s | Unit t1 => Unit (tsubst t1 s) | f1 /\ f2 => fsubst f1 s /\ fsubst f2 s | f1 \/ f2 => fsubst f1 s \/ fsubst f2 s | f1 ==> f2 => fsubst f1 s ==> fsubst f2 s | ~ f1 => ~ fsubst f1 s | ('exists 'X_i, f1) => 'exists 'X_i, if i == s.1 then f1 else fsubst f1 s | ('forall 'X_i, f1) => 'forall 'X_i, if i == s.1 then f1 else fsubst f1 s end%T. End Substitution. Section EvalTerm. Variable R : unitRingType. (* Evaluation of a reified term into R a ring with units *) Fixpoint eval (e : seq R) (t : term R) {struct t} : R := match t with | ('X_i)%T => e`_i | (x%:T)%T => x | (n%:R)%T => n%:R | (t1 + t2)%T => eval e t1 + eval e t2 | (- t1)%T => - eval e t1 | (t1 *+ n)%T => eval e t1 *+ n | (t1 * t2)%T => eval e t1 * eval e t2 | t1^-1%T => (eval e t1)^-1 | (t1 ^+ n)%T => eval e t1 ^+ n end. Definition same_env (e e' : seq R) := nth 0 e =1 nth 0 e'. Lemma eq_eval e e' t : same_env e e' -> eval e t = eval e' t. Proof. by move=> eq_e; elim: t => //= t1 -> // t2 ->. Qed. Lemma eval_tsubst e t s : eval e (tsubst t s) = eval (set_nth 0 e s.1 (eval e s.2)) t. Proof. case: s => i u; elim: t => //=; do 2?[move=> ? -> //] => j. by rewrite nth_set_nth /=; case: (_ == _). Qed. (* Evaluation of a reified formula *) Fixpoint holds (e : seq R) (f : formula R) {struct f} : Prop := match f with | Bool b => b | (t1 == t2)%T => eval e t1 = eval e t2 | Unit t1 => eval e t1 \in unit | (f1 /\ f2)%T => holds e f1 /\ holds e f2 | (f1 \/ f2)%T => holds e f1 \/ holds e f2 | (f1 ==> f2)%T => holds e f1 -> holds e f2 | (~ f1)%T => ~ holds e f1 | ('exists 'X_i, f1)%T => exists x, holds (set_nth 0 e i x) f1 | ('forall 'X_i, f1)%T => forall x, holds (set_nth 0 e i x) f1 end. Lemma same_env_sym e e' : same_env e e' -> same_env e' e. Proof. exact: fsym. Qed. (* Extensionality of formula evaluation *) Lemma eq_holds e e' f : same_env e e' -> holds e f -> holds e' f. Proof. pose sv := set_nth (0 : R). have eq_i i v e1 e2: same_env e1 e2 -> same_env (sv e1 i v) (sv e2 i v). by move=> eq_e j; rewrite !nth_set_nth /= eq_e. elim: f e e' => //=. - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). - by move=> t e e' eq_e; rewrite (eq_eval _ eq_e). - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. - by move=> f1 IH1 f2 IH2 e e' eq_e f12; move/IH1: (same_env_sym eq_e); eauto. - by move=> f1 IH1 e e'; move/same_env_sym; move/IH1; tauto. - by move=> i f1 IH1 e e'; move/(eq_i i)=> eq_e [x f_ex]; exists x; eauto. by move=> i f1 IH1 e e'; move/(eq_i i); eauto. Qed. (* Evaluation and substitution by a constant *) Lemma holds_fsubst e f i v : holds e (fsubst f (i, v%:T)%T) <-> holds (set_nth 0 e i v) f. Proof. elim: f e => //=; do [ by move=> *; rewrite !eval_tsubst | move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto | move=> f IHf e; move: (IHf e); tauto | move=> j f IHf e]. - case eq_ji: (j == i); first rewrite (eqP eq_ji). by split=> [] [x f_x]; exists x; rewrite set_set_nth eqxx in f_x *. split=> [] [x f_x]; exists x; move: f_x; rewrite set_set_nth eq_sym eq_ji; have:= IHf (set_nth 0 e j x); tauto. case eq_ji: (j == i); first rewrite (eqP eq_ji). by split=> [] f_ x; move: (f_ x); rewrite set_set_nth eqxx. split=> [] f_ x; move: (IHf (set_nth 0 e j x)) (f_ x); by rewrite set_set_nth eq_sym eq_ji; tauto. Qed. (* Boolean test selecting terms in the language of rings *) Fixpoint rterm (t : term R) := match t with | _^-1 => false | t1 + t2 | t1 * t2 => rterm t1 && rterm t2 | - t1 | t1 *+ _ | t1 ^+ _ => rterm t1 | _ => true end%T. (* Boolean test selecting formulas in the theory of rings *) Fixpoint rformula (f : formula R) := match f with | Bool _ => true | t1 == t2 => rterm t1 && rterm t2 | Unit t1 => false | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => rformula f1 && rformula f2 | ~ f1 | ('exists 'X__, f1) | ('forall 'X__, f1) => rformula f1 end%T. (* Upper bound of the names used in a term *) Fixpoint ub_var (t : term R) := match t with | 'X_i => i.+1 | t1 + t2 | t1 * t2 => maxn (ub_var t1) (ub_var t2) | - t1 | t1 *+ _ | t1 ^+ _ | t1^-1 => ub_var t1 | _ => 0%N end%T. (* Replaces inverses in the term t by fresh variables, accumulating the *) (* substitution. *) Fixpoint to_rterm (t : term R) (r : seq (term R)) (n : nat) {struct t} := match t with | t1^-1 => let: (t1', r1) := to_rterm t1 r n in ('X_(n + size r1), rcons r1 t1') | t1 + t2 => let: (t1', r1) := to_rterm t1 r n in let: (t2', r2) := to_rterm t2 r1 n in (t1' + t2', r2) | - t1 => let: (t1', r1) := to_rterm t1 r n in (- t1', r1) | t1 *+ m => let: (t1', r1) := to_rterm t1 r n in (t1' *+ m, r1) | t1 * t2 => let: (t1', r1) := to_rterm t1 r n in let: (t2', r2) := to_rterm t2 r1 n in (Mul t1' t2', r2) | t1 ^+ m => let: (t1', r1) := to_rterm t1 r n in (t1' ^+ m, r1) | _ => (t, r) end%T. Lemma to_rterm_id t r n : rterm t -> to_rterm t r n = (t, r). Proof. elim: t r n => //. - by move=> t1 IHt1 t2 IHt2 r n /= /andP[rt1 rt2]; rewrite {}IHt1 // IHt2. - by move=> t IHt r n /= rt; rewrite {}IHt. - by move=> t IHt r n m /= rt; rewrite {}IHt. - by move=> t1 IHt1 t2 IHt2 r n /= /andP[rt1 rt2]; rewrite {}IHt1 // IHt2. - by move=> t IHt r n m /= rt; rewrite {}IHt. Qed. (* A ring formula stating that t1 is equal to 0 in the ring theory. *) (* Also applies to non commutative rings. *) Definition eq0_rform t1 := let m := ub_var t1 in let: (t1', r1) := to_rterm t1 [::] m in let fix loop r i := match r with | [::] => t1' == 0 | t :: r' => let f := 'X_i * t == 1 /\ t * 'X_i == 1 in 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 end%T in loop r1 m. (* Transformation of a formula in the theory of rings with units into an *) (* equivalent formula in the sub-theory of rings. *) Fixpoint to_rform f := match f with | Bool b => f | t1 == t2 => eq0_rform (t1 - t2) | Unit t1 => eq0_rform (t1 * t1^-1 - 1) | f1 /\ f2 => to_rform f1 /\ to_rform f2 | f1 \/ f2 => to_rform f1 \/ to_rform f2 | f1 ==> f2 => to_rform f1 ==> to_rform f2 | ~ f1 => ~ to_rform f1 | ('exists 'X_i, f1) => 'exists 'X_i, to_rform f1 | ('forall 'X_i, f1) => 'forall 'X_i, to_rform f1 end%T. (* The transformation gives a ring formula. *) Lemma to_rform_rformula f : rformula (to_rform f). Proof. suffices eq0_ring t1: rformula (eq0_rform t1) by elim: f => //= => f1 ->. rewrite /eq0_rform; move: (ub_var t1) => m; set tr := _ m. suffices: all rterm (tr.1 :: tr.2). case: tr => {}t1 r /= /andP[t1_r]. by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. have: all rterm [::] by []. rewrite {}/tr; elim: t1 [::] => //=. - move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. - by move=> t1 IHt1 r /IHt1; case: to_rterm. - by move=> t1 IHt1 n r /IHt1; case: to_rterm. - move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. - move=> t1 IHt1 r. by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. - by move=> t1 IHt1 n r /IHt1; case: to_rterm. Qed. (* Correctness of the transformation. *) Lemma to_rformP e f : holds e (to_rform f) <-> holds e f. Proof. suffices{e f} equal0_equiv e t1 t2: holds e (eq0_rform (t1 - t2)) <-> (eval e t1 == eval e t2). - elim: f e => /=; try tauto. + move=> t1 t2 e. by split; [move/equal0_equiv/eqP | move/eqP/equal0_equiv]. + by move=> t1 e; rewrite unitrE; apply: equal0_equiv. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 e; move: (IHf1 e); tauto. + by move=> n f1 IHf1 e; split=> [] [x] /IHf1; exists x. + by move=> n f1 IHf1 e; split=> Hx x; apply/IHf1. rewrite -(add0r (eval e t2)) -(can2_eq (subrK _) (addrK _)). rewrite -/(eval e (t1 - t2)); move: (t1 - t2)%T => {t1 t2} t. have sub_var_tsubst s t0: s.1 >= ub_var t0 -> tsubst t0 s = t0. elim: t0 {t} => //=. - by move=> n; case: ltngtP. - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. - by move=> t1 IHt1 /IHt1->. - by move=> t1 IHt1 n /IHt1->. - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. - by move=> t1 IHt1 /IHt1->. - by move=> t1 IHt1 n /IHt1->. pose fix rsub t' m r : term R := if r is u :: r' then tsubst (rsub t' m.+1 r') (m, u^-1)%T else t'. pose fix ub_sub m r : Prop := if r is u :: r' then ub_var u <= m /\ ub_sub m.+1 r' else true. suffices{t} rsub_to_r t r0 m: m >= ub_var t -> ub_sub m r0 -> let: (t', r) := to_rterm t r0 m in [/\ take (size r0) r = r0, ub_var t' <= m + size r, ub_sub m r & rsub t' m r = t]. - have:= rsub_to_r t [::] _ (leqnn _); rewrite /eq0_rform. case: (to_rterm _ _ _) => [t1' r1] [//|_ _ ub_r1 def_t]. rewrite -{2}def_t {def_t}. elim: r1 (ub_var t) e ub_r1 => [|u r1 IHr1] m e /= => [_|[ub_u ub_r1]]. by split=> /eqP. rewrite eval_tsubst /=; set y := eval e u; split=> t_eq0. apply/IHr1=> //; apply: t_eq0. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y. case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. split=> [|[z]]; first by rewrite invr_out ?Uy. rewrite nth_set_nth /= eqxx. rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. by case/unitrP: Uy; exists z. move=> x def_x; apply/IHr1=> //; suff ->: x = y^-1 by []; move: def_x. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). by rewrite !sub_var_tsubst. have rsub_id r t0 n: ub_var t0 <= n -> rsub t0 n r = t0. by elim: r n => //= t1 r IHr n let0n; rewrite IHr ?sub_var_tsubst ?leqW. have rsub_acc r s t1 m1: ub_var t1 <= m1 + size r -> rsub t1 m1 (r ++ s) = rsub t1 m1 r. elim: r t1 m1 => [|t1 r IHr] t2 m1 /=; first by rewrite addn0; apply: rsub_id. by move=> letmr; rewrite IHr ?addSnnS. elim: t r0 m => /=; try do [ by move=> n r m hlt hub; rewrite take_size (ltn_addr _ hlt) rsub_id | by move=> n r m hlt hub; rewrite leq0n take_size rsub_id | move=> t1 IHt1 t2 IHt2 r m; rewrite geq_max; case/andP=> hub1 hub2 hmr; case: to_rterm {hub1 hmr}(IHt1 r m hub1 hmr) => t1' r1; case=> htake1 hub1' hsub1 <-; case: to_rterm {IHt2 hub2 hsub1}(IHt2 r1 m hub2 hsub1) => t2' r2 /=; rewrite geq_max; case=> htake2 -> hsub2 /= <-; rewrite -{1 2}(cat_take_drop (size r1) r2) htake2; set r3 := drop _ _; rewrite size_cat addnA (leq_trans _ (leq_addr _ _)) //; split=> {hsub2}//; first by [rewrite takel_cat // -htake1 size_take geq_min leqnn orbT]; rewrite -(rsub_acc r1 r3 t1') {hub1'}// -{htake1}htake2 {r3}cat_take_drop; by elim: r2 m => //= u r2 IHr2 m; rewrite IHr2 | do [ move=> t1 IHt1 r m; do 2!move=> /IHt1{}IHt1 | move=> t1 IHt1 n r m; do 2!move=> /IHt1{}IHt1]; case: to_rterm IHt1 => t1' r1 [-> -> hsub1 <-]; split=> {hsub1}//; by elim: r1 m => //= u r1 IHr1 m; rewrite IHr1]. move=> t1 IH r m letm /IH {IH} /(_ letm) {letm}. case: to_rterm => t1' r1 /= [def_r ub_t1' ub_r1 <-]. rewrite size_rcons addnS leqnn -{1}cats1 takel_cat ?def_r; last first. by rewrite -def_r size_take geq_min leqnn orbT. elim: r1 m ub_r1 ub_t1' {def_r} => /= [|u r1 IHr1] m => [_|[->]]. by rewrite addn0 eqxx. by rewrite -addSnnS => /IHr1 IH /IH[_ _ ub_r1 ->]. Qed. (* Boolean test selecting formulas which describe a constructible set, *) (* i.e. formulas without quantifiers. *) (* The quantifier elimination check. *) Fixpoint qf_form (f : formula R) := match f with | Bool _ | _ == _ | Unit _ => true | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => qf_form f1 && qf_form f2 | ~ f1 => qf_form f1 | _ => false end%T. (* Boolean holds predicate for quantifier free formulas *) Definition qf_eval e := fix loop (f : formula R) : bool := match f with | Bool b => b | t1 == t2 => (eval e t1 == eval e t2)%bool | Unit t1 => eval e t1 \in unit | f1 /\ f2 => loop f1 && loop f2 | f1 \/ f2 => loop f1 || loop f2 | f1 ==> f2 => (loop f1 ==> loop f2)%bool | ~ f1 => ~~ loop f1 |_ => false end%T. (* qf_eval is equivalent to holds *) Lemma qf_evalP e f : qf_form f -> reflect (holds e f) (qf_eval e f). Proof. elim: f => //=; try by move=> *; apply: idP. - by move=> t1 t2 _; apply: eqP. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by right; case. by case/IHf2; [left | right; case]. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1F]; first by do 2 left. by case/IHf2; [left; right | right; case]. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by left. by case/IHf2; [left | right; move/(_ f1T)]. by move=> f1 IHf1 /IHf1[]; [right | left]. Qed. Implicit Type bc : seq (term R) * seq (term R). (* Quantifier-free formula are normalized into DNF. A DNF is *) (* represented by the type seq (seq (term R) * seq (term R)), where we *) (* separate positive and negative literals *) (* DNF preserving conjunction *) Definition and_dnf bcs1 bcs2 := \big[cat/nil]_(bc1 <- bcs1) map (fun bc2 => (bc1.1 ++ bc2.1, bc1.2 ++ bc2.2)) bcs2. (* Computes a DNF from a qf ring formula *) Fixpoint qf_to_dnf (f : formula R) (neg : bool) {struct f} := match f with | Bool b => if b (+) neg then [:: ([::], [::])] else [::] | t1 == t2 => [:: if neg then ([::], [:: t1 - t2]) else ([:: t1 - t2], [::])] | f1 /\ f2 => (if neg then cat else and_dnf) [rec f1, neg] [rec f2, neg] | f1 \/ f2 => (if neg then and_dnf else cat) [rec f1, neg] [rec f2, neg] | f1 ==> f2 => (if neg then and_dnf else cat) [rec f1, ~~ neg] [rec f2, neg] | ~ f1 => [rec f1, ~~ neg] | _ => if neg then [:: ([::], [::])] else [::] end%T where "[ 'rec' f , neg ]" := (qf_to_dnf f neg). (* Conversely, transforms a DNF into a formula *) Definition dnf_to_form := let pos_lit t := And (t == 0) in let neg_lit t := And (t != 0) in let cls bc := Or (foldr pos_lit True bc.1 /\ foldr neg_lit True bc.2) in foldr cls False. (* Catenation of dnf is the Or of formulas *) Lemma cat_dnfP e bcs1 bcs2 : qf_eval e (dnf_to_form (bcs1 ++ bcs2)) = qf_eval e (dnf_to_form bcs1 \/ dnf_to_form bcs2). Proof. by elim: bcs1 => //= bc1 bcs1 IH1; rewrite -orbA; congr orb; rewrite IH1. Qed. (* and_dnf is the And of formulas *) Lemma and_dnfP e bcs1 bcs2 : qf_eval e (dnf_to_form (and_dnf bcs1 bcs2)) = qf_eval e (dnf_to_form bcs1 /\ dnf_to_form bcs2). Proof. elim: bcs1 => [|bc1 bcs1 IH1] /=; first by rewrite /and_dnf big_nil. rewrite /and_dnf big_cons -/(and_dnf bcs1 bcs2) cat_dnfP /=. rewrite {}IH1 /= andb_orl; congr orb. elim: bcs2 bc1 {bcs1} => [|bc2 bcs2 IH] bc1 /=; first by rewrite andbF. rewrite {}IH /= andb_orr; congr orb => {bcs2}. suffices aux (l1 l2 : seq (term R)) g : let redg := foldr (And \o g) True in qf_eval e (redg (l1 ++ l2)) = qf_eval e (redg l1 /\ redg l2)%T. + by rewrite 2!aux /= 2!andbA -andbA -andbCA andbA andbCA andbA. by elim: l1 => [| t1 l1 IHl1] //=; rewrite -andbA IHl1. Qed. Lemma qf_to_dnfP e : let qev f b := qf_eval e (dnf_to_form (qf_to_dnf f b)) in forall f, qf_form f && rformula f -> qev f false = qf_eval e f. Proof. move=> qev; have qevT f: qev f true = ~~ qev f false. rewrite {}/qev; elim: f => //=; do [by case | move=> f1 IH1 f2 IH2 | ]. - by move=> t1 t2; rewrite !andbT !orbF. - by rewrite and_dnfP cat_dnfP negb_and -IH1 -IH2. - by rewrite and_dnfP cat_dnfP negb_or -IH1 -IH2. - by rewrite and_dnfP cat_dnfP /= negb_or IH1 -IH2 negbK. by move=> t1 ->; rewrite negbK. rewrite /qev; elim=> //=; first by case. - by move=> t1 t2 _; rewrite subr_eq0 !andbT orbF. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite and_dnfP /= => /IH1-> /IH2->. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite cat_dnfP /= => /IH1-> => /IH2->. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite cat_dnfP /= [qf_eval _ _]qevT -implybE => /IH1 <- /IH2->. by move=> f1 IH1 /IH1 <-; rewrite -qevT. Qed. Lemma dnf_to_form_qf bcs : qf_form (dnf_to_form bcs). Proof. by elim: bcs => //= [[clT clF] _ ->] /=; elim: clT => //=; elim: clF. Qed. Definition dnf_rterm cl := all rterm cl.1 && all rterm cl.2. Lemma qf_to_dnf_rterm f b : rformula f -> all dnf_rterm (qf_to_dnf f b). Proof. set ok := all dnf_rterm. have cat_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (bcs1 ++ bcs2). by move=> ok1 ok2; rewrite [ok _]all_cat; apply/andP. have and_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (and_dnf bcs1 bcs2). rewrite /and_dnf unlock; elim: bcs1 => //= cl1 bcs1 IH1; rewrite -andbA. case/and3P=> ok11 ok12 ok1 ok2; rewrite cat_ok ?{}IH1 {bcs1 ok1}//. elim: bcs2 ok2 => //= cl2 bcs2 IH2 /andP[ok2 /IH2->]. by rewrite /dnf_rterm !all_cat ok11 ok12 /= !andbT. elim: f b => //=; [ by do 2!case | | | | | by auto | | ]; try by repeat case/andP || intro; case: ifP; auto. by rewrite /dnf_rterm => ?? [] /= ->. Qed. Lemma dnf_to_rform bcs : rformula (dnf_to_form bcs) = all dnf_rterm bcs. Proof. elim: bcs => //= [[cl1 cl2] bcs ->]; rewrite {2}/dnf_rterm /=; congr (_ && _). by congr andb; [elim: cl1 | elim: cl2] => //= t cl ->; rewrite andbT. Qed. Section If. Variables (pred_f then_f else_f : formula R). Definition If := (pred_f /\ then_f \/ ~ pred_f /\ else_f)%T. Lemma If_form_qf : qf_form pred_f -> qf_form then_f -> qf_form else_f -> qf_form If. Proof. by move=> /= -> -> ->. Qed. Lemma If_form_rf : rformula pred_f -> rformula then_f -> rformula else_f -> rformula If. Proof. by move=> /= -> -> ->. Qed. Lemma eval_If e : let ev := qf_eval e in ev If = (if ev pred_f then ev then_f else ev else_f). Proof. by rewrite /=; case: ifP => _; rewrite ?orbF. Qed. End If. Section Pick. Variables (I : finType) (pred_f then_f : I -> formula R) (else_f : formula R). Definition Pick := \big[Or/False]_(p : {ffun pred I}) ((\big[And/True]_i (if p i then pred_f i else ~ pred_f i)) /\ (if pick p is Some i then then_f i else else_f))%T. Lemma Pick_form_qf : (forall i, qf_form (pred_f i)) -> (forall i, qf_form (then_f i)) -> qf_form else_f -> qf_form Pick. Proof. move=> qfp qft qfe; have mA := (big_morph qf_form) true andb. rewrite mA // big1 //= => p _. rewrite mA // big1 => [|i _]; first by case: pick. by rewrite fun_if if_same /= qfp. Qed. Lemma eval_Pick e (qev := qf_eval e) : let P i := qev (pred_f i) in qev Pick = (if pick P is Some i then qev (then_f i) else qev else_f). Proof. move=> P; rewrite ((big_morph qev) false orb) //= big_orE /=. apply/existsP/idP=> [[p] | true_at_P]. rewrite ((big_morph qev) true andb) //= big_andE /=. case/andP=> /forallP-eq_p_P. rewrite (@eq_pick _ _ P) => [|i]; first by case: pick. by move/(_ i): eq_p_P => /=; case: (p i) => //= /negPf. exists [ffun i => P i] => /=; apply/andP; split. rewrite ((big_morph qev) true andb) //= big_andE /=. by apply/forallP=> i; rewrite /= ffunE; case Pi: (P i) => //=; apply: negbT. rewrite (@eq_pick _ _ P) => [|i]; first by case: pick true_at_P. by rewrite ffunE. Qed. End Pick. Section MultiQuant. Variable f : formula R. Implicit Types (I : seq nat) (e : seq R). Lemma foldExistsP I e : (exists2 e', {in [predC I], same_env e e'} & holds e' f) <-> holds e (foldr Exists f I). Proof. elim: I e => /= [|i I IHi] e. by split=> [[e' eq_e] |]; [apply: eq_holds => i; rewrite eq_e | exists e]. split=> [[e' eq_e f_e'] | [x]]; last set e_x := set_nth 0 e i x. exists e'`_i; apply/IHi; exists e' => // j. by have:= eq_e j; rewrite nth_set_nth /= !inE; case: eqP => // ->. case/IHi=> e' eq_e f_e'; exists e' => // j. by have:= eq_e j; rewrite nth_set_nth /= !inE; case: eqP. Qed. Lemma foldForallP I e : (forall e', {in [predC I], same_env e e'} -> holds e' f) <-> holds e (foldr Forall f I). Proof. elim: I e => /= [|i I IHi] e. by split=> [|f_e e' eq_e]; [apply | apply: eq_holds f_e => i; rewrite eq_e]. split=> [f_e' x | f_e e' eq_e]; first set e_x := set_nth 0 e i x. apply/IHi=> e' eq_e; apply: f_e' => j. by have:= eq_e j; rewrite nth_set_nth /= !inE; case: eqP. move/IHi: (f_e e'`_i); apply=> j. by have:= eq_e j; rewrite nth_set_nth /= !inE; case: eqP => // ->. Qed. End MultiQuant. End EvalTerm. Prenex Implicits dnf_rterm. Module IntegralDomain. Definition axiom (R : ringType) := forall x y : R, x * y = 0 -> (x == 0) || (y == 0). Section ClassDef. Set Primitive Projections. Record class_of (R : Type) : Type := Class {base : ComUnitRing.class_of R; mixin : axiom (Ring.Pack base)}. Unset Primitive Projections. Local Coercion base : class_of >-> ComUnitRing.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : axiom (@Ring.Pack T b0)) := fun bT b & phant_id (ComUnitRing.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> ComUnitRing.class_of. Arguments mixin [R] c [x y]. Coercion mixin : class_of >-> axiom. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Notation idomainType := type. Notation IdomainType T m := (@pack T _ m _ _ id _ id). Notation "[ 'idomainType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'idomainType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'idomainType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'idomainType' 'of' T ]") : form_scope. End Exports. End IntegralDomain. Import IntegralDomain.Exports. Section IntegralDomainTheory. Variable R : idomainType. Implicit Types x y : R. Lemma mulf_eq0 x y : (x * y == 0) = (x == 0) || (y == 0). Proof. apply/eqP/idP; first by case: R x y => T []. by case/pred2P=> ->; rewrite (mulr0, mul0r). Qed. Lemma prodf_eq0 (I : finType) (P : pred I) (F : I -> R) : reflect (exists2 i, P i & (F i == 0)) (\prod_(i | P i) F i == 0). Proof. apply: (iffP idP) => [|[i Pi /eqP Fi0]]; last first. by rewrite (bigD1 i) //= Fi0 mul0r. elim: (index_enum _) => [|i r IHr]; first by rewrite big_nil oner_eq0. rewrite big_cons /=; have [Pi | _] := ifP; last exact: IHr. by rewrite mulf_eq0; case/orP=> // Fi0; exists i. Qed. Lemma prodf_seq_eq0 I r (P : pred I) (F : I -> R) : (\prod_(i <- r | P i) F i == 0) = has (fun i => P i && (F i == 0)) r. Proof. by rewrite (big_morph _ mulf_eq0 (oner_eq0 _)) big_has_cond. Qed. Lemma mulf_neq0 x y : x != 0 -> y != 0 -> x * y != 0. Proof. by move=> x0 y0; rewrite mulf_eq0; apply/norP. Qed. Lemma prodf_neq0 (I : finType) (P : pred I) (F : I -> R) : reflect (forall i, P i -> (F i != 0)) (\prod_(i | P i) F i != 0). Proof. by rewrite (sameP (prodf_eq0 _ _) exists_inP); apply: exists_inPn. Qed. Lemma prodf_seq_neq0 I r (P : pred I) (F : I -> R) : (\prod_(i <- r | P i) F i != 0) = all (fun i => P i ==> (F i != 0)) r. Proof. rewrite prodf_seq_eq0 -all_predC; apply: eq_all => i /=. by rewrite implybE negb_and. Qed. Lemma expf_eq0 x n : (x ^+ n == 0) = (n > 0) && (x == 0). Proof. elim: n => [|n IHn]; first by rewrite oner_eq0. by rewrite exprS mulf_eq0 IHn andKb. Qed. Lemma sqrf_eq0 x : (x ^+ 2 == 0) = (x == 0). Proof. exact: expf_eq0. Qed. Lemma expf_neq0 x m : x != 0 -> x ^+ m != 0. Proof. by move=> x_nz; rewrite expf_eq0; apply/nandP; right. Qed. Lemma natf_neq0 n : (n%:R != 0 :> R) = [char R]^'.-nat n. Proof. have [-> | /prod_prime_decomp->] := posnP n; first by rewrite eqxx. rewrite !big_seq; elim/big_rec: _ => [|[p e] s /=]; first by rewrite oner_eq0. case/mem_prime_decomp=> p_pr _ _; rewrite pnatM pnatX eqn0Ngt orbC => <-. by rewrite natrM natrX mulf_eq0 expf_eq0 negb_or negb_and pnatE ?inE p_pr. Qed. Lemma natf0_char n : n > 0 -> n%:R == 0 :> R -> exists p, p \in [char R]. Proof. move=> n_gt0 nR_0; exists (pdiv n`_[char R]). apply: pnatP (pdiv_dvd _); rewrite ?part_pnat // ?pdiv_prime //. by rewrite ltn_neqAle eq_sym partn_eq1 // -natf_neq0 nR_0 /=. Qed. Lemma charf'_nat n : [char R]^'.-nat n = (n%:R != 0 :> R). Proof. have [-> | n_gt0] := posnP n; first by rewrite eqxx. apply/idP/idP => [|nz_n]; last first. by apply/pnatP=> // p p_pr p_dvd_n; apply: contra nz_n => /dvdn_charf <-. apply: contraL => n0; have [// | p charRp] := natf0_char _ n0. have [p_pr _] := andP charRp; rewrite (eq_pnat _ (eq_negn (charf_eq charRp))). by rewrite p'natE // (dvdn_charf charRp) n0. Qed. Lemma charf0P : [char R] =i pred0 <-> (forall n, (n%:R == 0 :> R) = (n == 0)%N). Proof. split=> charF0 n; last by rewrite !inE charF0 andbC; case: eqP => // ->. have [-> | n_gt0] := posnP; first exact: eqxx. by apply/negP; case/natf0_char=> // p; rewrite charF0. Qed. Lemma eqf_sqr x y : (x ^+ 2 == y ^+ 2) = (x == y) || (x == - y). Proof. by rewrite -subr_eq0 subr_sqr mulf_eq0 subr_eq0 addr_eq0. Qed. Lemma mulfI x : x != 0 -> injective ( *%R x). Proof. move=> nz_x y z; apply: contra_eq => neq_yz. by rewrite -subr_eq0 -mulrBr mulf_neq0 ?subr_eq0. Qed. Lemma mulIf x : x != 0 -> injective ( *%R^~ x). Proof. by move=> nz_x y z; rewrite -!(mulrC x); apply: mulfI. Qed. Lemma divfI x : x != 0 -> injective (fun y => x / y). Proof. by move/mulfI/inj_comp; apply; apply: invr_inj. Qed. Lemma divIf y : y != 0 -> injective (fun x => x / y). Proof. by rewrite -invr_eq0; apply: mulIf. Qed. Lemma sqrf_eq1 x : (x ^+ 2 == 1) = (x == 1) || (x == -1). Proof. by rewrite -subr_eq0 subr_sqr_1 mulf_eq0 subr_eq0 addr_eq0. Qed. Lemma expfS_eq1 x n : (x ^+ n.+1 == 1) = (x == 1) || (\sum_(i < n.+1) x ^+ i == 0). Proof. by rewrite -![_ == 1]subr_eq0 subrX1 mulf_eq0. Qed. Lemma lregP x : reflect (lreg x) (x != 0). Proof. by apply: (iffP idP) => [/mulfI | /lreg_neq0]. Qed. Lemma rregP x : reflect (rreg x) (x != 0). Proof. by apply: (iffP idP) => [/mulIf | /rreg_neq0]. Qed. Canonical regular_idomainType := [idomainType of R^o]. End IntegralDomainTheory. Arguments lregP {R x}. Arguments rregP {R x}. Module Field. Definition mixin_of (R : unitRingType) := forall x : R, x != 0 -> x \in unit. Lemma IdomainMixin R : mixin_of R -> IntegralDomain.axiom R. Proof. move=> m x y xy0; apply/norP=> [[]] /m Ux /m. by rewrite -(unitrMr _ Ux) xy0 unitr0. Qed. Section Mixins. Definition axiom (R : ringType) inv := forall x : R, x != 0 -> inv x * x = 1. Variables (R : comRingType) (inv : R -> R). Hypotheses (mulVf : axiom inv) (inv0 : inv 0 = 0). Fact intro_unit (x y : R) : y * x = 1 -> x != 0. Proof. by move=> yx1; apply: contraNneq (oner_neq0 R) => x0; rewrite -yx1 x0 mulr0. Qed. Fact inv_out : {in predC (predC1 0), inv =1 id}. Proof. by move=> x /negbNE/eqP->. Qed. Definition UnitMixin := ComUnitRing.Mixin mulVf intro_unit inv_out. Definition UnitRingType := [comUnitRingType of UnitRingType R UnitMixin]. Definition IdomainType := IdomainType UnitRingType (@IdomainMixin UnitRingType (fun => id)). Lemma Mixin : mixin_of IdomainType. Proof. by []. Qed. End Mixins. Section ClassDef. Set Primitive Projections. Record class_of (F : Type) : Type := Class { base : IntegralDomain.class_of F; mixin : mixin_of (UnitRing.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> IntegralDomain.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : mixin_of (@UnitRing.Pack T b0)) := fun bT b & phant_id (IntegralDomain.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @IntegralDomain.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> IntegralDomain.class_of. Arguments mixin [F] c [x]. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> IntegralDomain.type. Canonical idomainType. Notation fieldType := type. Notation FieldType T m := (@pack T _ m _ _ id _ id). Arguments Mixin {R inv} mulVf inv0 [x] nz_x. Notation FieldUnitMixin := UnitMixin. Notation FieldIdomainMixin := IdomainMixin. Notation FieldMixin := Mixin. Notation "[ 'fieldType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'fieldType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'fieldType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'fieldType' 'of' T ]") : form_scope. End Exports. End Field. Import Field.Exports. Section FieldTheory. Variable F : fieldType. Implicit Types x y : F. Lemma fieldP : Field.mixin_of F. Proof. by case: F => T []. Qed. Lemma unitfE x : (x \in unit) = (x != 0). Proof. by apply/idP/idP=> [/(memPn _)-> | /fieldP]; rewrite ?unitr0. Qed. Lemma mulVf x : x != 0 -> x^-1 * x = 1. Proof. by rewrite -unitfE; apply: mulVr. Qed. Lemma divff x : x != 0 -> x / x = 1. Proof. by rewrite -unitfE; apply: divrr. Qed. Definition mulfV := divff. Lemma mulKf x : x != 0 -> cancel ( *%R x) ( *%R x^-1). Proof. by rewrite -unitfE; apply: mulKr. Qed. Lemma mulVKf x : x != 0 -> cancel ( *%R x^-1) ( *%R x). Proof. by rewrite -unitfE; apply: mulVKr. Qed. Lemma mulfK x : x != 0 -> cancel ( *%R^~ x) ( *%R^~ x^-1). Proof. by rewrite -unitfE; apply: mulrK. Qed. Lemma mulfVK x : x != 0 -> cancel ( *%R^~ x^-1) ( *%R^~ x). Proof. by rewrite -unitfE; apply: divrK. Qed. Definition divfK := mulfVK. Lemma invfM : {morph @inv F : x y / x * y}. Proof. move=> x y; have [->|nzx] := eqVneq x 0; first by rewrite !(mul0r, invr0). have [->|nzy] := eqVneq y 0; first by rewrite !(mulr0, invr0). by rewrite mulrC invrM ?unitfE. Qed. Lemma invf_div x y : (x / y)^-1 = y / x. Proof. by rewrite invfM invrK mulrC. Qed. Lemma divKf x : x != 0 -> involutive (fun y => x / y). Proof. by move=> nz_x y; rewrite invf_div mulrC divfK. Qed. Lemma expfB_cond m n x : (x == 0) + n <= m -> x ^+ (m - n) = x ^+ m / x ^+ n. Proof. move/subnK=> <-; rewrite addnA addnK !exprD. have [-> | nz_x] := eqVneq; first by rewrite !mulr0 !mul0r. by rewrite mulfK ?expf_neq0. Qed. Lemma expfB m n x : n < m -> x ^+ (m - n) = x ^+ m / x ^+ n. Proof. by move=> lt_n_m; apply: expfB_cond; case: eqP => // _; apply: ltnW. Qed. Lemma prodfV I r (P : pred I) (E : I -> F) : \prod_(i <- r | P i) (E i)^-1 = (\prod_(i <- r | P i) E i)^-1. Proof. by rewrite (big_morph _ invfM (invr1 F)). Qed. Lemma prodf_div I r (P : pred I) (E D : I -> F) : \prod_(i <- r | P i) (E i / D i) = \prod_(i <- r | P i) E i / \prod_(i <- r | P i) D i. Proof. by rewrite big_split prodfV. Qed. Lemma telescope_prodf n m (f : nat -> F) : (forall k, n < k < m -> f k != 0) -> n < m -> \prod_(n <= k < m) (f k.+1 / f k) = f m / f n. Proof. move=> nz_f ltnm; apply: invr_inj; rewrite prodf_div !invf_div -prodf_div. by apply: telescope_prodr => // k /nz_f; rewrite unitfE. Qed. Lemma addf_div x1 y1 x2 y2 : y1 != 0 -> y2 != 0 -> x1 / y1 + x2 / y2 = (x1 * y2 + x2 * y1) / (y1 * y2). Proof. by move=> nzy1 nzy2; rewrite invfM mulrDl !mulrA mulrAC !mulfK. Qed. Lemma mulf_div x1 y1 x2 y2 : (x1 / y1) * (x2 / y2) = (x1 * x2) / (y1 * y2). Proof. by rewrite mulrACA -invfM. Qed. Lemma char0_natf_div : [char F] =i pred0 -> forall m d, d %| m -> (m %/ d)%:R = m%:R / d%:R :> F. Proof. move/charf0P=> char0F m [|d] d_dv_m; first by rewrite divn0 invr0 mulr0. by rewrite natr_div // unitfE char0F. Qed. Section FieldMorphismInj. Variables (R : ringType) (f : {rmorphism F -> R}). Lemma fmorph_eq0 x : (f x == 0) = (x == 0). Proof. have [-> | nz_x] := eqVneq x; first by rewrite rmorph0 eqxx. apply/eqP; move/(congr1 ( *%R (f x^-1)))/eqP. by rewrite -rmorphM mulVf // mulr0 rmorph1 ?oner_eq0. Qed. Lemma fmorph_inj : injective f. Proof. by apply/raddf_inj => x /eqP; rewrite fmorph_eq0 => /eqP. Qed. Lemma fmorph_eq1 x : (f x == 1) = (x == 1). Proof. by rewrite -(inj_eq fmorph_inj) rmorph1. Qed. Lemma fmorph_char : [char R] =i [char F]. Proof. by move=> p; rewrite !inE -fmorph_eq0 rmorph_nat. Qed. End FieldMorphismInj. Section FieldMorphismInv. Variables (R : unitRingType) (f : {rmorphism F -> R}). Lemma fmorph_unit x : (f x \in unit) = (x != 0). Proof. have [-> |] := eqVneq x; first by rewrite rmorph0 unitr0. by rewrite -unitfE; apply: rmorph_unit. Qed. Lemma fmorphV : {morph f: x / x^-1}. Proof. move=> x; have [-> | nz_x] := eqVneq x 0; first by rewrite !(invr0, rmorph0). by rewrite rmorphV ?unitfE. Qed. Lemma fmorph_div : {morph f : x y / x / y}. Proof. by move=> x y; rewrite rmorphM fmorphV. Qed. End FieldMorphismInv. Canonical regular_fieldType := [fieldType of F^o]. Section ModuleTheory. Variable V : lmodType F. Implicit Types (a : F) (v : V). Lemma scalerK a : a != 0 -> cancel ( *:%R a : V -> V) ( *:%R a^-1). Proof. by move=> nz_a v; rewrite scalerA mulVf // scale1r. Qed. Lemma scalerKV a : a != 0 -> cancel ( *:%R a^-1 : V -> V) ( *:%R a). Proof. by rewrite -invr_eq0 -{3}[a]invrK; apply: scalerK. Qed. Lemma scalerI a : a != 0 -> injective ( *:%R a : V -> V). Proof. by move=> nz_a; apply: can_inj (scalerK nz_a). Qed. Lemma scaler_eq0 a v : (a *: v == 0) = (a == 0) || (v == 0). Proof. have [-> | nz_a] := eqVneq a; first by rewrite scale0r eqxx. by rewrite (can2_eq (scalerK nz_a) (scalerKV nz_a)) scaler0. Qed. Lemma rpredZeq S (modS : submodPred S) (kS : keyed_pred modS) a v : (a *: v \in kS) = (a == 0) || (v \in kS). Proof. have [-> | nz_a] := eqVneq; first by rewrite scale0r rpred0. by apply/idP/idP; first rewrite -{2}(scalerK nz_a v); apply: rpredZ. Qed. End ModuleTheory. Lemma char_lalg (A : lalgType F) : [char A] =i [char F]. Proof. by move=> p; rewrite inE -scaler_nat scaler_eq0 oner_eq0 orbF. Qed. Section Predicates. Context (S : {pred F}) (divS : @divrPred F S) (kS : keyed_pred divS). Lemma fpredMl x y : x \in kS -> x != 0 -> (x * y \in kS) = (y \in kS). Proof. by rewrite -!unitfE; apply: rpredMl. Qed. Lemma fpredMr x y : x \in kS -> x != 0 -> (y * x \in kS) = (y \in kS). Proof. by rewrite -!unitfE; apply: rpredMr. Qed. Lemma fpred_divl x y : x \in kS -> x != 0 -> (x / y \in kS) = (y \in kS). Proof. by rewrite -!unitfE; apply: rpred_divl. Qed. Lemma fpred_divr x y : x \in kS -> x != 0 -> (y / x \in kS) = (y \in kS). Proof. by rewrite -!unitfE; apply: rpred_divr. Qed. End Predicates. End FieldTheory. Arguments fmorph_inj {F R} f [x1 x2]. Module DecidableField. Definition axiom (R : unitRingType) (s : seq R -> pred (formula R)) := forall e f, reflect (holds e f) (s e f). Record mixin_of (R : unitRingType) : Type := Mixin { sat : seq R -> pred (formula R); satP : axiom sat}. Section ClassDef. Set Primitive Projections. Record class_of (F : Type) : Type := Class {base : Field.class_of F; mixin : mixin_of (UnitRing.Pack base)}. Unset Primitive Projections. Local Coercion base : class_of >-> Field.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : mixin_of (@UnitRing.Pack T b0)) := fun bT b & phant_id (Field.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @IntegralDomain.Pack cT class. Definition fieldType := @Field.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Field.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> IntegralDomain.type. Canonical idomainType. Coercion fieldType : type >-> Field.type. Canonical fieldType. Notation decFieldType := type. Notation DecFieldType T m := (@pack T _ m _ _ id _ id). Notation DecFieldMixin := Mixin. Notation "[ 'decFieldType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'decFieldType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'decFieldType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'decFieldType' 'of' T ]") : form_scope. End Exports. End DecidableField. Import DecidableField.Exports. Section DecidableFieldTheory. Variable F : decFieldType. Definition sat := DecidableField.sat (DecidableField.class F). Lemma satP : DecidableField.axiom sat. Proof. exact: DecidableField.satP. Qed. Fact sol_subproof n f : reflect (exists s, (size s == n) && sat s f) (sat [::] (foldr Exists f (iota 0 n))). Proof. apply: (iffP (satP _ _)) => [|[s]]; last first. case/andP=> /eqP sz_s /satP f_s; apply/foldExistsP. exists s => // i; rewrite !inE mem_iota -leqNgt add0n => le_n_i. by rewrite !nth_default ?sz_s. case/foldExistsP=> e e0 f_e; set s := take n (set_nth 0 e n 0). have sz_s: size s = n by rewrite size_take size_set_nth leq_max leqnn. exists s; rewrite sz_s eqxx; apply/satP; apply: eq_holds f_e => i. case: (leqP n i) => [le_n_i | lt_i_n]. by rewrite -e0 ?nth_default ?sz_s // !inE mem_iota -leqNgt. by rewrite nth_take // nth_set_nth /= eq_sym eqn_leq leqNgt lt_i_n. Qed. Definition sol n f := if sol_subproof n f is ReflectT sP then xchoose sP else nseq n 0. Lemma size_sol n f : size (sol n f) = n. Proof. rewrite /sol; case: sol_subproof => [sP | _]; last exact: size_nseq. by case/andP: (xchooseP sP) => /eqP. Qed. Lemma solP n f : reflect (exists2 s, size s = n & holds s f) (sat (sol n f) f). Proof. rewrite /sol; case: sol_subproof => [sP | sPn]. case/andP: (xchooseP sP) => _ ->; left. by case: sP => s; case/andP; move/eqP=> <-; move/satP; exists s. apply: (iffP (satP _ _)); first by exists (nseq n 0); rewrite ?size_nseq. by case=> s sz_s; move/satP=> f_s; case: sPn; exists s; rewrite sz_s eqxx. Qed. Lemma eq_sat f1 f2 : (forall e, holds e f1 <-> holds e f2) -> sat^~ f1 =1 sat^~ f2. Proof. by move=> eqf12 e; apply/satP/satP; case: (eqf12 e). Qed. Lemma eq_sol f1 f2 : (forall e, holds e f1 <-> holds e f2) -> sol^~ f1 =1 sol^~ f2. Proof. rewrite /sol => /eq_sat eqf12 n. do 2![case: sol_subproof] => //= [f1s f2s | ns1 [s f2s] | [s f1s] []]. - by apply: eq_xchoose => s; rewrite eqf12. - by case: ns1; exists s; rewrite -eqf12. by exists s; rewrite eqf12. Qed. End DecidableFieldTheory. Arguments satP {F e f}. Arguments solP {F n f}. Section QE_Mixin. Variable F : Field.type. Implicit Type f : formula F. Variable proj : nat -> seq (term F) * seq (term F) -> formula F. (* proj is the elimination of a single existential quantifier *) (* The elimination projector is well_formed. *) Definition wf_QE_proj := forall i bc (bc_i := proj i bc), dnf_rterm bc -> qf_form bc_i && rformula bc_i. (* The elimination projector is valid *) Definition valid_QE_proj := forall i bc (ex_i_bc := ('exists 'X_i, dnf_to_form [:: bc])%T) e, dnf_rterm bc -> reflect (holds e ex_i_bc) (qf_eval e (proj i bc)). Hypotheses (wf_proj : wf_QE_proj) (ok_proj : valid_QE_proj). Let elim_aux f n := foldr Or False (map (proj n) (qf_to_dnf f false)). Fixpoint quantifier_elim f := match f with | f1 /\ f2 => (quantifier_elim f1) /\ (quantifier_elim f2) | f1 \/ f2 => (quantifier_elim f1) \/ (quantifier_elim f2) | f1 ==> f2 => (~ quantifier_elim f1) \/ (quantifier_elim f2) | ~ f => ~ quantifier_elim f | ('exists 'X_n, f) => elim_aux (quantifier_elim f) n | ('forall 'X_n, f) => ~ elim_aux (~ quantifier_elim f) n | _ => f end%T. Lemma quantifier_elim_wf f : let qf := quantifier_elim f in rformula f -> qf_form qf && rformula qf. Proof. suffices aux_wf f0 n : let qf := elim_aux f0 n in rformula f0 -> qf_form qf && rformula qf. - by elim: f => //=; do ?[ move=> f1 IH1 f2 IH2; case/andP=> rf1 rf2; case/andP:(IH1 rf1)=> -> ->; case/andP:(IH2 rf2)=> -> -> // | move=> n f1 IH rf1; case/andP: (IH rf1)=> qff rf; rewrite aux_wf ]. rewrite /elim_aux => rf. suffices or_wf fs : let ofs := foldr Or False fs in all (@qf_form F) fs && all (@rformula F) fs -> qf_form ofs && rformula ofs. - apply: or_wf. suffices map_proj_wf bcs: let mbcs := map (proj n) bcs in all dnf_rterm bcs -> all (@qf_form _) mbcs && all (@rformula _) mbcs. by apply/map_proj_wf/qf_to_dnf_rterm. elim: bcs => [|bc bcs ihb] bcsr //= /andP[rbc rbcs]. by rewrite andbAC andbA wf_proj //= andbC ihb. elim: fs => //= g gs ihg; rewrite -andbA => /and4P[-> qgs -> rgs] /=. by apply: ihg; rewrite qgs rgs. Qed. Lemma quantifier_elim_rformP e f : rformula f -> reflect (holds e f) (qf_eval e (quantifier_elim f)). Proof. pose rc e n f := exists x, qf_eval (set_nth 0 e n x) f. have auxP f0 e0 n0: qf_form f0 && rformula f0 -> reflect (rc e0 n0 f0) (qf_eval e0 (elim_aux f0 n0)). + rewrite /elim_aux => cf; set bcs := qf_to_dnf f0 false. apply: (@iffP (rc e0 n0 (dnf_to_form bcs))); last first. - by case=> x; rewrite -qf_to_dnfP //; exists x. - by case=> x; rewrite qf_to_dnfP //; exists x. have: all dnf_rterm bcs by case/andP: cf => _; apply: qf_to_dnf_rterm. elim: {f0 cf}bcs => [|bc bcs IHbcs] /=; first by right; case. case/andP=> r_bc /IHbcs {IHbcs}bcsP. have f_qf := dnf_to_form_qf [:: bc]. case: ok_proj => //= [ex_x|no_x]. left; case: ex_x => x /(qf_evalP _ f_qf); rewrite /= orbF => bc_x. by exists x; rewrite /= bc_x. apply: (iffP bcsP) => [[x bcs_x] | [x]] /=. by exists x; rewrite /= bcs_x orbT. case/orP => [bc_x|]; last by exists x. by case: no_x; exists x; apply/(qf_evalP _ f_qf); rewrite /= bc_x. elim: f e => //. - by move=> b e _; apply: idP. - by move=> t1 t2 e _; apply: eqP. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by right; case. by case/IH2; [left | right; case]. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; first by do 2!left. by case/IH2; [left; right | right; case]. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by left. by case/IH2; [left | right; move/(_ f1e)]. - by move=> f IHf e /= /IHf[]; [right | left]. - move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. by apply: (iffP (auxP _ _ _ rqf)) => [] [x]; exists x; apply/IHf. move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. case: auxP => // [f_x|no_x]; first by right=> no_x; case: f_x => x /IHf[]. by left=> x; apply/IHf=> //; apply/idPn=> f_x; case: no_x; exists x. Qed. Definition proj_sat e f := qf_eval e (quantifier_elim (to_rform f)). Lemma proj_satP : DecidableField.axiom proj_sat. Proof. move=> e f; have fP := quantifier_elim_rformP e (to_rform_rformula f). by apply: (iffP fP); move/to_rformP. Qed. Definition QEdecFieldMixin := DecidableField.Mixin proj_satP. End QE_Mixin. Module ClosedField. (* Axiom == all non-constant monic polynomials have a root *) Definition axiom (R : ringType) := forall n (P : nat -> R), n > 0 -> exists x : R, x ^+ n = \sum_(i < n) P i * (x ^+ i). Section ClassDef. Set Primitive Projections. Record class_of (F : Type) : Type := Class {base : DecidableField.class_of F; mixin : axiom (Ring.Pack base)}. Unset Primitive Projections. Local Coercion base : class_of >-> DecidableField.class_of. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : axiom (@Ring.Pack T b0)) := fun bT b & phant_id (DecidableField.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). (* There should eventually be a constructor from polynomial resolution *) (* that builds the DecidableField mixin using QE. *) Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @IntegralDomain.Pack cT class. Definition fieldType := @Field.Pack cT class. Definition decFieldType := @DecidableField.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> DecidableField.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> IntegralDomain.type. Canonical idomainType. Coercion fieldType : type >-> Field.type. Canonical fieldType. Coercion decFieldType : type >-> DecidableField.type. Canonical decFieldType. Notation closedFieldType := type. Notation ClosedFieldType T m := (@pack T _ m _ _ id _ id). Notation "[ 'closedFieldType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'closedFieldType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'closedFieldType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'closedFieldType' 'of' T ]") : form_scope. End Exports. End ClosedField. Import ClosedField.Exports. Section ClosedFieldTheory. Variable F : closedFieldType. Lemma solve_monicpoly : ClosedField.axiom F. Proof. by case: F => ? []. Qed. Lemma imaginary_exists : {i : F | i ^+ 2 = -1}. Proof. have /sig_eqW[i Di2] := @solve_monicpoly 2 (nth 0 [:: -1]) isT. by exists i; rewrite Di2 !big_ord_recl big_ord0 mul0r mulr1 !addr0. Qed. End ClosedFieldTheory. Module SubType. Section Zmodule. Variables (V : zmodType) (S : {pred V}). Variables (subS : zmodPred S) (kS : keyed_pred subS). Variable U : subType (mem kS). Let inU v Sv : U := Sub v Sv. Let zeroU := inU (rpred0 kS). Let oppU (u : U) := inU (rpredNr (valP u)). Let addU (u1 u2 : U) := inU (rpredD (valP u1) (valP u2)). Fact addA : associative addU. Proof. by move=> u1 u2 u3; apply: val_inj; rewrite !SubK addrA. Qed. Fact addC : commutative addU. Proof. by move=> u1 u2; apply: val_inj; rewrite !SubK addrC. Qed. Fact add0 : left_id zeroU addU. Proof. by move=> u; apply: val_inj; rewrite !SubK add0r. Qed. Fact addN : left_inverse zeroU oppU addU. Proof. by move=> u; apply: val_inj; rewrite !SubK addNr. Qed. Definition zmodMixin of phant U := ZmodMixin addA addC add0 addN. End Zmodule. Section Ring. Variables (R : ringType) (S : {pred R}). Variables (ringS : subringPred S) (kS : keyed_pred ringS). Definition cast_zmodType (V : zmodType) T (VeqT : V = T :> Type) := let cast mV := let: erefl in _ = T := VeqT return Zmodule.class_of T in mV in Zmodule.Pack (cast (Zmodule.class V)). Variable (T : subType (mem kS)) (V : zmodType) (VeqT: V = T :> Type). Let inT x Sx : T := Sub x Sx. Let oneT := inT (rpred1 kS). Let mulT (u1 u2 : T) := inT (rpredM (valP u1) (valP u2)). Let T' := cast_zmodType VeqT. Hypothesis valM : {morph (val : T' -> R) : x y / x - y}. Let val0 : val (0 : T') = 0. Proof. by rewrite -(subrr (0 : T')) valM subrr. Qed. Let valD : {morph (val : T' -> R): x y / x + y}. Proof. by move=> u v; rewrite -{1}[v]opprK -[- v]sub0r !valM val0 sub0r opprK. Qed. Fact mulA : @associative T' mulT. Proof. by move=> u1 u2 u3; apply: val_inj; rewrite !SubK mulrA. Qed. Fact mul1l : left_id oneT mulT. Proof. by move=> u; apply: val_inj; rewrite !SubK mul1r. Qed. Fact mul1r : right_id oneT mulT. Proof. by move=> u; apply: val_inj; rewrite !SubK mulr1. Qed. Fact mulDl : @left_distributive T' T' mulT +%R. Proof. by move=> u1 u2 u3; apply: val_inj; rewrite !(SubK, valD) mulrDl. Qed. Fact mulDr : @right_distributive T' T' mulT +%R. Proof. by move=> u1 u2 u3; apply: val_inj; rewrite !(SubK, valD) mulrDr. Qed. Fact nz1 : oneT != 0 :> T'. Proof. by apply: contraNneq (oner_neq0 R) => eq10; rewrite -val0 -eq10 SubK. Qed. Definition ringMixin := RingMixin mulA mul1l mul1r mulDl mulDr nz1. End Ring. Section Lmodule. Variables (R : ringType) (V : lmodType R) (S : {pred V}). Variables (linS : submodPred S) (kS : keyed_pred linS). Variables (W : subType (mem kS)) (Z : zmodType) (ZeqW : Z = W :> Type). Let scaleW a (w : W) := (Sub _ : _ -> W) (rpredZ a (valP w)). Let W' := cast_zmodType ZeqW. Hypothesis valD : {morph (val : W' -> V) : x y / x + y}. Fact scaleA a b (w : W') : scaleW a (scaleW b w) = scaleW (a * b) w. Proof. by apply: val_inj; rewrite !SubK scalerA. Qed. Fact scale1 : left_id 1 scaleW. Proof. by move=> w; apply: val_inj; rewrite !SubK scale1r. Qed. Fact scaleDr : @right_distributive R W' scaleW +%R. Proof. by move=> a w w2; apply: val_inj; rewrite !(SubK, valD) scalerDr. Qed. Fact scaleDl w : {morph (scaleW^~ w : R -> W') : a b / a + b}. Proof. by move=> a b; apply: val_inj; rewrite !(SubK, valD) scalerDl. Qed. Definition lmodMixin := LmodMixin scaleA scale1 scaleDr scaleDl. End Lmodule. Lemma lalgMixin (R : ringType) (A : lalgType R) (B : lmodType R) (f : B -> A) : phant B -> injective f -> scalable f -> forall mulB, {morph f : x y / mulB x y >-> x * y} -> Lalgebra.axiom mulB. Proof. by move=> _ injf fZ mulB fM a x y; apply: injf; rewrite !(fZ, fM) scalerAl. Qed. Lemma comRingMixin (R : comRingType) (T : ringType) (f : T -> R) : phant T -> injective f -> {morph f : x y / x * y} -> commutative (@mul T). Proof. by move=> _ inj_f fM x y; apply: inj_f; rewrite !fM mulrC. Qed. Lemma algMixin (R : comRingType) (A : algType R) (B : lalgType R) (f : B -> A) : phant B -> injective f -> {morph f : x y / x * y} -> scalable f -> @Algebra.axiom R B. Proof. by move=> _ inj_f fM fZ a x y; apply: inj_f; rewrite !(fM, fZ) scalerAr. Qed. Section UnitRing. Definition cast_ringType (Q : ringType) T (QeqT : Q = T :> Type) := let cast rQ := let: erefl in _ = T := QeqT return Ring.class_of T in rQ in Ring.Pack (cast (Ring.class Q)). Variables (R : unitRingType) (S : {pred R}). Variables (ringS : divringPred S) (kS : keyed_pred ringS). Variables (T : subType (mem kS)) (Q : ringType) (QeqT : Q = T :> Type). Let inT x Sx : T := Sub x Sx. Let invT (u : T) := inT (rpredVr (valP u)). Let unitT := [qualify a u : T | val u \is a unit]. Let T' := cast_ringType QeqT. Hypothesis val1 : val (1 : T') = 1. Hypothesis valM : {morph (val : T' -> R) : x y / x * y}. Fact mulVr : {in (unitT : {pred T'}), left_inverse (1 : T') invT (@mul T')}. Proof. by move=> u Uu; apply: val_inj; rewrite val1 valM SubK mulVr. Qed. Fact mulrV : {in unitT, right_inverse (1 : T') invT (@mul T')}. Proof. by move=> u Uu; apply: val_inj; rewrite val1 valM SubK mulrV. Qed. Fact unitP (u v : T') : v * u = 1 /\ u * v = 1 -> u \in unitT. Proof. by case=> vu1 uv1; apply/unitrP; exists (val v); rewrite -!valM vu1 uv1. Qed. Fact unit_id : {in [predC unitT], invT =1 id}. Proof. by move=> u /invr_out def_u1; apply: val_inj; rewrite SubK. Qed. Definition unitRingMixin := UnitRingMixin mulVr mulrV unitP unit_id. End UnitRing. Lemma idomainMixin (R : idomainType) (T : ringType) (f : T -> R) : phant T -> injective f -> f 0 = 0 -> {morph f : u v / u * v} -> @IntegralDomain.axiom T. Proof. move=> _ injf f0 fM u v uv0. by rewrite -!(inj_eq injf) !f0 -mulf_eq0 -fM uv0 f0. Qed. Lemma fieldMixin (F : fieldType) (K : unitRingType) (f : K -> F) : phant K -> injective f -> f 0 = 0 -> {mono f : u / u \in unit} -> @Field.mixin_of K. Proof. by move=> _ injf f0 fU u; rewrite -fU unitfE -f0 inj_eq. Qed. Module Exports. Notation "[ 'zmodMixin' 'of' U 'by' <: ]" := (zmodMixin (Phant U)) (at level 0, format "[ 'zmodMixin' 'of' U 'by' <: ]") : form_scope. Notation "[ 'ringMixin' 'of' R 'by' <: ]" := (@ringMixin _ _ _ _ _ _ (@erefl Type R%type) (rrefl _)) (at level 0, format "[ 'ringMixin' 'of' R 'by' <: ]") : form_scope. Notation "[ 'lmodMixin' 'of' U 'by' <: ]" := (@lmodMixin _ _ _ _ _ _ _ (@erefl Type U%type) (rrefl _)) (at level 0, format "[ 'lmodMixin' 'of' U 'by' <: ]") : form_scope. Notation "[ 'lalgMixin' 'of' A 'by' <: ]" := ((lalgMixin (Phant A) val_inj (rrefl _)) *%R (rrefl _)) (at level 0, format "[ 'lalgMixin' 'of' A 'by' <: ]") : form_scope. Notation "[ 'comRingMixin' 'of' R 'by' <: ]" := (comRingMixin (Phant R) val_inj (rrefl _)) (at level 0, format "[ 'comRingMixin' 'of' R 'by' <: ]") : form_scope. Notation "[ 'algMixin' 'of' A 'by' <: ]" := (algMixin (Phant A) val_inj (rrefl _) (rrefl _)) (at level 0, format "[ 'algMixin' 'of' A 'by' <: ]") : form_scope. Notation "[ 'unitRingMixin' 'of' R 'by' <: ]" := (@unitRingMixin _ _ _ _ _ _ (@erefl Type R%type) (erefl _) (rrefl _)) (at level 0, format "[ 'unitRingMixin' 'of' R 'by' <: ]") : form_scope. Notation "[ 'idomainMixin' 'of' R 'by' <: ]" := (idomainMixin (Phant R) val_inj (erefl _) (rrefl _)) (at level 0, format "[ 'idomainMixin' 'of' R 'by' <: ]") : form_scope. Notation "[ 'fieldMixin' 'of' F 'by' <: ]" := (fieldMixin (Phant F) val_inj (erefl _) (frefl _)) (at level 0, format "[ 'fieldMixin' 'of' F 'by' <: ]") : form_scope. End Exports. End SubType. Module Theory. Definition addrA := addrA. Definition addrC := addrC. Definition add0r := add0r. Definition addNr := addNr. Definition addr0 := addr0. Definition addrN := addrN. Definition subrr := subrr. Definition addrCA := addrCA. Definition addrAC := addrAC. Definition addrACA := addrACA. Definition addKr := addKr. Definition addNKr := addNKr. Definition addrK := addrK. Definition addrNK := addrNK. Definition subrK := subrK. Definition subKr := subKr. Definition addrI := @addrI. Definition addIr := @addIr. Definition subrI := @subrI. Definition subIr := @subIr. Arguments addrI {V} y [x1 x2]. Arguments addIr {V} x [x1 x2]. Arguments subrI {V} y [x1 x2]. Arguments subIr {V} x [x1 x2]. Definition opprK := @opprK. Arguments opprK {V}. Definition oppr_inj := @oppr_inj. Arguments oppr_inj {V} [x1 x2]. Definition oppr0 := oppr0. Definition oppr_eq0 := oppr_eq0. Definition opprD := opprD. Definition opprB := opprB. Definition addrKA := addrKA. Definition subrKA := subrKA. Definition subr0 := subr0. Definition sub0r := sub0r. Definition subr_eq := subr_eq. Definition addr0_eq := addr0_eq. Definition subr0_eq := subr0_eq. Definition subr_eq0 := subr_eq0. Definition addr_eq0 := addr_eq0. Definition eqr_opp := eqr_opp. Definition eqr_oppLR := eqr_oppLR. Definition sumrN := sumrN. Definition sumrB := sumrB. Definition sumrMnl := sumrMnl. Definition sumrMnr := sumrMnr. Definition sumr_const := sumr_const. Definition sumr_const_nat := sumr_const_nat. Definition telescope_sumr := telescope_sumr. Definition mulr0n := mulr0n. Definition mulr1n := mulr1n. Definition mulr2n := mulr2n. Definition mulrS := mulrS. Definition mulrSr := mulrSr. Definition mulrb := mulrb. Definition mul0rn := mul0rn. Definition mulNrn := mulNrn. Definition mulrnDl := mulrnDl. Definition mulrnDr := mulrnDr. Definition mulrnBl := mulrnBl. Definition mulrnBr := mulrnBr. Definition mulrnA := mulrnA. Definition mulrnAC := mulrnAC. Definition iter_addr := iter_addr. Definition iter_addr_0 := iter_addr_0. Definition mulrA := mulrA. Definition mul1r := mul1r. Definition mulr1 := mulr1. Definition mulrDl := mulrDl. Definition mulrDr := mulrDr. Definition oner_neq0 := oner_neq0. Definition oner_eq0 := oner_eq0. Definition mul0r := mul0r. Definition mulr0 := mulr0. Definition mulrN := mulrN. Definition mulNr := mulNr. Definition mulrNN := mulrNN. Definition mulN1r := mulN1r. Definition mulrN1 := mulrN1. Definition mulr_suml := mulr_suml. Definition mulr_sumr := mulr_sumr. Definition mulrBl := mulrBl. Definition mulrBr := mulrBr. Definition mulrnAl := mulrnAl. Definition mulrnAr := mulrnAr. Definition mulr_natl := mulr_natl. Definition mulr_natr := mulr_natr. Definition natrD := natrD. Definition natrB := natrB. Definition natr_sum := natr_sum. Definition natrM := natrM. Definition natrX := natrX. Definition expr0 := expr0. Definition exprS := exprS. Definition expr1 := expr1. Definition expr2 := expr2. Definition expr0n := expr0n. Definition expr1n := expr1n. Definition exprD := exprD. Definition exprSr := exprSr. Definition expr_sum := expr_sum. Definition commr_sym := commr_sym. Definition commr_refl := commr_refl. Definition commr0 := commr0. Definition commr1 := commr1. Definition commrN := commrN. Definition commrN1 := commrN1. Definition commrD := commrD. Definition commrB := commrB. Definition commr_sum := commr_sum. Definition commr_prod := commr_prod. Definition commrMn := commrMn. Definition commrM := commrM. Definition commr_nat := commr_nat. Definition commrX := commrX. Definition exprMn_comm := exprMn_comm. Definition commr_sign := commr_sign. Definition exprMn_n := exprMn_n. Definition exprM := exprM. Definition exprAC := exprAC. Definition expr_mod := expr_mod. Definition expr_dvd := expr_dvd. Definition signr_odd := signr_odd. Definition signr_eq0 := signr_eq0. Definition mulr_sign := mulr_sign. Definition signr_addb := signr_addb. Definition signrN := signrN. Definition signrE := signrE. Definition mulr_signM := mulr_signM. Definition exprNn := exprNn. Definition sqrrN := sqrrN. Definition sqrr_sign := sqrr_sign. Definition signrMK := signrMK. Definition mulrI_eq0 := mulrI_eq0. Definition lreg_neq0 := lreg_neq0. Definition mulrI0_lreg := mulrI0_lreg. Definition lregN := lregN. Definition lreg1 := lreg1. Definition lregM := lregM. Definition lregX := lregX. Definition lreg_sign := lreg_sign. Definition lregP {R x} := @lregP R x. Definition mulIr_eq0 := mulIr_eq0. Definition mulIr0_rreg := mulIr0_rreg. Definition rreg_neq0 := rreg_neq0. Definition rregN := rregN. Definition rreg1 := rreg1. Definition rregM := rregM. Definition revrX := revrX. Definition rregX := rregX. Definition rregP {R x} := @rregP R x. Definition exprDn_comm := exprDn_comm. Definition exprBn_comm := exprBn_comm. Definition subrXX_comm := subrXX_comm. Definition exprD1n := exprD1n. Definition subrX1 := subrX1. Definition sqrrD1 := sqrrD1. Definition sqrrB1 := sqrrB1. Definition subr_sqr_1 := subr_sqr_1. Definition charf0 := charf0. Definition charf_prime := charf_prime. Definition mulrn_char := mulrn_char. Definition dvdn_charf := dvdn_charf. Definition charf_eq := charf_eq. Definition bin_lt_charf_0 := bin_lt_charf_0. Definition Frobenius_autE := Frobenius_autE. Definition Frobenius_aut0 := Frobenius_aut0. Definition Frobenius_aut1 := Frobenius_aut1. Definition Frobenius_autD_comm := Frobenius_autD_comm. Definition Frobenius_autMn := Frobenius_autMn. Definition Frobenius_aut_nat := Frobenius_aut_nat. Definition Frobenius_autM_comm := Frobenius_autM_comm. Definition Frobenius_autX := Frobenius_autX. Definition Frobenius_autN := Frobenius_autN. Definition Frobenius_autB_comm := Frobenius_autB_comm. Definition exprNn_char := exprNn_char. Definition addrr_char2 := addrr_char2. Definition oppr_char2 := oppr_char2. Definition addrK_char2 := addrK_char2. Definition addKr_char2 := addKr_char2. Definition iter_mulr := iter_mulr. Definition iter_mulr_1 := iter_mulr_1. Definition prodr_const := prodr_const. Definition prodr_const_nat := prodr_const_nat. Definition mulrC := mulrC. Definition mulrCA := mulrCA. Definition mulrAC := mulrAC. Definition mulrACA := mulrACA. Definition exprMn := exprMn. Definition prodrXl := prodrXl. Definition prodrXr := prodrXr. Definition prodrN := prodrN. Definition prodrMn_const := prodrMn_const. Definition prodr_natmul := prodr_natmul. Definition natr_prod := natr_prod. Definition prodr_undup_exp_count := prodr_undup_exp_count. Definition exprDn := exprDn. Definition exprBn := exprBn. Definition subrXX := subrXX. Definition sqrrD := sqrrD. Definition sqrrB := sqrrB. Definition subr_sqr := subr_sqr. Definition subr_sqrDB := subr_sqrDB. Definition exprDn_char := exprDn_char. Definition mulrV := mulrV. Definition divrr := divrr. Definition mulVr := mulVr. Definition invr_out := invr_out. Definition unitrP {R x} := @unitrP R x. Definition mulKr := mulKr. Definition mulVKr := mulVKr. Definition mulrK := mulrK. Definition mulrVK := mulrVK. Definition divrK := divrK. Definition mulrI := mulrI. Definition mulIr := mulIr. Definition divrI := divrI. Definition divIr := divIr. Definition telescope_prodr := telescope_prodr. Definition commrV := commrV. Definition unitrE := unitrE. Definition invrK := @invrK. Arguments invrK {R}. Definition invr_inj := @invr_inj. Arguments invr_inj {R} [x1 x2]. Definition unitrV := unitrV. Definition unitr1 := unitr1. Definition invr1 := invr1. Definition divr1 := divr1. Definition div1r := div1r. Definition natr_div := natr_div. Definition unitr0 := unitr0. Definition invr0 := invr0. Definition unitrN1 := unitrN1. Definition unitrN := unitrN. Definition invrN1 := invrN1. Definition invrN := invrN. Definition invr_sign := invr_sign. Definition unitrMl := unitrMl. Definition unitrMr := unitrMr. Definition invrM := invrM. Definition invr_eq0 := invr_eq0. Definition invr_eq1 := invr_eq1. Definition invr_neq0 := invr_neq0. Definition unitrM_comm := unitrM_comm. Definition unitrX := unitrX. Definition unitrX_pos := unitrX_pos. Definition exprVn := exprVn. Definition exprB := exprB. Definition invr_signM := invr_signM. Definition divr_signM := divr_signM. Definition rpred0D := rpred0D. Definition rpred0 := rpred0. Definition rpredD := rpredD. Definition rpredNr := rpredNr. Definition rpred_sum := rpred_sum. Definition rpredMn := rpredMn. Definition rpredN := rpredN. Definition rpredB := rpredB. Definition rpredBC := rpredBC. Definition rpredMNn := rpredMNn. Definition rpredDr := rpredDr. Definition rpredDl := rpredDl. Definition rpredBr := rpredBr. Definition rpredBl := rpredBl. Definition rpredMsign := rpredMsign. Definition rpred1M := rpred1M. Definition rpred1 := rpred1. Definition rpredM := rpredM. Definition rpred_prod := rpred_prod. Definition rpredX := rpredX. Definition rpred_nat := rpred_nat. Definition rpredN1 := rpredN1. Definition rpred_sign := rpred_sign. Definition rpredZsign := rpredZsign. Definition rpredZnat := rpredZnat. Definition rpredZ := rpredZ. Definition rpredVr := rpredVr. Definition rpredV := rpredV. Definition rpred_div := rpred_div. Definition rpredXN := rpredXN. Definition rpredZeq := rpredZeq. Definition char_lalg := char_lalg. Definition rpredMr := rpredMr. Definition rpredMl := rpredMl. Definition rpred_divr := rpred_divr. Definition rpred_divl := rpred_divl. Definition eq_eval := eq_eval. Definition eval_tsubst := eval_tsubst. Definition eq_holds := eq_holds. Definition holds_fsubst := holds_fsubst. Definition unitrM := unitrM. Definition unitrPr {R x} := @unitrPr R x. Definition expr_div_n := expr_div_n. Definition mulr1_eq := mulr1_eq. Definition divr1_eq := divr1_eq. Definition divKr := divKr. Definition mulf_eq0 := mulf_eq0. Definition prodf_eq0 := prodf_eq0. Definition prodf_seq_eq0 := prodf_seq_eq0. Definition mulf_neq0 := mulf_neq0. Definition prodf_neq0 := prodf_neq0. Definition prodf_seq_neq0 := prodf_seq_neq0. Definition expf_eq0 := expf_eq0. Definition sqrf_eq0 := sqrf_eq0. Definition expf_neq0 := expf_neq0. Definition natf_neq0 := natf_neq0. Definition natf0_char := natf0_char. Definition charf'_nat := charf'_nat. Definition charf0P := charf0P. Definition eqf_sqr := eqf_sqr. Definition mulfI := mulfI. Definition mulIf := mulIf. Definition divfI := divfI. Definition divIf := divIf. Definition sqrf_eq1 := sqrf_eq1. Definition expfS_eq1 := expfS_eq1. Definition fieldP := fieldP. Definition unitfE := unitfE. Definition mulVf := mulVf. Definition mulfV := mulfV. Definition divff := divff. Definition mulKf := mulKf. Definition mulVKf := mulVKf. Definition mulfK := mulfK. Definition mulfVK := mulfVK. Definition divfK := divfK. Definition divKf := divKf. Definition invfM := invfM. Definition invf_div := invf_div. Definition expfB_cond := expfB_cond. Definition expfB := expfB. Definition prodfV := prodfV. Definition prodf_div := prodf_div. Definition telescope_prodf := telescope_prodf. Definition addf_div := addf_div. Definition mulf_div := mulf_div. Definition char0_natf_div := char0_natf_div. Definition fpredMr := fpredMr. Definition fpredMl := fpredMl. Definition fpred_divr := fpred_divr. Definition fpred_divl := fpred_divl. Definition satP {F e f} := @satP F e f. Definition eq_sat := eq_sat. Definition solP {F n f} := @solP F n f. Definition eq_sol := eq_sol. Definition size_sol := size_sol. Definition solve_monicpoly := solve_monicpoly. Definition raddf0 := raddf0. Definition raddf_eq0 := raddf_eq0. Definition raddf_inj := raddf_inj. Definition raddfN := raddfN. Definition raddfD := raddfD. Definition raddfB := raddfB. Definition raddf_sum := raddf_sum. Definition raddfMn := raddfMn. Definition raddfMNn := raddfMNn. Definition raddfMnat := raddfMnat. Definition raddfMsign := raddfMsign. Definition can2_additive := can2_additive. Definition bij_additive := bij_additive. Definition rmorph0 := rmorph0. Definition rmorphN := rmorphN. Definition rmorphD := rmorphD. Definition rmorphB := rmorphB. Definition rmorph_sum := rmorph_sum. Definition rmorphMn := rmorphMn. Definition rmorphMNn := rmorphMNn. Definition rmorphismP := rmorphismP. Definition rmorphismMP := rmorphismMP. Definition rmorph1 := rmorph1. Definition rmorph_eq1 := rmorph_eq1. Definition rmorphM := rmorphM. Definition rmorphMsign := rmorphMsign. Definition rmorph_nat := rmorph_nat. Definition rmorph_eq_nat := rmorph_eq_nat. Definition rmorph_prod := rmorph_prod. Definition rmorphX := rmorphX. Definition rmorphN1 := rmorphN1. Definition rmorph_sign := rmorph_sign. Definition rmorph_char := rmorph_char. Definition can2_rmorphism := can2_rmorphism. Definition bij_rmorphism := bij_rmorphism. Definition rmorph_comm := rmorph_comm. Definition rmorph_unit := rmorph_unit. Definition rmorphV := rmorphV. Definition rmorph_div := rmorph_div. Definition fmorph_eq0 := fmorph_eq0. Definition fmorph_inj := @fmorph_inj. Arguments fmorph_inj {F R} f [x1 x2]. Definition fmorph_eq1 := fmorph_eq1. Definition fmorph_char := fmorph_char. Definition fmorph_unit := fmorph_unit. Definition fmorphV := fmorphV. Definition fmorph_div := fmorph_div. Definition scalerA := scalerA. Definition scale1r := scale1r. Definition scalerDr := scalerDr. Definition scalerDl := scalerDl. Definition scaler0 := scaler0. Definition scale0r := scale0r. Definition scaleNr := scaleNr. Definition scaleN1r := scaleN1r. Definition scalerN := scalerN. Definition scalerBl := scalerBl. Definition scalerBr := scalerBr. Definition scaler_nat := scaler_nat. Definition scalerMnl := scalerMnl. Definition scalerMnr := scalerMnr. Definition scaler_suml := scaler_suml. Definition scaler_sumr := scaler_sumr. Definition scaler_eq0 := scaler_eq0. Definition scalerK := scalerK. Definition scalerKV := scalerKV. Definition scalerI := scalerI. Definition scalerAl := scalerAl. Definition mulr_algl := mulr_algl. Definition scaler_sign := scaler_sign. Definition signrZK := signrZK. Definition scalerCA := scalerCA. Definition scalerAr := scalerAr. Definition mulr_algr := mulr_algr. Definition comm_alg := comm_alg. Definition exprZn := exprZn. Definition scaler_prodl := scaler_prodl. Definition scaler_prodr := scaler_prodr. Definition scaler_prod := scaler_prod. Definition scaler_injl := scaler_injl. Definition scaler_unit := scaler_unit. Definition invrZ := invrZ. Definition raddfZnat := raddfZnat. Definition raddfZsign := raddfZsign. Definition in_algE := in_algE. Definition linear0 := linear0. Definition linearN := linearN. Definition linearD := linearD. Definition linearB := linearB. Definition linear_sum := linear_sum. Definition linearMn := linearMn. Definition linearMNn := linearMNn. Definition linearP := linearP. Definition linearZ_LR := linearZ_LR. Definition linearZ := linearZ. Definition linearPZ := linearPZ. Definition linearZZ := linearZZ. Definition scalarP := scalarP. Definition scalarZ := scalarZ. Definition can2_linear := can2_linear. Definition bij_linear := bij_linear. Definition rmorph_alg := rmorph_alg. Definition lrmorphismP := lrmorphismP. Definition can2_lrmorphism := can2_lrmorphism. Definition bij_lrmorphism := bij_lrmorphism. Definition imaginary_exists := imaginary_exists. Notation null_fun V := (null_fun V) (only parsing). Notation in_alg A := (in_alg_loc A). Notation prodrMn := (fun n A F => deprecate prodrMn prodrMn_const _ n _ A F) (only parsing). End Theory. Notation in_alg A := (in_alg_loc A). End GRing. Export Zmodule.Exports Ring.Exports Lmodule.Exports Lalgebra.Exports. Export Additive.Exports RMorphism.Exports Linear.Exports LRMorphism.Exports. Export Algebra.Exports UnitRing.Exports UnitAlgebra.Exports. Export ComRing.Exports ComAlgebra.Exports ComUnitRing.Exports. Export ComUnitAlgebra.Exports IntegralDomain.Exports Field.Exports. Export DecidableField.Exports ClosedField.Exports. Export Pred.Exports SubType.Exports. Notation QEdecFieldMixin := QEdecFieldMixin. Notation "0" := (zero _) : ring_scope. Notation "-%R" := (@opp _) : ring_scope. Notation "- x" := (opp x) : ring_scope. Notation "+%R" := (@add _). Notation "x + y" := (add x y) : ring_scope. Notation "x - y" := (add x (- y)) : ring_scope. Notation "x *+ n" := (natmul x n) : ring_scope. Notation "x *- n" := (opp (x *+ n)) : ring_scope. Notation "s `_ i" := (seq.nth 0%R s%R i) : ring_scope. Notation support := 0.-support. Notation "1" := (one _) : ring_scope. Notation "- 1" := (opp 1) : ring_scope. Notation "n %:R" := (natmul 1 n) : ring_scope. Notation "[ 'char' R ]" := (char (Phant R)) : ring_scope. Notation Frobenius_aut chRp := (Frobenius_aut chRp). Notation "*%R" := (@mul _). Notation "x * y" := (mul x y) : ring_scope. Notation "x ^+ n" := (exp x n) : ring_scope. Notation "x ^-1" := (inv x) : ring_scope. Notation "x ^- n" := (inv (x ^+ n)) : ring_scope. Notation "x / y" := (mul x y^-1) : ring_scope. Notation "*:%R" := (@scale _ _). Notation "a *: m" := (scale a m) : ring_scope. Notation "k %:A" := (scale k 1) : ring_scope. Notation "\0" := (null_fun _) : ring_scope. Notation "f \+ g" := (add_fun f g) : ring_scope. Notation "f \- g" := (sub_fun f g) : ring_scope. Notation "a \*: f" := (scale_fun a f) : ring_scope. Notation "x \*o f" := (mull_fun x f) : ring_scope. Notation "x \o* f" := (mulr_fun x f) : ring_scope. Arguments add_fun {_ _} f g _ /. Arguments sub_fun {_ _} f g _ /. Arguments mull_fun {_ _} a f _ /. Arguments mulr_fun {_ _} a f _ /. Arguments scale_fun {_ _ _} a f _ /. Notation "\sum_ ( i <- r | P ) F" := (\big[+%R/0%R]_(i <- r | P%B) F%R) : ring_scope. Notation "\sum_ ( i <- r ) F" := (\big[+%R/0%R]_(i <- r) F%R) : ring_scope. Notation "\sum_ ( m <= i < n | P ) F" := (\big[+%R/0%R]_(m <= i < n | P%B) F%R) : ring_scope. Notation "\sum_ ( m <= i < n ) F" := (\big[+%R/0%R]_(m <= i < n) F%R) : ring_scope. Notation "\sum_ ( i | P ) F" := (\big[+%R/0%R]_(i | P%B) F%R) : ring_scope. Notation "\sum_ i F" := (\big[+%R/0%R]_i F%R) : ring_scope. Notation "\sum_ ( i : t | P ) F" := (\big[+%R/0%R]_(i : t | P%B) F%R) (only parsing) : ring_scope. Notation "\sum_ ( i : t ) F" := (\big[+%R/0%R]_(i : t) F%R) (only parsing) : ring_scope. Notation "\sum_ ( i < n | P ) F" := (\big[+%R/0%R]_(i < n | P%B) F%R) : ring_scope. Notation "\sum_ ( i < n ) F" := (\big[+%R/0%R]_(i < n) F%R) : ring_scope. Notation "\sum_ ( i 'in' A | P ) F" := (\big[+%R/0%R]_(i in A | P%B) F%R) : ring_scope. Notation "\sum_ ( i 'in' A ) F" := (\big[+%R/0%R]_(i in A) F%R) : ring_scope. Notation "\prod_ ( i <- r | P ) F" := (\big[*%R/1%R]_(i <- r | P%B) F%R) : ring_scope. Notation "\prod_ ( i <- r ) F" := (\big[*%R/1%R]_(i <- r) F%R) : ring_scope. Notation "\prod_ ( m <= i < n | P ) F" := (\big[*%R/1%R]_(m <= i < n | P%B) F%R) : ring_scope. Notation "\prod_ ( m <= i < n ) F" := (\big[*%R/1%R]_(m <= i < n) F%R) : ring_scope. Notation "\prod_ ( i | P ) F" := (\big[*%R/1%R]_(i | P%B) F%R) : ring_scope. Notation "\prod_ i F" := (\big[*%R/1%R]_i F%R) : ring_scope. Notation "\prod_ ( i : t | P ) F" := (\big[*%R/1%R]_(i : t | P%B) F%R) (only parsing) : ring_scope. Notation "\prod_ ( i : t ) F" := (\big[*%R/1%R]_(i : t) F%R) (only parsing) : ring_scope. Notation "\prod_ ( i < n | P ) F" := (\big[*%R/1%R]_(i < n | P%B) F%R) : ring_scope. Notation "\prod_ ( i < n ) F" := (\big[*%R/1%R]_(i < n) F%R) : ring_scope. Notation "\prod_ ( i 'in' A | P ) F" := (\big[*%R/1%R]_(i in A | P%B) F%R) : ring_scope. Notation "\prod_ ( i 'in' A ) F" := (\big[*%R/1%R]_(i in A) F%R) : ring_scope. Canonical add_monoid. Canonical add_comoid. Canonical mul_monoid. Canonical mul_comoid. Canonical muloid. Canonical addoid. Canonical locked_additive. Canonical locked_rmorphism. Canonical locked_linear. Canonical locked_lrmorphism. Canonical idfun_additive. Canonical idfun_rmorphism. Canonical idfun_linear. Canonical idfun_lrmorphism. Canonical comp_additive. Canonical comp_rmorphism. Canonical comp_linear. Canonical comp_lrmorphism. Canonical opp_additive. Canonical opp_linear. Canonical scale_additive. Canonical scale_linear. Canonical null_fun_additive. Canonical null_fun_linear. Canonical scale_fun_additive. Canonical scale_fun_linear. Canonical add_fun_additive. Canonical add_fun_linear. Canonical sub_fun_additive. Canonical sub_fun_linear. Canonical mull_fun_additive. Canonical mull_fun_linear. Canonical mulr_fun_additive. Canonical mulr_fun_linear. Canonical Frobenius_aut_additive. Canonical Frobenius_aut_rmorphism. Canonical in_alg_additive. Canonical in_alg_rmorphism. Notation "R ^c" := (converse R) (at level 2, format "R ^c") : type_scope. Canonical converse_eqType. Canonical converse_choiceType. Canonical converse_zmodType. Canonical converse_ringType. Canonical converse_unitRingType. Notation "R ^o" := (regular R) (at level 2, format "R ^o") : type_scope. Canonical regular_eqType. Canonical regular_choiceType. Canonical regular_zmodType. Canonical regular_ringType. Canonical regular_lmodType. Canonical regular_lalgType. Canonical regular_comRingType. Canonical regular_algType. Canonical regular_unitRingType. Canonical regular_comUnitRingType. Canonical regular_unitAlgType. Canonical regular_comAlgType. Canonical regular_comUnitAlgType. Canonical regular_idomainType. Canonical regular_fieldType. Canonical unit_keyed. Canonical unit_opprPred. Canonical unit_mulrPred. Canonical unit_smulrPred. Canonical unit_divrPred. Canonical unit_sdivrPred. Bind Scope term_scope with term. Bind Scope term_scope with formula. Notation "''X_' i" := (Var _ i) : term_scope. Notation "n %:R" := (NatConst _ n) : term_scope. Notation "0" := 0%:R%T : term_scope. Notation "1" := 1%:R%T : term_scope. Notation "x %:T" := (Const x) : term_scope. Infix "+" := Add : term_scope. Notation "- t" := (Opp t) : term_scope. Notation "t - u" := (Add t (- u)) : term_scope. Infix "*" := Mul : term_scope. Infix "*+" := NatMul : term_scope. Notation "t ^-1" := (Inv t) : term_scope. Notation "t / u" := (Mul t u^-1) : term_scope. Infix "^+" := Exp : term_scope. Infix "==" := Equal : term_scope. Notation "x != y" := (GRing.Not (x == y)) : term_scope. Infix "/\" := And : term_scope. Infix "\/" := Or : term_scope. Infix "==>" := Implies : term_scope. Notation "~ f" := (Not f) : term_scope. Notation "''exists' ''X_' i , f" := (Exists i f) : term_scope. Notation "''forall' ''X_' i , f" := (Forall i f) : term_scope. (* Lifting Structure from the codomain of finfuns. *) Section FinFunZmod. Variable (aT : finType) (rT : zmodType). Implicit Types f g : {ffun aT -> rT}. Definition ffun_zero := [ffun a : aT => (0 : rT)]. Definition ffun_opp f := [ffun a => - f a]. Definition ffun_add f g := [ffun a => f a + g a]. Fact ffun_addA : associative ffun_add. Proof. by move=> f1 f2 f3; apply/ffunP=> a; rewrite !ffunE addrA. Qed. Fact ffun_addC : commutative ffun_add. Proof. by move=> f1 f2; apply/ffunP=> a; rewrite !ffunE addrC. Qed. Fact ffun_add0 : left_id ffun_zero ffun_add. Proof. by move=> f; apply/ffunP=> a; rewrite !ffunE add0r. Qed. Fact ffun_addN : left_inverse ffun_zero ffun_opp ffun_add. Proof. by move=> f; apply/ffunP=> a; rewrite !ffunE addNr. Qed. Definition ffun_zmodMixin := Zmodule.Mixin ffun_addA ffun_addC ffun_add0 ffun_addN. Canonical ffun_zmodType := Eval hnf in ZmodType _ ffun_zmodMixin. Section Sum. Variables (I : Type) (r : seq I) (P : pred I) (F : I -> {ffun aT -> rT}). Lemma sum_ffunE x : (\sum_(i <- r | P i) F i) x = \sum_(i <- r | P i) F i x. Proof. by elim/big_rec2: _ => // [|i _ y _ <-]; rewrite !ffunE. Qed. Lemma sum_ffun : \sum_(i <- r | P i) F i = [ffun x => \sum_(i <- r | P i) F i x]. Proof. by apply/ffunP=> i; rewrite sum_ffunE ffunE. Qed. End Sum. Lemma ffunMnE f n x : (f *+ n) x = f x *+ n. Proof. by rewrite -[n]card_ord -!sumr_const sum_ffunE. Qed. End FinFunZmod. Section FinFunRing. (* As rings require 1 != 0 in order to lift a ring structure over finfuns *) (* we need evidence that the domain is non-empty. *) Variable (aT : finType) (R : ringType) (a : aT). Definition ffun_one : {ffun aT -> R} := [ffun => 1]. Definition ffun_mul (f g : {ffun aT -> R}) := [ffun x => f x * g x]. Fact ffun_mulA : associative ffun_mul. Proof. by move=> f1 f2 f3; apply/ffunP=> i; rewrite !ffunE mulrA. Qed. Fact ffun_mul_1l : left_id ffun_one ffun_mul. Proof. by move=> f; apply/ffunP=> i; rewrite !ffunE mul1r. Qed. Fact ffun_mul_1r : right_id ffun_one ffun_mul. Proof. by move=> f; apply/ffunP=> i; rewrite !ffunE mulr1. Qed. Fact ffun_mul_addl : left_distributive ffun_mul (@ffun_add _ _). Proof. by move=> f1 f2 f3; apply/ffunP=> i; rewrite !ffunE mulrDl. Qed. Fact ffun_mul_addr : right_distributive ffun_mul (@ffun_add _ _). Proof. by move=> f1 f2 f3; apply/ffunP=> i; rewrite !ffunE mulrDr. Qed. Fact ffun1_nonzero : ffun_one != 0. Proof. by apply/eqP => /ffunP/(_ a)/eqP; rewrite !ffunE oner_eq0. Qed. Definition ffun_ringMixin := RingMixin ffun_mulA ffun_mul_1l ffun_mul_1r ffun_mul_addl ffun_mul_addr ffun1_nonzero. Definition ffun_ringType := Eval hnf in RingType {ffun aT -> R} ffun_ringMixin. End FinFunRing. Section FinFunComRing. Variable (aT : finType) (R : comRingType) (a : aT). Fact ffun_mulC : commutative (@ffun_mul aT R). Proof. by move=> f1 f2; apply/ffunP=> i; rewrite !ffunE mulrC. Qed. Definition ffun_comRingType := Eval hnf in ComRingType (ffun_ringType R a) ffun_mulC. End FinFunComRing. Section FinFunLmod. Variable (R : ringType) (aT : finType) (rT : lmodType R). Implicit Types f g : {ffun aT -> rT}. Definition ffun_scale k f := [ffun a => k *: f a]. Fact ffun_scaleA k1 k2 f : ffun_scale k1 (ffun_scale k2 f) = ffun_scale (k1 * k2) f. Proof. by apply/ffunP=> a; rewrite !ffunE scalerA. Qed. Fact ffun_scale1 : left_id 1 ffun_scale. Proof. by move=> f; apply/ffunP=> a; rewrite !ffunE scale1r. Qed. Fact ffun_scale_addr k : {morph (ffun_scale k) : x y / x + y}. Proof. by move=> f g; apply/ffunP=> a; rewrite !ffunE scalerDr. Qed. Fact ffun_scale_addl u : {morph (ffun_scale)^~ u : k1 k2 / k1 + k2}. Proof. by move=> k1 k2; apply/ffunP=> a; rewrite !ffunE scalerDl. Qed. Definition ffun_lmodMixin := LmodMixin ffun_scaleA ffun_scale1 ffun_scale_addr ffun_scale_addl. Canonical ffun_lmodType := Eval hnf in LmodType R {ffun aT -> rT} ffun_lmodMixin. End FinFunLmod. (* External direct product. *) Section PairZmod. Variables M1 M2 : zmodType. Definition opp_pair (x : M1 * M2) := (- x.1, - x.2). Definition add_pair (x y : M1 * M2) := (x.1 + y.1, x.2 + y.2). Fact pair_addA : associative add_pair. Proof. by move=> x y z; congr (_, _); apply: addrA. Qed. Fact pair_addC : commutative add_pair. Proof. by move=> x y; congr (_, _); apply: addrC. Qed. Fact pair_add0 : left_id (0, 0) add_pair. Proof. by case=> x1 x2; congr (_, _); apply: add0r. Qed. Fact pair_addN : left_inverse (0, 0) opp_pair add_pair. Proof. by move=> x; congr (_, _); apply: addNr. Qed. Definition pair_zmodMixin := ZmodMixin pair_addA pair_addC pair_add0 pair_addN. Canonical pair_zmodType := Eval hnf in ZmodType (M1 * M2) pair_zmodMixin. End PairZmod. Section PairRing. Variables R1 R2 : ringType. Definition mul_pair (x y : R1 * R2) := (x.1 * y.1, x.2 * y.2). Fact pair_mulA : associative mul_pair. Proof. by move=> x y z; congr (_, _); apply: mulrA. Qed. Fact pair_mul1l : left_id (1, 1) mul_pair. Proof. by case=> x1 x2; congr (_, _); apply: mul1r. Qed. Fact pair_mul1r : right_id (1, 1) mul_pair. Proof. by case=> x1 x2; congr (_, _); apply: mulr1. Qed. Fact pair_mulDl : left_distributive mul_pair +%R. Proof. by move=> x y z; congr (_, _); apply: mulrDl. Qed. Fact pair_mulDr : right_distributive mul_pair +%R. Proof. by move=> x y z; congr (_, _); apply: mulrDr. Qed. Fact pair_one_neq0 : (1, 1) != 0 :> R1 * R2. Proof. by rewrite xpair_eqE oner_eq0. Qed. Definition pair_ringMixin := RingMixin pair_mulA pair_mul1l pair_mul1r pair_mulDl pair_mulDr pair_one_neq0. Canonical pair_ringType := Eval hnf in RingType (R1 * R2) pair_ringMixin. End PairRing. Section PairComRing. Variables R1 R2 : comRingType. Fact pair_mulC : commutative (@mul_pair R1 R2). Proof. by move=> x y; congr (_, _); apply: mulrC. Qed. Canonical pair_comRingType := Eval hnf in ComRingType (R1 * R2) pair_mulC. End PairComRing. Section PairLmod. Variables (R : ringType) (V1 V2 : lmodType R). Definition scale_pair a (v : V1 * V2) : V1 * V2 := (a *: v.1, a *: v.2). Fact pair_scaleA a b u : scale_pair a (scale_pair b u) = scale_pair (a * b) u. Proof. by congr (_, _); apply: scalerA. Qed. Fact pair_scale1 u : scale_pair 1 u = u. Proof. by case: u => u1 u2; congr (_, _); apply: scale1r. Qed. Fact pair_scaleDr : right_distributive scale_pair +%R. Proof. by move=> a u v; congr (_, _); apply: scalerDr. Qed. Fact pair_scaleDl u : {morph scale_pair^~ u: a b / a + b}. Proof. by move=> a b; congr (_, _); apply: scalerDl. Qed. Definition pair_lmodMixin := LmodMixin pair_scaleA pair_scale1 pair_scaleDr pair_scaleDl. Canonical pair_lmodType := Eval hnf in LmodType R (V1 * V2) pair_lmodMixin. End PairLmod. Section PairLalg. Variables (R : ringType) (A1 A2 : lalgType R). Fact pair_scaleAl a (u v : A1 * A2) : a *: (u * v) = (a *: u) * v. Proof. by congr (_, _); apply: scalerAl. Qed. Canonical pair_lalgType := Eval hnf in LalgType R (A1 * A2) pair_scaleAl. End PairLalg. Section PairAlg. Variables (R : comRingType) (A1 A2 : algType R). Fact pair_scaleAr a (u v : A1 * A2) : a *: (u * v) = u * (a *: v). Proof. by congr (_, _); apply: scalerAr. Qed. Canonical pair_algType := Eval hnf in AlgType R (A1 * A2) pair_scaleAr. End PairAlg. Section PairUnitRing. Variables R1 R2 : unitRingType. Definition pair_unitr := [qualify a x : R1 * R2 | (x.1 \is a GRing.unit) && (x.2 \is a GRing.unit)]. Definition pair_invr x := if x \is a pair_unitr then (x.1^-1, x.2^-1) else x. Lemma pair_mulVl : {in pair_unitr, left_inverse 1 pair_invr *%R}. Proof. rewrite /pair_invr=> x; case: ifP => // /andP[Ux1 Ux2] _. by congr (_, _); apply: mulVr. Qed. Lemma pair_mulVr : {in pair_unitr, right_inverse 1 pair_invr *%R}. Proof. rewrite /pair_invr=> x; case: ifP => // /andP[Ux1 Ux2] _. by congr (_, _); apply: mulrV. Qed. Lemma pair_unitP x y : y * x = 1 /\ x * y = 1 -> x \is a pair_unitr. Proof. case=> [[y1x y2x] [x1y x2y]]; apply/andP. by split; apply/unitrP; [exists y.1 | exists y.2]. Qed. Lemma pair_invr_out : {in [predC pair_unitr], pair_invr =1 id}. Proof. by rewrite /pair_invr => x /negPf/= ->. Qed. Definition pair_unitRingMixin := UnitRingMixin pair_mulVl pair_mulVr pair_unitP pair_invr_out. Canonical pair_unitRingType := Eval hnf in UnitRingType (R1 * R2) pair_unitRingMixin. End PairUnitRing. Canonical pair_comUnitRingType (R1 R2 : comUnitRingType) := Eval hnf in [comUnitRingType of R1 * R2]. Canonical pair_unitAlgType (R : comUnitRingType) (A1 A2 : unitAlgType R) := Eval hnf in [unitAlgType R of A1 * A2]. Lemma pairMnE (M1 M2 : zmodType) (x : M1 * M2) n : x *+ n = (x.1 *+ n, x.2 *+ n). Proof. by case: x => x y; elim: n => //= n; rewrite !mulrS => ->. Qed. (* begin hide *) (* Testing subtype hierarchy Section Test0. Variables (T : choiceType) (S : {pred T}). Inductive B := mkB x & x \in S. Definition vB u := let: mkB x _ := u in x. Canonical B_subType := [subType for vB]. Definition B_eqMixin := [eqMixin of B by <:]. Canonical B_eqType := EqType B B_eqMixin. Definition B_choiceMixin := [choiceMixin of B by <:]. Canonical B_choiceType := ChoiceType B B_choiceMixin. End Test0. Section Test1. Variables (R : unitRingType) (S : {pred R}). Variables (ringS : divringPred S) (kS : keyed_pred ringS). Definition B_zmodMixin := [zmodMixin of B kS by <:]. Canonical B_zmodType := ZmodType (B kS) B_zmodMixin. Definition B_ringMixin := [ringMixin of B kS by <:]. Canonical B_ringType := RingType (B kS) B_ringMixin. Definition B_unitRingMixin := [unitRingMixin of B kS by <:]. Canonical B_unitRingType := UnitRingType (B kS) B_unitRingMixin. End Test1. Section Test2. Variables (R : comUnitRingType) (A : unitAlgType R) (S : {pred A}). Variables (algS : divalgPred S) (kS : keyed_pred algS). Definition B_lmodMixin := [lmodMixin of B kS by <:]. Canonical B_lmodType := LmodType R (B kS) B_lmodMixin. Definition B_lalgMixin := [lalgMixin of B kS by <:]. Canonical B_lalgType := LalgType R (B kS) B_lalgMixin. Definition B_algMixin := [algMixin of B kS by <:]. Canonical B_algType := AlgType R (B kS) B_algMixin. Canonical B_unitAlgType := [unitAlgType R of B kS]. End Test2. Section Test3. Variables (F : fieldType) (S : {pred F}). Variables (ringS : divringPred S) (kS : keyed_pred ringS). Definition B_comRingMixin := [comRingMixin of B kS by <:]. Canonical B_comRingType := ComRingType (B kS) B_comRingMixin. Canonical B_comUnitRingType := [comUnitRingType of B kS]. Definition B_idomainMixin := [idomainMixin of B kS by <:]. Canonical B_idomainType := IdomainType (B kS) B_idomainMixin. Definition B_fieldMixin := [fieldMixin of B kS by <:]. Canonical B_fieldType := FieldType (B kS) B_fieldMixin. End Test3. *) (* end hide *) math-comp-mathcomp-1.12.0/mathcomp/algebra/ssrint.v000066400000000000000000001613541375767750300222420ustar00rootroot00000000000000(* (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 order ssralg countalg ssrnum. From mathcomp Require Import poly. (******************************************************************************) (* This file develops a basic theory of signed integers, defining: *) (* int == the type of signed integers, with two constructors Posz for *) (* non-negative integers and Negz for negative integers. It *) (* supports the realDomainType interface (and its parents). *) (* n%:Z == explicit cast from nat to int (:= Posz n); displayed as n. *) (* However (Posz m = Posz n) is displayed as (m = n :> int) *) (* (and so are ==, != and <>) *) (* Lemma NegzE : turns (Negz n) into - n.+1%:Z. *) (* x *~ m == m times x, with m : int; *) (* convertible to x *+ n if m is Posz n *) (* convertible to x *- n.+1 if m is Negz n. *) (* m%:~R == the image of m : int in a generic ring (:= 1 *~ m). *) (* x ^ m == x to the m, with m : int; *) (* convertible to x ^+ n if m is Posz n *) (* convertible to x ^- n.+1 if m is Negz n. *) (* sgz x == sign of x : R, *) (* equals (0 : int) if and only x == 0, *) (* equals (1 : int) if x is positive *) (* and (-1 : int) otherwise. *) (* `|m|%N == the n : nat such that `|m|%R = n%:Z, for m : int. *) (* `|m - n|%N == the distance between m and n; the '-' is specialized to *) (* the int type, so m and n can be either of type nat or int *) (* thanks to the Posz coercion; m and n are however parsed in *) (* the %N scope. The IntDist submodule provides this notation *) (* and the corresponding theory independently of the rest of *) (* of the int and ssralg libraries (and notations). *) (* Warning: due to the declaration of Posz as a coercion, two terms might be *) (* displayed the same while not being convertible, for instance: *) (* (Posz (x - y)) and (Posz x) - (Posz y) for x, y : nat. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope int_scope. Declare Scope distn_scope. Declare Scope rat_scope. Reserved Notation "n %:Z" (at level 2, left associativity, format "n %:Z"). Reserved Notation "n = m :> 'in' 't'" (at level 70, m at next level, format "n = m :> 'in' 't'"). Reserved Notation "n == m :> 'in' 't'" (at level 70, m at next level, format "n == m :> 'in' 't'"). Reserved Notation "n != m :> 'in' 't'" (at level 70, m at next level, format "n != m :> 'in' 't'"). Reserved Notation "n <> m :> 'in' 't'" (at level 70, m at next level, format "n <> m :> 'in' 't'"). Import Order.TTheory GRing.Theory Num.Theory. Delimit Scope int_scope with Z. Local Open Scope int_scope. (* Defining int *) Variant int : Set := Posz of nat | Negz of nat. (* This must be deferred to module DistInt to work around the design flaws of *) (* the Coq module system. *) (* Coercion Posz : nat >-> int. *) Notation "n %:Z" := (Posz n) (only parsing) : int_scope. Notation "n %:Z" := (Posz n) (only parsing) : ring_scope. Notation "n = m :> 'in' 't'" := (Posz n = Posz m) (only printing) : ring_scope. Notation "n == m :> 'in' 't'" := (Posz n == Posz m) (only printing) : ring_scope. Notation "n != m :> 'in' 't'" := (Posz n != Posz m) (only printing) : ring_scope. Notation "n <> m :> 'in' 't'" := (Posz n <> Posz m) (only printing) : ring_scope. Definition natsum_of_int (m : int) : nat + nat := match m with Posz p => inl _ p | Negz n => inr _ n end. Definition int_of_natsum (m : nat + nat) := match m with inl p => Posz p | inr n => Negz n end. Lemma natsum_of_intK : cancel natsum_of_int int_of_natsum. Proof. by case. Qed. Definition int_eqMixin := CanEqMixin natsum_of_intK. Definition int_countMixin := CanCountMixin natsum_of_intK. Definition int_choiceMixin := CountChoiceMixin int_countMixin. Canonical int_eqType := Eval hnf in EqType int int_eqMixin. Canonical int_choiceType := Eval hnf in ChoiceType int int_choiceMixin. Canonical int_countType := Eval hnf in CountType int int_countMixin. Lemma eqz_nat (m n : nat) : (m%:Z == n%:Z) = (m == n). Proof. by []. Qed. Module intZmod. Section intZmod. Definition addz (m n : int) := match m, n with | Posz m', Posz n' => Posz (m' + n') | Negz m', Negz n' => Negz (m' + n').+1 | Posz m', Negz n' => if n' < m' then Posz (m' - n'.+1) else Negz (n' - m') | Negz n', Posz m' => if n' < m' then Posz (m' - n'.+1) else Negz (n' - m') end. Definition oppz m := nosimpl match m with | Posz n => if n is (n'.+1)%N then Negz n' else Posz 0 | Negz n => Posz (n.+1)%N end. Local Notation "0" := (Posz 0) : int_scope. Local Notation "-%Z" := (@oppz) : int_scope. Local Notation "- x" := (oppz x) : int_scope. Local Notation "+%Z" := (@addz) : int_scope. Local Notation "x + y" := (addz x y) : int_scope. Local Notation "x - y" := (x + - y) : int_scope. Lemma PoszD : {morph Posz : m n / (m + n)%N >-> m + n}. Proof. by []. Qed. Local Coercion Posz : nat >-> int. Lemma NegzE (n : nat) : Negz n = - n.+1. Proof. by []. Qed. Lemma int_rect (P : int -> Type) : P 0 -> (forall n : nat, P n -> P (n.+1)) -> (forall n : nat, P (- n) -> P (- (n.+1))) -> forall n : int, P n. Proof. by move=> P0 hPp hPn []; elim=> [|n ihn]//; do ?[apply: hPn | apply: hPp]. Qed. Definition int_rec := int_rect. Definition int_ind := int_rect. Variant int_spec (x : int) : int -> Type := | ZintNull of x = 0 : int_spec x 0 | ZintPos n of x = n.+1 : int_spec x n.+1 | ZintNeg n of x = - (n.+1)%:Z : int_spec x (- n.+1). Lemma intP x : int_spec x x. Proof. by move: x=> [] []; constructor. Qed. Lemma addzC : commutative addz. Proof. by move=> [] m [] n //=; rewrite addnC. Qed. Lemma add0z : left_id 0 addz. Proof. by move=> [] [|]. Qed. Lemma oppzK : involutive oppz. Proof. by do 2?case. Qed. Lemma oppz_add : {morph oppz : m n / m + n}. Proof. by move=> [[|n]|n] [[|m]|m] /=; rewrite ?addn0 ?subn0 ?addnS //; rewrite !NegzE !ltnS !subSS; case: ltngtP => [?|?|->]; rewrite ?subnn // ?oppzK ?subnS ?prednK // subn_gt0. Qed. Lemma add1Pz (n : int) : 1 + (n - 1) = n. Proof. by case: (intP n)=> // n' /= _; rewrite ?(subn1, addn0). Qed. Lemma subSz1 (n : int) : 1 + n - 1 = n. Proof. by apply: (inv_inj oppzK); rewrite addzC !oppz_add oppzK [_ - n]addzC add1Pz. Qed. Lemma addSnz (m : nat) (n : int) : (m.+1%N) + n = 1 + (m + n). Proof. move: m n=> [|m] [] [|n] //=; rewrite ?add1n ?subn1 // !(ltnS, subSS). case: ltngtP=> hnm /=; rewrite ?hnm ?subnn //. by rewrite subnS add1n prednK ?subn_gt0. by rewrite ltnS leqn0 subn_eq0 leqNgt hnm /= subnS subn1. Qed. Lemma addSz (m n : int) : (1 + m) + n = 1 + (m + n). Proof. case: m => [] m; first by rewrite -PoszD add1n addSnz. rewrite !NegzE; apply: (inv_inj oppzK). rewrite !oppz_add !oppzK addSnz [-1%:Z + _]addzC addSnz add1Pz. by rewrite [-1%:Z + _]addzC subSz1. Qed. Lemma addPz (m n : int) : (m - 1) + n = (m + n) - 1. Proof. by apply: (inv_inj oppzK); rewrite !oppz_add oppzK [_ + 1]addzC addSz addzC. Qed. Lemma addzA : associative addz. Proof. elim=> [|m ihm|m ihm] n p; first by rewrite !add0z. by rewrite -add1n PoszD !addSz ihm. by rewrite -add1n addnC PoszD oppz_add !addPz ihm. Qed. Lemma addNz : left_inverse (0:int) oppz addz. Proof. by do 3?elim. Qed. Lemma predn_int (n : nat) : 0 < n -> n.-1%:Z = n - 1. Proof. by case: n=> // n _ /=; rewrite subn1. Qed. Definition Mixin := ZmodMixin addzA addzC add0z addNz. End intZmod. End intZmod. Canonical int_ZmodType := ZmodType int intZmod.Mixin. Local Open Scope ring_scope. Section intZmoduleTheory. Local Coercion Posz : nat >-> int. Lemma PoszD : {morph Posz : n m / (n + m)%N >-> n + m}. Proof. by []. Qed. Lemma NegzE (n : nat) : Negz n = -(n.+1)%:Z. Proof. by []. Qed. Lemma int_rect (P : int -> Type) : P 0 -> (forall n : nat, P n -> P (n.+1)%N) -> (forall n : nat, P (- (n%:Z)) -> P (- (n.+1%N%:Z))) -> forall n : int, P n. Proof. by move=> P0 hPp hPn []; elim=> [|n ihn]//; do ?[apply: hPn | apply: hPp]. Qed. Definition int_rec := int_rect. Definition int_ind := int_rect. Variant int_spec (x : int) : int -> Type := | ZintNull : int_spec x 0 | ZintPos n : int_spec x n.+1 | ZintNeg n : int_spec x (- (n.+1)%:Z). Lemma intP x : int_spec x x. Proof. by move: x=> [] [] *; rewrite ?NegzE; constructor. Qed. Definition oppz_add := (@opprD [zmodType of int]). Lemma subzn (m n : nat) : (n <= m)%N -> m%:Z - n%:Z = (m - n)%N. Proof. elim: n=> //= [|n ihn] hmn; first by rewrite subr0 subn0. rewrite subnS -addn1 !PoszD opprD addrA ihn 1?ltnW //. by rewrite intZmod.predn_int // subn_gt0. Qed. Lemma subzSS (m n : nat) : m.+1%:Z - n.+1%:Z = m%:Z - n%:Z. Proof. by elim: n m=> [|n ihn] m //; rewrite !subzn. Qed. End intZmoduleTheory. Module intRing. Section intRing. Local Coercion Posz : nat >-> int. Definition mulz (m n : int) := match m, n with | Posz m', Posz n' => (m' * n')%N%:Z | Negz m', Negz n' => (m'.+1%N * n'.+1%N)%N%:Z | Posz m', Negz n' => - (m' * (n'.+1%N))%N%:Z | Negz n', Posz m' => - (m' * (n'.+1%N))%N%:Z end. Local Notation "1" := (1%N:int) : int_scope. Local Notation "*%Z" := (@mulz) : int_scope. Local Notation "x * y" := (mulz x y) : int_scope. Lemma mul0z : left_zero 0 *%Z. Proof. by case=> [n|[|n]] //=; rewrite muln0. Qed. Lemma mulzC : commutative mulz. Proof. by move=> [] m [] n //=; rewrite mulnC. Qed. Lemma mulz0 : right_zero 0 *%Z. Proof. by move=> x; rewrite mulzC mul0z. Qed. Lemma mulzN (m n : int) : (m * (- n))%Z = - (m * n)%Z. Proof. by case: (intP m)=> {m} [|m|m]; rewrite ?mul0z //; case: (intP n)=> {n} [|n|n]; rewrite ?mulz0 //= mulnC. Qed. Lemma mulNz (m n : int) : ((- m) * n)%Z = - (m * n)%Z. Proof. by rewrite mulzC mulzN mulzC. Qed. Lemma mulzA : associative mulz. Proof. by move=> [] m [] n [] p; rewrite ?NegzE ?(mulnA,mulNz,mulzN,opprK) //= ?mulnA. Qed. Lemma mul1z : left_id 1%Z mulz. Proof. by case=> [[|n]|n] //=; rewrite ?mul1n// plusE addn0. Qed. Lemma mulzS (x : int) (n : nat) : (x * n.+1%:Z)%Z = x + (x * n)%Z. Proof. by case: (intP x)=> [|m'|m'] //=; [rewrite mulnS|rewrite mulSn -opprD]. Qed. Lemma mulz_addl : left_distributive mulz (+%R). Proof. move=> x y z; elim: z=> [|n|n]; first by rewrite !(mul0z,mulzC). by rewrite !mulzS=> ->; rewrite !addrA [X in X + _]addrAC. rewrite !mulzN !mulzS -!opprD=> /oppr_inj->. by rewrite !addrA [X in X + _]addrAC. Qed. Lemma nonzero1z : 1%Z != 0. Proof. by []. Qed. Definition comMixin := ComRingMixin mulzA mulzC mul1z mulz_addl nonzero1z. End intRing. End intRing. Canonical int_Ring := Eval hnf in RingType int intRing.comMixin. Canonical int_comRing := Eval hnf in ComRingType int intRing.mulzC. Section intRingTheory. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Lemma PoszM : {morph Posz : n m / (n * m)%N >-> n * m}. Proof. by []. Qed. Lemma intS (n : nat) : n.+1%:Z = 1 + n%:Z. Proof. by rewrite -PoszD. Qed. Lemma predn_int (n : nat) : (0 < n)%N -> n.-1%:Z = n%:Z - 1. Proof. exact: intZmod.predn_int. Qed. End intRingTheory. Module intUnitRing. Section intUnitRing. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Definition unitz := [qualify a n : int | (n == 1) || (n == -1)]. Definition invz n : int := n. Lemma mulVz : {in unitz, left_inverse 1%R invz *%R}. Proof. by move=> n /pred2P[] ->. Qed. Lemma mulzn_eq1 m (n : nat) : (m * n == 1) = (m == 1) && (n == 1%N). Proof. by case: m => m /=; [rewrite -PoszM [_==_]muln_eq1 | case: n]. Qed. Lemma unitzPl m n : n * m = 1 -> m \is a unitz. Proof. rewrite qualifE => /eqP. by case: m => m; rewrite ?NegzE ?mulrN -?mulNr mulzn_eq1 => /andP[_ /eqP->]. Qed. Lemma invz_out : {in [predC unitz], invz =1 id}. Proof. exact. Qed. Lemma idomain_axiomz m n : m * n = 0 -> (m == 0) || (n == 0). Proof. by case: m n => m [] n //= /eqP; rewrite ?(NegzE, mulrN, mulNr) ?oppr_eq0 -PoszM [_ == _]muln_eq0. Qed. Definition comMixin := ComUnitRingMixin mulVz unitzPl invz_out. End intUnitRing. End intUnitRing. Canonical int_unitRingType := Eval hnf in UnitRingType int intUnitRing.comMixin. Canonical int_comUnitRing := Eval hnf in [comUnitRingType of int]. Canonical int_idomainType := Eval hnf in IdomainType int intUnitRing.idomain_axiomz. Canonical int_countZmodType := [countZmodType of int]. Canonical int_countRingType := [countRingType of int]. Canonical int_countComRingType := [countComRingType of int]. Canonical int_countUnitRingType := [countUnitRingType of int]. Canonical int_countComUnitRingType := [countComUnitRingType of int]. Canonical int_countIdomainType := [countIdomainType of int]. Definition absz m := match m with Posz p => p | Negz n => n.+1 end. Notation "m - n" := (@GRing.add int_ZmodType m%N (@GRing.opp int_ZmodType n%N)) : distn_scope. Arguments absz m%distn_scope. Local Notation "`| m |" := (absz m) : nat_scope. Module intOrdered. Section intOrdered. Implicit Types m n p : int. Local Coercion Posz : nat >-> int. Local Notation normz m := (absz m)%:Z. Definition lez m n := match m, n with | Posz m', Posz n' => (m' <= n')%N | Posz m', Negz n' => false | Negz m', Posz n' => true | Negz m', Negz n' => (n' <= m')%N end. Definition ltz m n := match m, n with | Posz m', Posz n' => (m' < n')%N | Posz m', Negz n' => false | Negz m', Posz n' => true | Negz m', Negz n' => (n' < m')%N end. 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_mul m n : lez 0 m -> lez 0 n -> lez 0 (m * n). Proof. by case: m n => [] m [] n. 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. case: (intP m); case: (intP n)=> // {}m {}n /=; rewrite ?ltnS -?opprD ?opprB ?subzSS; case: leqP=> // hmn; by [ rewrite subzn // | rewrite -opprB subzn ?(ltnW hmn) //; move: hmn; rewrite -subn_gt0; case: (_ - _)%N]. 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 m n : (ltz m n) = (n != m) && (lez m n). Proof. by move: m n => [] m [] n //=; rewrite (ltn_neqAle, leq_eqVlt) // eq_sym. Qed. 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_distrLatticeType := DistrLatticeType int intOrdered.Mixin. Canonical int_orderType := OrderType int intOrdered.lez_total. Canonical int_numDomainType := NumDomainType int intOrdered.Mixin. Canonical int_normedZmodType := NormedZmodType int int intOrdered.Mixin. Canonical int_realDomainType := [realDomainType of int]. Section intOrderedTheory. Local Coercion Posz : nat >-> int. Implicit Types m n p : nat. Implicit Types x y z : int. 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 ltNge lez_nat. Qed. Definition ltez_nat := (lez_nat, ltz_nat). Lemma leNz_nat m n : (- m%:Z <= n). Proof. by case: m. Qed. Lemma ltNz_nat m n : (- m%:Z < n) = (m != 0%N) || (n != 0%N). Proof. by move: m n=> [|?] []. Qed. Definition lteNz_nat := (leNz_nat, ltNz_nat). Lemma lezN_nat m n : (m%:Z <= - n%:Z) = (m == 0%N) && (n == 0%N). Proof. by move: m n=> [|?] []. Qed. Lemma ltzN_nat m n : (m%:Z < - n%:Z) = false. Proof. by move: m n=> [|?] []. Qed. Lemma le0z_nat n : 0 <= n :> int. Proof. by []. Qed. Lemma lez0_nat n : n <= 0 :> int = (n == 0%N :> nat). Proof. by elim: n. Qed. Definition ltezN_nat := (lezN_nat, ltzN_nat). Definition ltez_natE := (ltez_nat, lteNz_nat, ltezN_nat, le0z_nat, lez0_nat). Lemma gtz0_ge1 x : (0 < x) = (1 <= x). Proof. by case: (intP x). Qed. Lemma lez_add1r x y : (1 + x <= y) = (x < y). Proof. by rewrite -subr_gt0 gtz0_ge1 lter_sub_addr. Qed. Lemma lez_addr1 x y : (x + 1 <= y) = (x < y). Proof. by rewrite addrC lez_add1r. Qed. Lemma ltz_add1r x y : (x < 1 + y) = (x <= y). Proof. by rewrite -lez_add1r ler_add2l. Qed. Lemma ltz_addr1 x y : (x < y + 1) = (x <= y). Proof. by rewrite -lez_addr1 ler_add2r. Qed. End intOrderedTheory. Bind Scope ring_scope with int. (* definition of intmul *) Definition intmul (R : zmodType) (x : R) (n : int) := nosimpl match n with | Posz n => (x *+ n)%R | Negz n => (x *- (n.+1))%R end. Notation "*~%R" := (@intmul _) (at level 0, format " *~%R") : ring_scope. Notation "x *~ n" := (intmul x n) (at level 40, left associativity, format "x *~ n") : ring_scope. Notation intr := ( *~%R 1). Notation "n %:~R" := (1 *~ n)%R (at level 2, left associativity, format "n %:~R") : ring_scope. Lemma pmulrn (R : zmodType) (x : R) (n : nat) : x *+ n = x *~ n%:Z. Proof. by []. Qed. Lemma nmulrn (R : zmodType) (x : R) (n : nat) : x *- n = x *~ - n%:Z. Proof. by case: n=> [] //; rewrite ?oppr0. Qed. Section ZintLmod. Definition zmodule (M : Type) : Type := M. Local Notation "M ^z" := (zmodule M) (at level 2, format "M ^z") : type_scope. Local Coercion Posz : nat >-> int. Variable M : zmodType. Implicit Types m n : int. Implicit Types x y z : M. Fact mulrzA_C m n x : (x *~ n) *~ m = x *~ (m * n). Proof. elim: m=> [|m _|m _]; elim: n=> [|n _|n _]; rewrite /intmul //=; rewrite ?(muln0, mulr0n, mul0rn, oppr0, mulNrn, opprK) //; do ?by rewrite mulnC mulrnA. * by rewrite -mulrnA mulnC. * by rewrite -mulrnA. Qed. Fact mulrzAC m n x : (x *~ n) *~ m = (x *~ m) *~ n. Proof. by rewrite !mulrzA_C mulrC. Qed. Fact mulr1z (x : M) : x *~ 1 = x. Proof. by []. Qed. Fact mulrzDr m : {morph ( *~%R^~ m : M -> M) : x y / x + y}. Proof. by elim: m=> [|m _|m _] x y; rewrite ?addr0 /intmul //= ?mulrnDl // opprD. Qed. Lemma mulrzBl_nat (m n : nat) x : x *~ (m%:Z - n%:Z) = x *~ m - x *~ n. Proof. case: (leqP m n)=> hmn; rewrite /intmul //=. rewrite addrC -{1}[m:int]opprK -opprD subzn //. rewrite -{2}[n](@subnKC m)// mulrnDr opprD addrA subrr sub0r. by case hdmn: (_ - _)%N=> [|dmn] /=; first by rewrite mulr0n oppr0. have hnm := ltnW hmn. rewrite -{2}[m](@subnKC n)// mulrnDr addrAC subrr add0r. by rewrite subzn. Qed. Fact mulrzDl x : {morph *~%R x : m n / m + n}. Proof. elim=> [|m _|m _]; elim=> [|n _|n _]; rewrite /intmul //=; rewrite -?(opprD) ?(add0r, addr0, mulrnDr, subn0) //. * by rewrite -/(intmul _ _) mulrzBl_nat. * by rewrite -/(intmul _ _) addrC mulrzBl_nat addrC. * by rewrite -addnS -addSn mulrnDr. Qed. Definition Mint_LmodMixin := @LmodMixin _ [zmodType of M] (fun n x => x *~ n) mulrzA_C mulr1z mulrzDr mulrzDl. Canonical Mint_LmodType := LmodType int M^z Mint_LmodMixin. Lemma scalezrE n x : n *: (x : M^z) = x *~ n. Proof. by []. Qed. Lemma mulrzA x m n : x *~ (m * n) = x *~ m *~ n. Proof. by rewrite -!scalezrE scalerA mulrC. Qed. Lemma mulr0z x : x *~ 0 = 0. Proof. by []. Qed. Lemma mul0rz n : 0 *~ n = 0 :> M. Proof. by rewrite -scalezrE scaler0. Qed. Lemma mulrNz x n : x *~ (- n) = - (x *~ n). Proof. by rewrite -scalezrE scaleNr. Qed. Lemma mulrN1z x : x *~ (- 1) = - x. Proof. by rewrite -scalezrE scaleN1r. Qed. Lemma mulNrz x n : (- x) *~ n = - (x *~ n). Proof. by rewrite -scalezrE scalerN. Qed. Lemma mulrzBr x m n : x *~ (m - n) = x *~ m - x *~ n. Proof. by rewrite -scalezrE scalerBl. Qed. Lemma mulrzBl x y n : (x - y) *~ n = x *~ n - y *~ n. Proof. by rewrite -scalezrE scalerBr. Qed. Lemma mulrz_nat (n : nat) x : x *~ n%:R = x *+ n. Proof. by rewrite -scalezrE scaler_nat. Qed. Lemma mulrz_sumr : forall x I r (P : pred I) F, x *~ (\sum_(i <- r | P i) F i) = \sum_(i <- r | P i) x *~ F i. Proof. by rewrite -/M^z; apply: scaler_suml. Qed. Lemma mulrz_suml : forall n I r (P : pred I) (F : I -> M), (\sum_(i <- r | P i) F i) *~ n= \sum_(i <- r | P i) F i *~ n. Proof. by rewrite -/M^z; apply: scaler_sumr. Qed. Canonical intmul_additive x := Additive (@mulrzBr x). End ZintLmod. Lemma ffunMzE (I : finType) (M : zmodType) (f : {ffun I -> M}) z x : (f *~ z) x = f x *~ z. Proof. by case: z => n; rewrite ?ffunE ffunMnE. Qed. Lemma intz (n : int) : n%:~R = n. Proof. elim: n=> //= n ihn; rewrite /intmul /=. by rewrite -addn1 mulrnDr /= PoszD -ihn. by rewrite nmulrn intS opprD mulrzDl ihn. Qed. Lemma natz (n : nat) : n%:R = n%:Z :> int. Proof. by rewrite pmulrn intz. Qed. Section RintMod. Local Coercion Posz : nat >-> int. Variable R : ringType. Implicit Types m n : int. Implicit Types x y z : R. Lemma mulrzAl n x y : (x *~ n) * y = (x * y) *~ n. Proof. by elim: n=> //= *; rewrite ?mul0r ?mulr0z // /intmul /= -mulrnAl -?mulNr. Qed. Lemma mulrzAr n x y : x * (y *~ n) = (x * y) *~ n. Proof. by elim: n=> //= *; rewrite ?mulr0 ?mulr0z // /intmul /= -mulrnAr -?mulrN. Qed. Lemma mulrzl x n : n%:~R * x = x *~ n. Proof. by rewrite mulrzAl mul1r. Qed. Lemma mulrzr x n : x * n%:~R = x *~ n. Proof. by rewrite mulrzAr mulr1. Qed. Lemma mulNrNz n x : (-x) *~ (-n) = x *~ n. Proof. by rewrite mulNrz mulrNz opprK. Qed. Lemma mulrbz x (b : bool) : x *~ b = (if b then x else 0). Proof. by case: b. Qed. Lemma intrD m n : (m + n)%:~R = m%:~R + n%:~R :> R. Proof. exact: mulrzDl. Qed. Lemma intrM m n : (m * n)%:~R = m%:~R * n%:~R :> R. Proof. by rewrite mulrzA -mulrzr. Qed. Lemma intmul1_is_rmorphism : rmorphism ( *~%R (1 : R)). Proof. by do ?split; move=> // x y /=; rewrite ?intrD ?mulrNz ?intrM. Qed. Canonical intmul1_rmorphism := RMorphism intmul1_is_rmorphism. Lemma mulr2z n : n *~ 2 = n + n. Proof. exact: mulr2n. Qed. End RintMod. Lemma mulrzz m n : m *~ n = m * n. Proof. by rewrite -mulrzr intz. Qed. Lemma mulz2 n : n * 2%:Z = n + n. Proof. by rewrite -mulrzz. Qed. Lemma mul2z n : 2%:Z * n = n + n. Proof. by rewrite mulrC -mulrzz. Qed. Section LMod. Variable R : ringType. Variable V : (lmodType R). Local Coercion Posz : nat >-> int. Implicit Types m n : int. Implicit Types x y z : R. Implicit Types u v w : V. Lemma scaler_int n v : n%:~R *: v = v *~ n. Proof. elim: n=> [|n ihn|n ihn]; first by rewrite scale0r. by rewrite intS !mulrzDl scalerDl ihn scale1r. by rewrite intS opprD !mulrzDl scalerDl ihn scaleN1r. Qed. Lemma scalerMzl a v n : (a *: v) *~ n = (a *~ n) *: v. Proof. by rewrite -mulrzl -scaler_int scalerA. Qed. Lemma scalerMzr a v n : (a *: v) *~ n = a *: (v *~ n). Proof. by rewrite -!scaler_int !scalerA mulrzr mulrzl. Qed. End LMod. Lemma mulrz_int (M : zmodType) (n : int) (x : M) : x *~ n%:~R = x *~ n. Proof. by rewrite -scalezrE scaler_int. Qed. Section MorphTheory. Local Coercion Posz : nat >-> int. Section Additive. Variables (U V : zmodType) (f : {additive U -> V}). Lemma raddfMz n : {morph f : x / x *~ n}. Proof. case: n=> n x /=; first exact: raddfMn. by rewrite NegzE !mulrNz; apply: raddfMNn. Qed. End Additive. Section Multiplicative. Variables (R S : ringType) (f : {rmorphism R -> S}). Lemma rmorphMz : forall n, {morph f : x / x *~ n}. Proof. exact: raddfMz. Qed. Lemma rmorph_int : forall n, f n%:~R = n%:~R. Proof. by move=> n; rewrite rmorphMz rmorph1. Qed. End Multiplicative. Section Linear. Variable R : ringType. Variables (U V : lmodType R) (f : {linear U -> V}). Lemma linearMn : forall n, {morph f : x / x *~ n}. Proof. exact: raddfMz. Qed. End Linear. Lemma raddf_int_scalable (aV rV : lmodType int) (f : {additive aV -> rV}) : scalable f. Proof. by move=> z u; rewrite -[z]intz !scaler_int raddfMz. Qed. Section Zintmul1rMorph. Variable R : ringType. Lemma commrMz (x y : R) n : GRing.comm x y -> GRing.comm x (y *~ n). Proof. by rewrite /GRing.comm=> com_xy; rewrite mulrzAr mulrzAl com_xy. Qed. Lemma commr_int (x : R) n : GRing.comm x n%:~R. Proof. exact/commrMz/commr1. Qed. End Zintmul1rMorph. Section ZintBigMorphism. Variable R : ringType. Lemma sumMz : forall I r (P : pred I) F, (\sum_(i <- r | P i) F i)%N%:~R = \sum_(i <- r | P i) ((F i)%:~R) :> R. Proof. by apply: big_morph=> // x y; rewrite !pmulrn -rmorphD. Qed. Lemma prodMz : forall I r (P : pred I) F, (\prod_(i <- r | P i) F i)%N%:~R = \prod_(i <- r | P i) ((F i)%:~R) :> R. Proof. by apply: big_morph=> // x y; rewrite !pmulrn PoszM -rmorphM. Qed. End ZintBigMorphism. Section Frobenius. Variable R : ringType. Implicit Types x y : R. Variable p : nat. Hypothesis charFp : p \in [char R]. Local Notation "x ^f" := (Frobenius_aut charFp x). Lemma Frobenius_autMz x n : (x *~ n)^f = x^f *~ n. Proof. case: n=> n /=; first exact: Frobenius_autMn. by rewrite !NegzE !mulrNz Frobenius_autN Frobenius_autMn. Qed. Lemma Frobenius_aut_int n : (n%:~R)^f = n%:~R. Proof. by rewrite Frobenius_autMz Frobenius_aut1. Qed. End Frobenius. Section NumMorphism. Section PO. Variables (R : numDomainType). Implicit Types n m : int. Implicit Types x y : R. Lemma rmorphzP (f : {rmorphism int -> R}) : f =1 ( *~%R 1). Proof. move=> n; wlog : n / 0 <= n; case: n=> [] n //; do ?exact. by rewrite NegzE !rmorphN=>->. move=> _; elim: n=> [|n ihn]; first by rewrite rmorph0. by rewrite intS !rmorphD !rmorph1 ihn. Qed. (* intmul and ler/ltr *) 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: leW_mono (ler_pmulz2r _). Qed. Lemma ler_nmulz2r n (hn : n < 0) : {mono *~%R^~ n : x y /~ x <= y :> R}. Proof. move=> x y /=; rewrite -![_ *~ n]mulNrNz. 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: 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. Lemma ler_wnmulz2r n (hn : n <= 0) : {homo *~%R^~ n : x y /~ x <= y :> R}. Proof. by move=> x y xy /=; rewrite -ler_opp2 -!mulrNz ler_wpmulz2r // oppr_ge0. Qed. Lemma mulrz_ge0 x n (x0 : 0 <= x) (n0 : 0 <= n) : 0 <= x *~ n. Proof. by rewrite -(mul0rz _ n) ler_wpmulz2r. Qed. Lemma mulrz_le0 x n (x0 : x <= 0) (n0 : n <= 0) : 0 <= x *~ n. Proof. by rewrite -(mul0rz _ n) ler_wnmulz2r. Qed. Lemma mulrz_ge0_le0 x n (x0 : 0 <= x) (n0 : n <= 0) : x *~ n <= 0. Proof. by rewrite -(mul0rz _ n) ler_wnmulz2r. Qed. Lemma mulrz_le0_ge0 x n (x0 : x <= 0) (n0 : 0 <= n) : x *~ n <= 0. Proof. by rewrite -(mul0rz _ n) ler_wpmulz2r. Qed. Lemma pmulrz_lgt0 x n (n0 : 0 < n) : 0 < x *~ n = (0 < x). Proof. by rewrite -(mul0rz _ n) ltr_pmulz2r // mul0rz. Qed. Lemma nmulrz_lgt0 x n (n0 : n < 0) : 0 < x *~ n = (x < 0). Proof. by rewrite -(mul0rz _ n) ltr_nmulz2r // mul0rz. Qed. Lemma pmulrz_llt0 x n (n0 : 0 < n) : x *~ n < 0 = (x < 0). Proof. by rewrite -(mul0rz _ n) ltr_pmulz2r // mul0rz. Qed. Lemma nmulrz_llt0 x n (n0 : n < 0) : x *~ n < 0 = (0 < x). Proof. by rewrite -(mul0rz _ n) ltr_nmulz2r // mul0rz. Qed. Lemma pmulrz_lge0 x n (n0 : 0 < n) : 0 <= x *~ n = (0 <= x). Proof. by rewrite -(mul0rz _ n) ler_pmulz2r // mul0rz. Qed. Lemma nmulrz_lge0 x n (n0 : n < 0) : 0 <= x *~ n = (x <= 0). Proof. by rewrite -(mul0rz _ n) ler_nmulz2r // mul0rz. Qed. Lemma pmulrz_lle0 x n (n0 : 0 < n) : x *~ n <= 0 = (x <= 0). Proof. by rewrite -(mul0rz _ n) ler_pmulz2r // mul0rz. Qed. Lemma nmulrz_lle0 x n (n0 : n < 0) : x *~ n <= 0 = (0 <= x). Proof. by rewrite -(mul0rz _ n) ler_nmulz2r // mul0rz. Qed. Lemma ler_wpmulz2l x (hx : 0 <= x) : {homo *~%R x : x y / x <= y}. Proof. by move=> m n /= hmn; rewrite -subr_ge0 -mulrzBr mulrz_ge0 // subr_ge0. Qed. Lemma ler_wnmulz2l x (hx : x <= 0) : {homo *~%R x : x y /~ x <= y}. Proof. by move=> m n /= hmn; rewrite -subr_ge0 -mulrzBr mulrz_le0 // subr_le0. Qed. Lemma ler_pmulz2l x (hx : 0 < x) : {mono *~%R x : x y / x <= y}. Proof. move=> m n /=; rewrite real_mono ?num_real // => {m n}. by move=> m n /= hmn; rewrite -subr_gt0 -mulrzBr pmulrz_lgt0 // subr_gt0. Qed. Lemma ler_nmulz2l x (hx : x < 0) : {mono *~%R x : x y /~ x <= y}. Proof. move=> m n /=; rewrite real_nmono ?num_real // => {m n}. 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: leW_mono (ler_pmulz2l _). Qed. Lemma ltr_nmulz2l x (hx : x < 0) : {mono *~%R x : x y /~ x < y}. 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. Lemma nmulrz_rgt0 x n (x0 : x < 0) : 0 < x *~ n = (n < 0). Proof. by rewrite -(mulr0z x) ltr_nmulz2l. Qed. Lemma pmulrz_rlt0 x n (x0 : 0 < x) : x *~ n < 0 = (n < 0). Proof. by rewrite -(mulr0z x) ltr_pmulz2l. Qed. Lemma nmulrz_rlt0 x n (x0 : x < 0) : x *~ n < 0 = (0 < n). Proof. by rewrite -(mulr0z x) ltr_nmulz2l. Qed. Lemma pmulrz_rge0 x n (x0 : 0 < x) : 0 <= x *~ n = (0 <= n). Proof. by rewrite -(mulr0z x) ler_pmulz2l. Qed. Lemma nmulrz_rge0 x n (x0 : x < 0) : 0 <= x *~ n = (n <= 0). Proof. by rewrite -(mulr0z x) ler_nmulz2l. Qed. Lemma pmulrz_rle0 x n (x0 : 0 < x) : x *~ n <= 0 = (n <= 0). Proof. by rewrite -(mulr0z x) ler_pmulz2l. Qed. Lemma nmulrz_rle0 x n (x0 : x < 0) : x *~ n <= 0 = (0 <= n). 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: inc_inj y z; apply: ler_pmulz2l. Qed. Lemma ler_int m n : (m%:~R <= n%:~R :> R) = (m <= n). Proof. by rewrite ler_pmulz2l. Qed. Lemma ltr_int m n : (m%:~R < n%:~R :> R) = (m < n). Proof. by rewrite ltr_pmulz2l. Qed. Lemma eqr_int m n : (m%:~R == n%:~R :> R) = (m == n). Proof. by rewrite (inj_eq (mulrIz _)) ?oner_eq0. Qed. Lemma ler0z n : (0 <= n%:~R :> R) = (0 <= n). Proof. by rewrite pmulrz_rge0. Qed. Lemma ltr0z n : (0 < n%:~R :> R) = (0 < n). Proof. by rewrite pmulrz_rgt0. Qed. Lemma lerz0 n : (n%:~R <= 0 :> R) = (n <= 0). Proof. by rewrite pmulrz_rle0. Qed. Lemma ltrz0 n : (n%:~R < 0 :> R) = (n < 0). Proof. by rewrite pmulrz_rlt0. Qed. Lemma ler1z (n : int) : (1 <= n%:~R :> R) = (1 <= n). Proof. by rewrite -[1]/(1%:~R) ler_int. Qed. Lemma ltr1z (n : int) : (1 < n%:~R :> R) = (1 < n). Proof. by rewrite -[1]/(1%:~R) ltr_int. Qed. Lemma lerz1 n : (n%:~R <= 1 :> R) = (n <= 1). Proof. by rewrite -[1]/(1%:~R) ler_int. Qed. Lemma ltrz1 n : (n%:~R < 1 :> R) = (n < 1). Proof. by rewrite -[1]/(1%:~R) ltr_int. Qed. Lemma intr_eq0 n : (n%:~R == 0 :> R) = (n == 0). Proof. by rewrite -(mulr0z 1) (inj_eq (mulrIz _)) // oner_eq0. Qed. Lemma mulrz_eq0 x n : (x *~ n == 0) = ((n == 0) || (x == 0)). Proof. by rewrite -mulrzl mulf_eq0 intr_eq0. Qed. 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 le_total. Qed. Hint Resolve realz : core. Definition intr_inj := @mulrIz 1 (oner_neq0 R). End PO. End NumMorphism. End MorphTheory. Arguments intr_inj {R} [x1 x2]. Definition exprz (R : unitRingType) (x : R) (n : int) := nosimpl match n with | Posz n => x ^+ n | Negz n => x ^- (n.+1) end. Notation "x ^ n" := (exprz x n) : ring_scope. Section ExprzUnitRing. Variable R : unitRingType. Implicit Types x y : R. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Lemma exprnP x (n : nat) : x ^+ n = x ^ n. Proof. by []. Qed. Lemma exprnN x (n : nat) : x ^- n = x ^ -n%:Z. Proof. by case: n=> //; rewrite oppr0 expr0 invr1. Qed. Lemma expr0z x : x ^ 0 = 1. Proof. by []. Qed. Lemma expr1z x : x ^ 1 = x. Proof. by []. Qed. Lemma exprN1 x : x ^ (-1) = x^-1. Proof. by []. Qed. Lemma invr_expz x n : (x ^ n)^-1 = x ^ (- n). Proof. by case: (intP n)=> // [|m]; rewrite ?opprK ?expr0z ?invr1 // invrK. Qed. Lemma exprz_inv x n : (x^-1) ^ n = x ^ (- n). Proof. by case: (intP n)=> // m; rewrite -[_ ^ (- _)]exprVn ?opprK ?invrK. Qed. Lemma exp1rz n : 1 ^ n = 1 :> R. Proof. by case: (intP n)=> // m; rewrite -?exprz_inv ?invr1; apply: expr1n. Qed. Lemma exprSz x (n : nat) : x ^ n.+1 = x * x ^ n. Proof. exact: exprS. Qed. Lemma exprSzr x (n : nat) : x ^ n.+1 = x ^ n * x. Proof. exact: exprSr. Qed. Fact exprzD_nat x (m n : nat) : x ^ (m%:Z + n) = x ^ m * x ^ n. Proof. exact: exprD. Qed. Fact exprzD_Nnat x (m n : nat) : x ^ (-m%:Z + -n%:Z) = x ^ (-m%:Z) * x ^ (-n%:Z). Proof. by rewrite -opprD -!exprz_inv exprzD_nat. Qed. Lemma exprzD_ss x m n : (0 <= m) && (0 <= n) || (m <= 0) && (n <= 0) -> x ^ (m + n) = x ^ m * x ^ n. Proof. case: (intP m)=> {m} [|m|m]; case: (intP n)=> {n} [|n|n] //= _; by rewrite ?expr0z ?mul1r ?exprzD_nat ?exprzD_Nnat ?sub0r ?addr0 ?mulr1. Qed. Lemma exp0rz n : 0 ^ n = (n == 0)%:~R :> R. Proof. by case: (intP n)=> // m; rewrite -?exprz_inv ?invr0 exprSz mul0r. Qed. Lemma commrXz x y n : GRing.comm x y -> GRing.comm x (y ^ n). Proof. rewrite /GRing.comm; elim: n x y=> [|n ihn|n ihn] x y com_xy //=. * by rewrite expr0z mul1r mulr1. * by rewrite -exprnP commrX //. rewrite -exprz_inv -exprnP commrX //. case: (boolP (y \is a GRing.unit))=> uy; last by rewrite invr_out. by apply/eqP; rewrite (can2_eq (mulrVK _) (mulrK _)) // -mulrA com_xy mulKr. Qed. Lemma exprMz_comm x y n : x \is a GRing.unit -> y \is a GRing.unit -> GRing.comm x y -> (x * y) ^ n = x ^ n * y ^ n. Proof. move=> ux uy com_xy; elim: n => [|n _|n _]; first by rewrite expr0z mulr1. by rewrite -!exprnP exprMn_comm. rewrite -!exprnN -!exprVn com_xy -exprMn_comm ?invrM//. exact/commrV/commr_sym/commrV. Qed. Lemma commrXz_wmulls x y n : 0 <= n -> GRing.comm x y -> (x * y) ^ n = x ^ n * y ^ n. Proof. move=> n0 com_xy; elim: n n0 => [|n _|n _] //; first by rewrite expr0z mulr1. by rewrite -!exprnP exprMn_comm. Qed. Lemma unitrXz x n (ux : x \is a GRing.unit) : x ^ n \is a GRing.unit. Proof. case: (intP n)=> {n} [|n|n]; rewrite ?expr0z ?unitr1 ?unitrX //. by rewrite -invr_expz unitrV unitrX. 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_le=> n m hnm. by rewrite addrC hnm commrXz //; exact/commr_sym/commrXz. case: (intP m) hnm=> {m} [|m|m]; rewrite ?mul1r ?add0r //; case: (intP n)=> {n} [|n|n _]; rewrite ?mulr1 ?addr0 //; do ?by rewrite exprzD_ss. rewrite -invr_expz subzSS !exprSzr invrM ?unitrX // -mulrA mulVKr //. case: (leqP n m)=> [|/ltnW] hmn; rewrite -{2}(subnK hmn) exprzD_nat -subzn //. by rewrite mulrK ?unitrX. by rewrite invrM ?unitrXz // mulVKr ?unitrXz // -opprB -invr_expz. Qed. Lemma exprz_exp x m n : (x ^ m) ^ n = (x ^ (m * n)). Proof. wlog: n / 0 <= n. by case: n=> [n -> //|n]; rewrite ?NegzE mulrN -?invr_expz=> -> /=. elim: n x m=> [|n ihn|n ihn] x m // _; first by rewrite mulr0 !expr0z. rewrite exprSz ihn // intS mulrDr mulr1 exprzD_ss //. by case: (intP m)=> // m'; rewrite ?oppr_le0 //. Qed. Lemma exprzAC x m n : (x ^ m) ^ n = (x ^ n) ^ m. Proof. by rewrite !exprz_exp mulrC. Qed. Lemma exprz_out x n (nux : x \isn't a GRing.unit) (hn : 0 <= n) : x ^ (- n) = x ^ n. Proof. by case: (intP n) hn=> //= m; rewrite -exprnN -exprVn invr_out. Qed. End ExprzUnitRing. Section Exprz_Zint_UnitRing. Variable R : unitRingType. Implicit Types x y : R. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Lemma exprz_pmulzl x m n : 0 <= n -> (x *~ m) ^ n = x ^ n *~ (m ^ n). Proof. by elim: n=> [|n ihn|n _] // _; rewrite !exprSz ihn // mulrzAr mulrzAl -mulrzA. Qed. Lemma exprz_pintl m n (hn : 0 <= n) : m%:~R ^ n = (m ^ n)%:~R :> R. Proof. by rewrite exprz_pmulzl // exp1rz. Qed. Lemma exprzMzl x m n (ux : x \is a GRing.unit) (um : m%:~R \is a @GRing.unit R): (x *~ m) ^ n = (m%:~R ^ n) * x ^ n :> R. Proof. rewrite -[x *~ _]mulrzl exprMz_comm //; exact/commr_sym/commr_int. Qed. Lemma expNrz x n : (- x) ^ n = (-1) ^ n * x ^ n :> R. Proof. case: n=> [] n; rewrite ?NegzE; first exact: exprNn. by rewrite -!exprz_inv !invrN invr1; apply: exprNn. Qed. Lemma unitr_n0expz x n : n != 0 -> (x ^ n \is a GRing.unit) = (x \is a GRing.unit). Proof. by case: n => *; rewrite ?NegzE -?exprz_inv ?unitrX_pos ?unitrV ?lt0n. Qed. Lemma intrV (n : int) : n \in [:: 0; 1; -1] -> n%:~R ^-1 = n%:~R :> R. Proof. by case: (intP n)=> // [|[]|[]] //; rewrite ?rmorphN ?invrN (invr0, invr1). Qed. Lemma rmorphXz (R' : unitRingType) (f : {rmorphism R -> R'}) n : {in GRing.unit, {morph f : x / x ^ n}}. Proof. by case: n => n x Ux; rewrite ?rmorphV ?rpredX ?rmorphX. Qed. End Exprz_Zint_UnitRing. Section ExprzIdomain. Variable R : idomainType. Implicit Types x y : R. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Lemma expfz_eq0 x n : (x ^ n == 0) = (n != 0) && (x == 0). Proof. by case: n=> n; rewrite ?NegzE -?exprz_inv ?expf_eq0 ?lt0n ?invr_eq0. Qed. Lemma expfz_neq0 x n : x != 0 -> x ^ n != 0. Proof. by move=> x_nz; rewrite expfz_eq0; apply/nandP; right. Qed. Lemma exprzMl x y n (ux : x \is a GRing.unit) (uy : y \is a GRing.unit) : (x * y) ^ n = x ^ n * y ^ n. Proof. by rewrite exprMz_comm //; apply: mulrC. Qed. Lemma expfV (x : R) (i : int) : (x ^ i) ^-1 = (x ^-1) ^ i. Proof. by rewrite invr_expz exprz_inv. Qed. End ExprzIdomain. Section ExprzField. Variable F : fieldType. Implicit Types x y : F. Implicit Types m n : int. Local Coercion Posz : nat >-> int. Lemma expfzDr x m n : x != 0 -> x ^ (m + n) = x ^ m * x ^ n. Proof. by move=> hx; rewrite exprzDr ?unitfE. Qed. Lemma expfz_n0addr x m n : m + n != 0 -> x ^ (m + n) = x ^ m * x ^ n. Proof. have [-> hmn|nx0 _] := eqVneq x 0; last exact: expfzDr. rewrite !exp0rz (negPf hmn). case: (eqVneq m 0) hmn => [->|]; rewrite (mul0r, mul1r) //. by rewrite add0r=> /negPf->. Qed. Lemma expfzMl x y n : (x * y) ^ n = x ^ n * y ^ n. Proof. have [->|/negPf n0] := eqVneq n 0; first by rewrite !expr0z mulr1. case: (boolP ((x * y) == 0)); rewrite ?mulf_eq0. by case/pred2P=> ->; rewrite ?(mul0r, mulr0, exp0rz, n0). by case/norP=> x0 y0; rewrite exprzMl ?unitfE. Qed. Lemma fmorphXz (R : unitRingType) (f : {rmorphism F -> R}) n : {morph f : x / x ^ n}. Proof. by case: n => n x; rewrite ?fmorphV rmorphX. Qed. End ExprzField. Section ExprzOrder. Variable R : realFieldType. Implicit Types x y : R. Implicit Types m n : int. Local Coercion Posz : nat >-> int. (* ler and exprz *) Lemma exprz_ge0 n x (hx : 0 <= x) : (0 <= x ^ n). Proof. by case: n=> n; rewrite ?NegzE -?invr_expz ?invr_ge0 ?exprn_ge0. Qed. Lemma exprz_gt0 n x (hx : 0 < x) : (0 < x ^ n). Proof. by case: n=> n; rewrite ?NegzE -?invr_expz ?invr_gt0 ?exprn_gt0. Qed. Definition exprz_gte0 := (exprz_ge0, exprz_gt0). Lemma ler_wpiexpz2l x (x0 : 0 <= x) (x1 : x <= 1) : {in >= 0 &, {homo (exprz x) : x y /~ x <= y}}. Proof. move=> [] m [] n; rewrite -!topredE /= ?oppr_cp0 ?ltz_nat // => _ _. by rewrite lez_nat -?exprnP=> /ler_wiexpn2l; apply. Qed. Lemma ler_wniexpz2l x (x0 : 0 <= x) (x1 : x <= 1) : {in < 0 &, {homo (exprz x) : x y /~ x <= y}}. Proof. move=> [] m [] n; rewrite ?NegzE -!topredE /= ?oppr_cp0 ?ltz_nat // => _ _. rewrite ler_opp2 lez_nat -?invr_expz=> hmn; move: (x0). rewrite le0r=> /predU1P [->|lx0]; first by rewrite !exp0rz invr0. by rewrite lef_pinv -?topredE /= ?exprz_gt0 // ler_wiexpn2l. Qed. Fact ler_wpeexpz2l x (x1 : 1 <= x) : {in >= 0 &, {homo (exprz x) : x y / x <= y}}. Proof. move=> [] m [] n; rewrite -!topredE /= ?oppr_cp0 ?ltz_nat // => _ _. by rewrite lez_nat -?exprnP=> /ler_weexpn2l; apply. Qed. 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 ?(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)=> [|/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. Lemma pexprz_eq1 x n (x0 : 0 <= x) : (x ^ n == 1) = ((n == 0) || (x == 1)). Proof. case: n=> n; rewrite ?NegzE -?exprz_inv ?oppr_eq0 pexprn_eq1 // ?invr_eq1 //. by rewrite invr_ge0. Qed. Lemma ieexprIz x (x0 : 0 < x) (nx1 : x != 1) : injective (exprz x). Proof. apply: wlog_lt=> // m n hmn; first by move=> hmn'; rewrite hmn. move=> /(f_equal ( *%R^~ (x ^ (- n)))). 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: (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: (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: (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: (leW_nmono_in (ler_niexpz2l _ _)). Qed. Lemma ler_eexpz2l x (x1 : 1 < x) : {mono (exprz x) : x y / x <= y}. Proof. 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: (leW_mono (ler_eexpz2l _)). Qed. Lemma ler_wpexpz2r n (hn : 0 <= n) : {in >= 0 & , {homo ((@exprz R)^~ n) : x y / x <= y}}. Proof. by case: n hn=> // n _; apply: ler_expn2r. Qed. 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 _]ltW // oppr_cp0. Qed. Lemma pexpIrz n (n0 : n != 0) : {in >= 0 &, injective ((@exprz R)^~ n)}. Proof. move=> x y; rewrite ![_ \in _]le0r=> /predU1P [-> _ /eqP|hx]. by rewrite exp0rz ?(negPf n0) eq_sym expfz_eq0=> /andP [_ /eqP->]. case/predU1P=> [-> /eqP|hy]. by rewrite exp0rz ?(negPf n0) expfz_eq0=> /andP [_ /eqP]. move=> /(f_equal ( *%R^~ (y ^ (- n)))) /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 _]le_eqVlt => /predU1P [-> _ /eqP|hx]. by rewrite exp0rz ?(negPf n0) eq_sym expfz_eq0=> /andP [_ /eqP->]. case/predU1P=> [-> /eqP|hy]. by rewrite exp0rz ?(negPf n0) expfz_eq0=> /andP [_ /eqP]. move=> /(f_equal ( *%R^~ (y ^ (- n)))) /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: 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: 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: 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: leW_nmono_in (ler_nexpz2r _). Qed. Lemma eqr_expz2 n x y : n != 0 -> 0 <= x -> 0 <= y -> (x ^ n == y ^ n) = (x == y). Proof. by move=> *; rewrite (inj_in_eq (pexpIrz _)). Qed. End ExprzOrder. Local Notation sgr := Num.sg. Section Sgz. Variable R : numDomainType. Implicit Types x y z : R. Implicit Types m n p : int. Local Coercion Posz : nat >-> int. Definition sgz x : int := if x == 0 then 0 else if x < 0 then -1 else 1. Lemma sgz_def x : sgz x = (-1) ^+ (x < 0)%R *+ (x != 0). 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 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 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. Lemma sgzN1 : sgz (-1 : R) = -1. Proof. by rewrite ltr0_sgz // ltrN10. Qed. Definition sgzE := (sgz0, sgz1, sgzN1). Lemma sgz_sgr x : sgz (sgr x) = sgz x. Proof. by rewrite !(fun_if sgz) !sgzE. Qed. Lemma normr_sgz x : `|sgz x| = (x != 0). Proof. by rewrite sgz_def -mulr_natr normrMsign normr_nat natz. Qed. Lemma normr_sg x : `|sgr x| = (x != 0)%:~R. Proof. by rewrite sgr_def -mulr_natr normrMsign normr_nat. Qed. End Sgz. Section MoreSgz. Variable R : numDomainType. Lemma sgz_int m : sgz (m%:~R : R) = sgz m. Proof. by rewrite /sgz intr_eq0 ltrz0. Qed. Lemma sgrz (n : int) : sgr n = sgz n. Proof. by rewrite sgrEz intz. Qed. Lemma intr_sg m : (sgr m)%:~R = sgr (m%:~R) :> R. Proof. by rewrite sgrz -sgz_int -sgrEz. Qed. Lemma sgz_id (x : R) : sgz (sgz x) = sgz x. Proof. by rewrite !(fun_if (@sgz _)). Qed. End MoreSgz. Section SgzReal. Variable R : realDomainType. Implicit Types x y z : R. Implicit Types m n p : int. Local Coercion Posz : nat >-> int. Lemma sgz_cp0 x : ((sgz x == 1) = (0 < x)) * ((sgz x == -1) = (x < 0)) * ((sgz x == 0) = (x == 0)). Proof. by rewrite /sgz; case: ltrgtP. Qed. Variant sgz_val x : bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> R -> R -> int -> Set := | SgzNull of x = 0 : sgz_val x true true true true false false true false false true false false true false false true false false 0 0 0 | SgzPos of x > 0 : sgz_val x false false true false false true false false true false false true false false true false false true x 1 1 | SgzNeg of x < 0 : sgz_val x false true false false true false false true false false true false false true false false true false (-x) (-1) (-1). Lemma sgzP x : sgz_val x (0 == x) (x <= 0) (0 <= x) (x == 0) (x < 0) (0 < x) (0 == sgr x) (-1 == sgr x) (1 == sgr x) (sgr x == 0) (sgr x == -1) (sgr x == 1) (0 == sgz x) (-1 == sgz x) (1 == sgz 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 !leNgt; case: ltrgt0P; constructor. Qed. Lemma sgzN x : sgz (- x) = - sgz x. Proof. by rewrite /sgz oppr_eq0 oppr_lt0; case: ltrgtP. Qed. Lemma mulz_sg x : sgz x * sgz x = (x != 0)%:~R. Proof. by case: sgzP; rewrite ?(mulr0, mulr1, mulrNN). Qed. Lemma mulz_sg_eq1 x y : (sgz x * sgz y == 1) = (x != 0) && (sgz x == sgz y). Proof. do 2?case: sgzP=> _; rewrite ?(mulr0, mulr1, mulrN1, opprK, oppr0, eqxx); by rewrite ?[0 == 1]eq_sym ?oner_eq0 //= eqr_oppLR oppr0 oner_eq0. Qed. Lemma mulz_sg_eqN1 x y : (sgz x * sgz y == -1) = (x != 0) && (sgz x == - sgz y). Proof. by rewrite -eqr_oppLR -mulrN -sgzN mulz_sg_eq1. Qed. (* Lemma muls_eqA x y z : sgr x != 0 -> *) (* (sgr y * sgr z == sgr x) = ((sgr y * sgr x == sgr z) && (sgr z != 0)). *) (* Proof. by do 3!case: sgrP=> _. Qed. *) Lemma sgzM x y : sgz (x * y) = sgz x * sgz y. Proof. case: (sgzP x)=> hx; first by rewrite hx ?mul0r sgz0. case: (sgzP y)=> hy; first by rewrite hy !mulr0 sgz0. by apply/eqP; rewrite mul1r sgz_cp0 pmulr_rgt0. by apply/eqP; rewrite mul1r sgz_cp0 nmulr_llt0. case: (sgzP y)=> hy; first by rewrite hy !mulr0 sgz0. by apply/eqP; rewrite mulr1 sgz_cp0 nmulr_rlt0. by apply/eqP; rewrite mulN1r opprK sgz_cp0 nmulr_rgt0. Qed. Lemma sgzX (n : nat) x : sgz (x ^+ n) = (sgz x) ^+ n. Proof. by elim: n => [|n IHn]; rewrite ?sgz1 // !exprS sgzM IHn. Qed. Lemma sgz_eq0 x : (sgz x == 0) = (x == 0). Proof. by rewrite sgz_cp0. Qed. Lemma sgz_odd (n : nat) x : x != 0 -> (sgz x) ^+ n = (sgz x) ^+ (odd n). Proof. by case: sgzP => //=; rewrite ?expr1n // signr_odd. Qed. Lemma sgz_gt0 x : (sgz x > 0) = (x > 0). Proof. by case: sgzP. Qed. Lemma sgz_lt0 x : (sgz x < 0) = (x < 0). Proof. by case: sgzP. Qed. Lemma sgz_ge0 x : (sgz x >= 0) = (x >= 0). Proof. by case: sgzP. Qed. Lemma sgz_le0 x : (sgz x <= 0) = (x <= 0). Proof. by case: sgzP. Qed. Lemma sgz_smul x y : sgz (y *~ (sgz x)) = (sgz x) * (sgz y). Proof. by rewrite -mulrzl sgzM -sgrEz sgz_sgr. Qed. Lemma sgrMz m x : sgr (x *~ m) = sgr x *~ sgr m. Proof. by rewrite -mulrzr sgrM -intr_sg mulrzr. Qed. End SgzReal. Lemma sgz_eq (R R' : realDomainType) (x : R) (y : R') : (sgz x == sgz y) = ((x == 0) == (y == 0)) && ((0 < x) == (0 < y)). Proof. by do 2!case: sgzP. Qed. Lemma intr_sign (R : ringType) s : ((-1) ^+ s)%:~R = (-1) ^+ s :> R. Proof. exact: rmorph_sign. Qed. Section Absz. Implicit Types m n p : int. Open Scope nat_scope. Local Coercion Posz : nat >-> int. Lemma absz_nat (n : nat) : `|n| = n. Proof. by []. Qed. Lemma abszE (m : int) : `|m| = `|m|%R :> int. Proof. by []. Qed. Lemma absz0 : `|0%R| = 0. Proof. by []. Qed. Lemma abszN m : `|- m| = `|m|. Proof. by case: (normrN m). Qed. Lemma absz_eq0 m : (`|m| == 0) = (m == 0%R). Proof. by case: (intP m). Qed. Lemma absz_gt0 m : (`|m| > 0) = (m != 0%R). Proof. by case: (intP m). Qed. Lemma absz1 : `|1%R| = 1. Proof. by []. Qed. Lemma abszN1 : `|-1%R| = 1. Proof. by []. Qed. Lemma absz_id m : `|(`|m|)| = `|m|. Proof. by []. Qed. Lemma abszM m1 m2 : `|(m1 * m2)%R| = `|m1| * `|m2|. Proof. by case: m1 m2 => [[|m1]|m1] [[|m2]|m2] //=; rewrite ?mulnS mulnC. Qed. Lemma abszX (n : nat) m : `|m ^+ n| = `|m| ^ n. Proof. by elim: n => // n ihn; rewrite exprS expnS abszM ihn. Qed. Lemma absz_sg m : `|sgr m| = (m != 0%R). Proof. by case: (intP m). Qed. Lemma gez0_abs m : (0 <= m)%R -> `|m| = m :> int. Proof. by case: (intP m). Qed. Lemma gtz0_abs m : (0 < m)%R -> `|m| = m :> int. Proof. by case: (intP m). Qed. Lemma lez0_abs m : (m <= 0)%R -> `|m| = - m :> int. Proof. by case: (intP m). Qed. Lemma ltz0_abs m : (m < 0)%R -> `|m| = - m :> int. Proof. by case: (intP m). Qed. Lemma absz_sign s : `|(-1) ^+ s| = 1. Proof. by rewrite abszX exp1n. Qed. Lemma abszMsign s m : `|((-1) ^+ s * m)%R| = `|m|. Proof. by rewrite abszM absz_sign mul1n. Qed. Lemma mulz_sign_abs m : ((-1) ^+ (m < 0)%R * `|m|%:Z)%R = m. Proof. by rewrite abszE mulr_sign_norm. Qed. Lemma mulz_Nsign_abs m : ((-1) ^+ (0 < m)%R * `|m|%:Z)%R = - m. Proof. by rewrite abszE mulr_Nsign_norm. Qed. Lemma intEsign m : m = ((-1) ^+ (m < 0)%R * `|m|%:Z)%R. Proof. exact: numEsign. Qed. Lemma abszEsign m : `|m|%:Z = ((-1) ^+ (m < 0)%R * m)%R. Proof. exact: normrEsign. Qed. Lemma intEsg m : m = (sgz m * `|m|%:Z)%R. Proof. by rewrite -sgrz -numEsg. Qed. Lemma abszEsg m : (`|m|%:Z = sgz m * m)%R. Proof. by rewrite -sgrz -normrEsg. Qed. End Absz. Module Export IntDist. Notation "m - n" := (@GRing.add int_ZmodType m%N (@GRing.opp int_ZmodType n%N)) : distn_scope. Arguments absz m%distn_scope. Notation "`| m |" := (absz m) : nat_scope. Coercion Posz : nat >-> int. Section Distn. Open Scope nat_scope. Implicit Type m : int. Implicit Types n d : nat. Lemma distnC m1 m2 : `|m1 - m2| = `|m2 - m1|. Proof. by rewrite -opprB abszN. Qed. Lemma distnDl d n1 n2 : `|d + n1 - (d + n2)| = `|n1 - n2|. Proof. by rewrite !PoszD opprD addrCA -addrA addKr. Qed. Lemma distnDr d n1 n2 : `|n1 + d - (n2 + d)| = `|n1 - n2|. Proof. by rewrite -!(addnC d) distnDl. Qed. Lemma distnEr n1 n2 : n1 <= n2 -> `|n1 - n2| = n2 - n1. Proof. by move/subnK=> {1}<-; rewrite distnC PoszD addrK absz_nat. Qed. Lemma distnEl n1 n2 : n2 <= n1 -> `|n1 - n2| = n1 - n2. Proof. by move/distnEr <-; rewrite distnC. Qed. Lemma distn0 n : `|n - 0| = n. Proof. by rewrite subr0 absz_nat. Qed. Lemma dist0n n : `|0 - n| = n. Proof. by rewrite distnC distn0. Qed. Lemma distnn m : `|m - m| = 0. Proof. by rewrite subrr. Qed. Lemma distn_eq0 n1 n2 : (`|n1 - n2| == 0) = (n1 == n2). Proof. by rewrite absz_eq0 subr_eq0. Qed. Lemma distnS n : `|n - n.+1| = 1. Proof. exact: distnDr n 0 1. Qed. Lemma distSn n : `|n.+1 - n| = 1. Proof. exact: distnDr n 1 0. Qed. Lemma distn_eq1 n1 n2 : (`|n1 - n2| == 1) = (if n1 < n2 then n1.+1 == n2 else n1 == n2.+1). Proof. case: ltnP => [lt_n12 | le_n21]. by rewrite eq_sym -(eqn_add2r n1) distnEr ?subnK // ltnW. by rewrite -(eqn_add2r n2) distnEl ?subnK. Qed. Lemma leq_add_dist m1 m2 m3 : `|m1 - m3| <= `|m1 - m2| + `|m2 - m3|. Proof. by rewrite -lez_nat PoszD !abszE ler_dist_add. Qed. (* Most of this proof generalizes to all real-ordered rings. *) 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/leifP. wlog le_m31 : m1 m3 / (m3 <= m1)%R. 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 ?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 : `|n1 - n3| <= `|n1 - n2| + `|n2 - n3| ?= iff (n1 <= n2 <= n3) || (n3 <= n2 <= n1). Proof. exact: leqif_add_distz. Qed. Lemma sqrn_dist n1 n2 : `|n1 - n2| ^ 2 + 2 * (n1 * n2) = n1 ^ 2 + n2 ^ 2. Proof. wlog le_n21: n1 n2 / n2 <= n1. move=> IH; case/orP: (leq_total n2 n1) => /IH //. by rewrite (addnC (n2 ^ 2)) (mulnC n2) distnC. by rewrite distnEl ?sqrnB ?subnK ?nat_Cauchy. Qed. End Distn. End IntDist. Section NormInt. Variable R : numDomainType. 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|. Proof. by rewrite -mulrzl normrM -intr_norm mulrzl. Qed. Lemma expN1r (i : int) : (-1 : R) ^ i = (-1) ^+ `|i|. Proof. case: i => n; first by rewrite exprnP absz_nat. by rewrite NegzE abszN absz_nat -invr_expz expfV invrN1. Qed. End NormInt. Section PolyZintRing. Variable R : ringType. Implicit Types x y z: R. Implicit Types m n : int. Implicit Types i j k : nat. Implicit Types p q r : {poly R}. Lemma coefMrz p n i : (p *~ n)`_i = (p`_i *~ n). Proof. by case: n => n; rewrite ?NegzE (coefMNn, coefMn). Qed. Lemma polyCMz n : {morph (@polyC R) : c / c *~ n}. Proof. by case: (intP n) => // n' c; rewrite ?mulrNz ?polyCN polyCMn. Qed. Lemma hornerMz n p x : (p *~ n).[x] = p.[x] *~ n. Proof. by case: n => n; rewrite ?NegzE ?mulNzr ?(hornerN, hornerMn). Qed. Lemma horner_int n x : (n%:~R : {poly R}).[x] = n%:~R. Proof. by rewrite hornerMz hornerC. Qed. Lemma derivMz n p : (p *~ n)^`() = p^`() *~ n. Proof. by case: n => n; rewrite ?NegzE -?pmulrn (derivMn, derivMNn). Qed. Lemma mulpz p n : p *~ n = n%:~R *: p. Proof. by rewrite -mul_polyC polyCMz polyC1 mulrzl. Qed. End PolyZintRing. Section ZnatPred. Definition Znat := [qualify a n : int | 0 <= n]. Fact Znat_key : pred_key Znat. by []. Qed. Canonical Znat_keyd := KeyedQualifier Znat_key. Lemma Znat_def n : (n \is a Znat) = (0 <= n). Proof. by []. Qed. Lemma Znat_semiring_closed : semiring_closed Znat. Proof. by do 2?split => //; [apply: addr_ge0 | apply: mulr_ge0]. Qed. Canonical Znat_addrPred := AddrPred Znat_semiring_closed. Canonical Znat_mulrPred := MulrPred Znat_semiring_closed. Canonical Znat_semiringPred := SemiringPred Znat_semiring_closed. Lemma ZnatP (m : int) : reflect (exists n : nat, m = n) (m \is a Znat). Proof. by apply: (iffP idP) => [|[n -> //]]; case: m => // n; exists n. Qed. End ZnatPred. Section rpred. Lemma rpredMz M S (addS : @zmodPred M S) (kS : keyed_pred addS) m : {in kS, forall u, u *~ m \in kS}. Proof. by case: m => n u Su; rewrite ?rpredN ?rpredMn. Qed. Lemma rpred_int R S (ringS : @subringPred R S) (kS : keyed_pred ringS) m : m%:~R \in kS. Proof. by rewrite rpredMz ?rpred1. Qed. Lemma rpredZint (R : ringType) (M : lmodType R) S (addS : @zmodPred M S) (kS : keyed_pred addS) m : {in kS, forall u, m%:~R *: u \in kS}. Proof. by move=> u Su; rewrite /= scaler_int rpredMz. Qed. Lemma rpredXz R S (divS : @divrPred R S) (kS : keyed_pred divS) m : {in kS, forall x, x ^ m \in kS}. Proof. by case: m => n x Sx; rewrite ?rpredV rpredX. Qed. Lemma rpredXsign R S (divS : @divrPred R S) (kS : keyed_pred divS) n x : (x ^ ((-1) ^+ n) \in kS) = (x \in kS). Proof. by rewrite -signr_odd; case: (odd n); rewrite ?rpredV. Qed. End rpred. Notation "@ 'polyC_mulrz'" := (deprecate polyC_mulrz polyCMz) (at level 10, only parsing) : fun_scope. Notation polyC_mulrz := (@polyC_mulrz _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/ssrnum.v000066400000000000000000006771301375767750300222530ustar00rootroot00000000000000(* (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 ssrAC 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. To use this file, insert *) (* "Import Num.Theory." before your scripts. You can also "Import Num.Def." *) (* to enjoy shorter notations (e.g., minr instead of Num.min, lerif instead *) (* of Num.leif, etc.). *) (* *) (* * 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 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. *) (* *) (* * NormedZmodule (Zmodule with a norm) *) (* normedZmodType R *) (* == interface for a normed Zmodule structure indexed by *) (* numDomainType R. *) (* NormedZmodType R T m *) (* == pack the normed Zmodule mixin into a normedZmodType. *) (* The carrier T must have an integral domain structure. *) (* [normedZmodType R of T for S] *) (* == T-clone of the normedZmodType R structure S. *) (* [normedZmodType R of T] *) (* == clone of a canonical normedZmodType 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. *) (* *) (* * 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) *) (* realDomainType == interface for a real integral domain. *) (* [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. *) (* *) (* * ArchiField (A Real Field with the archimedean axiom) *) (* archiFieldType == interface for an archimedean field. *) (* ArchiFieldType T r *) (* == packs the archimedean 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. *) (* *) (* * 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 *) (* T. *) (* [rcfType of T for S] *) (* == T-clone of the realClosedFieldType structure S. *) (* *) (* The ordering symbols and notations (<, <=, >, >=, _ <= _ ?= iff _, *) (* _ < _ ?<= if _, >=<, 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. *) (* *) (* Over these structures, we have the following operations *) (* `|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.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 *) (* x >= 0, or 0 otherwise. *) (* For numeric algebraically closed fields we provide the generic definitions *) (* 'i == the imaginary number (:= sqrtC (-1)). *) (* 'Re z == the real component of z. *) (* 'Im z == the imaginary component of z. *) (* z^* == the complex conjugate of z (:= conjC z). *) (* sqrtC z == a nonnegative square root of z, i.e., 0 <= sqrt x if 0 <= x. *) (* n.-root z == more generally, for n > 0, an nth root of z, chosen with a *) (* minimal non-negative argument for n > 1 (i.e., with a *) (* maximal real part subject to a nonnegative imaginary part). *) (* Note that n.-root (-1) is a primitive 2nth root of unity, *) (* an thus not equal to -1 for n odd > 1 (this will be shown in *) (* file cyclotomic.v). *) (* *) (* - list of prefixes : *) (* p : positive *) (* n : negative *) (* sp : strictly positive *) (* sn : strictly negative *) (* i : interior = in [0, 1] or ]0, 1[ *) (* e : exterior = in [1, +oo[ or ]1; +oo[ *) (* w : non strict (weak) monotony *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope order_scope. Local Open Scope ring_scope. Import Order.TTheory GRing.Theory. Fact ring_display : unit. Proof. exact: tt. Qed. Module Num. Record normed_mixin_of (R T : zmodType) (Rorder : Order.POrder.mixin_of (Equality.class R)) (le_op := Order.POrder.le Rorder) := NormedMixin { norm_op : T -> R; _ : forall x y, le_op (norm_op (x + y)) (norm_op x + norm_op 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 : Order.POrder.mixin_of (Equality.class 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); }. Local Notation ring_for T b := (@GRing.Ring.Pack T b). Module NumDomain. Section ClassDef. Set Primitive Projections. Record class_of T := Class { base : GRing.IntegralDomain.class_of T; order_mixin : Order.POrder.mixin_of (Equality.class (ring_for T base)); normed_mixin : normed_mixin_of (ring_for T base) order_mixin; mixin : mixin_of normed_mixin; }. Unset Primitive Projections. 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). 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. Definition clone c of phant_id class 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 class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition porder_zmodType := @GRing.Zmodule.Pack porderType class. Definition porder_ringType := @GRing.Ring.Pack porderType class. Definition porder_comRingType := @GRing.ComRing.Pack porderType class. Definition porder_unitRingType := @GRing.UnitRing.Pack porderType class. Definition porder_comUnitRingType := @GRing.ComUnitRing.Pack porderType class. Definition porder_idomainType := @GRing.IntegralDomain.Pack porderType class. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion base : class_of >-> GRing.IntegralDomain.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. 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 porderType : type >-> Order.POrder.type. Canonical porderType. 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 _ _ 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. Local Notation num_for T b := (@NumDomain.Pack T b). Module NormedZmodule. Section ClassDef. Variable R : numDomainType. Set Primitive Projections. Record class_of (T : Type) := Class { base : GRing.Zmodule.class_of T; mixin : @normed_mixin_of R (@GRing.Zmodule.Pack T base) (NumDomain.class R); }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Zmodule.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. Definition pack b0 (m0 : @normed_mixin_of R (@GRing.Zmodule.Pack T b0) (NumDomain.class R)) := Pack phR (@Class T b0 m0). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. End ClassDef. (* TODO: Ideally,`numDomain_normedZmodType` should be located in *) (* `NumDomain_joins`. Currently, it's located here to make `hierarchy.ml` can *) (* recognize that `numDomainType` inherits `normedZmodType`. *) Definition numDomain_normedZmodType (R : numDomainType) : type (Phant R) := @Pack R (Phant R) R (Class (NumDomain.normed_mixin (NumDomain.class R))). Module Exports. Coercion base : class_of >-> GRing.Zmodule.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 numDomain_normedZmodType : NumDomain.type >-> type. Canonical numDomain_normedZmodType. Notation normedZmodType R := (type (Phant R)). Notation NormedZmodType R T m := (@pack _ (Phant R) T _ m). Notation NormedZmodMixin := Mixin. Notation "[ 'normedZmodType' R 'of' T 'for' cT ]" := (@clone _ (Phant R) T cT _ idfun) (at level 0, format "[ 'normedZmodType' R 'of' T 'for' cT ]") : form_scope. Notation "[ 'normedZmodType' R 'of' T ]" := (@clone _ (Phant R) T _ _ id) (at level 0, format "[ 'normedZmodType' R 'of' T ]") : form_scope. End Exports. End NormedZmodule. Import NormedZmodule.Exports. Module NumDomain_joins. Import NumDomain. Section NumDomain_joins. Variables (T : Type) (cT : type). Notation class := (class cT). (* Definition normedZmodType : normedZmodType cT := *) (* @NormedZmodule.Pack *) (* cT (Phant cT) cT *) (* (NormedZmodule.Class (NumDomain.normed_mixin class)). *) Notation normedZmodType := (NormedZmodule.numDomain_normedZmodType cT). Definition normedZmod_ringType := @GRing.Ring.Pack normedZmodType class. Definition normedZmod_comRingType := @GRing.ComRing.Pack normedZmodType class. Definition normedZmod_unitRingType := @GRing.UnitRing.Pack normedZmodType class. Definition normedZmod_comUnitRingType := @GRing.ComUnitRing.Pack normedZmodType class. Definition normedZmod_idomainType := @GRing.IntegralDomain.Pack normedZmodType class. Definition normedZmod_porderType := @Order.POrder.Pack ring_display normedZmodType class. End NumDomain_joins. Module Exports. (* Coercion normedZmodType : type >-> NormedZmodule.type. *) (* Canonical normedZmodType. *) Canonical normedZmod_ringType. Canonical normedZmod_comRingType. Canonical normedZmod_unitRingType. Canonical normedZmod_comUnitRingType. Canonical normedZmod_idomainType. Canonical normedZmod_porderType. End Exports. End NumDomain_joins. Export NumDomain_joins.Exports. Module Import Def. Definition normr (R : numDomainType) (T : normedZmodType R) : T -> R := nosimpl (norm_op (NormedZmodule.class T)). Arguments normr {R T} x. Notation ler := (@Order.le ring_display _) (only parsing). Notation "@ 'ler' R" := (@Order.le ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation ltr := (@Order.lt ring_display _) (only parsing). Notation "@ 'ltr' R" := (@Order.lt ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation ger := (@Order.ge ring_display _) (only parsing). Notation "@ 'ger' R" := (@Order.ge ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation gtr := (@Order.gt ring_display _) (only parsing). Notation "@ 'gtr' R" := (@Order.gt ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation lerif := (@Order.leif ring_display _) (only parsing). Notation "@ 'lerif' R" := (@Order.leif ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation lterif := (@Order.lteif ring_display _) (only parsing). Notation "@ 'lteif' R" := (@Order.lteif ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation comparabler := (@Order.comparable ring_display _) (only parsing). Notation "@ 'comparabler' R" := (@Order.comparable ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation maxr := (@Order.max ring_display _). Notation "@ 'maxr' R" := (@Order.max ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Notation minr := (@Order.min ring_display _). Notation "@ 'minr' R" := (@Order.min ring_display R) (at level 10, R at level 8, only parsing) : fun_scope. Section Def. Context {R : numDomainType}. 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]. 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 lteif := lterif (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. Notation real := Rreal. Module Keys. Section Keys. Variable R : numDomainType. Fact Rpos_key : pred_key (@pos R). Proof. by []. Qed. Definition Rpos_keyed := KeyedQualifier Rpos_key. Fact Rneg_key : pred_key (@real R). Proof. by []. Qed. Definition Rneg_keyed := KeyedQualifier Rneg_key. 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. End Keys. End Keys. (* (Exported) symbolic syntax. *) Module Import Syntax. Import Def Keys. Notation "`| x |" := (norm x) : ring_scope. Notation "<=%R" := le : fun_scope. Notation ">=%R" := ge : fun_scope. Notation "<%R" := lt : fun_scope. Notation ">%R" := gt : fun_scope. Notation "=<%R" := comparable : fun_scope. Notation "><%R" := (fun x y => ~~ (comparable x y)) : fun_scope. Notation "<= y" := (ge y) : ring_scope. Notation "<= y :> T" := (<= (y : T)) (only parsing) : ring_scope. Notation ">= y" := (le y) : ring_scope. Notation ">= y :> T" := (>= (y : T)) (only parsing) : ring_scope. Notation "< y" := (gt y) : ring_scope. Notation "< y :> T" := (< (y : T)) (only parsing) : ring_scope. Notation "> y" := (lt y) : ring_scope. Notation "> y :> T" := (> (y : T)) (only parsing) : ring_scope. Notation "x <= y" := (le x y) : ring_scope. Notation "x <= y :> T" := ((x : T) <= (y : T)) (only parsing) : 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)) (only parsing) : 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 < y ?<= 'if' C" := (lterif x y C) : ring_scope. Notation "x < y ?<= 'if' C :> R" := ((x : R) < (y : R) ?<= if C) (only parsing) : ring_scope. Notation ">=< y" := [pred x | comparable x y] : ring_scope. Notation ">=< y :> T" := (>=< (y : T)) (only parsing) : ring_scope. Notation "x >=< y" := (comparable x y) : ring_scope. Notation ">< y" := [pred x | ~~ comparable x y] : ring_scope. Notation ">< y :> T" := (>< (y : 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. Variable R : numDomainType. Definition real_axiom : Prop := forall x : R, x \is real. Definition archimedean_axiom : Prop := forall x : R, exists ub, `|x| < ub%:R. Definition real_closed_axiom : Prop := forall (p : {poly R}) (a b : R), a <= b -> p.[a] <= 0 <= p.[b] -> exists2 x, a <= x <= b & root p x. End ExtensionAxioms. (* The rest of the numbers interface hierarchy. *) Module NumField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : NumDomain.class_of R; mixin : GRing.Field.mixin_of (num_for R base); }. Unset Primitive Projections. 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. Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition pack := 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 class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. Definition porder_fieldType := @GRing.Field.Pack porderType class. Definition normedZmod_fieldType := @GRing.Field.Pack normedZmodType class. Definition numDomain_fieldType := @GRing.Field.Pack numDomainType class. End ClassDef. Module Exports. 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. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Canonical porder_fieldType. Canonical normedZmod_fieldType. Canonical numDomain_fieldType. Notation numFieldType := type. Notation "[ 'numFieldType' 'of' T ]" := (@pack T _ _ id _ _ id) (at level 0, format "[ 'numFieldType' 'of' T ]") : form_scope. End Exports. End NumField. Import NumField.Exports. Module ClosedField. Section ClassDef. Record imaginary_mixin_of (R : numDomainType) := ImaginaryMixin { imaginary : R; conj_op : {rmorphism R -> R}; _ : imaginary ^+ 2 = - 1; _ : forall x, x * conj_op x = `|x| ^+ 2; }. Set Primitive Projections. Record class_of R := Class { 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); }. Unset Primitive Projections. 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. Variables (T : Type) (cT : type). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. 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 class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition numFieldType := @NumField.Pack cT class. Definition decFieldType := @GRing.DecidableField.Pack cT class. Definition closedFieldType := @GRing.ClosedField.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. Definition porder_decFieldType := @GRing.DecidableField.Pack porderType class. Definition normedZmod_decFieldType := @GRing.DecidableField.Pack normedZmodType class. Definition numDomain_decFieldType := @GRing.DecidableField.Pack numDomainType class. Definition numField_decFieldType := @GRing.DecidableField.Pack numFieldType class. Definition porder_closedFieldType := @GRing.ClosedField.Pack porderType class. Definition normedZmod_closedFieldType := @GRing.ClosedField.Pack normedZmodType class. Definition numDomain_closedFieldType := @GRing.ClosedField.Pack numDomainType class. Definition numField_closedFieldType := @GRing.ClosedField.Pack numFieldType class. End ClassDef. Module Exports. 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. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion decFieldType : type >-> GRing.DecidableField.type. Canonical decFieldType. Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion closedFieldType : type >-> GRing.ClosedField.type. Canonical closedFieldType. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Canonical porder_decFieldType. Canonical normedZmod_decFieldType. Canonical numDomain_decFieldType. Canonical numField_decFieldType. Canonical porder_closedFieldType. Canonical normedZmod_closedFieldType. Canonical numDomain_closedFieldType. Canonical numField_closedFieldType. Notation numClosedFieldType := type. 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. Notation "[ 'numClosedFieldType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'numClosedFieldType' 'of' T ]") : form_scope. End Exports. End ClosedField. Import ClosedField.Exports. Module RealDomain. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : NumDomain.class_of R; nmixin : Order.Lattice.mixin_of base; lmixin : Order.DistrLattice.mixin_of (Order.Lattice.Class nmixin); tmixin : Order.Total.mixin_of base; }. Unset Primitive Projections. 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.DistrLattice.Class _ _ (lmixin c)) (@tmixin _ c). 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. Definition pack := fun bT b & phant_id (NumDomain.class bT) (b : NumDomain.class_of T) => fun mT n l m & phant_id (@Order.Total.class ring_display mT) (@Order.Total.Class T (@Order.DistrLattice.Class T (@Order.Lattice.Class T b n) l) m) => Pack (@Class T b n l m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition latticeType := @Order.Lattice.Pack ring_display cT class. Definition distrLatticeType := @Order.DistrLattice.Pack ring_display cT class. Definition orderType := @Order.Total.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. Definition zmod_latticeType := @Order.Lattice.Pack ring_display zmodType class. Definition ring_latticeType := @Order.Lattice.Pack ring_display ringType class. Definition comRing_latticeType := @Order.Lattice.Pack ring_display comRingType class. Definition unitRing_latticeType := @Order.Lattice.Pack ring_display unitRingType class. Definition comUnitRing_latticeType := @Order.Lattice.Pack ring_display comUnitRingType class. Definition idomain_latticeType := @Order.Lattice.Pack ring_display idomainType class. Definition normedZmod_latticeType := @Order.Lattice.Pack ring_display normedZmodType class. Definition numDomain_latticeType := @Order.Lattice.Pack ring_display numDomainType class. Definition zmod_distrLatticeType := @Order.DistrLattice.Pack ring_display zmodType class. Definition ring_distrLatticeType := @Order.DistrLattice.Pack ring_display ringType class. Definition comRing_distrLatticeType := @Order.DistrLattice.Pack ring_display comRingType class. Definition unitRing_distrLatticeType := @Order.DistrLattice.Pack ring_display unitRingType class. Definition comUnitRing_distrLatticeType := @Order.DistrLattice.Pack ring_display comUnitRingType class. Definition idomain_distrLatticeType := @Order.DistrLattice.Pack ring_display idomainType class. Definition normedZmod_distrLatticeType := @Order.DistrLattice.Pack ring_display normedZmodType class. Definition numDomain_distrLatticeType := @Order.DistrLattice.Pack ring_display numDomainType class. Definition zmod_orderType := @Order.Total.Pack ring_display zmodType class. Definition ring_orderType := @Order.Total.Pack ring_display ringType class. Definition comRing_orderType := @Order.Total.Pack ring_display comRingType class. Definition unitRing_orderType := @Order.Total.Pack ring_display unitRingType class. Definition comUnitRing_orderType := @Order.Total.Pack ring_display comUnitRingType class. Definition idomain_orderType := @Order.Total.Pack ring_display idomainType class. Definition normedZmod_orderType := @Order.Total.Pack ring_display normedZmodType class. Definition numDomain_orderType := @Order.Total.Pack ring_display numDomainType class. 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. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion latticeType : type >-> Order.Lattice.type. Canonical latticeType. Coercion distrLatticeType : type >-> Order.DistrLattice.type. Canonical distrLatticeType. Coercion orderType : type >-> Order.Total.type. Canonical orderType. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Canonical zmod_latticeType. Canonical ring_latticeType. Canonical comRing_latticeType. Canonical unitRing_latticeType. Canonical comUnitRing_latticeType. Canonical idomain_latticeType. Canonical normedZmod_latticeType. Canonical numDomain_latticeType. Canonical zmod_distrLatticeType. Canonical ring_distrLatticeType. Canonical comRing_distrLatticeType. Canonical unitRing_distrLatticeType. Canonical comUnitRing_distrLatticeType. Canonical idomain_distrLatticeType. Canonical normedZmod_distrLatticeType. Canonical numDomain_distrLatticeType. Canonical zmod_orderType. Canonical ring_orderType. Canonical comRing_orderType. Canonical unitRing_orderType. Canonical comUnitRing_orderType. Canonical idomain_orderType. Canonical normedZmod_orderType. Canonical numDomain_orderType. Notation realDomainType := type. Notation "[ 'realDomainType' 'of' T ]" := (@pack T _ _ id _ _ _ _ id) (at level 0, format "[ 'realDomainType' 'of' T ]") : form_scope. End Exports. End RealDomain. Import RealDomain.Exports. Module RealField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : NumField.class_of R; nmixin : Order.Lattice.mixin_of base; lmixin : Order.DistrLattice.mixin_of (Order.Lattice.Class nmixin); tmixin : Order.Total.mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> NumField.class_of. Local Coercion base2 R (c : class_of R) : RealDomain.class_of R := @RealDomain.Class _ _ (nmixin c) (lmixin c) (@tmixin R c). 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. Definition pack := fun bT (b : NumField.class_of T) & phant_id (NumField.class bT) b => fun mT n l t & phant_id (RealDomain.class mT) (@RealDomain.Class T b n l t) => Pack (@Class T b n l t). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition latticeType := @Order.Lattice.Pack ring_display cT class. Definition distrLatticeType := @Order.DistrLattice.Pack ring_display cT class. Definition orderType := @Order.Total.Pack ring_display cT class. Definition realDomainType := @RealDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition numFieldType := @NumField.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. Definition field_latticeType := @Order.Lattice.Pack ring_display fieldType class. Definition field_distrLatticeType := @Order.DistrLattice.Pack ring_display fieldType class. Definition field_orderType := @Order.Total.Pack ring_display fieldType class. Definition field_realDomainType := @RealDomain.Pack fieldType class. Definition numField_latticeType := @Order.Lattice.Pack ring_display numFieldType class. Definition numField_distrLatticeType := @Order.DistrLattice.Pack ring_display numFieldType class. Definition numField_orderType := @Order.Total.Pack ring_display numFieldType class. Definition numField_realDomainType := @RealDomain.Pack numFieldType class. End ClassDef. Module Exports. Coercion base : class_of >-> NumField.class_of. Coercion base2 : class_of >-> RealDomain.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion latticeType : type >-> Order.Lattice.type. Canonical latticeType. Coercion distrLatticeType : type >-> Order.DistrLattice.type. Canonical distrLatticeType. 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. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Canonical field_latticeType. Canonical field_distrLatticeType. Canonical field_orderType. Canonical field_realDomainType. Canonical numField_latticeType. Canonical numField_distrLatticeType. Canonical numField_orderType. Canonical numField_realDomainType. Notation realFieldType := type. Notation "[ 'realFieldType' 'of' T ]" := (@pack T _ _ id _ _ _ _ id) (at level 0, format "[ 'realFieldType' 'of' T ]") : form_scope. End Exports. End RealField. Import RealField.Exports. Module ArchimedeanField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : RealField.class_of R; mixin : archimedean_axiom (num_for R base) }. Unset Primitive Projections. Local Coercion base : class_of >-> RealField.class_of. 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. 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 => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition latticeType := @Order.Lattice.Pack ring_display cT class. Definition distrLatticeType := @Order.DistrLattice.Pack ring_display cT class. Definition orderType := @Order.Total.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition realDomainType := @RealDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition numFieldType := @NumField.Pack cT class. Definition realFieldType := @RealField.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. End ClassDef. Module Exports. Coercion base : class_of >-> RealField.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion latticeType : type >-> Order.Lattice.type. Canonical latticeType. Coercion distrLatticeType : type >-> Order.DistrLattice.type. Canonical distrLatticeType. Coercion orderType : type >-> Order.Total.type. Canonical orderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion realDomainType : type >-> RealDomain.type. Canonical realDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion realFieldType : type >-> RealField.type. Canonical realFieldType. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Notation archiFieldType := type. Notation ArchiFieldType T m := (@pack T _ m _ _ id _ id). Notation "[ 'archiFieldType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'archiFieldType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'archiFieldType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'archiFieldType' 'of' T ]") : form_scope. End Exports. End ArchimedeanField. Import ArchimedeanField.Exports. Module RealClosedField. Section ClassDef. Set Primitive Projections. Record class_of R := Class { base : RealField.class_of R; mixin : real_closed_axiom (num_for R base) }. Unset Primitive Projections. Local Coercion base : class_of >-> RealField.class_of. 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. 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 => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition comRingType := @GRing.ComRing.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition comUnitRingType := @GRing.ComUnitRing.Pack cT class. Definition idomainType := @GRing.IntegralDomain.Pack cT class. Definition porderType := @Order.POrder.Pack ring_display cT class. Definition latticeType := @Order.Lattice.Pack ring_display cT class. Definition distrLatticeType := @Order.DistrLattice.Pack ring_display cT class. Definition orderType := @Order.Total.Pack ring_display cT class. Definition numDomainType := @NumDomain.Pack cT class. Definition realDomainType := @RealDomain.Pack cT class. Definition fieldType := @GRing.Field.Pack cT class. Definition numFieldType := @NumField.Pack cT class. Definition realFieldType := @RealField.Pack cT class. Definition normedZmodType := NormedZmodType numDomainType cT class. End ClassDef. Module Exports. Coercion base : class_of >-> RealField.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. 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 porderType : type >-> Order.POrder.type. Canonical porderType. Coercion latticeType : type >-> Order.Lattice.type. Canonical latticeType. Coercion distrLatticeType : type >-> Order.DistrLattice.type. Canonical distrLatticeType. Coercion orderType : type >-> Order.Total.type. Canonical orderType. Coercion numDomainType : type >-> NumDomain.type. Canonical numDomainType. Coercion realDomainType : type >-> RealDomain.type. Canonical realDomainType. Coercion fieldType : type >-> GRing.Field.type. Canonical fieldType. Coercion numFieldType : type >-> NumField.type. Canonical numFieldType. Coercion realFieldType : type >-> RealField.type. Canonical realFieldType. Coercion normedZmodType : type >-> NormedZmodule.type. Canonical normedZmodType. Notation rcfType := Num.RealClosedField.type. Notation RcfType T m := (@pack T _ m _ _ id _ id). Notation "[ 'rcfType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'rcfType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'rcfType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'rcfType' 'of' T ]") : form_scope. End Exports. End RealClosedField. Import RealClosedField.Exports. (* The elementary theory needed to support the definition of the derived *) (* operations for the extensions described above. *) Module Import Internals. Section NormedZmodule. Variables (R : numDomainType) (V : normedZmodType R). Implicit Types (l : R) (x y : V). 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: V x => ? [? []]. 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 NormedZmodule. 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. Lemma ger_leVge x y : 0 <= x -> 0 <= y -> (x <= y) || (y <= x). Proof. by case: R x y => ? [? ? ? []]. 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. (* Basic consequences (just enough to get predicate closure properties). *) Lemma ger0_def x : (0 <= x) = (`|x| == x). Proof. by rewrite ler_def subr0. Qed. Lemma subr_ge0 x y : (0 <= x - y) = (y <= x). Proof. by rewrite ger0_def -ler_def. Qed. Lemma oppr_ge0 x : (0 <= - x) = (x <= 0). Proof. by rewrite -sub0r subr_ge0. Qed. Lemma ler01 : 0 <= 1 :> R. Proof. 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 lt_def oner_neq0 ler01. Qed. Lemma le0r x : (0 <= x) = (x == 0) || (0 < x). 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 ltW ?addr0 ?addr_gt0. Qed. Lemma pmulr_rgt0 x y : 0 < x -> (0 < x * y) = (0 < y). Proof. rewrite !lt_def !ger0_def normrM mulf_eq0 negb_or => /andP[x_neq0 /eqP->]. by rewrite x_neq0 (inj_eq (mulfI x_neq0)). Qed. (* Closure properties of the real predicates. *) Lemma posrE x : (x \is pos) = (0 < x). Proof. by []. Qed. Lemma nnegrE x : (x \is nneg) = (0 <= x). Proof. by []. Qed. Lemma realE x : (x \is real) = (0 <= x) || (x <= 0). Proof. by []. Qed. Fact pos_divr_closed : divr_closed (@pos R). Proof. split=> [|x y x_gt0 y_gt0]; rewrite posrE ?ltr01 //. have [Uy|/invr_out->] := boolP (y \is a GRing.unit); last by rewrite pmulr_rgt0. by rewrite -(pmulr_rgt0 _ y_gt0) mulrC divrK. Qed. Canonical pos_mulrPred := MulrPred pos_divr_closed. Canonical pos_divrPred := DivrPred pos_divr_closed. Fact nneg_divr_closed : divr_closed (@nneg R). Proof. split=> [|x y]; rewrite !nnegrE ?ler01 ?le0r // -!posrE. case/predU1P=> [-> _ | x_gt0]; first by rewrite mul0r eqxx. by case/predU1P=> [-> | y_gt0]; rewrite ?invr0 ?mulr0 ?eqxx // orbC rpred_div. Qed. 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: lexx | apply: addr_ge0]. Qed. Canonical nneg_addrPred := AddrPred nneg_addr_closed. Canonical nneg_semiringPred := SemiringPred nneg_divr_closed. Fact real_oppr_closed : oppr_closed (@real R). Proof. by move=> x; rewrite /= !realE oppr_ge0 orbC -!oppr_ge0 opprK. Qed. 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 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. case/orP: Ry => [y_ge0 | y_le0]; first by rewrite realE -nnegrE rpredD. by rewrite realE -[y]opprK orbC -oppr_ge0 opprB !subr_ge0 ger_leVge ?oppr_ge0. Qed. Canonical real_addrPred := AddrPred real_addr_closed. Canonical real_zmodPred := ZmodPred real_oppr_closed. Fact real_divr_closed : divr_closed (@real R). Proof. split=> [|x y Rx Ry]; first by rewrite realE ler01. without loss{Rx} x_ge0: x / 0 <= x. case/orP: Rx => [? | x_le0]; first exact. by rewrite -rpredN -mulNr; apply; rewrite ?oppr_ge0. without loss{Ry} y_ge0: y / 0 <= y; last by rewrite realE -nnegrE rpred_div. case/orP: Ry => [? | y_le0]; first exact. by rewrite -rpredN -mulrN -invrN; apply; rewrite ?oppr_ge0. Qed. Canonical real_mulrPred := MulrPred real_divr_closed. Canonical real_smulrPred := SmulrPred real_divr_closed. Canonical real_divrPred := DivrPred real_divr_closed. Canonical real_sdivrPred := SdivrPred real_divr_closed. Canonical real_semiringPred := SemiringPred real_divr_closed. Canonical real_subringPred := SubringPred real_divr_closed. Canonical real_divringPred := DivringPred real_divr_closed. End NumDomain. Lemma num_real (R : realDomainType) (x : R) : x \is real. Proof. exact: le_total. Qed. Fact archi_bound_subproof (R : archiFieldType) : archimedean_axiom R. Proof. by case: R => ? []. Qed. Section RealClosed. Variable R : rcfType. Lemma poly_ivt : real_closed_axiom R. Proof. by case: R => ? []. Qed. Fact sqrtr_subproof (x : R) : exists2 y, 0 <= y & (if 0 <= x then y ^+ 2 == x else y == 0) : bool. Proof. case x_ge0: (0 <= x); last by exists 0. have le0x1: 0 <= x + 1 by rewrite -nnegrE rpredD ?rpred1. have [|y /andP[y_ge0 _]] := @poly_ivt ('X^2 - x%:P) _ _ le0x1. rewrite !hornerE -subr_ge0 add0r opprK x_ge0 -expr2 sqrrD mulr1. by rewrite addrAC !addrA addrK -nnegrE !rpredD ?rpredX ?rpred1. by rewrite rootE !hornerE subr_eq0; exists y. Qed. End RealClosed. End Internals. Module PredInstances. Canonical pos_mulrPred. Canonical pos_divrPred. Canonical nneg_addrPred. Canonical nneg_mulrPred. Canonical nneg_divrPred. Canonical nneg_semiringPred. Canonical real_addrPred. Canonical real_opprPred. Canonical real_zmodPred. Canonical real_mulrPred. Canonical real_smulrPred. Canonical real_divrPred. Canonical real_sdivrPred. Canonical real_semiringPred. Canonical real_subringPred. Canonical real_divringPred. End PredInstances. Module Import ExtraDef. Definition archi_bound {R} x := sval (sigW (@archi_bound_subproof R x)). Definition sqrtr {R} x := s2val (sig2W (@sqrtr_subproof R x)). End ExtraDef. Notation bound := archi_bound. Notation sqrt := sqrtr. Module Import Theory. Section NumIntegralDomainTheory. Variable R : numDomainType. Implicit Types (V : normedZmodType R) (x y z t : R). (* Lemmas from the signature (reexported from internals). *) 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 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 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 definitions. *) 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. Lemma realE x : (x \is real) = (0 <= x) || (x <= 0). Proof. by []. Qed. (* General properties of <= and < *) 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. Proof. by rewrite lt0r; case/andP. 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. Lemma pmulr_rge0 x y : 0 < x -> (0 <= x * y) = (0 <= y). Proof. by rewrite !le0r mulf_eq0; case: eqP => // [-> /negPf[] | _ /pmulr_rgt0->]. Qed. (* Integer comparisons and characteristic 0. *) Lemma ler01 : 0 <= 1 :> R. Proof. exact: ler01. Qed. Lemma ltr01 : 0 < 1 :> R. Proof. exact: ltr01. Qed. Lemma ler0n n : 0 <= n%:R :> R. Proof. by rewrite -nnegrE rpred_nat. Qed. Hint Resolve ler01 ltr01 ler0n : core. Lemma ltr0Sn n : 0 < n.+1%:R :> R. Proof. by elim: n => // n; apply: addr_gt0. Qed. Lemma ltr0n n : (0 < n%:R :> R) = (0 < n)%N. 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 // gt_eqF. Qed. Lemma char_num : [char R] =i pred0. Proof. by case=> // p /=; rewrite !inE pnatr_eq0 andbF. Qed. (* Properties of the norm. *) 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 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|. 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 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 (@norm R R) : x / x ^-1}}. Proof. move=> x ux; apply: (mulrI (normr_unit ux)). by rewrite -normrM !divrr ?normr1 ?normr_unit. Qed. Lemma normrN1 : `|-1 : R| = 1. Proof. 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 ltxx. Qed. Lemma big_real x0 op I (P : pred I) F (s : seq I) : {in real &, forall x y, op x y \is real} -> x0 \is real -> {in P, forall i, F i \is real} -> \big[op/x0]_(i <- s | P i) F i \is real. Proof. exact: comparable_bigr. Qed. Lemma sum_real I (P : pred I) (F : I -> R) (s : seq I) : {in P, forall i, F i \is real} -> \sum_(i <- s | P i) F i \is real. Proof. by apply/big_real; [apply: rpredD | apply: rpred0]. Qed. Lemma prod_real I (P : pred I) (F : I -> R) (s : seq I) : {in P, forall i, F i \is real} -> \prod_(i <- s | P i) F i \is real. Proof. by apply/big_real; [apply: rpredM | apply: rpred1]. Qed. Section NormedZmoduleTheory. Variable V : normedZmodType R. Implicit Types (v w : V). 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 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 v) ler_norm_add. Qed. 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 NormedZmoduleTheory. 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 (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 !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). Proof. by rewrite -subr_gt0 opprB add0r subr_gt0. Qed. Definition subr_lte0 := (subr_le0, subr_lt0). Definition subr_gte0 := (subr_ge0, subr_gt0). Definition subr_cp0 := (subr_lte0, subr_gte0). (* Comparability in a numDomain *) Lemma comparable0r x : (0 >=< x)%R = (x \is Num.real). Proof. by []. Qed. Lemma comparabler0 x : (x >=< 0)%R = (x \is Num.real). Proof. by rewrite comparable_sym. Qed. Lemma subr_comparable0 x y : (x - y >=< 0)%R = (x >=< y)%R. Proof. by rewrite /comparable subr_ge0 subr_le0. Qed. Lemma comparablerE x y : (x >=< y)%R = (x - y \is Num.real). Proof. by rewrite -comparabler0 subr_comparable0. Qed. Lemma comparabler_trans : transitive (comparable : rel R). Proof. move=> y x z; rewrite !comparablerE => xBy_real yBz_real. by have := rpredD xBy_real yBz_real; rewrite addrA addrNK. Qed. (* Ordered ring properties. *) Definition lter01 := (ler01, ltr01). Lemma addr_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. exact: addr_ge0. Qed. End NumIntegralDomainTheory. 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 _)) => apply: normr_ge0 : core. 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 leW_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 (leW_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 (leW_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_gt0 x : (0 < - x) = (x < 0). Proof. by rewrite lter_oppr oppr0. Qed. Definition oppr_gte0 := (oppr_ge0, oppr_gt0). Lemma oppr_le0 x : (- x <= 0) = (0 <= x). Proof. by rewrite lter_oppl oppr0. Qed. Lemma oppr_lt0 x : (- x < 0) = (0 < x). Proof. by rewrite lter_oppl oppr0. Qed. Definition oppr_lte0 := (oppr_le0, oppr_lt0). 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 (@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: (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 (@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: (ltW hx) => hx'; rewrite !le0_cp // hx'. by rewrite oppr_cp0 hx // (@lt_trans _ _ 0) ?oppr_cp0. Qed. (* Properties of the real subset. *) Lemma ger0_real x : 0 <= x -> x \is real. Proof. by rewrite realE => ->. Qed. 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=> /ltW/ger0_real. Qed. Lemma ltr0_real x : x < 0 -> x \is real. Proof. by move=> /ltW/ler0_real. Qed. Lemma real0 : 0 \is @real R. Proof. by rewrite ger0_real. Qed. Hint Resolve real0 : core. Lemma real1 : 1 \is @real R. Proof. by rewrite ger0_real. Qed. Hint Resolve real1 : core. Lemma realn n : n%:R \is @real R. Proof. by rewrite ger0_real. Qed. Lemma ler_leVge x y : x <= 0 -> y <= 0 -> (x <= y) || (y <= x). Proof. by rewrite -!oppr_ge0 => /(ger_leVge _) /[apply]; rewrite !ler_opp2. Qed. Lemma real_leVge x y : x \is real -> y \is real -> (x <= y) || (y <= x). Proof. by rewrite -comparabler0 -comparable0r => /comparabler_trans P/P. Qed. Lemma real_comparable x y : x \is real -> y \is real -> x >=< y. Proof. exact: real_leVge. Qed. Lemma realB : {in real &, forall x y, x - y \is real}. Proof. exact: rpredB. Qed. Lemma realN : {mono (@GRing.opp R) : x / x \is real}. Proof. exact: rpredN. Qed. Lemma realBC x y : (x - y \is real) = (y - x \is real). Proof. exact: rpredBC. Qed. Lemma realD : {in real &, forall x y, x + y \is real}. Proof. exact: rpredD. Qed. (* dichotomy and trichotomy *) Variant ler_xor_gt (x y : R) : R -> R -> R -> R -> R -> R -> bool -> bool -> Set := | LerNotGt of x <= y : ler_xor_gt x y x x y y (y - x) (y - x) true false | GtrNotLe of y < x : ler_xor_gt x y y y x x (x - y) (x - y) false true. Variant ltr_xor_ge (x y : R) : R -> R -> R -> R -> R -> R -> bool -> bool -> Set := | LtrNotGe of x < y : ltr_xor_ge x y x x y y (y - x) (y - x) false true | GerNotLt of y <= x : ltr_xor_ge x y y y x x (x - y) (x - y) true false. Variant comparer x y : R -> R -> R -> R -> R -> R -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | ComparerLt of x < y : comparer x y x x y y (y - x) (y - x) false false false true false true | ComparerGt of x > y : comparer x y y y x x (x - y) (x - y) false false true false true false | ComparerEq of x = y : comparer x y x x x x 0 0 true true true true false false. Lemma real_leP x y : x \is real -> y \is real -> ler_xor_gt x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (x <= y) (y < x). Proof. move=> xR yR; case: (comparable_leP (real_leVge xR yR)) => xy. - by rewrite [`|x - y|]distrC !ger0_norm ?subr_cp0 //; constructor. - by rewrite [`|y - x|]distrC !gtr0_norm ?subr_cp0 //; constructor. Qed. Lemma real_ltP x y : x \is real -> y \is real -> ltr_xor_ge x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (y <= x) (x < y). Proof. by move=> xR yR; case: real_leP=> //; constructor. 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_leNgt : {in real &, forall x y, (x <= y) = ~~ (y < x)}. Proof. by move=> x y xR yR /=; case: real_leP. Qed. Lemma real_ltgtP x y : x \is real -> y \is real -> comparer x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y). Proof. move=> xR yR; case: (comparable_ltgtP (real_leVge yR xR)) => [?|?|->]. - by rewrite [`|y - x|]distrC !gtr0_norm ?subr_gt0//; constructor. - by rewrite [`|x - y|]distrC !gtr0_norm ?subr_gt0//; constructor. - by rewrite subrr normr0; constructor. Qed. Variant ger0_xor_lt0 (x : R) : R -> R -> R -> R -> R -> bool -> bool -> Set := | Ger0NotLt0 of 0 <= x : ger0_xor_lt0 x 0 0 x x x false true | Ltr0NotGe0 of x < 0 : ger0_xor_lt0 x x x 0 0 (- x) true false. Variant ler0_xor_gt0 (x : R) : R -> R -> R -> R -> R -> bool -> bool -> Set := | Ler0NotLe0 of x <= 0 : ler0_xor_gt0 x x x 0 0 (- x) false true | Gtr0NotGt0 of 0 < x : ler0_xor_gt0 x 0 0 x x x true false. Variant comparer0 x : R -> R -> R -> R -> R -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | ComparerGt0 of 0 < x : comparer0 x 0 0 x x x false false false true false true | ComparerLt0 of x < 0 : comparer0 x x x 0 0 (- x) false false true false true false | ComparerEq0 of x = 0 : comparer0 x 0 0 0 0 0 true true true true false false. Lemma real_ge0P x : x \is real -> ger0_xor_lt0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (x < 0) (0 <= x). Proof. move=> hx; rewrite -[X in `|X|]subr0; case: real_leP; by rewrite ?subr0 ?sub0r //; constructor. Qed. Lemma real_le0P x : x \is real -> ler0_xor_gt0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (0 < x) (x <= 0). Proof. move=> hx; rewrite -[X in `|X|]subr0; case: real_ltP; by rewrite ?subr0 ?sub0r //; constructor. Qed. Lemma real_ltgt0P x : x \is real -> comparer0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (0 == x) (x == 0) (x <= 0) (0 <= x) (x < 0) (x > 0). Proof. move=> hx; rewrite -[X in `|X|]subr0; case: (@real_ltgtP 0 x); by rewrite ?subr0 ?sub0r //; constructor. Qed. Lemma max_real : {in real &, forall x y, max x y \is real}. Proof. exact: comparable_maxr. Qed. Lemma min_real : {in real &, forall x y, min x y \is real}. Proof. exact: comparable_minr. Qed. Lemma bigmax_real I x0 (r : seq I) (P : pred I) (f : I -> R): x0 \is real -> {in P, forall i : I, f i \is real} -> \big[max/x0]_(i <- r | P i) f i \is real. Proof. exact/big_real/max_real. Qed. Lemma bigmin_real I x0 (r : seq I) (P : pred I) (f : I -> R): x0 \is real -> {in P, forall i : I, f i \is real} -> \big[min/x0]_(i <- r | P i) f i \is real. Proof. exact/big_real/min_real. Qed. Lemma real_neqr_lt : {in real &, forall x y, (x != y) = (x < y) || (y < x)}. 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. Lemma ger_sub_real x y : x <= y -> x - y \is real. Proof. by move=> le_xy; rewrite ler0_real // subr_le0. Qed. Lemma ler_real y x : x <= y -> (x \is real) = (y \is real). Proof. by move=> le_xy; rewrite -(addrNK x y) rpredDl ?ler_sub_real. Qed. Lemma ger_real x y : y <= x -> (x \is real) = (y \is real). Proof. by move=> le_yx; rewrite -(ler_real le_yx). Qed. Lemma ger1_real x : 1 <= x -> x \is real. Proof. by move=> /ger_real->. Qed. Lemma ler1_real x : x <= 1 -> x \is real. Proof. by move=> /ler_real->. Qed. Lemma Nreal_leF x y : y \is real -> x \notin real -> (x <= y) = false. Proof. by move=> yR; apply: contraNF=> /ler_real->. Qed. 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 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 lt_def Nreal_geF ?andbF. Qed. (* real wlog *) Lemma real_wlog_ler P : (forall a b, P b a -> P a b) -> (forall a b, a <= b -> P a b) -> 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_leP ha hb)=> [/hP //|/ltW hba]; apply/sP/hP. Qed. Lemma real_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, a \is real -> b \is real -> P a b. Proof. move=> rP sP hP; apply: real_wlog_ler=> // a b. by rewrite le_eqVlt; case: eqVneq => [->|] //= _ /hP. Qed. (* Monotony of addition *) Lemma ler_add2l x : {mono +%R x : y z / y <= z}. Proof. by move=> y z /=; rewrite -subr_ge0 opprD addrAC addNKr addrC subr_ge0. Qed. 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 (leW_mono (ler_add2l _)). Qed. Lemma ltr_add2r x : {mono +%R^~ x : y z / y < z}. 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). 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 (@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 (@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 (@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 // 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. Lemma ler_lt_sub x y z t : x <= y -> t < z -> x - z < y - t. Proof. by move=> lxy lzt; rewrite ler_lt_add // lter_opp2. Qed. Lemma ltr_le_sub x y z t : x < y -> t <= z -> x - z < y - t. Proof. by move=> lxy lzt; rewrite ltr_le_add // lter_opp2. Qed. Lemma ltr_sub x y z t : x < y -> t < z -> x - z < y - t. Proof. by move=> lxy lzt; rewrite ltr_add // lter_opp2. Qed. Lemma ler_subl_addr x y z : (x - y <= z) = (x <= z + y). Proof. by rewrite (monoLR (addrK _) (ler_add2r _)). Qed. Lemma ltr_subl_addr x y z : (x - y < z) = (x < z + y). Proof. by rewrite (monoLR (addrK _) (ltr_add2r _)). Qed. Lemma ler_subr_addr x y z : (x <= y - z) = (x + z <= y). Proof. by rewrite (monoLR (addrNK _) (ler_add2r _)). Qed. Lemma ltr_subr_addr x y z : (x < y - z) = (x + z < y). Proof. by rewrite (monoLR (addrNK _) (ltr_add2r _)). Qed. Definition ler_sub_addr := (ler_subl_addr, ler_subr_addr). Definition ltr_sub_addr := (ltr_subl_addr, ltr_subr_addr). Definition lter_sub_addr := (ler_sub_addr, ltr_sub_addr). Lemma ler_subl_addl x y z : (x - y <= z) = (x <= y + z). Proof. by rewrite lter_sub_addr addrC. Qed. Lemma ltr_subl_addl x y z : (x - y < z) = (x < y + z). Proof. by rewrite lter_sub_addr addrC. Qed. Lemma ler_subr_addl x y z : (x <= y - z) = (z + x <= y). Proof. by rewrite lter_sub_addr addrC. Qed. Lemma ltr_subr_addl x y z : (x < y - z) = (z + x < y). Proof. by rewrite lter_sub_addr addrC. Qed. Definition ler_sub_addl := (ler_subl_addl, ler_subr_addl). Definition ltr_sub_addl := (ltr_subl_addl, ltr_subr_addl). Definition lter_sub_addl := (ler_sub_addl, ltr_sub_addl). Lemma ler_addl x y : (x <= x + y) = (0 <= y). Proof. by rewrite -{1}[x]addr0 lter_add2. Qed. Lemma ltr_addl x y : (x < x + y) = (0 < y). Proof. by rewrite -{1}[x]addr0 lter_add2. Qed. Lemma ler_addr x y : (x <= y + x) = (0 <= y). Proof. by rewrite -{1}[x]add0r lter_add2. Qed. Lemma ltr_addr x y : (x < y + x) = (0 < y). Proof. by rewrite -{1}[x]add0r lter_add2. Qed. Lemma ger_addl x y : (x + y <= x) = (y <= 0). Proof. by rewrite -{2}[x]addr0 lter_add2. Qed. Lemma gtr_addl x y : (x + y < x) = (y < 0). Proof. by rewrite -{2}[x]addr0 lter_add2. Qed. Lemma ger_addr x y : (y + x <= x) = (y <= 0). Proof. by rewrite -{2}[x]add0r lter_add2. Qed. Lemma gtr_addr x y : (y + x < x) = (y < 0). Proof. by rewrite -{2}[x]add0r lter_add2. Qed. Definition cpr_add := (ler_addl, ler_addr, ger_addl, ger_addl, ltr_addl, ltr_addr, gtr_addl, gtr_addl). (* Addition with left member knwon to be positive/negative *) Lemma ler_paddl y x z : 0 <= x -> y <= z -> y <= x + z. Proof. by move=> *; rewrite -[y]add0r ler_add. Qed. Lemma ltr_paddl y x z : 0 <= x -> y < z -> y < x + z. Proof. by move=> *; rewrite -[y]add0r ler_lt_add. Qed. Lemma ltr_spaddl y x z : 0 < x -> y <= z -> y < x + z. Proof. by move=> *; rewrite -[y]add0r ltr_le_add. Qed. Lemma ltr_spsaddl y x z : 0 < x -> y < z -> y < x + z. Proof. by move=> *; rewrite -[y]add0r ltr_add. Qed. Lemma ler_naddl y x z : x <= 0 -> y <= z -> x + y <= z. Proof. by move=> *; rewrite -[z]add0r ler_add. Qed. Lemma ltr_naddl y x z : x <= 0 -> y < z -> x + y < z. Proof. by move=> *; rewrite -[z]add0r ler_lt_add. Qed. Lemma ltr_snaddl y x z : x < 0 -> y <= z -> x + y < z. Proof. by move=> *; rewrite -[z]add0r ltr_le_add. Qed. Lemma ltr_snsaddl y x z : x < 0 -> y < z -> x + y < z. Proof. by move=> *; rewrite -[z]add0r ltr_add. Qed. (* Addition with right member we know positive/negative *) Lemma ler_paddr y x z : 0 <= x -> y <= z -> y <= z + x. Proof. by move=> *; rewrite [_ + x]addrC ler_paddl. Qed. Lemma ltr_paddr y x z : 0 <= x -> y < z -> y < z + x. Proof. by move=> *; rewrite [_ + x]addrC ltr_paddl. Qed. Lemma ltr_spaddr y x z : 0 < x -> y <= z -> y < z + x. Proof. by move=> *; rewrite [_ + x]addrC ltr_spaddl. Qed. Lemma ltr_spsaddr y x z : 0 < x -> y < z -> y < z + x. Proof. by move=> *; rewrite [_ + x]addrC ltr_spsaddl. Qed. Lemma ler_naddr y x z : x <= 0 -> y <= z -> y + x <= z. Proof. by move=> *; rewrite [_ + x]addrC ler_naddl. Qed. Lemma ltr_naddr y x z : x <= 0 -> y < z -> y + x < z. Proof. by move=> *; rewrite [_ + x]addrC ltr_naddl. Qed. Lemma ltr_snaddr y x z : x < 0 -> y <= z -> y + x < z. Proof. by move=> *; rewrite [_ + x]addrC ltr_snaddl. Qed. Lemma ltr_snsaddr y x z : x < 0 -> y < z -> y + x < z. Proof. by move=> *; rewrite [_ + x]addrC ltr_snsaddl. Qed. (* x and y have the same sign and their sum is null *) 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 (gt_eqF hx) /= => hy; rewrite gt_eqF // ltr_spaddl. Qed. Lemma naddr_eq0 (x y : R) : x <= 0 -> y <= 0 -> (x + y == 0) = (x == 0) && (y == 0). Proof. by move=> lex0 ley0; rewrite -oppr_eq0 opprD paddr_eq0 ?oppr_cp0 // !oppr_eq0. Qed. Lemma addr_ss_eq0 (x y : R) : (0 <= x) && (0 <= y) || (x <= 0) && (y <= 0) -> (x + y == 0) = (x == 0) && (y == 0). Proof. by case/orP=> /andP []; [apply: paddr_eq0 | apply: naddr_eq0]. Qed. (* big sum and ler *) Lemma sumr_ge0 I (r : seq I) (P : pred I) (F : I -> R) : (forall i, P i -> (0 <= F i)) -> 0 <= \sum_(i <- r | P i) (F i). 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 _ (lexx _) ler_add). Qed. Lemma ler_sum_nat (m n : nat) (F G : nat -> R) : (forall i, (m <= i < n)%N -> F i <= G i) -> \sum_(m <= i < n) F i <= \sum_(m <= i < n) G i. Proof. by move=> le_FG; rewrite !big_nat ler_sum. Qed. Lemma psumr_eq0 (I : eqType) (r : seq I) (P : pred I) (F : I -> R) : (forall i, P i -> 0 <= F i) -> (\sum_(i <- r | P i) (F i) == 0) = (all (fun i => (P i) ==> (F i == 0)) r). Proof. elim: r=> [|a r ihr hr] /=; rewrite (big_nil, big_cons); first by rewrite eqxx. by case: ifP=> pa /=; rewrite ?paddr_eq0 ?ihr ?hr // sumr_ge0. Qed. (* :TODO: Cyril : See which form to keep *) Lemma psumr_eq0P (I : finType) (P : pred I) (F : I -> R) : (forall i, P i -> 0 <= F i) -> \sum_(i | P i) F i = 0 -> (forall i, P i -> F i = 0). Proof. move=> F_ge0 /eqP; rewrite psumr_eq0 // -big_all big_andE => /forallP hF i Pi. by move: (hF i); rewrite implyTb Pi /= => /eqP. Qed. (* mulr and ler/ltr *) Lemma ler_pmul2l x : 0 < x -> {mono *%R x : x y / x <= y}. Proof. 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: leW_mono (ler_pmul2l _). Qed. Definition lter_pmul2l := (ler_pmul2l, ltr_pmul2l). 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: leW_mono (ler_pmul2r _). Qed. Definition lter_pmul2r := (ler_pmul2r, ltr_pmul2r). Lemma ler_nmul2l x : x < 0 -> {mono *%R x : x y /~ x <= y}. Proof. 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: leW_nmono (ler_nmul2l _). Qed. Definition lter_nmul2l := (ler_nmul2l, ltr_nmul2l). 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: leW_nmono (ler_nmul2r _). Qed. Definition lter_nmul2r := (ler_nmul2r, ltr_nmul2r). Lemma ler_wpmul2l x : 0 <= x -> {homo *%R x : y z / y <= z}. Proof. by rewrite le0r => /orP[/eqP-> y z | /ler_pmul2l/mono2W//]; rewrite !mul0r. Qed. Lemma ler_wpmul2r x : 0 <= x -> {homo *%R^~ x : y z / y <= z}. Proof. by move=> x_ge0 y z leyz; rewrite ![_ * x]mulrC ler_wpmul2l. Qed. Lemma ler_wnmul2l x : x <= 0 -> {homo *%R x : y z /~ y <= z}. Proof. by move=> x_le0 y z leyz; rewrite -![x * _]mulrNN ler_wpmul2l ?lter_oppE. Qed. Lemma ler_wnmul2r x : x <= 0 -> {homo *%R^~ x : y z /~ y <= z}. Proof. by move=> x_le0 y z leyz; rewrite -![_ * x]mulrNN ler_wpmul2r ?lter_oppE. Qed. (* Binary forms, for backchaining. *) 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 := 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 := 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 < *) Lemma ler_pmuln2r n : (0 < n)%N -> {mono (@GRing.natmul R)^~ n : x y / x <= y}. Proof. 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/leW_mono. Qed. Lemma pmulrnI n : (0 < n)%N -> injective ((@GRing.natmul R)^~ n). 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. Lemma pmulrn_lgt0 x n : (0 < n)%N -> (0 < x *+ n) = (0 < x). Proof. by move=> n_gt0; rewrite -(mul0rn _ n) ltr_pmuln2r // mul0rn. Qed. Lemma pmulrn_llt0 x n : (0 < n)%N -> (x *+ n < 0) = (x < 0). Proof. by move=> n_gt0; rewrite -(mul0rn _ n) ltr_pmuln2r // mul0rn. Qed. Lemma pmulrn_lge0 x n : (0 < n)%N -> (0 <= x *+ n) = (0 <= x). Proof. by move=> n_gt0; rewrite -(mul0rn _ n) ler_pmuln2r // mul0rn. Qed. Lemma pmulrn_lle0 x n : (0 < n)%N -> (x *+ n <= 0) = (x <= 0). Proof. by move=> n_gt0; rewrite -(mul0rn _ n) ler_pmuln2r // mul0rn. Qed. Lemma ltr_wmuln2r x y n : x < y -> (x *+ n < y *+ n) = (0 < n)%N. Proof. by move=> ltxy; case: n=> // n; rewrite ltr_pmuln2r. Qed. Lemma ltr_wpmuln2r n : (0 < n)%N -> {homo (@GRing.natmul R)^~ n : x y / x < y}. Proof. by move=> n_gt0 x y /= / ltr_wmuln2r ->. Qed. Lemma ler_wmuln2r n : {homo (@GRing.natmul R)^~ n : x y / x <= y}. Proof. by move=> x y hxy /=; case: n=> // n; rewrite ler_pmuln2r. Qed. Lemma mulrn_wge0 x n : 0 <= x -> 0 <= x *+ n. Proof. by move=> /(ler_wmuln2r n); rewrite mul0rn. Qed. 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 ?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 ?lexx ?eqxx // ltr_pmuln2r. Qed. Lemma eqr_muln2r n x y : (x *+ n == y *+ n) = (n == 0)%N || (x == y). Proof. by rewrite !(@eq_le _ R) !ler_muln2r -orb_andr. Qed. (* More characteristic zero properties. *) Lemma mulrn_eq0 x n : (x *+ n == 0) = ((n == 0)%N || (x == 0)). Proof. by rewrite -mulr_natl mulf_eq0 pnatr_eq0. Qed. Lemma mulrIn x : x != 0 -> injective (GRing.natmul x). Proof. move=> x_neq0 m n; without loss /subnK <-: m n / (n <= m)%N. by move=> IH eq_xmn; case/orP: (leq_total m n) => /IH->. by move/eqP; rewrite mulrnDr -subr_eq0 addrK mulrn_eq0 => /predU1P[-> | /idPn]. Qed. Lemma ler_wpmuln2l x : 0 <= x -> {homo (@GRing.natmul R x) : m n / (m <= n)%N >-> m <= n}. Proof. by move=> xge0 m n /subnK <-; rewrite mulrnDr ler_paddl ?mulrn_wge0. Qed. Lemma ler_wnmuln2l x : x <= 0 -> {homo (@GRing.natmul R x) : m n / (n <= m)%N >-> m <= n}. Proof. by move=> xle0 m n hmn /=; rewrite -ler_opp2 -!mulNrn ler_wpmuln2l // oppr_cp0. Qed. Lemma mulrn_wgt0 x n : 0 < x -> 0 < x *+ n = (0 < n)%N. Proof. by case: n => // n hx; rewrite pmulrn_lgt0. Qed. Lemma mulrn_wlt0 x n : x < 0 -> x *+ n < 0 = (0 < n)%N. 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 // 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: leW_mono (ler_pmuln2l _). Qed. Lemma ler_nmuln2l x : x < 0 -> {mono (@GRing.natmul R x) : m n / (n <= m)%N >-> m <= n}. Proof. by move=> x_lt0 m n /=; rewrite -ler_opp2 -!mulNrn ler_pmuln2l // oppr_gt0. 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: leW_nmono (ler_nmuln2l _). Qed. Lemma ler_nat m n : (m%:R <= n%:R :> R) = (m <= n)%N. Proof. by rewrite ler_pmuln2l. Qed. Lemma ltr_nat m n : (m%:R < n%:R :> R) = (m < n)%N. Proof. by rewrite ltr_pmuln2l. Qed. Lemma eqr_nat m n : (m%:R == n%:R :> R) = (m == n)%N. Proof. by rewrite (inj_eq (mulrIn _)) ?oner_eq0. Qed. Lemma pnatr_eq1 n : (n%:R == 1 :> R) = (n == 1)%N. Proof. exact: eqr_nat 1%N. Qed. Lemma lern0 n : (n%:R <= 0 :> R) = (n == 0%N). Proof. by rewrite -[0]/0%:R ler_nat leqn0. Qed. Lemma ltrn0 n : (n%:R < 0 :> R) = false. Proof. by rewrite -[0]/0%:R ltr_nat ltn0. Qed. Lemma ler1n n : 1 <= n%:R :> R = (1 <= n)%N. Proof. by rewrite -ler_nat. Qed. Lemma ltr1n n : 1 < n%:R :> R = (1 < n)%N. Proof. by rewrite -ltr_nat. Qed. Lemma lern1 n : n%:R <= 1 :> R = (n <= 1)%N. Proof. by rewrite -ler_nat. Qed. 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 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. Lemma pmulrn_rlt0 x n : 0 < x -> x *+ n < 0 = false. Proof. by move=> x_gt0; rewrite -(mulr0n x) ltr_pmuln2l. Qed. Lemma pmulrn_rge0 x n : 0 < x -> 0 <= x *+ n. Proof. by move=> x_gt0; rewrite -(mulr0n x) ler_pmuln2l. Qed. Lemma pmulrn_rle0 x n : 0 < x -> x *+ n <= 0 = (n == 0)%N. Proof. by move=> x_gt0; rewrite -(mulr0n x) ler_pmuln2l ?leqn0. Qed. Lemma nmulrn_rgt0 x n : x < 0 -> 0 < x *+ n = false. Proof. by move=> x_lt0; rewrite -(mulr0n x) ltr_nmuln2l. Qed. Lemma nmulrn_rge0 x n : x < 0 -> 0 <= x *+ n = (n == 0)%N. Proof. by move=> x_lt0; rewrite -(mulr0n x) ler_nmuln2l ?leqn0. Qed. Lemma nmulrn_rle0 x n : x < 0 -> x *+ n <= 0. Proof. by move=> x_lt0; rewrite -(mulr0n x) ler_nmuln2l. Qed. (* (x * y) compared to 0 *) (* Remark : pmulr_rgt0 and pmulr_rge0 are defined above *) (* x positive and y right *) Lemma pmulr_rlt0 x y : 0 < x -> (x * y < 0) = (y < 0). Proof. by move=> x_gt0; rewrite -oppr_gt0 -mulrN pmulr_rgt0 // oppr_gt0. Qed. Lemma pmulr_rle0 x y : 0 < x -> (x * y <= 0) = (y <= 0). Proof. by move=> x_gt0; rewrite -oppr_ge0 -mulrN pmulr_rge0 // oppr_ge0. Qed. (* x positive and y left *) Lemma pmulr_lgt0 x y : 0 < x -> (0 < y * x) = (0 < y). Proof. by move=> x_gt0; rewrite mulrC pmulr_rgt0. Qed. Lemma pmulr_lge0 x y : 0 < x -> (0 <= y * x) = (0 <= y). Proof. by move=> x_gt0; rewrite mulrC pmulr_rge0. Qed. Lemma pmulr_llt0 x y : 0 < x -> (y * x < 0) = (y < 0). Proof. by move=> x_gt0; rewrite mulrC pmulr_rlt0. Qed. Lemma pmulr_lle0 x y : 0 < x -> (y * x <= 0) = (y <= 0). Proof. by move=> x_gt0; rewrite mulrC pmulr_rle0. Qed. (* x negative and y right *) Lemma nmulr_rgt0 x y : x < 0 -> (0 < x * y) = (y < 0). Proof. by move=> x_lt0; rewrite -mulrNN pmulr_rgt0 lter_oppE. Qed. Lemma nmulr_rge0 x y : x < 0 -> (0 <= x * y) = (y <= 0). Proof. by move=> x_lt0; rewrite -mulrNN pmulr_rge0 lter_oppE. Qed. Lemma nmulr_rlt0 x y : x < 0 -> (x * y < 0) = (0 < y). Proof. by move=> x_lt0; rewrite -mulrNN pmulr_rlt0 lter_oppE. Qed. Lemma nmulr_rle0 x y : x < 0 -> (x * y <= 0) = (0 <= y). Proof. by move=> x_lt0; rewrite -mulrNN pmulr_rle0 lter_oppE. Qed. (* x negative and y left *) Lemma nmulr_lgt0 x y : x < 0 -> (0 < y * x) = (y < 0). Proof. by move=> x_lt0; rewrite mulrC nmulr_rgt0. Qed. Lemma nmulr_lge0 x y : x < 0 -> (0 <= y * x) = (y <= 0). Proof. by move=> x_lt0; rewrite mulrC nmulr_rge0. Qed. Lemma nmulr_llt0 x y : x < 0 -> (y * x < 0) = (0 < y). Proof. by move=> x_lt0; rewrite mulrC nmulr_rlt0. Qed. Lemma nmulr_lle0 x y : x < 0 -> (y * x <= 0) = (0 <= y). Proof. by move=> x_lt0; rewrite mulrC nmulr_rle0. Qed. (* weak and symmetric lemmas *) Lemma mulr_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x * y. Proof. by move=> x_ge0 y_ge0; rewrite -(mulr0 x) ler_wpmul2l. Qed. Lemma mulr_le0 x y : x <= 0 -> y <= 0 -> 0 <= x * y. Proof. by move=> x_le0 y_le0; rewrite -(mulr0 x) ler_wnmul2l. Qed. Lemma mulr_ge0_le0 x y : 0 <= x -> y <= 0 -> x * y <= 0. Proof. by move=> x_le0 y_le0; rewrite -(mulr0 x) ler_wpmul2l. Qed. Lemma mulr_le0_ge0 x y : x <= 0 -> 0 <= y -> x * y <= 0. Proof. by move=> x_le0 y_le0; rewrite -(mulr0 x) ler_wnmul2l. Qed. (* mulr_gt0 with only one case *) Lemma mulr_gt0 x y : 0 < x -> 0 < y -> 0 < x * y. Proof. by move=> x_gt0 y_gt0; rewrite pmulr_rgt0. Qed. (* Iterated products *) Lemma prodr_ge0 I r (P : pred I) (E : I -> R) : (forall i, P i -> 0 <= E i) -> 0 <= \prod_(i <- r | P i) E i. Proof. by move=> Ege0; rewrite -nnegrE rpred_prod. Qed. Lemma prodr_gt0 I r (P : pred I) (E : I -> R) : (forall i, P i -> 0 < E i) -> 0 < \prod_(i <- r | P i) E i. Proof. by move=> Ege0; rewrite -posrE rpred_prod. Qed. Lemma ler_prod I r (P : pred I) (E1 E2 : I -> R) : (forall i, P i -> 0 <= E1 i <= E2 i) -> \prod_(i <- r | P i) E1 i <= \prod_(i <- r | P i) E2 i. Proof. move=> leE12; elim/(big_load (fun x => 0 <= x)): _. elim/big_rec2: _ => // i x2 x1 /leE12/andP[le0Ei leEi12] [x1ge0 le_x12]. by rewrite mulr_ge0 // ler_pmul. Qed. Lemma ltr_prod I r (P : pred I) (E1 E2 : I -> R) : has P r -> (forall i, P i -> 0 <= E1 i < E2 i) -> \prod_(i <- r | P i) E1 i < \prod_(i <- r | P i) E2 i. 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: 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) : (m < n)%N -> (forall i, (m <= i < n)%N -> 0 <= E1 i < E2 i) -> \prod_(m <= i < n) E1 i < \prod_(m <= i < n) E2 i. Proof. move=> lt_mn ltE12; rewrite !big_nat ltr_prod {ltE12}//. by apply/hasP; exists m; rewrite ?mem_index_iota leqnn. Qed. (* real of mul *) Lemma realMr x y : x != 0 -> x \is real -> (x * y \is real) = (y \is real). Proof. 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. Lemma realrM x y : y != 0 -> y \is real -> (x * y \is real) = (x \is real). Proof. by move=> y_neq0 yR; rewrite mulrC realMr. Qed. Lemma realM : {in real &, forall x y, x * y \is real}. Proof. exact: rpredM. Qed. Lemma realrMn x n : (n != 0)%N -> (x *+ n \is real) = (x \is real). Proof. by move=> n_neq0; rewrite -mulr_natl realMr ?realn ?pnatr_eq0. Qed. (* ler/ltr and multiplication between a positive/negative *) Lemma ger_pmull x y : 0 < y -> (x * y <= y) = (x <= 1). Proof. by move=> hy; rewrite -{2}[y]mul1r ler_pmul2r. Qed. Lemma gtr_pmull x y : 0 < y -> (x * y < y) = (x < 1). Proof. by move=> hy; rewrite -{2}[y]mul1r ltr_pmul2r. Qed. Lemma ger_pmulr x y : 0 < y -> (y * x <= y) = (x <= 1). Proof. by move=> hy; rewrite -{2}[y]mulr1 ler_pmul2l. Qed. Lemma gtr_pmulr x y : 0 < y -> (y * x < y) = (x < 1). Proof. by move=> hy; rewrite -{2}[y]mulr1 ltr_pmul2l. Qed. Lemma ler_pmull x y : 0 < y -> (y <= x * y) = (1 <= x). Proof. by move=> hy; rewrite -{1}[y]mul1r ler_pmul2r. Qed. Lemma ltr_pmull x y : 0 < y -> (y < x * y) = (1 < x). Proof. by move=> hy; rewrite -{1}[y]mul1r ltr_pmul2r. Qed. Lemma ler_pmulr x y : 0 < y -> (y <= y * x) = (1 <= x). Proof. by move=> hy; rewrite -{1}[y]mulr1 ler_pmul2l. Qed. Lemma ltr_pmulr x y : 0 < y -> (y < y * x) = (1 < x). Proof. by move=> hy; rewrite -{1}[y]mulr1 ltr_pmul2l. Qed. Lemma ger_nmull x y : y < 0 -> (x * y <= y) = (1 <= x). Proof. by move=> hy; rewrite -{2}[y]mul1r ler_nmul2r. Qed. Lemma gtr_nmull x y : y < 0 -> (x * y < y) = (1 < x). Proof. by move=> hy; rewrite -{2}[y]mul1r ltr_nmul2r. Qed. Lemma ger_nmulr x y : y < 0 -> (y * x <= y) = (1 <= x). Proof. by move=> hy; rewrite -{2}[y]mulr1 ler_nmul2l. Qed. Lemma gtr_nmulr x y : y < 0 -> (y * x < y) = (1 < x). Proof. by move=> hy; rewrite -{2}[y]mulr1 ltr_nmul2l. Qed. Lemma ler_nmull x y : y < 0 -> (y <= x * y) = (x <= 1). Proof. by move=> hy; rewrite -{1}[y]mul1r ler_nmul2r. Qed. Lemma ltr_nmull x y : y < 0 -> (y < x * y) = (x < 1). Proof. by move=> hy; rewrite -{1}[y]mul1r ltr_nmul2r. Qed. Lemma ler_nmulr x y : y < 0 -> (y <= y * x) = (x <= 1). Proof. by move=> hy; rewrite -{1}[y]mulr1 ler_nmul2l. Qed. Lemma ltr_nmulr x y : y < 0 -> (y < y * x) = (x < 1). Proof. by move=> hy; rewrite -{1}[y]mulr1 ltr_nmul2l. Qed. (* ler/ltr and multiplication between a positive/negative and a exterior (1 <= _) or interior (0 <= _ <= 1) *) Lemma ler_pemull x y : 0 <= y -> 1 <= x -> y <= x * y. Proof. by move=> hy hx; rewrite -{1}[y]mul1r ler_wpmul2r. Qed. Lemma ler_nemull x y : y <= 0 -> 1 <= x -> x * y <= y. Proof. by move=> hy hx; rewrite -{2}[y]mul1r ler_wnmul2r. Qed. Lemma ler_pemulr x y : 0 <= y -> 1 <= x -> y <= y * x. Proof. by move=> hy hx; rewrite -{1}[y]mulr1 ler_wpmul2l. Qed. Lemma ler_nemulr x y : y <= 0 -> 1 <= x -> y * x <= y. Proof. by move=> hy hx; rewrite -{2}[y]mulr1 ler_wnmul2l. Qed. Lemma ler_pimull x y : 0 <= y -> x <= 1 -> x * y <= y. Proof. by move=> hy hx; rewrite -{2}[y]mul1r ler_wpmul2r. Qed. Lemma ler_nimull x y : y <= 0 -> x <= 1 -> y <= x * y. Proof. by move=> hy hx; rewrite -{1}[y]mul1r ler_wnmul2r. Qed. Lemma ler_pimulr x y : 0 <= y -> x <= 1 -> y * x <= y. Proof. by move=> hy hx; rewrite -{2}[y]mulr1 ler_wpmul2l. Qed. 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 (@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 (@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 (@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 (@lt_trans _ _ y) // ltr_pmull // (lt_trans ltr01). Qed. Definition mulr_egte1 := (mulr_ege1, mulr_egt1). Definition mulr_cp1 := (mulr_ilte1, mulr_egte1). (* ler and ^-1 *) Lemma invr_gt0 x : (0 < x^-1) = (0 < x). Proof. have [ux | nux] := boolP (x \is a GRing.unit); last by rewrite invr_out. by apply/idP/idP=> /ltr_pmul2r<-; rewrite mul0r (mulrV, mulVr) ?ltr01. Qed. Lemma invr_ge0 x : (0 <= x^-1) = (0 <= x). Proof. by rewrite !le0r invr_gt0 invr_eq0. Qed. Lemma invr_lt0 x : (x^-1 < 0) = (x < 0). Proof. by rewrite -oppr_cp0 -invrN invr_gt0 oppr_cp0. Qed. Lemma invr_le0 x : (x^-1 <= 0) = (x <= 0). Proof. by rewrite -oppr_cp0 -invrN invr_ge0 oppr_cp0. Qed. Definition invr_gte0 := (invr_ge0, invr_gt0). Definition invr_lte0 := (invr_le0, invr_lt0). Lemma divr_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x / y. Proof. by move=> x_ge0 y_ge0; rewrite mulr_ge0 ?invr_ge0. Qed. Lemma divr_gt0 x y : 0 < x -> 0 < y -> 0 < x / y. Proof. by move=> x_gt0 y_gt0; rewrite pmulr_rgt0 ?invr_gt0. Qed. Lemma realV : {mono (@GRing.inv R) : x / x \is real}. Proof. exact: rpredV. Qed. (* ler and exprn *) Lemma exprn_ge0 n x : 0 <= x -> 0 <= x ^+ n. Proof. by move=> xge0; rewrite -nnegrE rpredX. Qed. Lemma realX n : {in real, forall x, x ^+ n \is real}. Proof. exact: rpredX. Qed. Lemma exprn_gt0 n x : 0 < x -> 0 < x ^+ n. Proof. by rewrite !lt0r expf_eq0 => /andP[/negPf-> /exprn_ge0->]; rewrite andbF. Qed. Definition exprn_gte0 := (exprn_ge0, exprn_gt0). Lemma exprn_ile1 n x : 0 <= x -> x <= 1 -> x ^+ n <= 1. Proof. move=> xge0 xle1; elim: n=> [|*]; rewrite ?expr0 // exprS. by rewrite mulr_ile1 ?exprn_ge0. 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 ltxx | elim=> [|n ihn]; first by rewrite expr1]. by rewrite exprS mulr_ilt1 // exprn_ge0. Qed. Definition exprn_ilte1 := (exprn_ile1, exprn_ilt1). Lemma exprn_ege1 n x : 1 <= x -> 1 <= x ^+ n. Proof. by move=> x_ge1; elim: n=> [|n ihn]; rewrite ?expr0 // exprS mulr_ege1. Qed. Lemma exprn_egt1 n x : 1 < x -> 1 < x ^+ n = (n != 0%N). Proof. move=> xgt1; case: n; first by rewrite eqxx ltxx. elim=> [|n ihn]; first by rewrite expr1. by rewrite exprS mulr_egt1 // exprn_ge0. Qed. Definition exprn_egte1 := (exprn_ege1, exprn_egt1). Definition exprn_cp1 := (exprn_ilte1, exprn_egte1). Lemma ler_iexpr x n : (0 < n)%N -> 0 <= x -> x <= 1 -> x ^+ n <= x. 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 => _ /lt_gtF ->. by move=> x0 x1; rewrite exprS gtr_pmulr // ?exprn_ilt1 // ltW. Qed. 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 ?(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 lt_gtF. by rewrite exprS ltr_pmulr ?(lt_trans _ x_ge1) ?exprn_egt1. Qed. Definition lter_eexpr := (ler_eexpr, ltr_eexpr). Definition lter_expr := (lter_iexpr, lter_eexpr). Lemma ler_wiexpn2l x : 0 <= x -> x <= 1 -> {homo (GRing.exp x) : m n / (n <= m)%N >-> m <= n}. Proof. move=> xge0 xle1 m n /= hmn. by rewrite -(subnK hmn) exprD ler_pimull ?(exprn_ge0, exprn_ile1). Qed. 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) // (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_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. Lemma ieexprIn x : 0 < x -> x != 1 -> injective (GRing.exp x). 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 ?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: (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: (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: (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: (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 ltxx. elim=> [|n IHn]; rewrite ?[_ ^+ _.+2]exprS //. 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 (@le_trans _ _ (x * y ^+ n)) ?ler_wpmul2l ?ler_wpmul2r ?exprn_ge0. Qed. Definition lter_expn2r := (ler_expn2r, ltr_expn2r). Lemma ltr_wpexpn2r n : (0 < n)%N -> {in nneg & , {homo ((@GRing.exp R)^~ n) : x y / x < y}}. Proof. by move=> ngt0 x y /= x0 y0 hxy; rewrite ltr_expn2r // -lt0n. Qed. Lemma ler_pexpn2r n : (0 < n)%N -> {in nneg & , {mono ((@GRing.exp R)^~ n) : x y / x <= y}}. Proof. case: n => // n _ x y; rewrite !qualifE /= => x_ge0 y_ge0. have [-> | nzx] := eqVneq x 0; first by rewrite exprS mul0r exprn_ge0. rewrite -subr_ge0 subrXX pmulr_lge0 ?subr_ge0 //= big_ord_recr /=. rewrite subnn expr0 mul1r /= ltr_spaddr // ?exprn_gt0 ?lt0r ?nzx //. by rewrite sumr_ge0 // => i _; rewrite mulr_ge0 ?exprn_ge0. 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 !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: 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). Proof. by move=> ngt0 xge0; rewrite -{1}[1](expr1n _ n) ler_pexpn2r // [_ \in _]ler01. Qed. Lemma expr_lt1 n x : (0 < n)%N -> 0 <= x -> (x ^+ n < 1) = (x < 1). Proof. by move=> ngt0 xge0; rewrite -{1}[1](expr1n _ n) ltr_pexpn2r // [_ \in _]ler01. Qed. Definition expr_lte1 := (expr_le1, expr_lt1). Lemma expr_ge1 n x : (0 < n)%N -> 0 <= x -> (1 <= x ^+ n) = (1 <= x). Proof. by move=> ngt0 xge0; rewrite -{1}[1](expr1n _ n) ler_pexpn2r // [_ \in _]ler01. Qed. Lemma expr_gt1 n x : (0 < n)%N -> 0 <= x -> (1 < x ^+ n) = (1 < x). Proof. by move=> ngt0 xge0; rewrite -{1}[1](expr1n _ n) ltr_pexpn2r // [_ \in _]ler01. 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 !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. Lemma eqr_expn2 n x y : (0 < n)%N -> 0 <= x -> 0 <= y -> (x ^+ n == y ^+ n) = (x == y). Proof. by move=> ngt0 xge0 yge0; rewrite (inj_in_eq (pexpIrn _)). Qed. Lemma sqrp_eq1 x : 0 <= x -> (x ^+ 2 == 1) = (x == 1). Proof. by move/pexpr_eq1->. Qed. Lemma sqrn_eq1 x : x <= 0 -> (x ^+ 2 == 1) = (x == -1). Proof. by rewrite -sqrrN -oppr_ge0 -eqr_oppLR => /sqrp_eq1. Qed. Lemma ler_sqr : {in nneg &, {mono (fun x => x ^+ 2) : x y / x <= y}}. Proof. exact: ler_pexpn2r. Qed. Lemma ltr_sqr : {in nneg &, {mono (fun x => x ^+ 2) : x y / x < y}}. Proof. exact: ltr_pexpn2r. Qed. Lemma ler_pinv : {in [pred x in GRing.unit | 0 < x] &, {mono (@GRing.inv R) : x y /~ x <= y}}. Proof. move=> x y /andP [ux hx] /andP [uy hy] /=. rewrite -(ler_pmul2l hx) -(ler_pmul2r hy). by rewrite !(divrr, mulrVK) ?unitf_gt0 // mul1r. Qed. Lemma ler_ninv : {in [pred x in GRing.unit | x < 0] &, {mono (@GRing.inv R) : x y /~ x <= y}}. Proof. move=> x y /andP [ux hx] /andP [uy hy] /=. rewrite -(ler_nmul2l hx) -(ler_nmul2r hy). by rewrite !(divrr, mulrVK) ?unitf_lt0 // mul1r. Qed. Lemma ltr_pinv : {in [pred x in GRing.unit | 0 < x] &, {mono (@GRing.inv R) : x y /~ x < y}}. 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: leW_nmono_in ler_ninv. Qed. Lemma invr_gt1 x : x \is a GRing.unit -> 0 < x -> (1 < x^-1) = (x < 1). Proof. by move=> Ux xgt0; rewrite -{1}[1]invr1 ltr_pinv ?inE ?unitr1 ?ltr01 ?Ux. Qed. Lemma invr_ge1 x : x \is a GRing.unit -> 0 < x -> (1 <= x^-1) = (x <= 1). Proof. by move=> Ux xgt0; rewrite -{1}[1]invr1 ler_pinv ?inE ?unitr1 ?ltr01 // Ux. Qed. Definition invr_gte1 := (invr_ge1, invr_gt1). Lemma invr_le1 x (ux : x \is a GRing.unit) (hx : 0 < x) : (x^-1 <= 1) = (1 <= x). Proof. by rewrite -invr_ge1 ?invr_gt0 ?unitrV // invrK. Qed. Lemma invr_lt1 x (ux : x \is a GRing.unit) (hx : 0 < x) : (x^-1 < 1) = (1 < x). Proof. by rewrite -invr_gt1 ?invr_gt0 ?unitrV // invrK. Qed. Definition invr_lte1 := (invr_le1, invr_lt1). Definition invr_cp1 := (invr_gte1, invr_lte1). (* max and min *) Lemma addr_min_max x y : min x y + max x y = x + y. Proof. by rewrite /min /max; case: ifP => //; rewrite addrC. Qed. Lemma addr_max_min x y : max x y + min x y = x + y. Proof. by rewrite addrC addr_min_max. Qed. Lemma minr_to_max x y : min x y = x + y - max x y. 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 real_oppr_max : {in real &, {morph -%R : x y / max x y >-> min x y : R}}. Proof. move=> x y x_real y_real; rewrite !(fun_if, if_arg) ltr_opp2. by case: real_ltgtP => // ->. Qed. Lemma real_oppr_min : {in real &, {morph -%R : x y / min x y >-> max x y : R}}. Proof. by move=> x y xr yr; rewrite -[RHS]opprK real_oppr_max ?realN// !opprK. Qed. Lemma real_addr_minl : {in real & real & real, @left_distributive R R +%R min}. Proof. by move=> x y z xr yr zr; case: (@real_leP (_ + _)); rewrite ?realD//; rewrite lter_add2; case: real_leP. Qed. Lemma real_addr_minr : {in real & real & real, @right_distributive R R +%R min}. Proof. by move=> x y z xr yr zr; rewrite !(addrC x) real_addr_minl. Qed. Lemma real_addr_maxl : {in real & real & real, @left_distributive R R +%R max}. Proof. by move=> x y z xr yr zr; case: (@real_leP (_ + _)); rewrite ?realD//; rewrite lter_add2; case: real_leP. Qed. Lemma real_addr_maxr : {in real & real & real, @right_distributive R R +%R max}. Proof. by move=> x y z xr yr zr; rewrite !(addrC x) real_addr_maxl. Qed. Lemma minr_pmulr x y z : 0 <= x -> x * min y z = min (x * y) (x * z). Proof. have [|x_gt0||->]// := comparableP x; last by rewrite !mul0r minxx. by rewrite !(fun_if, if_arg) lter_pmul2l//; case: (y < z). Qed. Lemma maxr_pmulr x y z : 0 <= x -> x * max y z = max (x * y) (x * z). Proof. have [|x_gt0||->]// := comparableP x; last by rewrite !mul0r maxxx. by rewrite !(fun_if, if_arg) lter_pmul2l//; case: (y < z). Qed. Lemma real_maxr_nmulr x y z : x <= 0 -> y \is real -> z \is real -> x * max y z = min (x * y) (x * z). Proof. move=> x0 yr zr; rewrite -[_ * _]opprK -mulrN real_oppr_max// -mulNr. by rewrite minr_pmulr ?oppr_ge0// !(mulNr, mulrN, opprK). Qed. Lemma real_minr_nmulr x y z : x <= 0 -> y \is real -> z \is real -> x * min y z = max (x * y) (x * z). Proof. move=> x0 yr zr; rewrite -[_ * _]opprK -mulrN real_oppr_min// -mulNr. by rewrite maxr_pmulr ?oppr_ge0// !(mulNr, mulrN, opprK). Qed. Lemma minr_pmull x y z : 0 <= x -> min y z * x = min (y * x) (z * x). Proof. by move=> *; rewrite mulrC minr_pmulr // ![_ * x]mulrC. Qed. Lemma maxr_pmull x y z : 0 <= x -> max y z * x = max (y * x) (z * x). Proof. by move=> *; rewrite mulrC maxr_pmulr // ![_ * x]mulrC. Qed. Lemma real_minr_nmull x y z : x <= 0 -> y \is real -> z \is real -> min y z * x = max (y * x) (z * x). Proof. by move=> *; rewrite mulrC real_minr_nmulr // ![_ * x]mulrC. Qed. Lemma real_maxr_nmull x y z : x <= 0 -> y \is real -> z \is real -> max y z * x = min (y * x) (z * x). Proof. by move=> *; rewrite mulrC real_maxr_nmulr // ![_ * x]mulrC. Qed. Lemma real_maxrN x : x \is real -> max x (- x) = `|x|. Proof. move=> x_real; rewrite /max. by case: real_ge0P => // [/ge0_cp [] | /lt0_cp []]; case: (@real_leP (- x) x); rewrite ?realN. Qed. Lemma real_maxNr x : x \is real -> max (- x) x = `|x|. Proof. by move=> x_real; rewrite comparable_maxC ?real_maxrN ?real_comparable ?realN. Qed. Lemma real_minrN x : x \is real -> min x (- x) = - `|x|. Proof. by move=> x_real; rewrite -[LHS]opprK real_oppr_min ?opprK ?real_maxNr ?realN. Qed. Lemma real_minNr x : x \is real -> min (- x) x = - `|x|. Proof. by move=> x_real; rewrite -[LHS]opprK real_oppr_min ?opprK ?real_maxrN ?realN. Qed. Section RealDomainArgExtremum. Context {I : finType} (i0 : I). Context (P : pred I) (F : I -> R) (Pi0 : P i0). Hypothesis F_real : {in P, forall i, F i \is real}. Lemma real_arg_minP : extremum_spec <=%R P F [arg min_(i < i0 | P i) F i]. Proof. by apply: comparable_arg_minP => // i j iP jP; rewrite real_comparable ?F_real. Qed. Lemma real_arg_maxP : extremum_spec >=%R P F [arg max_(i > i0 | P i) F i]. Proof. by apply: comparable_arg_maxP => // i j iP jP; rewrite real_comparable ?F_real. Qed. End RealDomainArgExtremum. (* norm *) Lemma real_ler_norm x : x \is real -> x <= `|x|. Proof. by case/real_ge0P=> hx //; rewrite (le_trans (ltW hx)) // oppr_ge0 ltW. Qed. (* norm + add *) Section NormedZmoduleTheory. Variable V : normedZmodType 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 -> 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: le_trans; apply: ler_norm_add. 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 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 v w : `|v| - `|w| <= `|v + w|. Proof. rewrite -{1}[v](addrK w) lter_sub_addl. by rewrite (le_trans (ler_norm_add _ _)) // addrC normrN. 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 v w : `| `|v| - `|w| | <= `|v - w|. Proof. have [||_|_] // := @real_leP `|v| `|w|; last by rewrite ler_sub_dist. by rewrite distrC ler_sub_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 NormedZmoduleTheory. Hint Extern 0 (is_true (norm _ \is real)) => apply: normr_real : core. Lemma real_ler_norml x y : x \is real -> (`|x| <= y) = (- y <= x <= y). Proof. 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 (le_trans _ x_ge0) // oppr_le0 (le_trans x_ge0). Qed. Lemma real_ler_normlP x y : x \is real -> reflect ((-x <= y) * (x <= y)) (`|x| <= y). Proof. by move=> Rx; rewrite real_ler_norml // ler_oppl; apply: (iffP andP) => [] []. Qed. Arguments real_ler_normlP {x y}. Lemma real_eqr_norml x y : x \is real -> (`|x| == y) = ((x == y) || (x == -y)) && (0 <= y). Proof. move=> Rx. apply/idP/idP=> [|/andP[/pred2P[]-> /ger0_norm/eqP]]; rewrite ?normrE //. case: real_le0P => // hx; rewrite 1?eqr_oppLR => /eqP exy. by move: hx; rewrite exy ?oppr_le0 eqxx orbT //. 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_le0P; rewrite // opprK orbC. Qed. Lemma real_ltr_norml x y : x \is real -> (`|x| < y) = (- y < x < y). Proof. 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 (lt_le_trans _ x_ge0) // oppr_lt0 (le_lt_trans x_ge0). Qed. Definition real_lter_norml := (real_ler_norml, real_ltr_norml). Lemma real_ltr_normlP x y : x \is real -> reflect ((-x < y) * (x < y)) (`|x| < y). Proof. move=> Rx; rewrite real_ltr_norml // ltr_oppl. by apply: (iffP (@andP _ _)); case. Qed. Arguments real_ltr_normlP {x y}. 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_leNgt ?real_ltr_norml // negb_and -?real_leNgt ?realN //. by rewrite orbC ler_oppr. Qed. 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_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 real_ltr_normlW x y : x \is real -> `|x| < y -> x < y. Proof. by move=> ?; case/real_ltr_normlP. Qed. Lemma real_ltrNnormlW x y : x \is real -> `|x| < y -> - y < x. Proof. by move=> ?; case/real_ltr_normlP => //; rewrite ltr_oppl. Qed. Lemma real_ler_normlW x y : x \is real -> `|x| <= y -> x <= y. Proof. by move=> ?; case/real_ler_normlP. Qed. Lemma real_lerNnormlW x y : x \is real -> `|x| <= y -> - y <= x. Proof. by move=> ?; case/real_ler_normlP => //; rewrite ler_oppl. Qed. 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. Lemma real_ltr_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. Definition real_lter_distl := (real_ler_distl, real_ltr_distl). Lemma real_ltr_distl_addr x y e : x - y \is real -> `|x - y| < e -> x < y + e. Proof. by move=> ?; rewrite real_ltr_distl // => /andP[]. Qed. Lemma real_ler_distl_addr x y e : x - y \is real -> `|x - y| <= e -> x <= y + e. Proof. by move=> ?; rewrite real_ler_distl // => /andP[]. Qed. Lemma real_ltr_distlC_addr x y e : x - y \is real -> `|x - y| < e -> y < x + e. Proof. by rewrite realBC (distrC x) => ? /real_ltr_distl_addr; apply. Qed. Lemma real_ler_distlC_addr x y e : x - y \is real -> `|x - y| <= e -> y <= x + e. Proof. by rewrite realBC distrC => ? /real_ler_distl_addr; apply. Qed. Lemma real_ltr_distl_subl x y e : x - y \is real -> `|x - y| < e -> x - e < y. Proof. by move/real_ltr_distl_addr; rewrite ltr_sub_addr; apply. Qed. Lemma real_ler_distl_subl x y e : x - y \is real -> `|x - y| <= e -> x - e <= y. Proof. by move/real_ler_distl_addr; rewrite ler_sub_addr; apply. Qed. Lemma real_ltr_distlC_subl x y e : x - y \is real -> `|x - y| < e -> y - e < x. Proof. by rewrite realBC distrC => ? /real_ltr_distl_subl; apply. Qed. Lemma real_ler_distlC_subl x y e : x - y \is real -> `|x - y| <= e -> y - e <= x. Proof. by rewrite realBC distrC => ? /real_ler_distl_subl; apply. Qed. (* GG: pointless duplication }-( *) Lemma eqr_norm_id x : (`|x| == x) = (0 <= x). Proof. by rewrite ger0_def. Qed. Lemma eqr_normN x : (`|x| == - x) = (x <= 0). Proof. by rewrite ler0_def. Qed. 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_ge0P xR. rewrite -[x]opprK -mulN1r exprMn -signr_odd (negPf even_n) expr0 mul1r. by rewrite exprn_ge0 ?oppr_ge0 ?ltW. Qed. Lemma real_exprn_even_gt0 n x : x \is real -> ~~ odd n -> (0 < x ^+ n) = (n == 0)%N || (x != 0). Proof. move=> xR n_even; rewrite lt0r real_exprn_even_ge0 ?expf_eq0 //. by rewrite andbT negb_and lt0n negbK. 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_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 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_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 ?ltW // (lt_eqF x_lt0) ?orbT. Qed. Lemma real_exprn_odd_gt0 n x : x \is real -> odd n -> (0 < x ^+ n) = (0 < x). Proof. by move=> xR n_odd; rewrite !lt0r expf_eq0 real_exprn_odd_ge0; case: n n_odd. 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_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_ltNge ?rpred0 ?rpredX // real_exprn_odd_ge0. Qed. (* GG: Could this be a better definition of "real" ? *) Lemma realEsqr x : (x \is real) = (0 <= x ^+ 2). Proof. by rewrite ger0_def normrX eqf_sqr -ger0_def -ler0_def. Qed. Lemma real_normK x : x \is real -> `|x| ^+ 2 = x ^+ 2. Proof. by move=> Rx; rewrite -normrX ger0_norm -?realEsqr. Qed. (* Binary sign ((-1) ^+ s). *) Lemma normr_sign s : `|(-1) ^+ s : R| = 1. Proof. by rewrite normrX normrN1 expr1n. Qed. Lemma normrMsign s x : `|(-1) ^+ s * x| = `|x|. Proof. by rewrite normrM normr_sign mul1r. Qed. Lemma signr_gt0 (b : bool) : (0 < (-1) ^+ b :> R) = ~~ b. Proof. by case: b; rewrite (ltr01, ltr0N1). Qed. Lemma signr_lt0 (b : bool) : ((-1) ^+ b < 0 :> R) = b. Proof. by case: b; rewrite // ?(ltrN10, ltr10). Qed. 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 le_eqVlt signr_eq0 signr_lt0. Qed. (* This actually holds for char R != 2. *) Lemma signr_inj : injective (fun b : bool => (-1) ^+ b : R). Proof. exact: can_inj (fun x => 0 >= x) signr_le0. Qed. (* Ternary sign (sg). *) Lemma sgr_def x : sg x = (-1) ^+ (x < 0)%R *+ (x != 0). Proof. by rewrite /sg; do 2!case: ifP => //. Qed. 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 gt_eqF // lt_gtF. Qed. Lemma ltr0_sg x : x < 0 -> sg x = -1. 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. Lemma sgrN1 : sg (-1) = -1 :> R. Proof. by rewrite ltr0_sg // ltrN10. Qed. Definition sgrE := (sgr0, sgr1, sgrN1). Lemma sqr_sg x : sg x ^+ 2 = (x != 0)%:R. Proof. by rewrite sgr_def exprMn_n sqrr_sign -mulnn mulnb andbb. Qed. Lemma mulr_sg_eq1 x y : (sg x * y == 1) = (x != 0) && (sg x == y). Proof. rewrite /sg eq_sym; case: ifP => _; first by rewrite mul0r oner_eq0. by case: ifP => _; rewrite ?mul1r // mulN1r eqr_oppLR. Qed. Lemma mulr_sg_eqN1 x y : (sg x * sg y == -1) = (x != 0) && (sg x == - sg y). Proof. move/sg: y => y; rewrite /sg eq_sym eqr_oppLR. case: ifP => _; first by rewrite mul0r oppr0 oner_eq0. by case: ifP => _; rewrite ?mul1r // mulN1r eqr_oppLR. Qed. Lemma sgr_eq0 x : (sg x == 0) = (x == 0). Proof. by rewrite -sqrf_eq0 sqr_sg pnatr_eq0; case: (x == 0). Qed. Lemma sgr_odd n x : x != 0 -> (sg x) ^+ n = (sg x) ^+ (odd n). Proof. by rewrite /sg; do 2!case: ifP => // _; rewrite ?expr1n ?signr_odd. Qed. Lemma sgrMn x n : sg (x *+ n) = (n != 0%N)%:R * sg x. Proof. case: n => [|n]; first by rewrite mulr0n sgr0 mul0r. by rewrite !sgr_def mulrn_eq0 mul1r pmulrn_llt0. Qed. Lemma sgr_nat n : sg n%:R = (n != 0%N)%:R :> R. Proof. by rewrite sgrMn sgr1 mulr1. Qed. Lemma sgr_id x : sg (sg x) = sg x. 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 // lt_gtF. Qed. Lemma sgr_le0 x : (sgr x <= 0) = (x <= 0). 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_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. Lemma real_normrEsign (x : R) (xR : x \is real) : `|x| = (-1) ^+ (x < 0)%R * x. Proof. by rewrite {3}[x]realEsign // signrMK. Qed. (* GG: pointless duplication... *) Lemma real_mulr_sign_norm x : x \is real -> (-1) ^+ (x < 0)%R * `|x| = x. Proof. by move/realEsign. Qed. Lemma real_mulr_Nsign_norm x : x \is real -> (-1) ^+ (0 < x)%R * `|x| = - x. Proof. by move/realNEsign. Qed. Lemma realEsg x : x \is real -> x = sgr x * `|x|. Proof. move=> xR; have [-> | ] := eqVneq x 0; first by rewrite normr0 mulr0. by move=> /neqr0_sign <-; rewrite -realEsign. Qed. 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 le_gtF // normr_eq0 mulrb if_neg. Qed. (* leif *) 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 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 leif_subRL x y z C : (x <= y - z ?= iff C) = (x + z <= y ?= iff C). Proof. by rewrite -leif_subLR opprK. Qed. 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_leif (ler_add2r x2)) -(mono_leif (C := C2) (ler_add2l y1)). exact: leif_trans. Qed. 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 /leif lexx eqxx. exact: leif_add. Qed. 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/leif_sum; rewrite big1_eq. Qed. Lemma real_leif_norm x : x \is real -> x <= `|x| ?= iff (0 <= x). Proof. by move=> xR; rewrite ger0_def eq_sym; apply: leif_eq; rewrite real_ler_norm. Qed. 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 | ] := eqVneq _ 0. 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 lt_def y1nz (le_trans _ le_xy1). have [x2_0 | x2nz] := eqVneq x2 0. 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 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: leif_pmul => //; rewrite (nmono_leif ler_opp2). Qed. 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 pi E1 <= pi E2 ?= iff (pi E2 == 0) || [forall (i | P i), C i]. 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/leifP; rewrite orbT. have Ei_ge0 := E1_ge0 i Pi; split; first by rewrite mulr_ge0. congr (leif _ _ _): (leif_pmul Ei_ge0 m1ge0 (leE12 i Pi) le_m12). by rewrite mulf_eq0 -!orbA; congr (_ || _); rewrite !orb_andr orbA orbb. Qed. (* lteif *) Lemma subr_lteifr0 C x y : (y - x < 0 ?<= if C) = (y < x ?<= if C). Proof. by case: C => /=; rewrite subr_lte0. Qed. Lemma subr_lteif0r C x y : (0 < y - x ?<= if C) = (x < y ?<= if C). Proof. by case: C => /=; rewrite subr_gte0. Qed. Definition subr_lteif0 := (subr_lteifr0, subr_lteif0r). Lemma lteif01 C : 0 < 1 ?<= if C :> R. Proof. by case: C; rewrite /= lter01. Qed. Lemma lteif_oppl C x y : - x < y ?<= if C = (- y < x ?<= if C). Proof. by case: C; rewrite /= lter_oppl. Qed. Lemma lteif_oppr C x y : x < - y ?<= if C = (y < - x ?<= if C). Proof. by case: C; rewrite /= lter_oppr. Qed. Lemma lteif_0oppr C x : 0 < - x ?<= if C = (x < 0 ?<= if C). Proof. by case: C; rewrite /= (oppr_ge0, oppr_gt0). Qed. Lemma lteif_oppr0 C x : - x < 0 ?<= if C = (0 < x ?<= if C). Proof. by case: C; rewrite /= (oppr_le0, oppr_lt0). Qed. Lemma lteif_opp2 C : {mono -%R : x y /~ x < y ?<= if C :> R}. Proof. by case: C => ? ?; rewrite /= lter_opp2. Qed. Definition lteif_oppE := (lteif_0oppr, lteif_oppr0, lteif_opp2). Lemma lteif_add2l C x : {mono +%R x : y z / y < z ?<= if C}. Proof. by case: C => ? ?; rewrite /= lter_add2. Qed. Lemma lteif_add2r C x : {mono +%R^~ x : y z / y < z ?<= if C}. Proof. by case: C => ? ?; rewrite /= lter_add2. Qed. Definition lteif_add2 := (lteif_add2l, lteif_add2r). Lemma lteif_subl_addr C x y z : (x - y < z ?<= if C) = (x < z + y ?<= if C). Proof. by case: C; rewrite /= lter_sub_addr. Qed. Lemma lteif_subr_addr C x y z : (x < y - z ?<= if C) = (x + z < y ?<= if C). Proof. by case: C; rewrite /= lter_sub_addr. Qed. Definition lteif_sub_addr := (lteif_subl_addr, lteif_subr_addr). Lemma lteif_subl_addl C x y z : (x - y < z ?<= if C) = (x < y + z ?<= if C). Proof. by case: C; rewrite /= lter_sub_addl. Qed. Lemma lteif_subr_addl C x y z : (x < y - z ?<= if C) = (z + x < y ?<= if C). Proof. by case: C; rewrite /= lter_sub_addl. Qed. Definition lteif_sub_addl := (lteif_subl_addl, lteif_subr_addl). Lemma lteif_pmul2l C x : 0 < x -> {mono *%R x : y z / y < z ?<= if C}. Proof. by case: C => ? ? ?; rewrite /= lter_pmul2l. Qed. Lemma lteif_pmul2r C x : 0 < x -> {mono *%R^~ x : y z / y < z ?<= if C}. Proof. by case: C => ? ? ?; rewrite /= lter_pmul2r. Qed. Lemma lteif_nmul2l C x : x < 0 -> {mono *%R x : y z /~ y < z ?<= if C}. Proof. by case: C => ? ? ?; rewrite /= lter_nmul2l. Qed. Lemma lteif_nmul2r C x : x < 0 -> {mono *%R^~ x : y z /~ y < z ?<= if C}. Proof. by case: C => ? ? ?; rewrite /= lter_nmul2r. Qed. Lemma lteif_nnormr C x y : y < 0 ?<= if ~~ C -> (`|x| < y ?<= if C) = false. Proof. by case: C => ?; rewrite /= lter_nnormr. Qed. Lemma real_lteifNE x y C : x \is Num.real -> y \is Num.real -> x < y ?<= if ~~ C = ~~ (y < x ?<= if C). Proof. by move=> ? ?; rewrite comparable_lteifNE ?real_comparable. Qed. Lemma real_lteif_norml C x y : x \is Num.real -> (`|x| < y ?<= if C) = ((- y < x ?<= if C) && (x < y ?<= if C)). Proof. by case: C => ?; rewrite /= real_lter_norml. Qed. Lemma real_lteif_normr C x y : y \is Num.real -> (x < `|y| ?<= if C) = ((x < y ?<= if C) || (x < - y ?<= if C)). Proof. by case: C => ?; rewrite /= real_lter_normr. Qed. Lemma real_lteif_distl C x y e : x - y \is real -> (`|x - y| < e ?<= if C) = (y - e < x ?<= if C) && (x < y + e ?<= if C). Proof. by case: C => /= ?; rewrite real_lter_distl. Qed. (* Mean inequalities. *) 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 -leif_subRL addrAC -sqrrB -subr_eq0. by rewrite -sqrf_eq0 eq_sym; apply: leif_eq; rewrite -realEsqr rpredB. Qed. 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) -leif_subLR addrK. exact: real_leif_mean_square_scaled. Qed. 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/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_const -(eq_bigr _ E_i) prodr_const. set mu := \sum_(i in A) E i; pose En i := E i *+ n. pose cmp_mu s := [pred i | s * mu < s * En i]. 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 i: i \in A -> s * En i <= s * mu. 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] := 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. 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 lt_gtF. have{i'j} A'j: j \in A' by rewrite !inE Aj i'j. 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 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 // 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 /=. rewrite !(bigD1 j A'j) /= addrCA eqxx !addrA subrK; congr (_ + _). by apply: eq_bigr => k /andP[_ /negPf->]. rewrite prodrMn_const 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: lt_le_trans. rewrite ltr_pmul2r //= eqxx -addrA mulrDr mulrC -ltr_subl_addl -mulrBl. by rewrite mulrC ltr_pmul2r ?subr_gt0. Qed. (* Polynomial bound. *) 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 (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. Hint Resolve ler_opp2 ltr_opp2 real0 real1 normr_real : core. Arguments ler_sqr {R} [x y]. 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}. 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'). 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_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_ltP xR yR. by rewrite lt_geF ?mf. by rewrite ltW_nhomo. Qed. Lemma real_mono_in : {in D &, {homo f : x y / x < y}} -> {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_leP xR yR; first by rewrite (ltW_homo_in Dmf). by rewrite lt_geF ?Dmf. Qed. Lemma real_nmono_in : {in D &, {homo f : x y /~ x < y}} -> {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_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)} -> {in real &, {mono f' : x y / x <= y >-> (x <= y)}}. Proof. 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)} -> {in real &, {mono f' : x y / y <= x >-> (x <= y)}}. Proof. 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)}} -> {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_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)}} -> {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_ltP xR yR; last by rewrite (ltW_nhomo_in Dmf). by rewrite lt_geF ?Dmf. Qed. End NumDomainMonotonyTheoryForReals. Section FinGroup. Import GroupScope. Variables (R : numDomainType) (gT : finGroupType). Implicit Types G : {group gT}. 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 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 gt_eqF // natr_indexg_gt0. Qed. End FinGroup. Section NumFieldTheory. 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 lt_eqF. Qed. Lemma unitf_lt0 x : x < 0 -> x \is a GRing.unit. 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. 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: leW_nmono_in lef_pinv. Qed. Lemma ltf_ninv: {in neg &, {mono (@GRing.inv F) : x y /~ x < y}}. Proof. exact: leW_nmono_in lef_ninv. Qed. Definition ltef_pinv := (lef_pinv, ltf_pinv). Definition ltef_ninv := (lef_ninv, ltf_ninv). Lemma invf_gt1 x : 0 < x -> (1 < x^-1) = (x < 1). Proof. by move=> x_gt0; rewrite -{1}[1]invr1 ltf_pinv ?posrE ?ltr01. Qed. Lemma invf_ge1 x : 0 < x -> (1 <= x^-1) = (x <= 1). Proof. by move=> x_lt0; rewrite -{1}[1]invr1 lef_pinv ?posrE ?ltr01. Qed. Definition invf_gte1 := (invf_ge1, invf_gt1). Lemma invf_le1 x : 0 < x -> (x^-1 <= 1) = (1 <= x). Proof. by move=> x_gt0; rewrite -invf_ge1 ?invr_gt0 // invrK. Qed. Lemma invf_lt1 x : 0 < x -> (x^-1 < 1) = (1 < x). Proof. by move=> x_lt0; rewrite -invf_gt1 ?invr_gt0 // invrK. Qed. Definition invf_lte1 := (invf_le1, invf_lt1). 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 _ 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 _ 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 ?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 ?gt_eqF. Qed. Definition lter_pdivr_mulr := (ler_pdivr_mulr, ltr_pdivr_mulr). Lemma ler_pdivl_mull z x y : 0 < z -> (x <= z^-1 * y) = (z * x <= y). Proof. by move=> z_gt0; rewrite mulrC ler_pdivl_mulr ?[z * _]mulrC. Qed. Lemma ltr_pdivl_mull z x y : 0 < z -> (x < z^-1 * y) = (z * x < y). Proof. by move=> z_gt0; rewrite mulrC ltr_pdivl_mulr ?[z * _]mulrC. Qed. Definition lter_pdivl_mull := (ler_pdivl_mull, ltr_pdivl_mull). Lemma ler_pdivr_mull z x y : 0 < z -> (z^-1 * y <= x) = (y <= z * x). Proof. by move=> z_gt0; rewrite mulrC ler_pdivr_mulr ?[z * _]mulrC. Qed. Lemma ltr_pdivr_mull z x y : 0 < z -> (z^-1 * y < x) = (y < z * x). 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 ?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 ?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 ?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 ?lt_eqF. Qed. Definition lter_ndivr_mulr := (ler_ndivr_mulr, ltr_ndivr_mulr). Lemma ler_ndivl_mull z x y : z < 0 -> (x <= z^-1 * y) = (y <= z * x). Proof. by move=> z_lt0; rewrite mulrC ler_ndivl_mulr ?[z * _]mulrC. Qed. Lemma ltr_ndivl_mull z x y : z < 0 -> (x < z^-1 * y) = (y < z * x). Proof. by move=> z_lt0; rewrite mulrC ltr_ndivl_mulr ?[z * _]mulrC. Qed. Definition lter_ndivl_mull := (ler_ndivl_mull, ltr_ndivl_mull). Lemma ler_ndivr_mull z x y : z < 0 -> (z^-1 * y <= x) = (z * x <= y). Proof. by move=> z_lt0; rewrite mulrC ler_ndivr_mulr ?[z * _]mulrC. Qed. Lemma ltr_ndivr_mull z x y : z < 0 -> (z^-1 * y < x) = (z * x < y). Proof. by move=> z_lt0; rewrite mulrC ltr_ndivr_mulr ?[z * _]mulrC. Qed. 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 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 F) : x y / x / y}. Proof. by move=> x y /=; rewrite normrM normfV. Qed. Lemma invr_sg x : (sg x)^-1 = sgr x. Proof. by rewrite !(fun_if GRing.inv) !(invr0, invrN, invr1). Qed. Lemma sgrV x : sgr x^-1 = sgr x. Proof. by rewrite /sgr invr_eq0 invr_lt0. Qed. (* lteif *) Lemma lteif_pdivl_mulr C z x y : 0 < z -> x < y / z ?<= if C = (x * z < y ?<= if C). Proof. by case: C => ? /=; rewrite lter_pdivl_mulr. Qed. Lemma lteif_pdivr_mulr C z x y : 0 < z -> y / z < x ?<= if C = (y < x * z ?<= if C). Proof. by case: C => ? /=; rewrite lter_pdivr_mulr. Qed. Lemma lteif_pdivl_mull C z x y : 0 < z -> x < z^-1 * y ?<= if C = (z * x < y ?<= if C). Proof. by case: C => ? /=; rewrite lter_pdivl_mull. Qed. Lemma lteif_pdivr_mull C z x y : 0 < z -> z^-1 * y < x ?<= if C = (y < z * x ?<= if C). Proof. by case: C => ? /=; rewrite lter_pdivr_mull. Qed. Lemma lteif_ndivl_mulr C z x y : z < 0 -> x < y / z ?<= if C = (y < x * z ?<= if C). Proof. by case: C => ? /=; rewrite lter_ndivl_mulr. Qed. Lemma lteif_ndivr_mulr C z x y : z < 0 -> y / z < x ?<= if C = (x * z < y ?<= if C). Proof. by case: C => ? /=; rewrite lter_ndivr_mulr. Qed. Lemma lteif_ndivl_mull C z x y : z < 0 -> x < z^-1 * y ?<= if C = (y < z * x ?<= if C). Proof. by case: C => ? /=; rewrite lter_ndivl_mull. Qed. Lemma lteif_ndivr_mull C z x y : z < 0 -> z^-1 * y < x ?<= if C = (z * x < y ?<= if C). Proof. by case: C => ? /=; rewrite lter_ndivr_mull. Qed. (* Interval midpoint. *) Local Notation mid x y := ((x + y) / 2%:R). Lemma midf_le x y : x <= y -> (x <= mid x y) * (mid x y <= y). Proof. move=> lexy; rewrite ler_pdivl_mulr ?ler_pdivr_mulr ?ltr0Sn //. by rewrite !mulrDr !mulr1 ler_add2r ler_add2l. Qed. Lemma midf_lt x y : x < y -> (x < mid x y) * (mid x y < y). Proof. move=> ltxy; rewrite ltr_pdivl_mulr ?ltr_pdivr_mulr ?ltr0Sn //. by rewrite !mulrDr !mulr1 ltr_add2r ltr_add2l. Qed. Definition midf_lte := (midf_le, midf_lt). (* The AGM, unscaled but without the nth root. *) 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_leif (ler_pmul2r (ltr_nat F 0 2))). by rewrite divfK ?pnatr_eq0 // mulr_natr; apply: real_leif_mean_square_scaled. Qed. 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_leif (ler_pmul2r (ltr_nat F 0 4))). rewrite mulr_natr (natrX F 2 2) -exprMn divfK ?pnatr_eq0 //. exact: real_leif_AGM2_scaled. Qed. 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/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 /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. Implicit Type p : {poly F}. Lemma Cauchy_root_bound p : p != 0 -> {b | forall x, root p x -> `|x| <= b}. Proof. move=> nz_p; set a := lead_coef p; set n := (size p).-1. have [q Dp]: {q | forall x, x != 0 -> p.[x] = (a - q.[x^-1] / x) * x ^+ n}. exists (- \poly_(i < n) p`_(n - i.+1)) => x nz_x. rewrite hornerN mulNr opprK horner_poly mulrDl !mulr_suml addrC. rewrite horner_coef polySpred // big_ord_recr (reindex_inj rev_ord_inj) /=. 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 (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 (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 (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 le_gtF // ub_q // normfV invf_le1 ?normr_gt0. Qed. Import GroupScope. Lemma natf_indexg (gT : finGroupType) (G H : {group gT}) : H \subset G -> #|G : H|%:R = (#|G|%:R / #|H|%:R)%R :> F. Proof. by move=> sHG; rewrite -divgS // natf_div ?cardSg. Qed. End NumFieldTheory. Section RealDomainTheory. 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 lerP x y : ler_xor_gt x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (x <= y) (y < x). Proof. exact: real_leP. Qed. Lemma ltrP x y : ltr_xor_ge x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (y <= x) (x < y). Proof. exact: real_ltP. Qed. Lemma ltrgtP x y : comparer x y (min y x) (min x y) (max y x) (max x y) `|x - y| `|y - x| (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y) . Proof. exact: real_ltgtP. Qed. Lemma ger0P x : ger0_xor_lt0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (x < 0) (0 <= x). Proof. exact: real_ge0P. Qed. Lemma ler0P x : ler0_xor_gt0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (0 < x) (x <= 0). Proof. exact: real_le0P. Qed. Lemma ltrgt0P x : comparer0 x (min 0 x) (min x 0) (max 0 x) (max x 0) `|x| (0 == x) (x == 0) (x <= 0) (0 <= x) (x < 0) (x > 0). Proof. exact: real_ltgt0P. Qed. (* sign *) Lemma mulr_lt0 x y : (x * y < 0) = [&& x != 0, y != 0 & (x < 0) (+) (y < 0)]. Proof. have [x_gt0|x_lt0|->] /= := ltrgt0P x; last by rewrite mul0r. by rewrite pmulr_rlt0 //; case: ltrgt0P. by rewrite nmulr_rlt0 //; case: ltrgt0P. Qed. Lemma neq0_mulr_lt0 x y : x != 0 -> y != 0 -> (x * y < 0) = (x < 0) (+) (y < 0). Proof. by move=> x_neq0 y_neq0; rewrite mulr_lt0 x_neq0 y_neq0. Qed. 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 *) Lemma mulr_sign_norm x : (-1) ^+ (x < 0)%R * `|x| = x. Proof. by rewrite real_mulr_sign_norm. Qed. Lemma mulr_Nsign_norm x : (-1) ^+ (0 < x)%R * `|x| = - x. Proof. by rewrite real_mulr_Nsign_norm. Qed. Lemma numEsign x : x = (-1) ^+ (x < 0)%R * `|x|. Proof. by rewrite -realEsign. Qed. Lemma numNEsign x : -x = (-1) ^+ (0 < x)%R * `|x|. Proof. by rewrite -realNEsign. Qed. Lemma normrEsign x : `|x| = (-1) ^+ (x < 0)%R * x. Proof. by rewrite -real_normrEsign. Qed. End RealDomainTheory. Hint Resolve num_real : core. Section RealDomainOperations. Notation "[ 'arg' 'min_' ( i < i0 | P ) F ]" := (Order.arg_min (disp := ring_display) i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, format "[ 'arg' 'min_' ( i < i0 | P ) F ]") : ring_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 ]") : ring_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 ]") : ring_scope. Notation "[ 'arg' 'max_' ( i > i0 | P ) F ]" := (Order.arg_max (disp := ring_display) i0 (fun i => P%B) (fun i => F)) (at level 0, i, i0 at level 10, format "[ 'arg' 'max_' ( i > i0 | P ) F ]") : ring_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 ]") : ring_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 ]") : ring_scope. (* sgr section *) Variable R : realDomainType. Implicit Types x y z t : R. Let numR_real := @num_real R. Hint Resolve numR_real : core. Lemma sgr_cp0 x : ((sg x == 1) = (0 < x)) * ((sg x == -1) = (x < 0)) * ((sg x == 0) = (x == 0)). Proof. 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. Variant sgr_val x : R -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> R -> Set := | SgrNull of x = 0 : sgr_val x 0 true true true true false false true false false true false false 0 | SgrPos of x > 0 : sgr_val x x false false true false false true false false true false false true 1 | SgrNeg of x < 0 : sgr_val x (- x) false true false false true false false true false false true false (-1). Lemma sgrP x : sgr_val x `|x| (0 == x) (x <= 0) (0 <= x) (x == 0) (x < 0) (0 < x) (0 == sg x) (-1 == sg x) (1 == sg x) (sg x == 0) (sg x == -1) (sg x == 1) (sg x). Proof. by rewrite ![_ == sg _]eq_sym !sgr_cp0 /sg; case: ltrgt0P; constructor. Qed. Lemma normrEsg x : `|x| = sg x * x. Proof. by case: sgrP; rewrite ?(mul0r, mul1r, mulN1r). Qed. Lemma numEsg x : x = sg x * `|x|. Proof. by case: sgrP; rewrite !(mul1r, mul0r, mulrNN). Qed. (* GG: duplicate! *) Lemma mulr_sg_norm x : sg x * `|x| = x. Proof. by rewrite -numEsg. Qed. Lemma sgrM x y : sg (x * y) = sg x * sg y. Proof. rewrite !sgr_def mulr_lt0 andbA mulrnAr mulrnAl -mulrnA mulnb -negb_or mulf_eq0. by case: (~~ _) => //; rewrite signr_addb. Qed. Lemma sgrN x : sg (- x) = - sg x. Proof. by rewrite -mulrN1 sgrM sgrN1 mulrN1. Qed. Lemma sgrX n x : sg (x ^+ n) = (sg x) ^+ n. Proof. by elim: n => [|n IHn]; rewrite ?sgr1 // !exprS sgrM IHn. Qed. Lemma sgr_smul x y : sg (sg x * y) = sg x * sg y. Proof. by rewrite sgrM sgr_id. Qed. 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 !leNgt sgr_lt0. Qed. (* norm section *) Lemma ler_norm x : (x <= `|x|). Proof. exact: real_ler_norm. Qed. Lemma ler_norml x y : (`|x| <= y) = (- y <= x <= y). Proof. exact: real_ler_norml. Qed. Lemma ler_normlP x y : reflect ((- x <= y) * (x <= y)) (`|x| <= y). Proof. exact: real_ler_normlP. Qed. Arguments ler_normlP {x y}. Lemma eqr_norml x y : (`|x| == y) = ((x == y) || (x == -y)) && (0 <= y). Proof. exact: real_eqr_norml. Qed. Lemma eqr_norm2 x y : (`|x| == `|y|) = (x == y) || (x == -y). Proof. exact: real_eqr_norm2. Qed. Lemma ltr_norml x y : (`|x| < y) = (- y < x < y). Proof. exact: real_ltr_norml. Qed. Definition lter_norml := (ler_norml, ltr_norml). Lemma ltr_normlP x y : reflect ((-x < y) * (x < y)) (`|x| < y). Proof. exact: real_ltr_normlP. Qed. Arguments ltr_normlP {x y}. Lemma ltr_normlW x y : `|x| < y -> x < y. Proof. exact: real_ltr_normlW. Qed. Lemma ltrNnormlW x y : `|x| < y -> - y < x. Proof. exact: real_ltrNnormlW. Qed. Lemma ler_normlW x y : `|x| <= y -> x <= y. Proof. exact: real_ler_normlW. Qed. Lemma lerNnormlW x y : `|x| <= y -> - y <= x. Proof. exact: real_lerNnormlW. Qed. Lemma ler_normr x y : (x <= `|y|) = (x <= y) || (x <= - y). Proof. exact: real_ler_normr. Qed. Lemma ltr_normr x y : (x < `|y|) = (x < y) || (x < - y). Proof. exact: real_ltr_normr. Qed. Definition lter_normr := (ler_normr, ltr_normr). Lemma ler_distl x y e : (`|x - y| <= e) = (y - e <= x <= y + e). Proof. exact: real_ler_distl. Qed. Lemma ltr_distl x y e : (`|x - y| < e) = (y - e < x < y + e). Proof. exact: real_ltr_distl. Qed. Definition lter_distl := (ler_distl, ltr_distl). Lemma ltr_distl_addr x y e : `|x - y| < e -> x < y + e. Proof. exact: real_ltr_distl_addr. Qed. Lemma ler_distl_addr x y e : `|x - y| <= e -> x <= y + e. Proof. exact: real_ler_distl_addr. Qed. Lemma ltr_distlC_addr x y e : `|x - y| < e -> y < x + e. Proof. exact: real_ltr_distlC_addr. Qed. Lemma ler_distlC_addr x y e : `|x - y| <= e -> y <= x + e. Proof. exact: real_ler_distlC_addr. Qed. Lemma ltr_distl_subl x y e : `|x - y| < e -> x - e < y. Proof. exact: real_ltr_distl_subl. Qed. Lemma ler_distl_subl x y e : `|x - y| <= e -> x - e <= y. Proof. exact: real_ler_distl_subl. Qed. Lemma ltr_distlC_subl x y e : `|x - y| < e -> y - e < x. Proof. exact: real_ltr_distlC_subl. Qed. Lemma ler_distlC_subr x y e : `|x - y| <= e -> y - e <= x. Proof. exact: real_ler_distlC_subl. Qed. Lemma exprn_even_ge0 n x : ~~ odd n -> 0 <= x ^+ n. Proof. by move=> even_n; rewrite real_exprn_even_ge0 ?num_real. Qed. Lemma exprn_even_gt0 n x : ~~ odd n -> (0 < x ^+ n) = (n == 0)%N || (x != 0). Proof. by move=> even_n; rewrite real_exprn_even_gt0 ?num_real. Qed. Lemma exprn_even_le0 n x : ~~ odd n -> (x ^+ n <= 0) = (n != 0%N) && (x == 0). Proof. by move=> even_n; rewrite real_exprn_even_le0 ?num_real. Qed. Lemma exprn_even_lt0 n x : ~~ odd n -> (x ^+ n < 0) = false. Proof. by move=> even_n; rewrite real_exprn_even_lt0 ?num_real. Qed. Lemma exprn_odd_ge0 n x : odd n -> (0 <= x ^+ n) = (0 <= x). Proof. by move=> even_n; rewrite real_exprn_odd_ge0 ?num_real. Qed. Lemma exprn_odd_gt0 n x : odd n -> (0 < x ^+ n) = (0 < x). Proof. by move=> even_n; rewrite real_exprn_odd_gt0 ?num_real. Qed. Lemma exprn_odd_le0 n x : odd n -> (x ^+ n <= 0) = (x <= 0). Proof. by move=> even_n; rewrite real_exprn_odd_le0 ?num_real. Qed. Lemma exprn_odd_lt0 n x : odd n -> (x ^+ n < 0) = (x < 0). Proof. by move=> even_n; rewrite real_exprn_odd_lt0 ?num_real. Qed. (* lteif *) Lemma lteif_norml C x y : (`|x| < y ?<= if C) = (- y < x ?<= if C) && (x < y ?<= if C). Proof. by case: C; rewrite /= lter_norml. Qed. Lemma lteif_normr C x y : (x < `|y| ?<= if C) = (x < y ?<= if C) || (x < - y ?<= if C). Proof. by case: C; rewrite /= lter_normr. Qed. Lemma lteif_distl C x y e : (`|x - y| < e ?<= if C) = (y - e < x ?<= if C) && (x < y + e ?<= if C). Proof. by case: C; rewrite /= lter_distl. Qed. (* Special lemmas for squares. *) 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 leif_mean_square_scaled x y : x * y *+ 2 <= x ^+ 2 + y ^+ 2 ?= iff (x == y). Proof. exact: real_leif_mean_square_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. Lemma oppr_max : {morph -%R : x y / max x y >-> min x y : R}. Proof. by move=> x y; apply: real_oppr_max. Qed. Lemma oppr_min : {morph -%R : x y / min x y >-> max x y : R}. Proof. by move=> x y; apply: real_oppr_min. Qed. Lemma addr_minl : @left_distributive R R +%R min. Proof. by move=> x y z; apply: real_addr_minl. Qed. Lemma addr_minr : @right_distributive R R +%R min. Proof. by move=> x y z; apply: real_addr_minr. Qed. Lemma addr_maxl : @left_distributive R R +%R max. Proof. by move=> x y z; apply: real_addr_maxl. Qed. Lemma addr_maxr : @right_distributive R R +%R max. Proof. by move=> x y z; apply: real_addr_maxr. Qed. Lemma minr_nmulr x y z : x <= 0 -> x * min y z = max (x * y) (x * z). Proof. by move=> x_le0; apply: real_minr_nmulr. Qed. Lemma maxr_nmulr x y z : x <= 0 -> x * max y z = min (x * y) (x * z). Proof. by move=> x_le0; apply: real_maxr_nmulr. Qed. Lemma minr_nmull x y z : x <= 0 -> min y z * x = max (y * x) (z * x). Proof. by move=> x_le0; apply: real_minr_nmull. Qed. Lemma maxr_nmull x y z : x <= 0 -> max y z * x = min (y * x) (z * x). Proof. by move=> x_le0; apply: real_maxr_nmull. Qed. Lemma maxrN x : max x (- x) = `|x|. Proof. exact: real_maxrN. Qed. Lemma maxNr x : max (- x) x = `|x|. Proof. exact: real_maxNr. Qed. Lemma minrN x : min x (- x) = - `|x|. Proof. exact: real_minrN. Qed. Lemma minNr x : min (- x) x = - `|x|. Proof. exact: real_minNr. Qed. End MinMax. Section PolyBounds. 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 // le_maxr !ler_normr. by have [_|_] := ler0P x; rewrite ?ler_opp2 ?le_a_x ?le_x_b orbT. Qed. Lemma monic_Cauchy_bound : p \is monic -> {b | forall x, x >= b -> p.[x] > 0}. Proof. move/monicP=> mon_p; pose n := (size p - 2)%N. 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 := 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: 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: le_trans (ler_norm _) _. rewrite normrN normrM ler_wpmul2l // normrX. by rewrite ger0_norm ?(ltW x_gt0) // ler_weexpn2l ?leq_ord. Qed. End PolyBounds. End RealDomainOperations. Section RealField. Variables (F : realFieldType) (x y : F). 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 leif_AGM2 : x * y <= ((x + y) / 2%:R)^+ 2 ?= iff (x == y). Proof. by apply: real_leif_AGM2; apply: num_real. Qed. End RealField. Section ArchimedeanFieldTheory. Variables (F : archiFieldType) (x : F). Lemma archi_boundP : 0 <= x -> x < (bound x)%:R. 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: 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. End ArchimedeanFieldTheory. Section RealClosedFieldTheory. Variable R : rcfType. Implicit Types a x y : R. Lemma poly_ivt : real_closed_axiom R. Proof. exact: poly_ivt. Qed. (* Square Root theory *) Lemma sqrtr_ge0 a : 0 <= sqrt a. Proof. by rewrite /sqrt; case: (sig2W _). Qed. Hint Resolve sqrtr_ge0 : core. Lemma sqr_sqrtr a : 0 <= a -> sqrt a ^+ 2 = a. Proof. by rewrite /sqrt => a_ge0; case: (sig2W _) => /= x _; rewrite a_ge0 => /eqP. Qed. Lemma ler0_sqrtr a : a <= 0 -> sqrt a = 0. Proof. rewrite /sqrtr; case: (sig2W _) => x /= _. by have [//|_ /eqP//|->] := ltrgt0P a; rewrite mulf_eq0 orbb => /eqP. Qed. Lemma ltr0_sqrtr a : a < 0 -> sqrt a = 0. 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 | IsSqrtr b of 0 <= b : sqrtr_spec a (b ^+ 2) true false b. Lemma sqrtrP a : sqrtr_spec a a (0 <= a) (a < 0) (sqrt a). Proof. have [a_ge0|a_lt0] := ger0P a. by rewrite -{1 2}[a]sqr_sqrtr //; constructor. by rewrite ltr0_sqrtr //; constructor. Qed. Lemma sqrtr_sqr a : sqrt (a ^+ 2) = `|a|. Proof. have /eqP : sqrt (a ^+ 2) ^+ 2 = `|a| ^+ 2. by rewrite -normrX ger0_norm ?sqr_sqrtr ?sqr_ge0. rewrite eqf_sqr => /predU1P[-> //|ha]. have := sqrtr_ge0 (a ^+ 2); rewrite (eqP ha) oppr_ge0 normr_le0 => /eqP ->. by rewrite normr0 oppr0. Qed. Lemma sqrtrM a b : 0 <= a -> sqrt (a * b) = sqrt a * sqrt b. Proof. case: (sqrtrP a) => // {}a a_ge0 _; case: (sqrtrP b) => [b_lt0 | {}b b_ge0]. by rewrite mulr0 ler0_sqrtr // nmulr_lle0 ?mulr_ge0. by rewrite mulrACA sqrtr_sqr ger0_norm ?mulr_ge0. Qed. Lemma sqrtr0 : sqrt 0 = 0 :> R. Proof. by move: (sqrtr_sqr 0); rewrite exprS mul0r => ->; rewrite normr0. Qed. Lemma sqrtr1 : sqrt 1 = 1 :> R. Proof. by move: (sqrtr_sqr 1); rewrite expr1n => ->; rewrite normr1. Qed. Lemma sqrtr_eq0 a : (sqrt a == 0) = (a <= 0). Proof. 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 -ltNge andbT. Qed. Lemma eqr_sqrt a b : 0 <= a -> 0 <= b -> (sqrt a == sqrt b) = (a == b). Proof. move=> a_ge0 b_ge0; apply/eqP/eqP=> [HS|->] //. by move: (sqr_sqrtr a_ge0); rewrite HS (sqr_sqrtr b_ge0). 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 -ltNge; move/ltW; rewrite -sqrtr_eq0; move/eqP->. rewrite -(@ler_pexpn2r R 2) ?nnegrE ?sqrtr_ge0 //. by rewrite !sqr_sqrtr // (le_trans pa). Qed. Lemma ler_psqrt : {in @pos R &, {mono sqrt : a b / a <= b}}. Proof. 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 (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 (leW_mono_in ler_psqrt). by rewrite ler0_sqrtr // sqrtr_gt0 b_gt0 (le_lt_trans a_le0). Qed. End RealClosedFieldTheory. Definition conjC {C : numClosedFieldType} : {rmorphism C -> C} := ClosedField.conj_op (ClosedField.conj_mixin (ClosedField.class C)). Notation "z ^*" := (@conjC _ z) (at level 2, format "z ^*") : ring_scope. Definition imaginaryC {C : numClosedFieldType} : C := ClosedField.imaginary (ClosedField.conj_mixin (ClosedField.class C)). Notation "'i" := (@imaginaryC _) (at level 0) : ring_scope. Section ClosedFieldTheory. Variable C : numClosedFieldType. Implicit Types a x y z : C. Definition normCK x : `|x| ^+ 2 = x * x^*. Proof. by case: C x => ? [? ? ? []]. Qed. Lemma sqrCi : 'i ^+ 2 = -1 :> C. Proof. by case: C => ? [? ? ? []]. Qed. Lemma conjCK : involutive (@conjC C). Proof. have JE x : x^* = `|x|^+2 / x. have [->|x_neq0] := eqVneq x 0; first by rewrite rmorph0 invr0 mulr0. by apply: (canRL (mulfK _)) => //; rewrite mulrC -normCK. move=> x; have [->|x_neq0] := eqVneq x 0; first by rewrite !rmorph0. rewrite !JE normrM normfV exprMn normrX normr_id. rewrite invfM exprVn (AC (2*2)%AC (1*(2*3)*4)%AC)/= -invfM -exprMn. by rewrite divff ?mul1r ?invrK // !expf_eq0 normr_eq0 //. Qed. Let Re2 z := z + z^*. Definition nnegIm z := (0 <= imaginaryC * (z^* - z)). Definition argCle y z := nnegIm z ==> nnegIm y && (Re2 z <= Re2 y). Variant rootC_spec n (x : C) : Type := RootCspec (y : C) of if (n > 0)%N then y ^+ n = x else y = 0 & forall z, (n > 0)%N -> z ^+ n = x -> argCle y z. Fact rootC_subproof n x : rootC_spec n x. Proof. 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] /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. by case: posnP => //; case: negP. pose r := sort argCle r0; have r_arg: sorted argCle r by apply: sort_sorted. have{} Dp: p = \prod_(z <- r) ('X - z%:P). rewrite Dp lead_coefE sz_p coefB coefXn coefC -mulrb -mulrnA mulnb lt0n andNb. by rewrite subr0 eqxx scale1r; apply/esym/perm_big; rewrite perm_sort. have mem_rP z: (n > 0)%N -> reflect (z ^+ n = x) (z \in r). move=> n_gt0; rewrite -root_prod_XsubC -Dp rootE !hornerE hornerXn n_gt0. by rewrite subr_eq0; apply: eqP. exists r`_0 => [|z n_gt0 /(mem_rP z n_gt0) r_z]. have sz_r: size r = n by apply: succn_inj; rewrite -sz_p Dp size_prod_XsubC. 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 lexx. by move/(order_path_min argCle_trans)/allP->. Qed. Definition nthroot n x := let: RootCspec y _ _ := rootC_subproof n x in y. Notation "n .-root" := (nthroot n) (at level 2, format "n .-root") : ring_scope. Notation "n .-root" := (nthroot n) (only parsing) : ring_scope. Notation sqrtC := 2.-root. Definition Re x := (x + x^*) / 2%:R. Definition Im x := 'i * (x^* - x) / 2%:R. Notation "'Re z" := (Re z) (at level 10, z at level 8) : ring_scope. Notation "'Im z" := (Im z) (at level 10, z at level 8) : ring_scope. 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. Qed. Lemma mul_conjC_gt0 x : (0 < x * x^*) = (x != 0). Proof. have [->|x_neq0] := eqVneq; first by rewrite rmorph0 mulr0. by rewrite -normCK exprn_gt0 ?normr_gt0. Qed. Lemma mul_conjC_eq0 x : (x * x^* == 0) = (x == 0). Proof. by rewrite -normCK expf_eq0 normr_eq0. Qed. Lemma conjC_ge0 x : (0 <= x^*) = (0 <= x). Proof. wlog suffices: x / 0 <= x -> 0 <= x^*. by move=> IH; apply/idP/idP=> /IH; rewrite ?conjCK. rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite rmorph0. by rewrite -(pmulr_rge0 _ x_gt0) mul_conjC_ge0. Qed. Lemma conjC_nat n : (n%:R)^* = n%:R :> C. Proof. exact: rmorph_nat. Qed. Lemma conjC0 : 0^* = 0 :> C. Proof. exact: rmorph0. Qed. Lemma conjC1 : 1^* = 1 :> C. Proof. exact: rmorph1. Qed. Lemma conjC_eq0 x : (x^* == 0) = (x == 0). Proof. exact: fmorph_eq0. Qed. Lemma invC_norm x : x^-1 = `|x| ^- 2 * x^*. Proof. have [-> | nx_x] := eqVneq x 0; first by rewrite conjC0 mulr0 invr0. by rewrite normCK invfM divfK ?conjC_eq0. Qed. (* Real number subset. *) Lemma CrealE x : (x \is real) = (x^* == x). Proof. rewrite realEsqr ger0_def normrX normCK. by have [-> | /mulfI/inj_eq-> //] := eqVneq x 0; rewrite rmorph0 !eqxx. Qed. Lemma CrealP {x} : reflect (x^* = x) (x \is real). Proof. by rewrite CrealE; apply: eqP. Qed. Lemma conj_Creal x : x \is real -> x^* = x. Proof. by move/CrealP. Qed. Lemma conj_normC z : `|z|^* = `|z|. Proof. by rewrite conj_Creal ?normr_real. Qed. Lemma geC0_conj x : 0 <= x -> x^* = x. Proof. by move=> /ger0_real/CrealP. Qed. Lemma geC0_unit_exp x n : 0 <= x -> (x ^+ n.+1 == 1) = (x == 1). Proof. by move=> x_ge0; rewrite pexpr_eq1. Qed. (* Elementary properties of roots. *) Ltac case_rootC := rewrite /nthroot; case: (rootC_subproof _ _). Lemma root0C x : 0.-root x = 0. Proof. by case_rootC. Qed. Lemma rootCK n : (n > 0)%N -> cancel n.-root (fun x => x ^+ n). Proof. by case: n => //= n _ x; case_rootC. Qed. Lemma root1C x : 1.-root x = x. Proof. exact: (@rootCK 1). Qed. Lemma rootC0 n : n.-root 0 = 0. Proof. have [-> | n_gt0] := posnP n; first by rewrite root0C. by have /eqP := rootCK n_gt0 0; rewrite expf_eq0 n_gt0 /= => /eqP. Qed. Lemma rootC_inj n : (n > 0)%N -> injective n.-root. Proof. by move/rootCK/can_inj. Qed. Lemma eqr_rootC n : (n > 0)%N -> {mono n.-root : x y / x == y}. Proof. by move/rootC_inj/inj_eq. Qed. Lemma rootC_eq0 n x : (n > 0)%N -> (n.-root x == 0) = (x == 0). 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 lt_geF ?ltr01. Qed. Lemma neq0Ci : 'i != 0 :> C. Proof. by apply: contraNneq nonRealCi => ->; apply: real0. Qed. Lemma normCi : `|'i| = 1 :> C. 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. Lemma conjCi : 'i^* = - 'i :> C. Proof. by rewrite -invCi invC_norm normCi expr1n invr1 mul1r. Qed. Lemma Crect x : x = 'Re x + 'i * 'Im x. Proof. rewrite 2!mulrA -expr2 sqrCi mulN1r opprB -mulrDl addrACA subrr addr0. by rewrite -mulr2n -mulr_natr mulfK. Qed. Lemma Creal_Re x : 'Re x \is real. Proof. by rewrite CrealE fmorph_div rmorph_nat rmorphD conjCK addrC. Qed. Lemma Creal_Im x : 'Im x \is real. Proof. rewrite CrealE fmorph_div rmorph_nat rmorphM rmorphB conjCK. by rewrite conjCi -opprB mulrNN. Qed. Hint Resolve Creal_Re Creal_Im : core. Fact Re_is_additive : additive Re. Proof. by move=> x y; rewrite /Re rmorphB addrACA -opprD mulrBl. Qed. Canonical Re_additive := Additive Re_is_additive. Fact Im_is_additive : additive Im. Proof. by move=> x y; rewrite /Im rmorphB opprD addrACA -opprD mulrBr mulrBl. Qed. Canonical Im_additive := Additive Im_is_additive. Lemma Creal_ImP z : reflect ('Im z = 0) (z \is real). Proof. rewrite CrealE -subr_eq0 -(can_eq (mulKf neq0Ci)) mulr0. by rewrite -(can_eq (divfK nz2)) mul0r; apply: eqP. Qed. Lemma Creal_ReP z : reflect ('Re z = z) (z \in real). Proof. rewrite (sameP (Creal_ImP z) eqP) -(can_eq (mulKf neq0Ci)) mulr0. by rewrite -(inj_eq (addrI ('Re z))) addr0 -Crect eq_sym; apply: eqP. Qed. Lemma ReMl : {in real, forall x, {morph Re : z / x * z}}. Proof. by move=> x Rx z /=; rewrite /Re rmorphM (conj_Creal Rx) -mulrDr -mulrA. Qed. Lemma ReMr : {in real, forall x, {morph Re : z / z * x}}. Proof. by move=> x Rx z /=; rewrite mulrC ReMl // mulrC. Qed. Lemma ImMl : {in real, forall x, {morph Im : z / x * z}}. Proof. by move=> x Rx z; rewrite /Im rmorphM (conj_Creal Rx) -mulrBr mulrCA !mulrA. Qed. Lemma ImMr : {in real, forall x, {morph Im : z / z * x}}. Proof. by move=> x Rx z /=; rewrite mulrC ImMl // mulrC. Qed. Lemma Re_i : 'Re 'i = 0. Proof. by rewrite /Re conjCi subrr mul0r. Qed. Lemma Im_i : 'Im 'i = 1. Proof. rewrite /Im conjCi -opprD mulrN -mulr2n mulrnAr ['i * _]sqrCi. by rewrite mulNrn opprK divff. Qed. Lemma Re_conj z : 'Re z^* = 'Re z. Proof. by rewrite /Re addrC conjCK. Qed. Lemma Im_conj z : 'Im z^* = - 'Im z. Proof. by rewrite /Im -mulNr -mulrN opprB conjCK. Qed. Lemma Re_rect : {in real &, forall x y, 'Re (x + 'i * y) = x}. Proof. move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ReP x Rx). by rewrite ReMr // Re_i mul0r addr0. Qed. Lemma Im_rect : {in real &, forall x y, 'Im (x + 'i * y) = y}. Proof. move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ImP x Rx) add0r. by rewrite ImMr // Im_i mul1r. Qed. Lemma conjC_rect : {in real &, forall x y, (x + 'i * y)^* = x - 'i * y}. Proof. by move=> x y Rx Ry; rewrite /= rmorphD rmorphM conjCi mulNr !conj_Creal. Qed. Lemma addC_rect x1 y1 x2 y2 : (x1 + 'i * y1) + (x2 + 'i * y2) = x1 + x2 + 'i * (y1 + y2). Proof. by rewrite addrACA -mulrDr. Qed. Lemma oppC_rect x y : - (x + 'i * y) = - x + 'i * (- y). Proof. by rewrite mulrN -opprD. Qed. Lemma subC_rect x1 y1 x2 y2 : (x1 + 'i * y1) - (x2 + 'i * y2) = x1 - x2 + 'i * (y1 - y2). Proof. by rewrite oppC_rect addC_rect. Qed. Lemma mulC_rect x1 y1 x2 y2 : (x1 + 'i * y1) * (x2 + 'i * y2) = x1 * x2 - y1 * y2 + 'i * (x1 * y2 + x2 * y1). Proof. rewrite mulrDl !mulrDr (AC (2*2)%AC (1*4*(2*3))%AC)/= mulrACA. by rewrite -expr2 sqrCi mulN1r -!mulrA [_ * ('i * _)]mulrCA [_ * y1]mulrC. Qed. Lemma normC2_rect : {in real &, forall x y, `|x + 'i * y| ^+ 2 = x ^+ 2 + y ^+ 2}. Proof. move=> x y Rx Ry; rewrite /= normCK rmorphD rmorphM conjCi !conj_Creal //. by rewrite mulrC mulNr -subr_sqr exprMn sqrCi mulN1r opprK. Qed. Lemma normC2_Re_Im z : `|z| ^+ 2 = 'Re z ^+ 2 + 'Im z ^+ 2. Proof. by rewrite -normC2_rect -?Crect. Qed. Lemma invC_rect : {in real &, forall x y, (x + 'i * y)^-1 = (x - 'i * y) / (x ^+ 2 + y ^+ 2)}. Proof. by move=> x y Rx Ry; rewrite /= invC_norm conjC_rect // mulrC normC2_rect. Qed. Lemma leif_normC_Re_Creal z : `|'Re z| <= `|z| ?= iff (z \is real). Proof. rewrite -(mono_in_leif ler_sqr); try by rewrite qualifE. rewrite [`|'Re _| ^+ 2]normCK conj_Creal // normC2_Re_Im -expr2. rewrite addrC -leif_subLR subrr (sameP (Creal_ImP _) eqP) -sqrf_eq0 eq_sym. by apply: leif_eq; rewrite -realEsqr. Qed. 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/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. (* Equality from polar coordinates, for the upper plane. *) Lemma eqC_semipolar x y : `|x| = `|y| -> 'Re x = 'Re y -> 0 <= 'Im x * 'Im y -> x = y. Proof. move=> eq_norm eq_Re sign_Im. rewrite [x]Crect [y]Crect eq_Re; congr (_ + 'i * _). have /eqP := congr1 (fun z => z ^+ 2) eq_norm. rewrite !normC2_Re_Im eq_Re (can_eq (addKr _)) eqf_sqr => /pred2P[] // eq_Im. rewrite eq_Im mulNr -expr2 oppr_ge0 real_exprn_even_le0 //= in sign_Im. by rewrite eq_Im (eqP sign_Im) oppr0. Qed. (* Nth roots. *) Let argCleP y z : reflect (0 <= 'Im z -> 0 <= 'Im y /\ 'Re z <= 'Re y) (argCle y z). Proof. suffices dIm x: nnegIm x = (0 <= 'Im x). rewrite /argCle !dIm ler_pmul2r ?invr_gt0 ?ltr0n //. by apply: (iffP implyP) => geZyz /geZyz/andP. by rewrite /('Im x) pmulr_lge0 ?invr_gt0 ?ltr0n //; congr (0 <= _ * _). Qed. (* case Du: sqrCi => [u u2N1] /=. *) (* have/eqP := u2N1; rewrite -sqrCi eqf_sqr => /pred2P[] //. *) (* have:= conjCi; rewrite /'i; case_rootC => /= v v2n1 min_v conj_v Duv. *) (* have{min_v} /idPn[] := min_v u isT u2N1; rewrite negb_imply /nnegIm Du /= Duv. *) (* rewrite rmorphN conj_v opprK -opprD mulrNN mulNr -mulr2n mulrnAr -expr2 v2n1. *) (* by rewrite mulNrn opprK ler0n oppr_ge0 (ler_nat _ 2 0). *) Lemma rootC_Re_max n x y : (n > 0)%N -> y ^+ n = x -> 0 <= 'Im y -> 'Re y <= 'Re (n.-root x). Proof. by move=> n_gt0 yn_x leI0y; case_rootC=> z /= _ /(_ y n_gt0 yn_x)/argCleP[]. Qed. Let neg_unity_root n : (n > 1)%N -> exists2 w : C, w ^+ n = 1 & 'Re w < 0. Proof. move=> n_gt1; have [|w /eqP pw_0] := closed_rootP (\poly_(i < n) (1 : C)) _. by rewrite size_poly_eq ?oner_eq0 // -(subnKC n_gt1). rewrite horner_poly (eq_bigr _ (fun _ _ => mul1r _)) in pw_0. have wn1: w ^+ n = 1 by apply/eqP; rewrite -subr_eq0 subrX1 pw_0 mulr0. 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 // 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_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_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 // 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 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 // ltW // nmulr_lgt0. without loss leI0z: z zn_x leR0z / 'Im z >= 0. move=> IHz; have: 'Im z \is real by []. 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: 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 -(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. Qed. Lemma rootC_gt0 n x : (n > 0)%N -> (n.-root x > 0) = (x > 0). 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 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 (@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 !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/leW_mono_in. Qed. Lemma exprCK n x : (0 < n)%N -> 0 <= x -> n.-root (x ^+ n) = x. Proof. move=> n_gt0 x_ge0; apply/eqP. by rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?exprn_ge0 ?rootCK. Qed. Lemma norm_rootC n x : `|n.-root x| = n.-root `|x|. Proof. have [-> | n_gt0] := posnP n; first by rewrite !root0C normr0. 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. Proof. move=> n_gt0 x_ge0; apply/eqP. by rewrite -(eqr_expn2 n_gt0) ?(exprn_ge0, rootC_ge0) // 1?exprAC !rootCK. Qed. Lemma rootC1 n : (n > 0)%N -> n.-root 1 = 1. Proof. by move/(rootCX 0)/(_ ler01). Qed. Lemma rootCpX n x k : (k > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k. Proof. by case: n => [|n] k_gt0; [rewrite !root0C expr0n gtn_eqF | apply: rootCX]. Qed. Lemma rootCV n x : (n > 0)%N -> 0 <= x -> n.-root x^-1 = (n.-root x)^-1. Proof. move=> n_gt0 x_ge0; apply/eqP. by rewrite -(eqr_expn2 n_gt0) ?(invr_ge0, rootC_ge0) // !exprVn !rootCK. Qed. Lemma rootC_eq1 n x : (n > 0)%N -> (n.-root x == 1) = (x == 1). Proof. by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) eqr_rootC. Qed. Lemma rootC_ge1 n x : (n > 0)%N -> (n.-root x >= 1) = (x >= 1). Proof. 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 !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 !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] := (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 ?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) // -!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 ?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. Proof. by move=> x_ge0; rewrite mulrC rootCMl // mulrC. Qed. Lemma imaginaryCE : 'i = sqrtC (-1). Proof. have : sqrtC (-1) ^+ 2 - 'i ^+ 2 == 0 by rewrite sqrCi rootCK // subrr. rewrite subr_sqr mulf_eq0 subr_eq0 addr_eq0; have [//|_/= /eqP sCN1E] := eqP. by have := @Im_rootC_ge0 2 (-1) isT; rewrite sCN1E raddfN /= Im_i ler0N1. Qed. (* More properties of n.-root will be established in cyclotomic.v. *) (* The proper form of the Arithmetic - Geometric Mean inequality. *) 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/leif_refl/forall_inP=> i. by rewrite (card0_eq n0). 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: leif_AGM. Qed. (* Square root. *) Lemma sqrtC0 : sqrtC 0 = 0. Proof. exact: rootC0. Qed. Lemma sqrtC1 : sqrtC 1 = 1. Proof. exact: rootC1. Qed. Lemma sqrtCK x : sqrtC x ^+ 2 = x. Proof. exact: rootCK. Qed. Lemma sqrCK x : 0 <= x -> sqrtC (x ^+ 2) = x. Proof. exact: exprCK. Qed. Lemma sqrtC_ge0 x : (0 <= sqrtC x) = (0 <= x). Proof. exact: rootC_ge0. Qed. Lemma sqrtC_eq0 x : (sqrtC x == 0) = (x == 0). Proof. exact: rootC_eq0. Qed. Lemma sqrtC_gt0 x : (sqrtC x > 0) = (x > 0). Proof. exact: rootC_gt0. Qed. Lemma sqrtC_lt0 x : (sqrtC x < 0) = false. Proof. exact: rootC_lt0. Qed. Lemma sqrtC_le0 x : (sqrtC x <= 0) = (x == 0). Proof. exact: rootC_le0. Qed. Lemma ler_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x <= y}}. Proof. exact: ler_rootC. Qed. Lemma ltr_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x < y}}. Proof. exact: ltr_rootC. Qed. Lemma eqr_sqrtC : {mono sqrtC : x y / x == y}. Proof. exact: eqr_rootC. Qed. Lemma sqrtC_inj : injective sqrtC. Proof. exact: rootC_inj. Qed. Lemma sqrtCM : {in Num.nneg &, {morph sqrtC : x y / x * y}}. Proof. by move=> x y _; apply: rootCMr. Qed. Lemma sqrCK_P x : reflect (sqrtC (x ^+ 2) = x) ((0 <= 'Im x) && ~~ (x < 0)). 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_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. Qed. Lemma norm_conjC x : `|x^*| = `|x|. Proof. by rewrite !normC_def conjCK mulrC. Qed. Lemma normC_rect : {in real &, forall x y, `|x + 'i * y| = sqrtC (x ^+ 2 + y ^+ 2)}. Proof. by move=> x y Rx Ry; rewrite /= normC_def -normCK normC2_rect. Qed. Lemma normC_Re_Im z : `|z| = sqrtC ('Re z ^+ 2 + 'Im z ^+ 2). Proof. by rewrite normC_def -normCK normC2_Re_Im. Qed. (* Norm sum (in)equalities. *) Lemma normC_add_eq x y : `|x + y| = `|x| + `|y| -> {t : C | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}. Proof. move=> lin_xy; apply: sig2_eqW; pose u z := if z == 0 then 1 else z / `|z|. have uE z: (`|u z| = 1) * (`|z| * u z = z). rewrite /u; have [->|nz_z] := eqVneq; first by rewrite normr0 normr1 mul0r. by rewrite normf_div normr_id mulrCA divff ?mulr1 ?normr_eq0. have [->|nz_x] := eqVneq x 0; first by exists (u y); rewrite uE ?normr0 ?mul0r. exists (u x); rewrite uE // /u (negPf nz_x); congr (_ , _). have{lin_xy} def2xy: `|x| * `|y| *+ 2 = x * y ^* + y * x ^*. apply/(addrI (x * x^*))/(addIr (y * y^*)); rewrite -2!{1}normCK -sqrrD. by rewrite addrA -addrA -!mulrDr -mulrDl -rmorphD -normCK lin_xy. have def_xy: x * y^* = y * x^*. apply/eqP; rewrite -subr_eq0 -[_ == 0](@expf_eq0 _ _ 2). rewrite (canRL (subrK _) (subr_sqrDB _ _)) opprK -def2xy exprMn_n exprMn. by rewrite mulrN (@GRing.mul C).[AC (2*2)%AC (1*4*(3*2))%AC] -!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. by rewrite mulrCA divfK ?normr_eq0 // mulrAC mulrA. Qed. Lemma normC_sum_eq (I : finType) (P : pred I) (F : I -> C) : `|\sum_(i | P i) F i| = \sum_(i | P i) `|F i| -> {t : C | `|t| == 1 & forall i, P i -> F i = `|F i| * t}. Proof. have [i /andP[Pi nzFi] | F0] := pickP [pred i | P i & F i != 0]; last first. exists 1 => [|i Pi]; first by rewrite normr1. by case/nandP: (F0 i) => [/negP[]// | /negbNE/eqP->]; rewrite normr0 mul0r. rewrite !(bigD1 i Pi) /= => norm_sumF; pose Q j := P j && (j != i). rewrite -normr_eq0 in nzFi; set c := F i / `|F i|; exists c => [|j Pj]. by rewrite normrM normfV normr_id divff. 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 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. Lemma normC_sum_eq1 (I : finType) (P : pred I) (F : I -> C) : `|\sum_(i | P i) F i| = (\sum_(i | P i) `|F i|) -> (forall i, P i -> `|F i| = 1) -> {t : C | `|t| == 1 & forall i, P i -> F i = t}. Proof. case/normC_sum_eq=> t t1 defF normF. by exists t => // i Pi; rewrite defF // normF // mul1r. Qed. Lemma normC_sum_upper (I : finType) (P : pred I) (F G : I -> C) : (forall i, P i -> `|F i| <= G i) -> \sum_(i | P i) F i = \sum_(i | P i) G i -> 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: 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 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 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). have /psumr_eq0P eqFG i: P i -> 0 <= G i - F i. by move=> Pi; rewrite subr_ge0 defF // t1 mulr1 leFG. move=> i /eqFG/(canRL (subrK _))->; rewrite ?add0r //. by rewrite sumrB -/sumF eq_sumFG subrr. Qed. Lemma normC_sub_eq x y : `|x - y| = `|x| - `|y| -> {t | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}. Proof. set z := x - y; rewrite -(subrK y x) -/z => /(canLR (subrK _))/esym-Dx. have [t t_1 [Dz Dy]] := normC_add_eq Dx. by exists t; rewrite // Dx mulrDl -Dz -Dy. Qed. End ClosedFieldTheory. Notation "n .-root" := (@nthroot _ n) (at level 2, format "n .-root") : ring_scope. Notation sqrtC := 2.-root. Notation "'i" := (@imaginaryC _) (at level 0) : ring_scope. Notation "'Re z" := (Re z) (at level 10, z at level 8) : ring_scope. Notation "'Im z" := (Im z) (at level 10, z at level 8) : ring_scope. Arguments conjCK {C} x. Arguments sqrCK {C} [x] le0x. Arguments sqrCK_P {C x}. End Theory. (*************) (* 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) : ring_scope. Local Notation "x < y" := (lt m x y) : ring_scope. 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 lt_def; case: eqVneq => //= ->; 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 ltPOrderMixin : ltPOrderMixin R := LtPOrderMixin le_def' ltrr lt_trans. Definition normedZmodMixin : @normed_mixin_of R R ltPOrderMixin := @Num.NormedMixin _ _ ltPOrderMixin (norm m) (normD m) (@norm_eq0 m) normrMn normrN. Definition numDomainMixin : @mixin_of R ltPOrderMixin normedZmodMixin := @Num.Mixin _ ltPOrderMixin normedZmodMixin (@addr_gt0 m) (@ger_total m) (@normM m) (@le_def m). End NumMixin. Module Exports. Notation numMixin := of_. Notation NumMixin := Mixin. Coercion ltPOrderMixin : numMixin >-> Order.LtPOrderMixin.of_. Coercion normedZmodMixin : numMixin >-> normed_mixin_of. Coercion numDomainMixin : numMixin >-> mixin_of. Definition NumDomainOfIdomain (T : idomainType) (m : of_ T) := NumDomainType (POrderType ring_display T m) m. End Exports. End NumMixin. Import NumMixin.Exports. Module RealMixin. Section RealMixin. Variables (R : numDomainType). Variable (real : real_axiom R). Lemma le_total : totalPOrderMixin R. Proof. move=> x y; move: (real (x - y)). by rewrite unfold_in !ler_def subr0 add0r opprB orbC. Qed. End RealMixin. Module Exports. Coercion le_total : real_axiom >-> totalPOrderMixin. Definition RealDomainOfNumDomain (T : numDomainType) (m : real_axiom T) := [realDomainType of OrderOfPOrder m]. End Exports. End RealMixin. Import RealMixin.Exports. 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; }. Variable (m : of_). Local Notation "x <= y" := (le m x y) : ring_scope. Local Notation "x < y" := (lt m x y) : ring_scope. 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 m 0; rewrite orbb. 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 andbT addr_eq0; apply: contraNneq x_neq0 => hxy. by rewrite [x](@le0_anti m) // hxy -le0N opprK. 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 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 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 le_total : total (le m). Proof. by move=> x y; rewrite -sub_ge0 -opprB le0N orbC -sub_ge0 le0_total. Qed. Definition numMixin : numMixin R := NumMixin le_normD lt0_add eq0_norm (in2W le_total) normM le_def (lt_def m). Definition orderMixin : totalPOrderMixin (POrderType ring_display R numMixin) := le_total. End RealLeMixin. Module Exports. Notation realLeMixin := of_. Notation RealLeMixin := Mixin. Coercion numMixin : realLeMixin >-> NumMixin.of_. Coercion orderMixin : realLeMixin >-> totalPOrderMixin. Definition LeRealDomainOfIdomain (R : idomainType) (m : of_ R) := [realDomainType of @OrderOfPOrder _ (NumDomainOfIdomain m) m]. Definition LeRealFieldOfField (R : fieldType) (m : of_ R) := [realFieldType of [numFieldType of LeRealDomainOfIdomain m]]. End Exports. End RealLeMixin. Import RealLeMixin.Exports. 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) : ring_scope. Local Notation "x <= y" := (le m x y) : ring_scope. 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 -[0 < - x]lt0N opprK. apply/orP; case: (eqVneq x) => //=; exact: lt0_total. Qed. Let le00 : (0 <= 0). Proof. by rewrite le_def eqxx. Qed. 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. 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 ?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 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 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: eqVneq => //= ->; rewrite -sub_gt0 subrr. by apply/idP=> lt00; case/negP: (lt0_ngt0 lt00). Qed. Fact le_total : total (le m). Proof. move=> x y; rewrite !le_def; have [->|] //= := eqVneq; rewrite -subr_eq0. by move/(lt0_total m); rewrite -(sub_gt0 _ (x - y)) sub0r opprB !sub_gt0 orbC. Qed. Definition numMixin : numMixin R := NumMixin le_normD (@lt0_add m) eq0_norm (in2W le_total) normM le_def' lt_def. Definition orderMixin : totalPOrderMixin (POrderType ring_display R numMixin) := le_total. End RealLtMixin. Module Exports. Notation realLtMixin := of_. Notation RealLtMixin := Mixin. Coercion numMixin : realLtMixin >-> NumMixin.of_. Coercion orderMixin : realLtMixin >-> totalPOrderMixin. Definition LtRealDomainOfIdomain (R : idomainType) (m : of_ R) := [realDomainType of @OrderOfPOrder _ (NumDomainOfIdomain m) m]. Definition LtRealFieldOfField (R : fieldType) (m : of_ R) := [realFieldType of [numFieldType of LtRealDomainOfIdomain m]]. End Exports. End RealLtMixin. Import RealLtMixin.Exports. End Num. Export Num.NumDomain.Exports Num.NormedZmodule.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 ImaginaryMixin := Num.ClosedField.ImaginaryMixin. (* compatibility module *) Module mc_1_10. 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. Module Import Def. Export ssrnum.Num.Def. Definition minr {R : numDomainType} (x y : R) := if x <= y then x else y. Definition maxr {R : numDomainType} (x y : R) := if x <= y then y else x. End Def. Notation min := minr. Notation max := maxr. Module Import Syntax. Notation "`| x |" := (@norm _ (@Num.NormedZmodule.numDomain_normedZmodType _) 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 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 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. End NumDomainOperationTheory. 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. Section MinMax. Let mrE x y : ((min x y = Order.min x y) * (maxr x y = Order.max x y))%type. Proof. by rewrite /minr /min /maxr /max; case: comparableP. Qed. Ltac mapply x := do ?[rewrite !mrE|apply: x|move=> ?]. Ltac mexact x := by mapply x. Lemma minrC : @commutative R R min. Proof. mexact @minC. Qed. Lemma minrr : @idempotent R min. Proof. mexact @minxx. Qed. Lemma minr_l x y : x <= y -> min x y = x. Proof. mexact @min_l. Qed. Lemma minr_r x y : y <= x -> min x y = y. Proof. mexact @min_r. Qed. Lemma maxrC : @commutative R R max. Proof. mexact @maxC. Qed. Lemma maxrr : @idempotent R max. Proof. mexact @maxxx. Qed. Lemma maxr_l x y : y <= x -> max x y = x. Proof. mexact @max_l. Qed. Lemma maxr_r x y : x <= y -> max x y = y. Proof. mexact @max_r. Qed. Lemma minrA x y z : min x (min y z) = min (min x y) z. Proof. mexact @minA. Qed. Lemma minrCA : @left_commutative R R min. Proof. mexact @minCA. Qed. Lemma minrAC : @right_commutative R R min. Proof. mexact @minAC. Qed. Lemma maxrA x y z : max x (max y z) = max (max x y) z. Proof. mexact @maxA. Qed. Lemma maxrCA : @left_commutative R R max. Proof. mexact @maxCA. Qed. Lemma maxrAC : @right_commutative R R max. Proof. mexact @maxAC. Qed. Lemma eqr_minl x y : (min x y == x) = (x <= y). Proof. mexact @eq_minl. Qed. Lemma eqr_minr x y : (min x y == y) = (y <= x). Proof. mexact @eq_minr. Qed. Lemma eqr_maxl x y : (max x y == x) = (y <= x). Proof. mexact @eq_maxl. Qed. Lemma eqr_maxr x y : (max x y == y) = (x <= y). Proof. mexact @eq_maxr. Qed. Lemma ler_minr x y z : (x <= min y z) = (x <= y) && (x <= z). Proof. mexact @le_minr. Qed. Lemma ler_minl x y z : (min y z <= x) = (y <= x) || (z <= x). Proof. mexact @le_minl. Qed. Lemma ler_maxr x y z : (x <= max y z) = (x <= y) || (x <= z). Proof. mexact @le_maxr. Qed. Lemma ler_maxl x y z : (max y z <= x) = (y <= x) && (z <= x). Proof. mexact @le_maxl. Qed. Lemma ltr_minr x y z : (x < min y z) = (x < y) && (x < z). Proof. mexact @lt_minr. Qed. Lemma ltr_minl x y z : (min y z < x) = (y < x) || (z < x). Proof. mexact @lt_minl. Qed. Lemma ltr_maxr x y z : (x < max y z) = (x < y) || (x < z). Proof. mexact @lt_maxr. Qed. Lemma ltr_maxl x y z : (max y z < x) = (y < x) && (z < x). Proof. mexact @lt_maxl. 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 minrK x y : max (min x y) x = x. Proof. rewrite minrC; mexact @minxK. Qed. Lemma minKr x y : min y (max x y) = y. Proof. rewrite maxrC; mexact @maxKx. Qed. Lemma maxr_minl : @left_distributive R R max min. Proof. mexact @max_minl. Qed. Lemma maxr_minr : @right_distributive R R max min. Proof. mexact @max_minr. Qed. Lemma minr_maxl : @left_distributive R R min max. Proof. mexact @min_maxl. Qed. Lemma minr_maxr : @right_distributive R R min max. Proof. mexact @min_maxr. 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 minrP x y : minr_spec x y (x <= y) (y < x) (min x y). Proof. by rewrite mrE; 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 rewrite mrE; case: (leP y); constructor. Qed. End MinMax. End RealDomainOperations. 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. Notation "@ 'real_lerP'" := (deprecate real_lerP real_leP) (at level 10, only parsing) : fun_scope. Notation real_lerP := (@real_lerP _ _ _) (only parsing). Notation "@ 'real_ltrP'" := (deprecate real_ltrP real_ltP) (at level 10, only parsing) : fun_scope. Notation real_ltrP := (@real_ltrP _ _ _) (only parsing). Notation "@ 'real_ltrNge'" := (deprecate real_ltrNge real_ltNge) (at level 10, only parsing) : fun_scope. Notation real_ltrNge := (@real_ltrNge _ _ _) (only parsing). Notation "@ 'real_lerNgt'" := (deprecate real_lerNgt real_leNgt) (at level 10, only parsing) : fun_scope. Notation real_lerNgt := (@real_lerNgt _ _ _) (only parsing). Notation "@ 'real_ltrgtP'" := (deprecate real_ltrgtP real_ltgtP) (at level 10, only parsing) : fun_scope. Notation real_ltrgtP := (@real_ltrgtP _ _ _) (only parsing). Notation "@ 'real_ger0P'" := (deprecate real_ger0P real_ge0P) (at level 10, only parsing) : fun_scope. Notation real_ger0P := (@real_ger0P _ _) (only parsing). Notation "@ 'real_ltrgt0P'" := (deprecate real_ltrgt0P real_ltgt0P) (at level 10, only parsing) : fun_scope. Notation real_ltrgt0P := (@real_ltrgt0P _ _) (only parsing). Notation lerif_nat := (deprecate lerif_nat leif_nat_r) (only parsing). Notation "@ 'lerif_subLR'" := (deprecate lerif_subLR leif_subLR) (at level 10, only parsing) : fun_scope. Notation lerif_subLR := (@lerif_subLR _) (only parsing). Notation "@ 'lerif_subRL'" := (deprecate lerif_subRL leif_subRL) (at level 10, only parsing) : fun_scope. Notation lerif_subRL := (@lerif_subRL _) (only parsing). Notation "@ 'lerif_add'" := (deprecate lerif_add leif_add) (at level 10, only parsing) : fun_scope. Notation lerif_add := (@lerif_add _ _ _ _ _ _ _) (only parsing). Notation "@ 'lerif_sum'" := (deprecate lerif_sum leif_sum) (at level 10, only parsing) : fun_scope. Notation lerif_sum := (@lerif_sum _ _ _ _ _ _) (only parsing). Notation "@ 'lerif_0_sum'" := (deprecate lerif_0_sum leif_0_sum) (at level 10, only parsing) : fun_scope. Notation lerif_0_sum := (@lerif_0_sum _ _ _ _ _) (only parsing). Notation "@ 'real_lerif_norm'" := (deprecate real_lerif_norm real_leif_norm) (at level 10, only parsing) : fun_scope. Notation real_lerif_norm := (@real_lerif_norm _ _) (only parsing). Notation "@ 'lerif_pmul'" := (deprecate lerif_pmul leif_pmul) (at level 10, only parsing) : fun_scope. Notation lerif_pmul := (@lerif_pmul _ _ _ _ _ _ _) (only parsing). Notation "@ 'lerif_nmul'" := (deprecate lerif_nmul leif_nmul) (at level 10, only parsing) : fun_scope. Notation lerif_nmul := (@lerif_nmul _ _ _ _ _ _ _) (only parsing). Notation "@ 'lerif_pprod'" := (deprecate lerif_pprod leif_pprod) (at level 10, only parsing) : fun_scope. Notation lerif_pprod := (@lerif_pprod _ _ _ _ _ _) (only parsing). Notation "@ 'real_lerif_mean_square_scaled'" := (deprecate real_lerif_mean_square_scaled real_leif_mean_square_scaled) (at level 10, only parsing) : fun_scope. Notation real_lerif_mean_square_scaled := (@real_lerif_mean_square_scaled _ _ _ _ _ _) (only parsing). Notation "@ 'real_lerif_AGM2_scaled'" := (deprecate real_lerif_AGM2_scaled real_leif_AGM2_scaled) (at level 10, only parsing) : fun_scope. Notation real_lerif_AGM2_scaled := (@real_lerif_AGM2_scaled _ _ _) (only parsing). Notation "@ 'lerif_AGM_scaled'" := (deprecate lerif_AGM_scaled leif_AGM2_scaled) (at level 10, only parsing) : fun_scope. Notation lerif_AGM_scaled := (@lerif_AGM_scaled _ _ _ _) (only parsing). Notation "@ 'real_lerif_mean_square'" := (deprecate real_lerif_mean_square real_leif_mean_square) (at level 10, only parsing) : fun_scope. Notation real_lerif_mean_square := (@real_lerif_mean_square _ _ _) (only parsing). Notation "@ 'real_lerif_AGM2'" := (deprecate real_lerif_AGM2 real_leif_AGM2) (at level 10, only parsing) : fun_scope. Notation real_lerif_AGM2 := (@real_lerif_AGM2 _ _ _) (only parsing). Notation "@ 'lerif_AGM'" := (deprecate lerif_AGM leif_AGM) (at level 10, only parsing) : fun_scope. Notation lerif_AGM := (@lerif_AGM _ _ _ _) (only parsing). Notation "@ 'lerif_mean_square_scaled'" := (deprecate lerif_mean_square_scaled leif_mean_square_scaled) (at level 10, only parsing) : fun_scope. Notation lerif_mean_square_scaled := (@lerif_mean_square_scaled _) (only parsing). Notation "@ 'lerif_AGM2_scaled'" := (deprecate lerif_AGM2_scaled leif_AGM2_scaled) (at level 10, only parsing) : fun_scope. Notation lerif_AGM2_scaled := (@lerif_AGM2_scaled _) (only parsing). Notation "@ 'lerif_mean_square'" := (deprecate lerif_mean_square leif_mean_square) (at level 10, only parsing) : fun_scope. Notation lerif_mean_square := (@lerif_mean_square _) (only parsing). Notation "@ 'lerif_AGM2'" := (deprecate lerif_AGM2 leif_AGM2) (at level 10, only parsing) : fun_scope. Notation lerif_AGM2 := (@lerif_AGM2 _) (only parsing). Notation "@ 'lerif_normC_Re_Creal'" := (deprecate lerif_normC_Re_Creal leif_normC_Re_Creal) (at level 10, only parsing) : fun_scope. Notation lerif_normC_Re_Creal := (@lerif_normC_Re_Creal _) (only parsing). Notation "@ 'lerif_Re_Creal'" := (deprecate lerif_Re_Creal leif_Re_Creal) (at level 10, only parsing) : fun_scope. Notation lerif_Re_Creal := (@lerif_Re_Creal _) (only parsing). Notation "@ 'lerif_rootC_AGM'" := (deprecate lerif_rootC_AGM leif_rootC_AGM) (at level 10, only parsing) : fun_scope. Notation lerif_rootC_AGM := (@lerif_rootC_AGM _ _ _ _) (only parsing). 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_10. math-comp-mathcomp-1.12.0/mathcomp/algebra/vector.v000066400000000000000000002273361375767750300222250ustar00rootroot00000000000000(* (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 finfun tuple. From mathcomp Require Import ssralg matrix mxalgebra zmodp. (******************************************************************************) (* * Finite dimensional vector spaces *) (* vectType R == interface structure for finite dimensional (more *) (* precisely, detachable) vector spaces over R, which *) (* should be at least a ringType. *) (* Vector.axiom n M <-> type M is linearly isomorphic to 'rV_n. *) (* := {v2r : M -> 'rV_n| linear v2r & bijective v2r}. *) (* VectMixin isoM == packages a proof isoV of Vector.axiom n M as the *) (* vectType mixin for an n-dimensional R-space *) (* structure on a type M that is an lmodType R. *) (* VectType K M mT == packs the vectType mixin mT to into a vectType K *) (* instance for T; T should have an lmodType K *) (* canonical instance. *) (* [vectType R of T for vS] == a copy of the vS : vectType R structure where *) (* the sort is replaced by T; vS : lmodType R should *) (* be convertible to a canonical lmodType for T. *) (* [vectType R of V] == a clone of an existing vectType R structure on V. *) (* {vspace vT} == the type of (detachable) subspaces of vT; vT *) (* should have a vectType structure over a fieldType. *) (* subvs_of U == the subtype of elements of V in the subspace U. *) (* This is canonically a vectType. *) (* vsval u == linear injection of u : subvs_of U into V. *) (* vsproj U v == linear projection of v : V in subvs U. *) (* 'Hom(aT, rT) == the type of linear functions (homomorphisms) from *) (* aT to rT, where aT and rT ARE vectType structures. *) (* Elements of 'Hom(aT, rT) coerce to Coq functions. *) (* --> Caveat: aT and rT must denote actual vectType structures, not their *) (* projections on Type. *) (* linfun f == a vector linear function in 'Hom(aT, rT) that *) (* coincides with f : aT -> rT when f is linear. *) (* 'End(vT) == endomorphisms of vT (:= 'Hom(vT, vT)). *) (* --> The types subvs_of U, 'Hom(aT, rT), 'End(vT), K^o, 'M[K]_(m, n), *) (* vT * wT, {ffun I -> vT}, vT ^ n all have canonical vectType instances. *) (* *) (* Functions: *) (* <[v]>%VS == the vector space generated by v (a line if v != 0).*) (* 0%VS == the trivial vector subspace. *) (* fullv, {:vT} == the complete vector subspace (displays as fullv). *) (* (U + V)%VS == the join (sum) of two subspaces U and V. *) (* (U :&: V)%VS == intersection of vector subspaces U and V. *) (* (U^C)%VS == a complement of the vector subspace U. *) (* (U :\: V)%VS == a local complement to U :& V in the subspace U. *) (* \dim U == dimension of a vector space U. *) (* span X, <>%VS == the subspace spanned by the vector sequence X. *) (* coord X i v == i'th coordinate of v on X, when v \in <>%VS and *) (* where X : n.-tuple vT and i : 'I_n. Note that *) (* coord X i is a scalar function. *) (* vpick U == a nonzero element of U if U= 0%VS, or 0 if U = 0. *) (* vbasis U == a (\dim U).-tuple that is a basis of U. *) (* \1%VF == the identity linear function. *) (* (f \o g)%VF == the composite of two linear functions f and g. *) (* (f^-1)%VF == a linear function that is a right inverse to the *) (* linear function f on the codomain of f. *) (* (f @: U)%VS == the image of vs by the linear function f. *) (* (f @^-1: U)%VS == the pre-image of vs by the linear function f. *) (* lker f == the kernel of the linear function f. *) (* limg f == the image of the linear function f. *) (* fixedSpace f == the fixed space of a linear endomorphism f *) (* daddv_pi U V == projection onto U along V if U and V are disjoint; *) (* daddv_pi U V + daddv_pi V U is then a projection *) (* onto the direct sum (U + V)%VS. *) (* projv U == projection onto U (along U^C, := daddv_pi U U^C). *) (* addv_pi1 U V == projection onto the subspace U :\: V of U along V. *) (* addv_pi2 U V == projection onto V along U :\: V; note that *) (* addv_pi1 U V and addv_pi2 U V are (asymmetrical) *) (* complementary projections on (U + V)%VS. *) (* sumv_pi_for defV i == for defV : V = (V \sum_(j <- r | P j) Vs j)%VS, *) (* j ranging over an eqType, this is a projection on *) (* a subspace of Vs i, along a complement in V, such *) (* that \sum_(j <- r | P j) sumv_pi_for defV j is a *) (* projection onto V if filter P r is duplicate-free *) (* (e.g., when V := \sum_(j | P j) Vs j). *) (* sumv_pi V i == notation the above when defV == erefl V, and V is *) (* convertible to \sum_(j <- r | P j) Vs j)%VS. *) (* *) (* Predicates: *) (* v \in U == v belongs to U (:= (<[v]> <= U)%VS). *) (* (U <= V)%VS == U is a subspace of V. *) (* free B == B is a sequence of nonzero linearly independent *) (* vectors. *) (* basis_of U b == b is a basis of the subspace U. *) (* directv S == S is the expression for a direct sum of subspaces. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope vspace_scope. Declare Scope lfun_scope. Local Open Scope ring_scope. Reserved Notation "{ 'vspace' T }" (at level 0, format "{ 'vspace' T }"). Reserved Notation "''Hom' ( T , rT )" (at level 8, format "''Hom' ( T , rT )"). Reserved Notation "''End' ( T )" (at level 8, format "''End' ( T )"). Reserved Notation "\dim A" (at level 10, A at level 8, format "\dim A"). Delimit Scope vspace_scope with VS. Import GRing.Theory. (* Finite dimension vector space *) Module Vector. Section ClassDef. Variable R : ringType. Definition axiom_def n (V : lmodType R) of phant V := {v2r : V -> 'rV[R]_n | linear v2r & bijective v2r}. Inductive mixin_of (V : lmodType R) := Mixin dim & axiom_def dim (Phant V). Set Primitive Projections. Record class_of V := Class { base : GRing.Lmodule.class_of R V; mixin : mixin_of (GRing.Lmodule.Pack _ base) }. Unset Primitive Projections. Local Coercion base : class_of >-> GRing.Lmodule.class_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. Definition dim := let: Mixin n _ := mixin class in n. Definition pack b0 (m0 : mixin_of (@GRing.Lmodule.Pack R _ T b0)) := fun bT b & phant_id (@GRing.Lmodule.class _ phR bT) b => fun m & phant_id m0 m => Pack phR (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. End ClassDef. Notation axiom n V := (axiom_def n (Phant V)). Section OtherDefs. Local Coercion sort : type >-> Sortclass. Local Coercion dim : type >-> nat. Inductive space (K : fieldType) (vT : type (Phant K)) (phV : phant vT) := Space (mx : 'M[K]_vT) & <>%MS == mx. Inductive hom (R : ringType) (vT wT : type (Phant R)) := Hom of 'M[R]_(vT, wT). End OtherDefs. Module Import Exports. Coercion base : class_of >-> GRing.Lmodule.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion eqType: type >-> Equality.type. Bind Scope ring_scope with sort. Canonical eqType. Coercion choiceType: type >-> Choice.type. Canonical choiceType. Coercion zmodType: type >-> GRing.Zmodule.type. Canonical zmodType. Coercion lmodType: type>-> GRing.Lmodule.type. Canonical lmodType. Notation vectType R := (@type _ (Phant R)). Notation VectType R V mV := (@pack _ (Phant R) V _ mV _ _ id _ id). Notation VectMixin := Mixin. Notation "[ 'vectType' R 'of' T 'for' cT ]" := (@clone _ (Phant R) T cT _ idfun) (at level 0, format "[ 'vectType' R 'of' T 'for' cT ]") : form_scope. Notation "[ 'vectType' R 'of' T ]" := (@clone _ (Phant R) T _ _ idfun) (at level 0, format "[ 'vectType' R 'of' T ]") : form_scope. Notation "{ 'vspace' vT }" := (space (Phant vT)) : type_scope. Notation "''Hom' ( aT , rT )" := (hom aT rT) : type_scope. Notation "''End' ( vT )" := (hom vT vT) : type_scope. Prenex Implicits Hom. Delimit Scope vspace_scope with VS. Bind Scope vspace_scope with space. Delimit Scope lfun_scope with VF. Bind Scope lfun_scope with hom. End Exports. (* The contents of this module exposes the matrix encodings, and should *) (* therefore not be used outside of the vector library implementation. *) Module InternalTheory. Section Iso. Variables (R : ringType) (vT rT : vectType R). Local Coercion dim : vectType >-> nat. Fact v2r_subproof : axiom vT vT. Proof. by case: vT => T [bT []]. Qed. Definition v2r := s2val v2r_subproof. Let v2r_bij : bijective v2r := s2valP' v2r_subproof. Fact r2v_subproof : {r2v | cancel r2v v2r}. Proof. have r2vP r: {v | v2r v = r}. by apply: sig_eqW; have [v _ vK] := v2r_bij; exists (v r). by exists (fun r => sval (r2vP r)) => r; case: (r2vP r). Qed. Definition r2v := sval r2v_subproof. Lemma r2vK : cancel r2v v2r. Proof. exact: svalP r2v_subproof. Qed. Lemma r2v_inj : injective r2v. Proof. exact: can_inj r2vK. Qed. Lemma v2rK : cancel v2r r2v. Proof. by have/bij_can_sym:= r2vK; apply. Qed. Lemma v2r_inj : injective v2r. Proof. exact: can_inj v2rK. Qed. Canonical v2r_linear := Linear (s2valP v2r_subproof : linear v2r). Canonical r2v_linear := Linear (can2_linear v2rK r2vK). End Iso. Section Vspace. Variables (K : fieldType) (vT : vectType K). Local Coercion dim : vectType >-> nat. Definition b2mx n (X : n.-tuple vT) := \matrix_i v2r (tnth X i). Lemma b2mxK n (X : n.-tuple vT) i : r2v (row i (b2mx X)) = X`_i. Proof. by rewrite rowK v2rK -tnth_nth. Qed. Definition vs2mx {phV} (U : @space K vT phV) := let: Space mx _ := U in mx. Lemma gen_vs2mx (U : {vspace vT}) : <>%MS = vs2mx U. Proof. by apply/eqP; rewrite /vs2mx; case: U. Qed. Fact mx2vs_subproof m (A : 'M[K]_(m, vT)) : <<(<>)>>%MS == <>%MS. Proof. by rewrite genmx_id. Qed. Definition mx2vs {m} A : {vspace vT} := Space _ (@mx2vs_subproof m A). Canonical space_subType := [subType for @vs2mx (Phant vT)]. Lemma vs2mxK : cancel vs2mx mx2vs. Proof. by move=> v; apply: val_inj; rewrite /= gen_vs2mx. Qed. Lemma mx2vsK m (M : 'M_(m, vT)) : (vs2mx (mx2vs M) :=: M)%MS. Proof. exact: genmxE. Qed. End Vspace. Section Hom. Variables (R : ringType) (aT rT : vectType R). Definition f2mx (f : 'Hom(aT, rT)) := let: Hom A := f in A. Canonical hom_subType := [newType for f2mx]. End Hom. Arguments mx2vs {K vT m%N} A%MS. Prenex Implicits v2r r2v v2rK r2vK b2mx vs2mx vs2mxK f2mx. End InternalTheory. End Vector. Export Vector.Exports. Import Vector.InternalTheory. Section VspaceDefs. Variables (K : fieldType) (vT : vectType K). Implicit Types (u : vT) (X : seq vT) (U V : {vspace vT}). Definition space_eqMixin := Eval hnf in [eqMixin of {vspace vT} by <:]. Canonical space_eqType := EqType {vspace vT} space_eqMixin. Definition space_choiceMixin := Eval hnf in [choiceMixin of {vspace vT} by <:]. Canonical space_choiceType := ChoiceType {vspace vT} space_choiceMixin. Definition dimv U := \rank (vs2mx U). Definition subsetv U V := (vs2mx U <= vs2mx V)%MS. Definition vline u := mx2vs (v2r u). (* Vspace membership is defined as line inclusion. *) Definition pred_of_vspace phV (U : Vector.space phV) : {pred vT} := fun v => (vs2mx (vline v) <= vs2mx U)%MS. Canonical vspace_predType := @PredType _ (unkeyed {vspace vT}) (@pred_of_vspace _). Definition fullv : {vspace vT} := mx2vs 1%:M. Definition addv U V := mx2vs (vs2mx U + vs2mx V). Definition capv U V := mx2vs (vs2mx U :&: vs2mx V). Definition complv U := mx2vs (vs2mx U)^C. Definition diffv U V := mx2vs (vs2mx U :\: vs2mx V). Definition vpick U := r2v (nz_row (vs2mx U)). Fact span_key : unit. Proof. by []. Qed. Definition span_expanded_def X := mx2vs (b2mx (in_tuple X)). Definition span := locked_with span_key span_expanded_def. Canonical span_unlockable := [unlockable fun span]. Definition vbasis_def U := [tuple r2v (row i (row_base (vs2mx U))) | i < dimv U]. Definition vbasis := locked_with span_key vbasis_def. Canonical vbasis_unlockable := [unlockable fun vbasis]. (* coord and directv are defined in the VectorTheory section. *) Definition free X := dimv (span X) == size X. Definition basis_of U X := (span X == U) && free X. End VspaceDefs. Coercion pred_of_vspace : Vector.space >-> pred_sort. Notation "\dim U" := (dimv U) : nat_scope. Notation "U <= V" := (subsetv U V) : vspace_scope. Notation "U <= V <= W" := (subsetv U V && subsetv V W) : vspace_scope. Notation "<[ v ] >" := (vline v) : vspace_scope. Notation "<< X >>" := (span X) : vspace_scope. Notation "0" := (vline 0) : vspace_scope. Arguments fullv {K vT}. Prenex Implicits subsetv addv capv complv diffv span free basis_of. Notation "U + V" := (addv U V) : vspace_scope. Notation "U :&: V" := (capv U V) : vspace_scope. Notation "U ^C" := (complv U) (at level 8, format "U ^C") : vspace_scope. Notation "U :\: V" := (diffv U V) : vspace_scope. Notation "{ : vT }" := (@fullv _ vT) (only parsing) : vspace_scope. Notation "\sum_ ( i <- r | P ) U" := (\big[addv/0%VS]_(i <- r | P%B) U%VS) : vspace_scope. Notation "\sum_ ( i <- r ) U" := (\big[addv/0%VS]_(i <- r) U%VS) : vspace_scope. Notation "\sum_ ( m <= i < n | P ) U" := (\big[addv/0%VS]_(m <= i < n | P%B) U%VS) : vspace_scope. Notation "\sum_ ( m <= i < n ) U" := (\big[addv/0%VS]_(m <= i < n) U%VS) : vspace_scope. Notation "\sum_ ( i | P ) U" := (\big[addv/0%VS]_(i | P%B) U%VS) : vspace_scope. Notation "\sum_ i U" := (\big[addv/0%VS]_i U%VS) : vspace_scope. Notation "\sum_ ( i : t | P ) U" := (\big[addv/0%VS]_(i : t | P%B) U%VS) (only parsing) : vspace_scope. Notation "\sum_ ( i : t ) U" := (\big[addv/0%VS]_(i : t) U%VS) (only parsing) : vspace_scope. Notation "\sum_ ( i < n | P ) U" := (\big[addv/0%VS]_(i < n | P%B) U%VS) : vspace_scope. Notation "\sum_ ( i < n ) U" := (\big[addv/0%VS]_(i < n) U%VS) : vspace_scope. Notation "\sum_ ( i 'in' A | P ) U" := (\big[addv/0%VS]_(i in A | P%B) U%VS) : vspace_scope. Notation "\sum_ ( i 'in' A ) U" := (\big[addv/0%VS]_(i in A) U%VS) : vspace_scope. Notation "\bigcap_ ( i <- r | P ) U" := (\big[capv/fullv]_(i <- r | P%B) U%VS) : vspace_scope. Notation "\bigcap_ ( i <- r ) U" := (\big[capv/fullv]_(i <- r) U%VS) : vspace_scope. Notation "\bigcap_ ( m <= i < n | P ) U" := (\big[capv/fullv]_(m <= i < n | P%B) U%VS) : vspace_scope. Notation "\bigcap_ ( m <= i < n ) U" := (\big[capv/fullv]_(m <= i < n) U%VS) : vspace_scope. Notation "\bigcap_ ( i | P ) U" := (\big[capv/fullv]_(i | P%B) U%VS) : vspace_scope. Notation "\bigcap_ i U" := (\big[capv/fullv]_i U%VS) : vspace_scope. Notation "\bigcap_ ( i : t | P ) U" := (\big[capv/fullv]_(i : t | P%B) U%VS) (only parsing) : vspace_scope. Notation "\bigcap_ ( i : t ) U" := (\big[capv/fullv]_(i : t) U%VS) (only parsing) : vspace_scope. Notation "\bigcap_ ( i < n | P ) U" := (\big[capv/fullv]_(i < n | P%B) U%VS) : vspace_scope. Notation "\bigcap_ ( i < n ) U" := (\big[capv/fullv]_(i < n) U%VS) : vspace_scope. Notation "\bigcap_ ( i 'in' A | P ) U" := (\big[capv/fullv]_(i in A | P%B) U%VS) : vspace_scope. Notation "\bigcap_ ( i 'in' A ) U" := (\big[capv/fullv]_(i in A) U%VS) : vspace_scope. Section VectorTheory. Variables (K : fieldType) (vT : vectType K). Implicit Types (a : K) (u v w : vT) (X Y : seq vT) (U V W : {vspace vT}). Local Notation subV := (@subsetv K vT) (only parsing). Local Notation addV := (@addv K vT) (only parsing). Local Notation capV := (@capv K vT) (only parsing). (* begin hide *) (* Internal theory facts *) Let vs2mxP U V : reflect (U = V) (vs2mx U == vs2mx V)%MS. Proof. by rewrite (sameP genmxP eqP) !gen_vs2mx; apply: eqP. Qed. Let memvK v U : (v \in U) = (v2r v <= vs2mx U)%MS. Proof. by rewrite -genmxE. Qed. Let mem_r2v rv U : (r2v rv \in U) = (rv <= vs2mx U)%MS. Proof. by rewrite memvK r2vK. Qed. Let vs2mx0 : @vs2mx K vT _ 0 = 0. Proof. by rewrite /= linear0 genmx0. Qed. Let vs2mxD U V : vs2mx (U + V) = (vs2mx U + vs2mx V)%MS. Proof. by rewrite /= genmx_adds !gen_vs2mx. Qed. Let vs2mx_sum := big_morph _ vs2mxD vs2mx0. Let vs2mxI U V : vs2mx (U :&: V) = (vs2mx U :&: vs2mx V)%MS. Proof. by rewrite /= genmx_cap !gen_vs2mx. Qed. Let vs2mxF : vs2mx {:vT} = 1%:M. Proof. by rewrite /= genmx1. Qed. Let row_b2mx n (X : n.-tuple vT) i : row i (b2mx X) = v2r X`_i. Proof. by rewrite -tnth_nth rowK. Qed. Let span_b2mx n (X : n.-tuple vT) : span X = mx2vs (b2mx X). Proof. by rewrite unlock tvalK; case: _ / (esym _). Qed. Let mul_b2mx n (X : n.-tuple vT) (rk : 'rV_n) : \sum_i rk 0 i *: X`_i = r2v (rk *m b2mx X). Proof. rewrite mulmx_sum_row linear_sum; apply: eq_bigr => i _. by rewrite row_b2mx linearZ /= v2rK. Qed. Let lin_b2mx n (X : n.-tuple vT) k : \sum_(i < n) k i *: X`_i = r2v (\row_i k i *m b2mx X). Proof. by rewrite -mul_b2mx; apply: eq_bigr => i _; rewrite mxE. Qed. Let free_b2mx n (X : n.-tuple vT) : free X = row_free (b2mx X). Proof. by rewrite /free /dimv span_b2mx genmxE size_tuple. Qed. (* end hide *) Fact vspace_key U : pred_key U. Proof. by []. Qed. Canonical vspace_keyed U := KeyedPred (vspace_key U). Lemma memvE v U : (v \in U) = (<[v]> <= U)%VS. Proof. by []. Qed. Lemma vlineP v1 v2 : reflect (exists k, v1 = k *: v2) (v1 \in <[v2]>)%VS. Proof. apply: (iffP idP) => [|[k ->]]; rewrite memvK genmxE ?linearZ ?scalemx_sub //. by case/sub_rVP=> k; rewrite -linearZ => /v2r_inj->; exists k. Qed. Fact memv_submod_closed U : submod_closed U. Proof. split=> [|a u v]; rewrite !memvK ?linear0 ?sub0mx // => Uu Uv. by rewrite linearP addmx_sub ?scalemx_sub. Qed. Canonical memv_opprPred U := OpprPred (memv_submod_closed U). Canonical memv_addrPred U := AddrPred (memv_submod_closed U). Canonical memv_zmodPred U := ZmodPred (memv_submod_closed U). Canonical memv_submodPred U := SubmodPred (memv_submod_closed U). Lemma mem0v U : 0 \in U. Proof. exact: rpred0. Qed. Lemma memvN U v : (- v \in U) = (v \in U). Proof. exact: rpredN. Qed. Lemma memvD U : {in U &, forall u v, u + v \in U}. Proof. exact: rpredD. Qed. Lemma memvB U : {in U &, forall u v, u - v \in U}. Proof. exact: rpredB. Qed. Lemma memvZ U k : {in U, forall v, k *: v \in U}. Proof. exact: rpredZ. Qed. Lemma memv_suml I r (P : pred I) vs U : (forall i, P i -> vs i \in U) -> \sum_(i <- r | P i) vs i \in U. Proof. exact: rpred_sum. Qed. Lemma memv_line u : u \in <[u]>%VS. Proof. by apply/vlineP; exists 1; rewrite scale1r. Qed. Lemma subvP U V : reflect {subset U <= V} (U <= V)%VS. Proof. apply: (iffP rV_subP) => sU12 u. by rewrite !memvE /subsetv !genmxE => /sU12. by have:= sU12 (r2v u); rewrite !memvE /subsetv !genmxE r2vK. Qed. Lemma subvv U : (U <= U)%VS. Proof. exact/subvP. Qed. Hint Resolve subvv : core. Lemma subv_trans : transitive subV. Proof. by move=> U V W /subvP sUV /subvP sVW; apply/subvP=> u /sUV/sVW. Qed. Lemma subv_anti : antisymmetric subV. Proof. by move=> U V; apply/vs2mxP. Qed. Lemma eqEsubv U V : (U == V) = (U <= V <= U)%VS. Proof. by apply/eqP/idP=> [-> | /subv_anti//]; rewrite subvv. Qed. Lemma vspaceP U V : U =i V <-> U = V. Proof. split=> [eqUV | -> //]; apply/subv_anti/andP. by split; apply/subvP=> v; rewrite eqUV. Qed. Lemma subvPn {U V} : reflect (exists2 u, u \in U & u \notin V) (~~ (U <= V)%VS). Proof. apply: (iffP idP) => [|[u Uu]]; last by apply: contra => /subvP->. case/row_subPn=> i; set vi := row i _ => V'vi. by exists (r2v vi); rewrite memvK r2vK ?row_sub. Qed. (* Empty space. *) Lemma sub0v U : (0 <= U)%VS. Proof. exact: mem0v. Qed. Lemma subv0 U : (U <= 0)%VS = (U == 0%VS). Proof. by rewrite eqEsubv sub0v andbT. Qed. Lemma memv0 v : v \in 0%VS = (v == 0). Proof. by apply/idP/eqP=> [/vlineP[k ->] | ->]; rewrite (scaler0, mem0v). Qed. (* Full space *) Lemma subvf U : (U <= fullv)%VS. Proof. by rewrite /subsetv vs2mxF submx1. Qed. Lemma memvf v : v \in fullv. Proof. exact: subvf. Qed. (* Picking a non-zero vector in a subspace. *) Lemma memv_pick U : vpick U \in U. Proof. by rewrite mem_r2v nz_row_sub. Qed. Lemma vpick0 U : (vpick U == 0) = (U == 0%VS). Proof. by rewrite -memv0 mem_r2v -subv0 /subV vs2mx0 !submx0 nz_row_eq0. Qed. (* Sum of subspaces. *) Lemma subv_add U V W : (U + V <= W)%VS = (U <= W)%VS && (V <= W)%VS. Proof. by rewrite /subV vs2mxD addsmx_sub. Qed. Lemma addvS U1 U2 V1 V2 : (U1 <= U2 -> V1 <= V2 -> U1 + V1 <= U2 + V2)%VS. Proof. by rewrite /subV !vs2mxD; apply: addsmxS. Qed. Lemma addvSl U V : (U <= U + V)%VS. Proof. by rewrite /subV vs2mxD addsmxSl. Qed. Lemma addvSr U V : (V <= U + V)%VS. Proof. by rewrite /subV vs2mxD addsmxSr. Qed. Lemma addvC : commutative addV. Proof. by move=> U V; apply/vs2mxP; rewrite !vs2mxD addsmxC submx_refl. Qed. Lemma addvA : associative addV. Proof. by move=> U V W; apply/vs2mxP; rewrite !vs2mxD addsmxA submx_refl. Qed. Lemma addv_idPl {U V}: reflect (U + V = U)%VS (V <= U)%VS. Proof. by rewrite /subV (sameP addsmx_idPl eqmxP) -vs2mxD; apply: vs2mxP. Qed. Lemma addv_idPr {U V} : reflect (U + V = V)%VS (U <= V)%VS. Proof. by rewrite addvC; apply: addv_idPl. Qed. Lemma addvv : idempotent addV. Proof. by move=> U; apply/addv_idPl. Qed. Lemma add0v : left_id 0%VS addV. Proof. by move=> U; apply/addv_idPr/sub0v. Qed. Lemma addv0 : right_id 0%VS addV. Proof. by move=> U; apply/addv_idPl/sub0v. Qed. Lemma sumfv : left_zero fullv addV. Proof. by move=> U; apply/addv_idPl/subvf. Qed. Lemma addvf : right_zero fullv addV. Proof. by move=> U; apply/addv_idPr/subvf. Qed. Canonical addv_monoid := Monoid.Law addvA add0v addv0. Canonical addv_comoid := Monoid.ComLaw addvC. Lemma memv_add u v U V : u \in U -> v \in V -> u + v \in (U + V)%VS. Proof. by rewrite !memvK genmxE linearD; apply: addmx_sub_adds. Qed. Lemma memv_addP {w U V} : reflect (exists2 u, u \in U & exists2 v, v \in V & w = u + v) (w \in U + V)%VS. Proof. apply: (iffP idP) => [|[u Uu [v Vv ->]]]; last exact: memv_add. rewrite memvK genmxE => /sub_addsmxP[r /(canRL v2rK)->]. rewrite linearD /=; set u := r2v _; set v := r2v _. by exists u; last exists v; rewrite // mem_r2v submxMl. Qed. Section BigSum. Variable I : finType. Implicit Type P : pred I. Lemma sumv_sup i0 P U Vs : P i0 -> (U <= Vs i0)%VS -> (U <= \sum_(i | P i) Vs i)%VS. Proof. by move=> Pi0 /subv_trans-> //; rewrite (bigD1 i0) ?addvSl. Qed. Arguments sumv_sup i0 [P U Vs]. Lemma subv_sumP {P Us V} : reflect (forall i, P i -> Us i <= V)%VS (\sum_(i | P i) Us i <= V)%VS. Proof. apply: (iffP idP) => [sUV i Pi | sUV]. by apply: subv_trans sUV; apply: sumv_sup Pi _. by elim/big_rec: _ => [|i W Pi sWV]; rewrite ?sub0v // subv_add sUV. Qed. Lemma memv_sumr P vs (Us : I -> {vspace vT}) : (forall i, P i -> vs i \in Us i) -> \sum_(i | P i) vs i \in (\sum_(i | P i) Us i)%VS. Proof. by move=> Uv; apply/rpred_sum=> i Pi; apply/(sumv_sup i Pi)/Uv. Qed. Lemma memv_sumP {P} {Us : I -> {vspace vT}} {v} : reflect (exists2 vs, forall i, P i -> vs i \in Us i & v = \sum_(i | P i) vs i) (v \in \sum_(i | P i) Us i)%VS. Proof. apply: (iffP idP) => [|[vs Uv ->]]; last exact: memv_sumr. rewrite memvK vs2mx_sum => /sub_sumsmxP[r /(canRL v2rK)->]. pose f i := r2v (r i *m vs2mx (Us i)); rewrite linear_sum /=. by exists f => //= i _; rewrite mem_r2v submxMl. Qed. End BigSum. (* Intersection *) Lemma subv_cap U V W : (U <= V :&: W)%VS = (U <= V)%VS && (U <= W)%VS. Proof. by rewrite /subV vs2mxI sub_capmx. Qed. Lemma capvS U1 U2 V1 V2 : (U1 <= U2 -> V1 <= V2 -> U1 :&: V1 <= U2 :&: V2)%VS. Proof. by rewrite /subV !vs2mxI; apply: capmxS. Qed. Lemma capvSl U V : (U :&: V <= U)%VS. Proof. by rewrite /subV vs2mxI capmxSl. Qed. Lemma capvSr U V : (U :&: V <= V)%VS. Proof. by rewrite /subV vs2mxI capmxSr. Qed. Lemma capvC : commutative capV. Proof. by move=> U V; apply/vs2mxP; rewrite !vs2mxI capmxC submx_refl. Qed. Lemma capvA : associative capV. Proof. by move=> U V W; apply/vs2mxP; rewrite !vs2mxI capmxA submx_refl. Qed. Lemma capv_idPl {U V} : reflect (U :&: V = U)%VS (U <= V)%VS. Proof. by rewrite /subV(sameP capmx_idPl eqmxP) -vs2mxI; apply: vs2mxP. Qed. Lemma capv_idPr {U V} : reflect (U :&: V = V)%VS (V <= U)%VS. Proof. by rewrite capvC; apply: capv_idPl. Qed. Lemma capvv : idempotent capV. Proof. by move=> U; apply/capv_idPl. Qed. Lemma cap0v : left_zero 0%VS capV. Proof. by move=> U; apply/capv_idPl/sub0v. Qed. Lemma capv0 : right_zero 0%VS capV. Proof. by move=> U; apply/capv_idPr/sub0v. Qed. Lemma capfv : left_id fullv capV. Proof. by move=> U; apply/capv_idPr/subvf. Qed. Lemma capvf : right_id fullv capV. Proof. by move=> U; apply/capv_idPl/subvf. Qed. Canonical capv_monoid := Monoid.Law capvA capfv capvf. Canonical capv_comoid := Monoid.ComLaw capvC. Lemma memv_cap w U V : (w \in U :&: V)%VS = (w \in U) && (w \in V). Proof. by rewrite !memvE subv_cap. Qed. Lemma memv_capP {w U V} : reflect (w \in U /\ w \in V) (w \in U :&: V)%VS. Proof. by rewrite memv_cap; apply: andP. Qed. Lemma vspace_modl U V W : (U <= W -> U + (V :&: W) = (U + V) :&: W)%VS. Proof. by move=> sUV; apply/vs2mxP; rewrite !(vs2mxD, vs2mxI); apply/eqmxP/matrix_modl. Qed. Lemma vspace_modr U V W : (W <= U -> (U :&: V) + W = U :&: (V + W))%VS. Proof. by rewrite -!(addvC W) !(capvC U); apply: vspace_modl. Qed. Section BigCap. Variable I : finType. Implicit Type P : pred I. Lemma bigcapv_inf i0 P Us V : P i0 -> (Us i0 <= V -> \bigcap_(i | P i) Us i <= V)%VS. Proof. by move=> Pi0; apply: subv_trans; rewrite (bigD1 i0) ?capvSl. Qed. Lemma subv_bigcapP {P U Vs} : reflect (forall i, P i -> U <= Vs i)%VS (U <= \bigcap_(i | P i) Vs i)%VS. Proof. apply: (iffP idP) => [sUV i Pi | sUV]. by rewrite (subv_trans sUV) ?(bigcapv_inf Pi). by elim/big_rec: _ => [|i W Pi]; rewrite ?subvf // subv_cap sUV. Qed. End BigCap. (* Complement *) Lemma addv_complf U : (U + U^C)%VS = fullv. Proof. apply/vs2mxP; rewrite vs2mxD -gen_vs2mx -genmx_adds !genmxE submx1 sub1mx. exact: addsmx_compl_full. Qed. Lemma capv_compl U : (U :&: U^C = 0)%VS. Proof. apply/val_inj; rewrite [val]/= vs2mx0 vs2mxI -gen_vs2mx -genmx_cap. by rewrite capmx_compl genmx0. Qed. (* Difference *) Lemma diffvSl U V : (U :\: V <= U)%VS. Proof. by rewrite /subV genmxE diffmxSl. Qed. Lemma capv_diff U V : ((U :\: V) :&: V = 0)%VS. Proof. apply/val_inj; rewrite [val]/= vs2mx0 vs2mxI -(gen_vs2mx V) -genmx_cap. by rewrite capmx_diff genmx0. Qed. Lemma addv_diff_cap U V : (U :\: V + U :&: V)%VS = U. Proof. apply/vs2mxP; rewrite vs2mxD -genmx_adds !genmxE. exact/eqmxP/addsmx_diff_cap_eq. Qed. Lemma addv_diff U V : (U :\: V + V = U + V)%VS. Proof. by rewrite -{2}(addv_diff_cap U V) -addvA (addv_idPr (capvSr U V)). Qed. (* Subspace dimension. *) Lemma dimv0 : \dim (0%VS : {vspace vT}) = 0%N. Proof. by rewrite /dimv vs2mx0 mxrank0. Qed. Lemma dimv_eq0 U : (\dim U == 0%N) = (U == 0%VS). Proof. by rewrite /dimv /= mxrank_eq0 {2}/eq_op /= linear0 genmx0. Qed. Lemma dimvf : \dim {:vT} = Vector.dim vT. Proof. by rewrite /dimv vs2mxF mxrank1. Qed. Lemma dim_vline v : \dim <[v]> = (v != 0). Proof. by rewrite /dimv mxrank_gen rank_rV (can2_eq v2rK r2vK) linear0. Qed. Lemma dimvS U V : (U <= V)%VS -> \dim U <= \dim V. Proof. exact: mxrankS. Qed. Lemma dimv_leqif_sup U V : (U <= V)%VS -> \dim U <= \dim V ?= iff (V <= U)%VS. Proof. exact: mxrank_leqif_sup. Qed. Lemma dimv_leqif_eq U V : (U <= V)%VS -> \dim U <= \dim V ?= iff (U == V). Proof. by rewrite eqEsubv; apply: mxrank_leqif_eq. Qed. Lemma eqEdim U V : (U == V) = (U <= V)%VS && (\dim V <= \dim U). Proof. by apply/idP/andP=> [/eqP | [/dimv_leqif_eq/geq_leqif]] ->. Qed. Lemma dimv_compl U : \dim U^C = (\dim {:vT} - \dim U)%N. Proof. by rewrite dimvf /dimv mxrank_gen mxrank_compl. Qed. Lemma dimv_cap_compl U V : (\dim (U :&: V) + \dim (U :\: V))%N = \dim U. Proof. by rewrite /dimv !mxrank_gen mxrank_cap_compl. Qed. Lemma dimv_sum_cap U V : (\dim (U + V) + \dim (U :&: V) = \dim U + \dim V)%N. Proof. by rewrite /dimv !mxrank_gen mxrank_sum_cap. Qed. Lemma dimv_disjoint_sum U V : (U :&: V = 0)%VS -> \dim (U + V) = (\dim U + \dim V)%N. Proof. by move=> dxUV; rewrite -dimv_sum_cap dxUV dimv0 addn0. Qed. Lemma dimv_add_leqif U V : \dim (U + V) <= \dim U + \dim V ?= iff (U :&: V <= 0)%VS. Proof. by rewrite /dimv /subV !mxrank_gen vs2mx0 genmxE; apply: mxrank_adds_leqif. Qed. Lemma diffv_eq0 U V : (U :\: V == 0)%VS = (U <= V)%VS. Proof. rewrite -dimv_eq0 -(eqn_add2l (\dim (U :&: V))) addn0 dimv_cap_compl eq_sym. by rewrite (dimv_leqif_eq (capvSl _ _)) (sameP capv_idPl eqP). Qed. Lemma dimv_leq_sum I r (P : pred I) (Us : I -> {vspace vT}) : \dim (\sum_(i <- r | P i) Us i) <= \sum_(i <- r | P i) \dim (Us i). Proof. elim/big_rec2: _ => [|i d vs _ le_vs_d]; first by rewrite dim_vline eqxx. by apply: (leq_trans (dimv_add_leqif _ _)); rewrite leq_add2l. Qed. Section SumExpr. (* The vector direct sum theory clones the interface types of the matrix *) (* direct sum theory (see mxalgebra for the technical details), but *) (* nevetheless reuses much of the matrix theory. *) Structure addv_expr := Sumv { addv_val :> wrapped {vspace vT}; addv_dim : wrapped nat; _ : mxsum_spec (vs2mx (unwrap addv_val)) (unwrap addv_dim) }. (* Piggyback on mxalgebra theory. *) Definition vs2mx_sum_expr_subproof (S : addv_expr) : mxsum_spec (vs2mx (unwrap S)) (unwrap (addv_dim S)). Proof. by case: S. Qed. Canonical vs2mx_sum_expr S := ProperMxsumExpr (vs2mx_sum_expr_subproof S). Canonical trivial_addv U := @Sumv (Wrap U) (Wrap (\dim U)) (TrivialMxsum _). Structure proper_addv_expr := ProperSumvExpr { proper_addv_val :> {vspace vT}; proper_addv_dim :> nat; _ : mxsum_spec (vs2mx proper_addv_val) proper_addv_dim }. Definition proper_addvP (S : proper_addv_expr) := let: ProperSumvExpr _ _ termS := S return mxsum_spec (vs2mx S) S in termS. Canonical proper_addv (S : proper_addv_expr) := @Sumv (wrap (S : {vspace vT})) (wrap (S : nat)) (proper_addvP S). Section Binary. Variables S1 S2 : addv_expr. Fact binary_addv_subproof : mxsum_spec (vs2mx (unwrap S1 + unwrap S2)) (unwrap (addv_dim S1) + unwrap (addv_dim S2)). Proof. by rewrite vs2mxD; apply: proper_mxsumP. Qed. Canonical binary_addv_expr := ProperSumvExpr binary_addv_subproof. End Binary. Section Nary. Variables (I : Type) (r : seq I) (P : pred I) (S_ : I -> addv_expr). Fact nary_addv_subproof : mxsum_spec (vs2mx (\sum_(i <- r | P i) unwrap (S_ i))) (\sum_(i <- r | P i) unwrap (addv_dim (S_ i))). Proof. by rewrite vs2mx_sum; apply: proper_mxsumP. Qed. Canonical nary_addv_expr := ProperSumvExpr nary_addv_subproof. End Nary. Definition directv_def S of phantom {vspace vT} (unwrap (addv_val S)) := \dim (unwrap S) == unwrap (addv_dim S). End SumExpr. Local Notation directv A := (directv_def (Phantom {vspace _} A%VS)). Lemma directvE (S : addv_expr) : directv (unwrap S) = (\dim (unwrap S) == unwrap (addv_dim S)). Proof. by []. Qed. Lemma directvP {S : proper_addv_expr} : reflect (\dim S = S :> nat) (directv S). Proof. exact: eqnP. Qed. Lemma directv_trivial U : directv (unwrap (@trivial_addv U)). Proof. exact: eqxx. Qed. Lemma dimv_sum_leqif (S : addv_expr) : \dim (unwrap S) <= unwrap (addv_dim S) ?= iff directv (unwrap S). Proof. rewrite directvE; case: S => [[U] [d] /= defUd]; split=> //=. rewrite /dimv; elim: {1}_ {U}_ d / defUd => // m1 m2 A1 A2 r1 r2 _ leA1 _ leA2. by apply: leq_trans (leq_add leA1 leA2); rewrite mxrank_adds_leqif. Qed. Lemma directvEgeq (S : addv_expr) : directv (unwrap S) = (\dim (unwrap S) >= unwrap (addv_dim S)). Proof. by rewrite leq_eqVlt ltnNge eq_sym !dimv_sum_leqif orbF. Qed. Section BinaryDirect. Lemma directv_addE (S1 S2 : addv_expr) : directv (unwrap S1 + unwrap S2) = [&& directv (unwrap S1), directv (unwrap S2) & unwrap S1 :&: unwrap S2 == 0]%VS. Proof. by rewrite /directv_def /dimv vs2mxD -mxdirectE mxdirect_addsE -vs2mxI -vs2mx0. Qed. Lemma directv_addP {U V} : reflect (U :&: V = 0)%VS (directv (U + V)). Proof. by rewrite directv_addE !directv_trivial; apply: eqP. Qed. Lemma directv_add_unique {U V} : reflect (forall u1 u2 v1 v2, u1 \in U -> u2 \in U -> v1 \in V -> v2 \in V -> (u1 + v1 == u2 + v2) = ((u1, v1) == (u2, v2))) (directv (U + V)). Proof. apply: (iffP directv_addP) => [dxUV u1 u2 v1 v2 Uu1 Uu2 Vv1 Vv2 | dxUV]. apply/idP/idP=> [| /eqP[-> ->] //]; rewrite -subr_eq0 opprD addrACA addr_eq0. move/eqP=> eq_uv; rewrite xpair_eqE -subr_eq0 eq_uv oppr_eq0 subr_eq0 andbb. by rewrite -subr_eq0 -memv0 -dxUV memv_cap -memvN -eq_uv !memvB. apply/eqP; rewrite -subv0; apply/subvP=> v /memv_capP[U1v U2v]. by rewrite memv0 -[v == 0]andbb {1}eq_sym -xpair_eqE -dxUV ?mem0v // addrC. Qed. End BinaryDirect. Section NaryDirect. Context {I : finType} {P : pred I}. Lemma directv_sumP {Us : I -> {vspace vT}} : reflect (forall i, P i -> Us i :&: (\sum_(j | P j && (j != i)) Us j) = 0)%VS (directv (\sum_(i | P i) Us i)). Proof. rewrite directvE /= /dimv vs2mx_sum -mxdirectE; apply: (equivP mxdirect_sumsP). by do [split=> dxU i /dxU; rewrite -vs2mx_sum -vs2mxI -vs2mx0] => [/val_inj|->]. Qed. Lemma directv_sumE {Ss : I -> addv_expr} (xunwrap := unwrap) : reflect [/\ forall i, P i -> directv (unwrap (Ss i)) & directv (\sum_(i | P i) xunwrap (Ss i))] (directv (\sum_(i | P i) unwrap (Ss i))). Proof. by rewrite !directvE /= /dimv 2!{1}vs2mx_sum -!mxdirectE; apply: mxdirect_sumsE. Qed. Lemma directv_sum_independent {Us : I -> {vspace vT}} : reflect (forall us, (forall i, P i -> us i \in Us i) -> \sum_(i | P i) us i = 0 -> (forall i, P i -> us i = 0)) (directv (\sum_(i | P i) Us i)). Proof. apply: (iffP directv_sumP) => [dxU us Uu u_0 i Pi | dxU i Pi]. apply/eqP; rewrite -memv0 -(dxU i Pi) memv_cap Uu //= -memvN -sub0r -{1}u_0. by rewrite (bigD1 i) //= addrC addKr memv_sumr // => j /andP[/Uu]. apply/eqP; rewrite -subv0; apply/subvP=> v. rewrite memv_cap memv0 => /andP[Uiv /memv_sumP[us Uu Dv]]. have: \sum_(j | P j) [eta us with i |-> - v] j = 0. rewrite (bigD1 i) //= eqxx {1}Dv addrC -sumrB big1 // => j /andP[_ i'j]. by rewrite (negPf i'j) subrr. move/dxU/(_ i Pi); rewrite /= eqxx -oppr_eq0 => -> // j Pj. by have [-> | i'j] := eqVneq; rewrite ?memvN // Uu ?Pj. Qed. Lemma directv_sum_unique {Us : I -> {vspace vT}} : reflect (forall us vs, (forall i, P i -> us i \in Us i) -> (forall i, P i -> vs i \in Us i) -> (\sum_(i | P i) us i == \sum_(i | P i) vs i) = [forall (i | P i), us i == vs i]) (directv (\sum_(i | P i) Us i)). Proof. apply: (iffP directv_sum_independent) => [dxU us vs Uu Uv | dxU us Uu u_0 i Pi]. apply/idP/forall_inP=> [|eq_uv]; last by apply/eqP/eq_bigr => i /eq_uv/eqP. rewrite -subr_eq0 -sumrB => /eqP/dxU eq_uv i Pi. by rewrite -subr_eq0 eq_uv // => j Pj; apply: memvB; move: j Pj. apply/eqP; have:= esym (dxU us \0 Uu _); rewrite u_0 big1_eq eqxx. by move/(_ _)/forall_inP=> -> // j _; apply: mem0v. Qed. End NaryDirect. (* Linear span generated by a list of vectors *) Lemma memv_span X v : v \in X -> v \in <>%VS. Proof. by case/seq_tnthP=> i {v}->; rewrite unlock memvK genmxE (eq_row_sub i) // rowK. Qed. Lemma memv_span1 v : v \in <<[:: v]>>%VS. Proof. by rewrite memv_span ?mem_head. Qed. Lemma dim_span X : \dim <> <= size X. Proof. by rewrite unlock /dimv genmxE rank_leq_row. Qed. Lemma span_subvP {X U} : reflect {subset X <= U} (<> <= U)%VS. Proof. rewrite /subV [@span _ _]unlock genmxE. apply: (iffP row_subP) => /= [sXU | sXU i]. by move=> _ /seq_tnthP[i ->]; have:= sXU i; rewrite rowK memvK. by rewrite rowK -memvK sXU ?mem_tnth. Qed. Lemma sub_span X Y : {subset X <= Y} -> (<> <= <>)%VS. Proof. by move=> sXY; apply/span_subvP=> v /sXY/memv_span. Qed. Lemma eq_span X Y : X =i Y -> (<> = <>)%VS. Proof. by move=> eqXY; apply: subv_anti; rewrite !sub_span // => u; rewrite eqXY. Qed. Lemma span_def X : span X = (\sum_(u <- X) <[u]>)%VS. Proof. apply/subv_anti/andP; split. by apply/span_subvP=> v Xv; rewrite (big_rem v) // memvE addvSl. by rewrite big_tnth; apply/subv_sumP=> i _; rewrite -memvE memv_span ?mem_tnth. Qed. Lemma span_nil : (<> = 0)%VS. Proof. by rewrite span_def big_nil. Qed. Lemma span_seq1 v : (<<[:: v]>> = <[v]>)%VS. Proof. by rewrite span_def big_seq1. Qed. Lemma span_cons v X : (<> = <[v]> + <>)%VS. Proof. by rewrite !span_def big_cons. Qed. Lemma span_cat X Y : (<> = <> + <>)%VS. Proof. by rewrite !span_def big_cat. Qed. (* Coordinates function; should perhaps be generalized to nat indices. *) Definition coord_expanded_def n (X : n.-tuple vT) i v := (v2r v *m pinvmx (b2mx X)) 0 i. Definition coord := locked_with span_key coord_expanded_def. Canonical coord_unlockable := [unlockable fun coord]. Fact coord_is_scalar n (X : n.-tuple vT) i : scalar (coord X i). Proof. by move=> k u v; rewrite unlock linearP mulmxDl -scalemxAl !mxE. Qed. Canonical coord_addidive n Xn i := Additive (@coord_is_scalar n Xn i). Canonical coord_linear n Xn i := AddLinear (@coord_is_scalar n Xn i). Lemma coord_span n (X : n.-tuple vT) v : v \in span X -> v = \sum_i coord X i v *: X`_i. Proof. rewrite memvK span_b2mx genmxE => Xv. by rewrite unlock_with mul_b2mx mulmxKpV ?v2rK. Qed. Lemma coord0 i v : coord [tuple 0] i v = 0. Proof. rewrite unlock /pinvmx rank_rV; case: negP => [[] | _]. by apply/eqP/rowP=> j; rewrite !mxE (tnth_nth 0) /= linear0 mxE. by rewrite pid_mx_0 !(mulmx0, mul0mx) mxE. Qed. (* Free generator sequences. *) Lemma nil_free : free (Nil vT). Proof. by rewrite /free span_nil dimv0. Qed. Lemma seq1_free v : free [:: v] = (v != 0). Proof. by rewrite /free span_seq1 dim_vline; case: (~~ _). Qed. Lemma perm_free X Y : perm_eq X Y -> free X = free Y. Proof. by move=> eqXY; rewrite /free (perm_size eqXY) (eq_span (perm_mem eqXY)). Qed. Lemma free_directv X : free X = (0 \notin X) && directv (\sum_(v <- X) <[v]>). Proof. have leXi i (v := tnth (in_tuple X) i): true -> \dim <[v]> <= 1 ?= iff (v != 0). by rewrite -seq1_free -span_seq1 => _; apply/leqif_eq/dim_span. have [_ /=] := leqif_trans (dimv_sum_leqif _) (leqif_sum leXi). rewrite sum1_card card_ord !directvE /= /free andbC span_def !(big_tnth _ _ X). by congr (_ = _ && _); rewrite -has_pred1 -all_predC -big_all big_tnth big_andE. Qed. Lemma free_not0 v X : free X -> v \in X -> v != 0. Proof. by rewrite free_directv andbC => /andP[_ /memPn]; apply. Qed. Lemma freeP n (X : n.-tuple vT) : reflect (forall k, \sum_(i < n) k i *: X`_i = 0 -> (forall i, k i = 0)) (free X). Proof. rewrite free_b2mx; apply: (iffP idP) => [t_free k kt0 i | t_free]. suffices /rowP/(_ i): \row_i k i = 0 by rewrite !mxE. by apply/(row_free_inj t_free)/r2v_inj; rewrite mul0mx -lin_b2mx kt0 linear0. rewrite -kermx_eq0; apply/rowV0P=> rk /sub_kermxP kt0. by apply/rowP=> i; rewrite mxE {}t_free // mul_b2mx kt0 linear0. Qed. Lemma coord_free n (X : n.-tuple vT) (i j : 'I_n) : free X -> coord X j (X`_i) = (i == j)%:R. Proof. rewrite unlock free_b2mx => /row_freeP[Ct CtK]; rewrite -row_b2mx. by rewrite -row_mul -[pinvmx _]mulmx1 -CtK 2!mulmxA mulmxKpV // CtK !mxE. Qed. Lemma coord_sum_free n (X : n.-tuple vT) k j : free X -> coord X j (\sum_(i < n) k i *: X`_i) = k j. Proof. move=> Xfree; rewrite linear_sum (bigD1 j) ?linearZ //= coord_free // eqxx. rewrite mulr1 big1 ?addr0 // => i /negPf j'i. by rewrite linearZ /= coord_free // j'i mulr0. Qed. Lemma cat_free X Y : free (X ++ Y) = [&& free X, free Y & directv (<> + <>)]. Proof. rewrite !free_directv mem_cat directvE /= !big_cat -directvE directv_addE /=. rewrite negb_or -!andbA; do !bool_congr; rewrite -!span_def. by rewrite (sameP eqP directv_addP). Qed. Lemma catl_free Y X : free (X ++ Y) -> free X. Proof. by rewrite cat_free => /and3P[]. Qed. Lemma catr_free X Y : free (X ++ Y) -> free Y. Proof. by rewrite cat_free => /and3P[]. Qed. Lemma filter_free p X : free X -> free (filter p X). Proof. rewrite -(perm_free (etrans (perm_filterC p X _) (perm_refl X))). exact: catl_free. Qed. Lemma free_cons v X : free (v :: X) = (v \notin <>)%VS && free X. Proof. rewrite (cat_free [:: v]) seq1_free directvEgeq /= span_seq1 dim_vline. case: eqP => [-> | _] /=; first by rewrite mem0v. rewrite andbC ltnNge (geq_leqif (dimv_leqif_sup _)) ?addvSr //. by rewrite subv_add subvv andbT -memvE. Qed. Lemma freeE n (X : n.-tuple vT) : free X = [forall i : 'I_n, X`_i \notin <>%VS]. Proof. case: X => X /= /eqP <-{n}; rewrite -(big_andE xpredT) /=. elim: X => [|v X IH_X] /=; first by rewrite nil_free big_ord0. by rewrite free_cons IH_X big_ord_recl drop0. Qed. Lemma freeNE n (X : n.-tuple vT) : ~~ free X = [exists i : 'I_n, X`_i \in <>%VS]. Proof. by rewrite freeE -negb_exists negbK. Qed. Lemma free_uniq X : free X -> uniq X. Proof. elim: X => //= v b IH_X; rewrite free_cons => /andP[X'v /IH_X->]. by rewrite (contra _ X'v) // => /memv_span. Qed. Lemma free_span X v (sumX := fun k => \sum_(x <- X) k x *: x) : free X -> v \in <>%VS -> {k | v = sumX k & forall k1, v = sumX k1 -> {in X, k1 =1 k}}. Proof. rewrite -{2}[X]in_tupleE => freeX /coord_span def_v. pose k x := oapp (fun i => coord (in_tuple X) i v) 0 (insub (index x X)). exists k => [|k1 {}def_v _ /(nthP 0)[i ltiX <-]]. rewrite /sumX (big_nth 0) big_mkord def_v; apply: eq_bigr => i _. by rewrite /k index_uniq ?free_uniq // valK. rewrite /k /= index_uniq ?free_uniq // insubT //= def_v. by rewrite /sumX (big_nth 0) big_mkord coord_sum_free. Qed. Lemma linear_of_free (rT : lmodType K) X (fX : seq rT) : {f : {linear vT -> rT} | free X -> size fX = size X -> map f X = fX}. Proof. pose f u := \sum_i coord (in_tuple X) i u *: fX`_i. have lin_f: linear f. move=> k u v; rewrite scaler_sumr -big_split; apply: eq_bigr => i _. by rewrite /= scalerA -scalerDl linearP. exists (Linear lin_f) => freeX eq_szX. apply/esym/(@eq_from_nth _ 0); rewrite ?size_map eq_szX // => i ltiX. rewrite (nth_map 0) //= /f (bigD1 (Ordinal ltiX)) //=. rewrite big1 => [|j /negbTE neqji]; rewrite (coord_free (Ordinal _)) //. by rewrite eqxx scale1r addr0. by rewrite eq_sym neqji scale0r. Qed. (* Subspace bases *) Lemma span_basis U X : basis_of U X -> <>%VS = U. Proof. by case/andP=> /eqP. Qed. Lemma basis_free U X : basis_of U X -> free X. Proof. by case/andP. Qed. Lemma coord_basis U n (X : n.-tuple vT) v : basis_of U X -> v \in U -> v = \sum_i coord X i v *: X`_i. Proof. by move/span_basis <-; apply: coord_span. Qed. Lemma nil_basis : basis_of 0 (Nil vT). Proof. by rewrite /basis_of span_nil eqxx nil_free. Qed. Lemma seq1_basis v : v != 0 -> basis_of <[v]> [:: v]. Proof. by move=> nz_v; rewrite /basis_of span_seq1 // eqxx seq1_free. Qed. Lemma basis_not0 x U X : basis_of U X -> x \in X -> x != 0. Proof. by move/basis_free/free_not0; apply. Qed. Lemma basis_mem x U X : basis_of U X -> x \in X -> x \in U. Proof. by move/span_basis=> <- /memv_span. Qed. Lemma cat_basis U V X Y : directv (U + V) -> basis_of U X -> basis_of V Y -> basis_of (U + V) (X ++ Y). Proof. move=> dxUV /andP[/eqP defU freeX] /andP[/eqP defV freeY]. by rewrite /basis_of span_cat cat_free defU defV // eqxx freeX freeY. Qed. Lemma size_basis U n (X : n.-tuple vT) : basis_of U X -> \dim U = n. Proof. by case/andP=> /eqP <- /eqnP->; apply: size_tuple. Qed. Lemma basisEdim X U : basis_of U X = (U <= <>)%VS && (size X <= \dim U). Proof. apply/andP/idP=> [[defU /eqnP <-]| ]; first by rewrite -eqEdim eq_sym. case/andP=> sUX leXU; have leXX := dim_span X. rewrite /free eq_sym eqEdim sUX eqn_leq !(leq_trans leXX) //. by rewrite (leq_trans leXU) ?dimvS. Qed. Lemma basisEfree X U : basis_of U X = [&& free X, (<> <= U)%VS & \dim U <= size X]. Proof. by rewrite andbC; apply: andb_id2r => freeX; rewrite eqEdim (eqnP freeX). Qed. Lemma perm_basis X Y U : perm_eq X Y -> basis_of U X = basis_of U Y. Proof. move=> eqXY; congr ((_ == _) && _); last exact: perm_free. exact/eq_span/perm_mem. Qed. Lemma vbasisP U : basis_of U (vbasis U). Proof. rewrite /basis_of free_b2mx span_b2mx (sameP eqP (vs2mxP _ _)) !genmxE. have ->: b2mx (vbasis U) = row_base (vs2mx U). by apply/row_matrixP=> i; rewrite unlock rowK tnth_mktuple r2vK. by rewrite row_base_free !eq_row_base submx_refl. Qed. Lemma vbasis_mem v U : v \in (vbasis U) -> v \in U. Proof. exact: basis_mem (vbasisP _). Qed. Lemma coord_vbasis v U : v \in U -> v = \sum_(i < \dim U) coord (vbasis U) i v *: (vbasis U)`_i. Proof. exact: coord_basis (vbasisP U). Qed. Section BigSumBasis. Variables (I : finType) (P : pred I) (Xs : I -> seq vT). Lemma span_bigcat : (<<\big[cat/[::]]_(i | P i) Xs i>> = \sum_(i | P i) <>)%VS. Proof. by rewrite (big_morph _ span_cat span_nil). Qed. Lemma bigcat_free : directv (\sum_(i | P i) <>) -> (forall i, P i -> free (Xs i)) -> free (\big[cat/[::]]_(i | P i) Xs i). Proof. rewrite /free directvE /= span_bigcat => /directvP-> /= freeXs. rewrite (big_morph _ (@size_cat _) (erefl _)) /=. by apply/eqP/eq_bigr=> i /freeXs/eqP. Qed. Lemma bigcat_basis Us (U := (\sum_(i | P i) Us i)%VS) : directv U -> (forall i, P i -> basis_of (Us i) (Xs i)) -> basis_of U (\big[cat/[::]]_(i | P i) Xs i). Proof. move=> dxU XsUs; rewrite /basis_of span_bigcat. have defUs i: P i -> span (Xs i) = Us i by case/XsUs/andP=> /eqP. rewrite (eq_bigr _ defUs) eqxx bigcat_free // => [|_ /XsUs/andP[]//]. apply/directvP; rewrite /= (eq_bigr _ defUs) (directvP dxU) /=. by apply/eq_bigr=> i /defUs->. Qed. End BigSumBasis. End VectorTheory. Hint Resolve subvv : core. Arguments subvP {K vT U V}. Arguments addv_idPl {K vT U V}. Arguments addv_idPr {K vT U V}. Arguments memv_addP {K vT w U V }. Arguments sumv_sup [K vT I] i0 [P U Vs]. Arguments memv_sumP {K vT I P Us v}. Arguments subv_sumP {K vT I P Us V}. Arguments capv_idPl {K vT U V}. Arguments capv_idPr {K vT U V}. Arguments memv_capP {K vT w U V}. Arguments bigcapv_inf [K vT I] i0 [P Us V]. Arguments subv_bigcapP {K vT I P U Vs}. Arguments directvP {K vT S}. Arguments directv_addP {K vT U V}. Arguments directv_add_unique {K vT U V}. Arguments directv_sumP {K vT I P Us}. Arguments directv_sumE {K vT I P Ss}. Arguments directv_sum_independent {K vT I P Us}. Arguments directv_sum_unique {K vT I P Us}. Arguments span_subvP {K vT X U}. Arguments freeP {K vT n X}. Prenex Implicits coord. Notation directv S := (directv_def (Phantom _ S%VS)). (* Linear functions over a vectType *) Section LfunDefs. Variable R : ringType. Implicit Types aT vT rT : vectType R. Fact lfun_key : unit. Proof. by []. Qed. Definition fun_of_lfun_def aT rT (f : 'Hom(aT, rT)) := r2v \o mulmxr (f2mx f) \o v2r. Definition fun_of_lfun := locked_with lfun_key fun_of_lfun_def. Canonical fun_of_lfun_unlockable := [unlockable fun fun_of_lfun]. Definition linfun_def aT rT (f : aT -> rT) := Vector.Hom (lin1_mx (v2r \o f \o r2v)). Definition linfun := locked_with lfun_key linfun_def. Canonical linfun_unlockable := [unlockable fun linfun]. Definition id_lfun vT := @linfun vT vT idfun. Definition comp_lfun aT vT rT (f : 'Hom(vT, rT)) (g : 'Hom(aT, vT)) := linfun (fun_of_lfun f \o fun_of_lfun g). End LfunDefs. Coercion fun_of_lfun : Vector.hom >-> Funclass. Notation "\1" := (@id_lfun _ _) : lfun_scope. Notation "f \o g" := (comp_lfun f g) : lfun_scope. Section LfunVspaceDefs. Variable K : fieldType. Implicit Types aT rT : vectType K. Definition inv_lfun aT rT (f : 'Hom(aT, rT)) := Vector.Hom (pinvmx (f2mx f)). Definition lker aT rT (f : 'Hom(aT, rT)) := mx2vs (kermx (f2mx f)). Fact lfun_img_key : unit. Proof. by []. Qed. Definition lfun_img_def aT rT f (U : {vspace aT}) : {vspace rT} := mx2vs (vs2mx U *m f2mx f). Definition lfun_img := locked_with lfun_img_key lfun_img_def. Canonical lfun_img_unlockable := [unlockable fun lfun_img]. Definition lfun_preim aT rT (f : 'Hom(aT, rT)) W := (lfun_img (inv_lfun f) (W :&: lfun_img f fullv) + lker f)%VS. End LfunVspaceDefs. Prenex Implicits linfun lfun_img lker lfun_preim. Notation "f ^-1" := (inv_lfun f) : lfun_scope. Notation "f @: U" := (lfun_img f%VF%R U) (at level 24) : vspace_scope. Notation "f @^-1: W" := (lfun_preim f%VF%R W) (at level 24) : vspace_scope. Notation limg f := (lfun_img f fullv). Section LfunZmodType. Variables (R : ringType) (aT rT : vectType R). Implicit Types f g h : 'Hom(aT, rT). Definition lfun_eqMixin := Eval hnf in [eqMixin of 'Hom(aT, rT) by <:]. Canonical lfun_eqType := EqType 'Hom(aT, rT) lfun_eqMixin. Definition lfun_choiceMixin := [choiceMixin of 'Hom(aT, rT) by <:]. Canonical lfun_choiceType := ChoiceType 'Hom(aT, rT) lfun_choiceMixin. Fact lfun_is_linear f : linear f. Proof. by rewrite unlock; apply: linearP. Qed. Canonical lfun_additive f := Additive (lfun_is_linear f). Canonical lfun_linear f := AddLinear (lfun_is_linear f). Lemma lfunE (ff : {linear aT -> rT}) : linfun ff =1 ff. Proof. by move=> v; rewrite 2!unlock /= mul_rV_lin1 /= !v2rK. Qed. Lemma fun_of_lfunK : cancel (@fun_of_lfun R aT rT) linfun. Proof. move=> f; apply/val_inj/row_matrixP=> i. by rewrite 2!unlock /= !rowE mul_rV_lin1 /= !r2vK. Qed. Lemma lfunP f g : f =1 g <-> f = g. Proof. split=> [eq_fg | -> //]; rewrite -[f]fun_of_lfunK -[g]fun_of_lfunK unlock. by apply/val_inj/row_matrixP=> i; rewrite !rowE !mul_rV_lin1 /= eq_fg. Qed. Definition zero_lfun : 'Hom(aT, rT) := linfun \0. Definition add_lfun f g := linfun (f \+ g). Definition opp_lfun f := linfun (-%R \o f). Fact lfun_addA : associative add_lfun. Proof. by move=> f g h; apply/lfunP=> v; rewrite !lfunE /= !lfunE addrA. Qed. Fact lfun_addC : commutative add_lfun. Proof. by move=> f g; apply/lfunP=> v; rewrite !lfunE /= addrC. Qed. Fact lfun_add0 : left_id zero_lfun add_lfun. Proof. by move=> f; apply/lfunP=> v; rewrite lfunE /= lfunE add0r. Qed. Lemma lfun_addN : left_inverse zero_lfun opp_lfun add_lfun. Proof. by move=> f; apply/lfunP=> v; rewrite !lfunE /= lfunE addNr. Qed. Definition lfun_zmodMixin := ZmodMixin lfun_addA lfun_addC lfun_add0 lfun_addN. Canonical lfun_zmodType := Eval hnf in ZmodType 'Hom(aT, rT) lfun_zmodMixin. Lemma zero_lfunE x : (0 : 'Hom(aT, rT)) x = 0. Proof. exact: lfunE. Qed. Lemma add_lfunE f g x : (f + g) x = f x + g x. Proof. exact: lfunE. Qed. Lemma opp_lfunE f x : (- f) x = - f x. Proof. exact: lfunE. Qed. Lemma sum_lfunE I (r : seq I) (P : pred I) (fs : I -> 'Hom(aT, rT)) x : (\sum_(i <- r | P i) fs i) x = \sum_(i <- r | P i) fs i x. Proof. by elim/big_rec2: _ => [|i _ f _ <-]; rewrite lfunE. Qed. End LfunZmodType. Arguments fun_of_lfunK {R aT rT}. Section LfunVectType. Variables (R : comRingType) (aT rT : vectType R). Implicit Types f : 'Hom(aT, rT). Definition scale_lfun k f := linfun (k \*: f). Local Infix "*:l" := scale_lfun (at level 40). Fact lfun_scaleA k1 k2 f : k1 *:l (k2 *:l f) = (k1 * k2) *:l f. Proof. by apply/lfunP=> v; rewrite !lfunE /= lfunE scalerA. Qed. Fact lfun_scale1 f : 1 *:l f = f. Proof. by apply/lfunP=> v; rewrite lfunE /= scale1r. Qed. Fact lfun_scaleDr k f1 f2 : k *:l (f1 + f2) = k *:l f1 + k *:l f2. Proof. by apply/lfunP=> v; rewrite !lfunE /= !lfunE scalerDr. Qed. Fact lfun_scaleDl f k1 k2 : (k1 + k2) *:l f = k1 *:l f + k2 *:l f. Proof. by apply/lfunP=> v; rewrite !lfunE /= !lfunE scalerDl. Qed. Definition lfun_lmodMixin := LmodMixin lfun_scaleA lfun_scale1 lfun_scaleDr lfun_scaleDl. Canonical lfun_lmodType := Eval hnf in LmodType R 'Hom(aT, rT) lfun_lmodMixin. Lemma scale_lfunE k f x : (k *: f) x = k *: f x. Proof. exact: lfunE. Qed. (* GG: exists (Vector.Hom \o vec_mx) fails in the proof below in 8.3, *) (* probably because of incomplete type unification. Will it work in 8.4? *) Fact lfun_vect_iso : Vector.axiom (Vector.dim aT * Vector.dim rT) 'Hom(aT, rT). Proof. exists (mxvec \o f2mx) => [a f g|]. rewrite /= -linearP /= -[A in _ = mxvec A]/(f2mx (Vector.Hom _)). congr (mxvec (f2mx _)); apply/lfunP=> v; do 2!rewrite lfunE /=. by rewrite unlock /= -linearP mulmxDr scalemxAr. apply: Bijective (Vector.Hom \o vec_mx) _ _ => [[A]|A] /=; last exact: vec_mxK. by rewrite mxvecK. Qed. Definition lfun_vectMixin := VectMixin lfun_vect_iso. Canonical lfun_vectType := VectType R 'Hom(aT, rT) lfun_vectMixin. End LfunVectType. Section CompLfun. Variables (R : ringType) (wT aT vT rT : vectType R). Implicit Types (f : 'Hom(vT, rT)) (g : 'Hom(aT, vT)) (h : 'Hom(wT, aT)). Lemma id_lfunE u: \1%VF u = u :> aT. Proof. exact: lfunE. Qed. Lemma comp_lfunE f g u : (f \o g)%VF u = f (g u). Proof. exact: lfunE. Qed. Lemma comp_lfunA f g h : (f \o (g \o h) = (f \o g) \o h)%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfun1l f : (\1 \o f)%VF = f. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfun1r f : (f \o \1)%VF = f. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfun0l g : (0 \o g)%VF = 0 :> 'Hom(aT, rT). Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfun0r f : (f \o 0)%VF = 0 :> 'Hom(aT, rT). Proof. by apply/lfunP=> u; do !rewrite lfunE /=; rewrite linear0. Qed. Lemma comp_lfunDl f1 f2 g : ((f1 + f2) \o g = (f1 \o g) + (f2 \o g))%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfunDr f g1 g2 : (f \o (g1 + g2) = (f \o g1) + (f \o g2))%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=; rewrite linearD. Qed. Lemma comp_lfunNl f g : ((- f) \o g = - (f \o g))%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfunNr f g : (f \o (- g) = - (f \o g))%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=; rewrite linearN. Qed. End CompLfun. Definition lfun_simp := (comp_lfunE, scale_lfunE, opp_lfunE, add_lfunE, sum_lfunE, lfunE). Section ScaleCompLfun. Variables (R : comRingType) (aT vT rT : vectType R). Implicit Types (f : 'Hom(vT, rT)) (g : 'Hom(aT, vT)). Lemma comp_lfunZl k f g : (k *: (f \o g) = (k *: f) \o g)%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=. Qed. Lemma comp_lfunZr k f g : (k *: (f \o g) = f \o (k *: g))%VF. Proof. by apply/lfunP=> u; do !rewrite lfunE /=; rewrite linearZ. Qed. End ScaleCompLfun. Section LinearImage. Variables (K : fieldType) (aT rT : vectType K). Implicit Types (f g : 'Hom(aT, rT)) (U V : {vspace aT}) (W : {vspace rT}). Lemma limgS f U V : (U <= V)%VS -> (f @: U <= f @: V)%VS. Proof. by rewrite unlock /subsetv !genmxE; apply: submxMr. Qed. Lemma limg_line f v : (f @: <[v]> = <[f v]>)%VS. Proof. apply/eqP; rewrite 2!unlock eqEsubv /subsetv /= r2vK !genmxE. by rewrite !(eqmxMr _ (genmxE _)) submx_refl. Qed. Lemma limg0 f : (f @: 0 = 0)%VS. Proof. by rewrite limg_line linear0. Qed. Lemma memv_img f v U : v \in U -> f v \in (f @: U)%VS. Proof. by move=> Uv; rewrite memvE -limg_line limgS. Qed. Lemma memv_imgP f w U : reflect (exists2 u, u \in U & w = f u) (w \in f @: U)%VS. Proof. apply: (iffP idP) => [|[u Uu ->]]; last exact: memv_img. rewrite 2!unlock memvE /subsetv !genmxE => /submxP[ku Drw]. exists (r2v (ku *m vs2mx U)); last by rewrite /= r2vK -mulmxA -Drw v2rK. by rewrite memvE /subsetv !genmxE r2vK submxMl. Qed. Lemma lim0g U : (0 @: U = 0 :> {vspace rT})%VS. Proof. apply/eqP; rewrite -subv0; apply/subvP=> _ /memv_imgP[u _ ->]. by rewrite lfunE rpred0. Qed. Lemma eq_in_limg V f g : {in V, f =1 g} -> (f @: V = g @: V)%VS. Proof. move=> eq_fg; apply/vspaceP=> y. by apply/memv_imgP/memv_imgP=> [][x Vx ->]; exists x; rewrite ?eq_fg. Qed. Lemma limgD f : {morph lfun_img f : U V / U + V}%VS. Proof. move=> U V; apply/eqP; rewrite unlock eqEsubv /subsetv /= -genmx_adds. by rewrite !genmxE !(eqmxMr _ (genmxE _)) !addsmxMr submx_refl. Qed. Lemma limg_sum f I r (P : pred I) Us : (f @: (\sum_(i <- r | P i) Us i) = \sum_(i <- r | P i) f @: Us i)%VS. Proof. exact: (big_morph _ (limgD f) (limg0 f)). Qed. Lemma limg_cap f U V : (f @: (U :&: V) <= f @: U :&: f @: V)%VS. Proof. by rewrite subv_cap !limgS ?capvSl ?capvSr. Qed. Lemma limg_bigcap f I r (P : pred I) Us : (f @: (\bigcap_(i <- r | P i) Us i) <= \bigcap_(i <- r | P i) f @: Us i)%VS. Proof. elim/big_rec2: _ => [|i V U _ sUV]; first exact: subvf. by rewrite (subv_trans (limg_cap f _ U)) ?capvS. Qed. Lemma limg_span f X : (f @: <> = <>)%VS. Proof. by rewrite !span_def big_map limg_sum; apply: eq_bigr => x _; rewrite limg_line. Qed. Lemma lfunPn f g : reflect (exists u, f u != g u) (f != g). Proof. apply: (iffP idP) => [f'g|[x]]; last by apply: contraNneq => /lfunP->. suffices /subvPn[_ /memv_imgP[u _ ->]]: ~~ (limg (f - g) <= 0)%VS. by rewrite lfunE /= lfunE /= memv0 subr_eq0; exists u. apply: contra f'g => /subvP fg0; apply/eqP/lfunP=> u; apply/eqP. by rewrite -subr_eq0 -opp_lfunE -add_lfunE -memv0 fg0 ?memv_img ?memvf. Qed. Lemma inv_lfun_def f : (f \o f^-1 \o f)%VF = f. Proof. apply/lfunP=> u; do !rewrite lfunE /=; rewrite unlock /= !r2vK. by rewrite mulmxKpV ?submxMl. Qed. Lemma limg_lfunVK f : {in limg f, cancel f^-1%VF f}. Proof. by move=> _ /memv_imgP[u _ ->]; rewrite -!comp_lfunE inv_lfun_def. Qed. Lemma lkerE f U : (U <= lker f)%VS = (f @: U == 0)%VS. Proof. rewrite unlock -dimv_eq0 /dimv /subsetv !genmxE mxrank_eq0. by rewrite (sameP sub_kermxP eqP). Qed. Lemma memv_ker f v : (v \in lker f) = (f v == 0). Proof. by rewrite -memv0 !memvE subv0 lkerE limg_line. Qed. Lemma eqlfunP f g v : reflect (f v = g v) (v \in lker (f - g)). Proof. by rewrite memv_ker !lfun_simp subr_eq0; apply: eqP. Qed. Lemma eqlfun_inP V f g : reflect {in V, f =1 g} (V <= lker (f - g))%VS. Proof. by apply: (iffP subvP) => E x /E/eqlfunP. Qed. Lemma limg_ker_compl f U : (f @: (U :\: lker f) = f @: U)%VS. Proof. rewrite -{2}(addv_diff_cap U (lker f)) limgD; apply/esym/addv_idPl. by rewrite (subv_trans _ (sub0v _)) // subv0 -lkerE capvSr. Qed. Lemma limg_ker_dim f U : (\dim (U :&: lker f) + \dim (f @: U) = \dim U)%N. Proof. rewrite unlock /dimv /= genmx_cap genmx_id -genmx_cap !genmxE. by rewrite addnC mxrank_mul_ker. Qed. Lemma limg_dim_eq f U : (U :&: lker f = 0)%VS -> \dim (f @: U) = \dim U. Proof. by rewrite -(limg_ker_dim f U) => ->; rewrite dimv0. Qed. Lemma limg_basis_of f U X : (U :&: lker f = 0)%VS -> basis_of U X -> basis_of (f @: U) (map f X). Proof. move=> injUf /andP[/eqP defU /eqnP freeX]. by rewrite /basis_of /free size_map -limg_span -freeX defU limg_dim_eq ?eqxx. Qed. Lemma lker0P f : reflect (injective f) (lker f == 0%VS). Proof. rewrite -subv0; apply: (iffP subvP) => [injf u v eq_fuv | injf u]. apply/eqP; rewrite -subr_eq0 -memv0 injf //. by rewrite memv_ker linearB /= eq_fuv subrr. by rewrite memv_ker memv0 -(inj_eq injf) linear0. Qed. Lemma limg_ker0 f U V : lker f == 0%VS -> (f @: U <= f @: V)%VS = (U <= V)%VS. Proof. move/lker0P=> injf; apply/idP/idP=> [/subvP sfUV | ]; last exact: limgS. by apply/subvP=> u Uu; have /memv_imgP[v Vv /injf->] := sfUV _ (memv_img f Uu). Qed. Lemma eq_limg_ker0 f U V : lker f == 0%VS -> (f @: U == f @: V)%VS = (U == V). Proof. by move=> injf; rewrite !eqEsubv !limg_ker0. Qed. Lemma lker0_lfunK f : lker f == 0%VS -> cancel f f^-1%VF. Proof. by move/lker0P=> injf u; apply: injf; rewrite limg_lfunVK ?memv_img ?memvf. Qed. Lemma lker0_compVf f : lker f == 0%VS -> (f^-1 \o f = \1)%VF. Proof. by move/lker0_lfunK=> fK; apply/lfunP=> u; rewrite !lfunE /= fK. Qed. End LinearImage. Arguments memv_imgP {K aT rT f w U}. Arguments lfunPn {K aT rT f g}. Arguments lker0P {K aT rT f}. Arguments eqlfunP {K aT rT f g v}. Arguments eqlfun_inP {K aT rT V f g}. Arguments limg_lfunVK {K aT rT f} [x] f_x. Section FixedSpace. Variables (K : fieldType) (vT : vectType K). Implicit Types (f : 'End(vT)) (U : {vspace vT}). Definition fixedSpace f : {vspace vT} := lker (f - \1%VF). Lemma fixedSpaceP f a : reflect (f a = a) (a \in fixedSpace f). Proof. by rewrite memv_ker add_lfunE opp_lfunE id_lfunE subr_eq0; apply: eqP. Qed. Lemma fixedSpacesP f U : reflect {in U, f =1 id} (U <= fixedSpace f)%VS. Proof. by apply: (iffP subvP) => cUf x /cUf/fixedSpaceP. Qed. Lemma fixedSpace_limg f U : (U <= fixedSpace f -> f @: U = U)%VS. Proof. move/fixedSpacesP=> cUf; apply/vspaceP=> x. by apply/memv_imgP/idP=> [[{}x Ux ->] | Ux]; last exists x; rewrite ?cUf. Qed. Lemma fixedSpace_id : fixedSpace \1 = {:vT}%VS. Proof. by apply/vspaceP=> x; rewrite memvf; apply/fixedSpaceP; rewrite lfunE. Qed. End FixedSpace. Arguments fixedSpaceP {K vT f a}. Arguments fixedSpacesP {K vT f U}. Section LinAut. Variables (K : fieldType) (vT : vectType K) (f : 'End(vT)). Hypothesis kerf0 : lker f == 0%VS. Lemma lker0_limgf : limg f = fullv. Proof. by apply/eqP; rewrite eqEdim subvf limg_dim_eq //= (eqP kerf0) capv0. Qed. Lemma lker0_lfunVK : cancel f^-1%VF f. Proof. by move=> u; rewrite limg_lfunVK // lker0_limgf memvf. Qed. Lemma lker0_compfV : (f \o f^-1 = \1)%VF. Proof. by apply/lfunP=> u; rewrite !lfunE /= lker0_lfunVK. Qed. Lemma lker0_compVKf aT g : (f \o (f^-1 \o g))%VF = g :> 'Hom(aT, vT). Proof. by rewrite comp_lfunA lker0_compfV comp_lfun1l. Qed. Lemma lker0_compKf aT g : (f^-1 \o (f \o g))%VF = g :> 'Hom(aT, vT). Proof. by rewrite comp_lfunA lker0_compVf ?comp_lfun1l. Qed. Lemma lker0_compfK rT h : ((h \o f) \o f^-1)%VF = h :> 'Hom(vT, rT). Proof. by rewrite -comp_lfunA lker0_compfV comp_lfun1r. Qed. Lemma lker0_compfVK rT h : ((h \o f^-1) \o f)%VF = h :> 'Hom(vT, rT). Proof. by rewrite -comp_lfunA lker0_compVf ?comp_lfun1r. Qed. End LinAut. Section LinearImageComp. Variables (K : fieldType) (aT vT rT : vectType K). Implicit Types (f : 'Hom(aT, vT)) (g : 'Hom(vT, rT)) (U : {vspace aT}). Lemma lim1g U : (\1 @: U)%VS = U. Proof. have /andP[/eqP <- _] := vbasisP U; rewrite limg_span map_id_in // => u _. by rewrite lfunE. Qed. Lemma limg_comp f g U : ((g \o f) @: U = g @: (f @: U))%VS. Proof. have /andP[/eqP <- _] := vbasisP U; rewrite !limg_span; congr (span _). by rewrite -map_comp; apply/eq_map => u; rewrite lfunE. Qed. End LinearImageComp. Section LinearPreimage. Variables (K : fieldType) (aT rT : vectType K). Implicit Types (f : 'Hom(aT, rT)) (U : {vspace aT}) (V W : {vspace rT}). Lemma lpreim_cap_limg f W : (f @^-1: (W :&: limg f))%VS = (f @^-1: W)%VS. Proof. by rewrite /lfun_preim -capvA capvv. Qed. Lemma lpreim0 f : (f @^-1: 0)%VS = lker f. Proof. by rewrite /lfun_preim cap0v limg0 add0v. Qed. Lemma lpreimS f V W : (V <= W)%VS-> (f @^-1: V <= f @^-1: W)%VS. Proof. by move=> sVW; rewrite addvS // limgS // capvS. Qed. Lemma lpreimK f W : (W <= limg f)%VS -> (f @: (f @^-1: W))%VS = W. Proof. move=> sWf; rewrite limgD (capv_idPl sWf) // -limg_comp. have /eqP->: (f @: lker f == 0)%VS by rewrite -lkerE. have /andP[/eqP defW _] := vbasisP W; rewrite addv0 -defW limg_span. rewrite map_id_in // => x Xx; rewrite lfunE /= limg_lfunVK //. by apply: span_subvP Xx; rewrite defW. Qed. Lemma memv_preim f u W : (f u \in W) = (u \in f @^-1: W)%VS. Proof. apply/idP/idP=> [Wfu | /(memv_img f)]; last first. by rewrite -lpreim_cap_limg lpreimK ?capvSr // => /memv_capP[]. rewrite -[u](addNKr (f^-1%VF (f u))) memv_add ?memv_img //. by rewrite memv_cap Wfu memv_img ?memvf. by rewrite memv_ker addrC linearB /= subr_eq0 limg_lfunVK ?memv_img ?memvf. Qed. End LinearPreimage. Arguments lpreimK {K aT rT f} [W] fW. Section LfunAlgebra. (* This section is a bit of a place holder: the instances we build here can't *) (* be canonical because we are missing an interface for proper vectTypes, *) (* would sit between Vector and Falgebra. For now, we just supply structure *) (* definitions here and supply actual instances for F-algebras in a submodule *) (* of the algebra library (there is currently no actual use of the End(vT) *) (* algebra structure). Also note that the unit ring structure is missing. *) Variables (R : comRingType) (vT : vectType R). Hypothesis vT_proper : Vector.dim vT > 0. Fact lfun1_neq0 : \1%VF != 0 :> 'End(vT). Proof. apply/eqP=> /lfunP/(_ (r2v (const_mx 1))); rewrite !lfunE /= => /(canRL r2vK). by move=> /rowP/(_ (Ordinal vT_proper))/eqP; rewrite linear0 !mxE oner_eq0. Qed. Prenex Implicits comp_lfunA comp_lfun1l comp_lfun1r comp_lfunDl comp_lfunDr. Definition lfun_comp_ringMixin := RingMixin comp_lfunA comp_lfun1l comp_lfun1r comp_lfunDl comp_lfunDr lfun1_neq0. Definition lfun_comp_ringType := RingType 'End(vT) lfun_comp_ringMixin. (* In the standard endomorphism ring product is categorical composition. *) Definition lfun_ringMixin : GRing.Ring.mixin_of (lfun_zmodType vT vT) := GRing.converse_ringMixin lfun_comp_ringType. Definition lfun_ringType := Eval hnf in RingType 'End(vT) lfun_ringMixin. Definition lfun_lalgType := Eval hnf in [lalgType R of 'End(vT) for LalgType R lfun_ringType (fun k x y => comp_lfunZr k y x)]. Definition lfun_algType := Eval hnf in [algType R of 'End(vT) for AlgType R _ (fun k (x y : lfun_lalgType) => comp_lfunZl k y x)]. End LfunAlgebra. Section Projection. Variables (K : fieldType) (vT : vectType K). Implicit Types U V : {vspace vT}. Definition daddv_pi U V := Vector.Hom (proj_mx (vs2mx U) (vs2mx V)). Definition projv U := daddv_pi U U^C. Definition addv_pi1 U V := daddv_pi (U :\: V) V. Definition addv_pi2 U V := daddv_pi V (U :\: V). Lemma memv_pi U V w : (daddv_pi U V) w \in U. Proof. by rewrite unlock memvE /subsetv genmxE /= r2vK proj_mx_sub. Qed. Lemma memv_proj U w : projv U w \in U. Proof. exact: memv_pi. Qed. Lemma memv_pi1 U V w : (addv_pi1 U V) w \in U. Proof. by rewrite (subvP (diffvSl U V)) ?memv_pi. Qed. Lemma memv_pi2 U V w : (addv_pi2 U V) w \in V. Proof. exact: memv_pi. Qed. Lemma daddv_pi_id U V u : (U :&: V = 0)%VS -> u \in U -> daddv_pi U V u = u. Proof. move/eqP; rewrite -dimv_eq0 memvE /subsetv /dimv !genmxE mxrank_eq0 => /eqP. by move=> dxUV Uu; rewrite unlock /= proj_mx_id ?v2rK. Qed. Lemma daddv_pi_proj U V w (pi := daddv_pi U V) : (U :&: V = 0)%VS -> pi (pi w) = pi w. Proof. by move/daddv_pi_id=> -> //; apply: memv_pi. Qed. Lemma daddv_pi_add U V w : (U :&: V = 0)%VS -> (w \in U + V)%VS -> daddv_pi U V w + daddv_pi V U w = w. Proof. move/eqP; rewrite -dimv_eq0 memvE /subsetv /dimv !genmxE mxrank_eq0 => /eqP. by move=> dxUW UVw; rewrite unlock /= -linearD /= add_proj_mx ?v2rK. Qed. Lemma projv_id U u : u \in U -> projv U u = u. Proof. exact: daddv_pi_id (capv_compl _). Qed. Lemma projv_proj U w : projv U (projv U w) = projv U w. Proof. exact: daddv_pi_proj (capv_compl _). Qed. Lemma memv_projC U w : w - projv U w \in (U^C)%VS. Proof. rewrite -{1}[w](daddv_pi_add (capv_compl U)) ?addv_complf ?memvf //. by rewrite addrC addKr memv_pi. Qed. Lemma limg_proj U : limg (projv U) = U. Proof. apply/vspaceP=> u; apply/memv_imgP/idP=> [[u1 _ ->] | ]; first exact: memv_proj. by exists (projv U u); rewrite ?projv_id ?memv_img ?memvf. Qed. Lemma lker_proj U : lker (projv U) = (U^C)%VS. Proof. apply/eqP; rewrite eqEdim andbC; apply/andP; split. by rewrite dimv_compl -(limg_ker_dim (projv U) fullv) limg_proj addnK capfv. by apply/subvP=> v; rewrite memv_ker -{2}[v]subr0 => /eqP <-; apply: memv_projC. Qed. Lemma addv_pi1_proj U V w (pi1 := addv_pi1 U V) : pi1 (pi1 w) = pi1 w. Proof. by rewrite daddv_pi_proj // capv_diff. Qed. Lemma addv_pi2_id U V v : v \in V -> addv_pi2 U V v = v. Proof. by apply: daddv_pi_id; rewrite capvC capv_diff. Qed. Lemma addv_pi2_proj U V w (pi2 := addv_pi2 U V) : pi2 (pi2 w) = pi2 w. Proof. by rewrite addv_pi2_id ?memv_pi2. Qed. Lemma addv_pi1_pi2 U V w : w \in (U + V)%VS -> addv_pi1 U V w + addv_pi2 U V w = w. Proof. by rewrite -addv_diff; exact/daddv_pi_add/capv_diff. Qed. Section Sumv_Pi. Variables (I : eqType) (r0 : seq I) (P : pred I) (Vs : I -> {vspace vT}). Let sumv_pi_rec i := fix loop r := if r is j :: r1 then let V1 := (\sum_(k <- r1) Vs k)%VS in if j == i then addv_pi1 (Vs j) V1 else (loop r1 \o addv_pi2 (Vs j) V1)%VF else 0. Notation sumV := (\sum_(i <- r0 | P i) Vs i)%VS. Definition sumv_pi_for V of V = sumV := fun i => sumv_pi_rec i (filter P r0). Variables (V : {vspace vT}) (defV : V = sumV). Lemma memv_sum_pi i v : sumv_pi_for defV i v \in Vs i. Proof. rewrite /sumv_pi_for. elim: (filter P r0) v => [|j r IHr] v /=; first by rewrite lfunE mem0v. by case: eqP => [->|_]; rewrite ?lfunE ?memv_pi1 /=. Qed. Lemma sumv_pi_uniq_sum v : uniq (filter P r0) -> v \in V -> \sum_(i <- r0 | P i) sumv_pi_for defV i v = v. Proof. rewrite /sumv_pi_for defV -!(big_filter r0 P). elim: (filter P r0) v => [|i r IHr] v /= => [_ | /andP[r'i /IHr{}IHr]]. by rewrite !big_nil memv0 => /eqP. rewrite !big_cons eqxx => /addv_pi1_pi2; congr (_ + _ = v). rewrite -[_ v]IHr ?memv_pi2 //; apply: eq_big_seq => j /=. by case: eqP => [<- /idPn | _]; rewrite ?lfunE. Qed. End Sumv_Pi. End Projection. Prenex Implicits daddv_pi projv addv_pi1 addv_pi2. Notation sumv_pi V := (sumv_pi_for (erefl V)). Section SumvPi. Variable (K : fieldType) (vT : vectType K). Lemma sumv_pi_sum (I : finType) (P : pred I) Vs v (V : {vspace vT}) (defV : V = (\sum_(i | P i) Vs i)%VS) : v \in V -> \sum_(i | P i) sumv_pi_for defV i v = v :> vT. Proof. by apply: sumv_pi_uniq_sum; have [e _ []] := big_enumP. Qed. Lemma sumv_pi_nat_sum m n (P : pred nat) Vs v (V : {vspace vT}) (defV : V = (\sum_(m <= i < n | P i) Vs i)%VS) : v \in V -> \sum_(m <= i < n | P i) sumv_pi_for defV i v = v :> vT. Proof. by apply: sumv_pi_uniq_sum; apply/filter_uniq/iota_uniq. Qed. End SumvPi. Section SubVector. (* Turn a {vspace V} into a vectType *) Variable (K : fieldType) (vT : vectType K) (U : {vspace vT}). Inductive subvs_of : predArgType := Subvs u & u \in U. Definition vsval w := let: Subvs u _ := w in u. Canonical subvs_subType := Eval hnf in [subType for vsval]. Definition subvs_eqMixin := Eval hnf in [eqMixin of subvs_of by <:]. Canonical subvs_eqType := Eval hnf in EqType subvs_of subvs_eqMixin. Definition subvs_choiceMixin := [choiceMixin of subvs_of by <:]. Canonical subvs_choiceType := ChoiceType subvs_of subvs_choiceMixin. Definition subvs_zmodMixin := [zmodMixin of subvs_of by <:]. Canonical subvs_zmodType := ZmodType subvs_of subvs_zmodMixin. Definition subvs_lmodMixin := [lmodMixin of subvs_of by <:]. Canonical subvs_lmodType := LmodType K subvs_of subvs_lmodMixin. Lemma subvsP w : vsval w \in U. Proof. exact: valP. Qed. Lemma subvs_inj : injective vsval. Proof. exact: val_inj. Qed. Lemma congr_subvs u v : u = v -> vsval u = vsval v. Proof. exact: congr1. Qed. Lemma vsval_is_linear : linear vsval. Proof. by []. Qed. Canonical vsval_additive := Additive vsval_is_linear. Canonical vsval_linear := AddLinear vsval_is_linear. Fact vsproj_key : unit. Proof. by []. Qed. Definition vsproj_def u := Subvs (memv_proj U u). Definition vsproj := locked_with vsproj_key vsproj_def. Canonical vsproj_unlockable := [unlockable fun vsproj]. Lemma vsprojK : {in U, cancel vsproj vsval}. Proof. by rewrite unlock; apply: projv_id. Qed. Lemma vsvalK : cancel vsval vsproj. Proof. by move=> w; apply/val_inj/vsprojK/subvsP. Qed. Lemma vsproj_is_linear : linear vsproj. Proof. by move=> k w1 w2; apply: val_inj; rewrite unlock /= linearP. Qed. Canonical vsproj_additive := Additive vsproj_is_linear. Canonical vsproj_linear := AddLinear vsproj_is_linear. Fact subvs_vect_iso : Vector.axiom (\dim U) subvs_of. Proof. exists (fun w => \row_i coord (vbasis U) i (vsval w)). by move=> k w1 w2; apply/rowP=> i; rewrite !mxE linearP. exists (fun rw : 'rV_(\dim U) => vsproj (\sum_i rw 0 i *: (vbasis U)`_i)). move=> w /=; congr (vsproj _ = w): (vsvalK w). by rewrite {1}(coord_vbasis (subvsP w)); apply: eq_bigr => i _; rewrite mxE. move=> rw; apply/rowP=> i; rewrite mxE vsprojK. by rewrite coord_sum_free ?(basis_free (vbasisP U)). by apply: rpred_sum => j _; rewrite rpredZ ?vbasis_mem ?memt_nth. Qed. Definition subvs_vectMixin := VectMixin subvs_vect_iso. Canonical subvs_vectType := VectType K subvs_of subvs_vectMixin. End SubVector. Prenex Implicits vsval vsproj vsvalK. Arguments subvs_inj {K vT U} [x1 x2]. Arguments vsprojK {K vT U} [x] Ux. Section MatrixVectType. Variables (R : ringType) (m n : nat). (* The apparently useless => /= in line 1 of the proof performs some evar *) (* expansions that the Ltac interpretation of exists is incapable of doing. *) Fact matrix_vect_iso : Vector.axiom (m * n) 'M[R]_(m, n). Proof. exists mxvec => /=; first exact: linearP. by exists vec_mx; [apply: mxvecK | apply: vec_mxK]. Qed. Definition matrix_vectMixin := VectMixin matrix_vect_iso. Canonical matrix_vectType := VectType R 'M[R]_(m, n) matrix_vectMixin. End MatrixVectType. (* A ring is a one-dimension vector space *) Section RegularVectType. Variable R : ringType. Fact regular_vect_iso : Vector.axiom 1 R^o. Proof. exists (fun a => a%:M) => [a b c|]; first by rewrite rmorphD scale_scalar_mx. by exists (fun A : 'M_1 => A 0 0) => [a | A]; rewrite ?mxE // -mx11_scalar. Qed. Definition regular_vectMixin := VectMixin regular_vect_iso. Canonical regular_vectType := VectType R R^o regular_vectMixin. End RegularVectType. (* External direct product of two vectTypes. *) Section ProdVector. Variables (R : ringType) (vT1 vT2 : vectType R). Fact pair_vect_iso : Vector.axiom (Vector.dim vT1 + Vector.dim vT2) (vT1 * vT2). Proof. pose p2r (u : vT1 * vT2) := row_mx (v2r u.1) (v2r u.2). pose r2p w := (r2v (lsubmx w) : vT1, r2v (rsubmx w) : vT2). have r2pK : cancel r2p p2r by move=> w; rewrite /p2r !r2vK hsubmxK. have p2rK : cancel p2r r2p by case=> u v; rewrite /r2p row_mxKl row_mxKr !v2rK. have r2p_lin: linear r2p by move=> a u v; congr (_ , _); rewrite /= !linearP. by exists p2r; [apply: (@can2_linear _ _ _ (Linear r2p_lin)) | exists r2p]. Qed. Definition pair_vectMixin := VectMixin pair_vect_iso. Canonical pair_vectType := VectType R (vT1 * vT2) pair_vectMixin. End ProdVector. (* Function from a finType into a ring form a vectype. *) Section FunVectType. Variable (I : finType) (R : ringType) (vT : vectType R). (* Type unification with exist is again a problem in this proof. *) Fact ffun_vect_iso : Vector.axiom (#|I| * Vector.dim vT) {ffun I -> vT}. Proof. pose fr (f : {ffun I -> vT}) := mxvec (\matrix_(i < #|I|) v2r (f (enum_val i))). exists fr => /= [k f g|]. rewrite /fr -linearP; congr (mxvec _); apply/matrixP=> i j. by rewrite !mxE /= !ffunE linearP !mxE. exists (fun r => [ffun i => r2v (row (enum_rank i) (vec_mx r)) : vT]) => [g|r]. by apply/ffunP=> i; rewrite ffunE mxvecK rowK v2rK enum_rankK. by apply/(canLR vec_mxK)/matrixP=> i j; rewrite mxE ffunE r2vK enum_valK mxE. Qed. Definition ffun_vectMixin := VectMixin ffun_vect_iso. Canonical ffun_vectType := VectType R {ffun I -> vT} ffun_vectMixin. End FunVectType. Canonical exp_vectType (K : fieldType) (vT : vectType K) n := [vectType K of vT ^ n]. (* Solving a tuple of linear equations. *) Section Solver. Variable (K : fieldType) (vT : vectType K). Variables (n : nat) (lhs : n.-tuple 'End(vT)) (rhs : n.-tuple vT). Let lhsf u := finfun ((tnth lhs)^~ u). Definition vsolve_eq U := finfun (tnth rhs) \in (linfun lhsf @: U)%VS. Lemma vsolve_eqP (U : {vspace vT}) : reflect (exists2 u, u \in U & forall i, tnth lhs i u = tnth rhs i) (vsolve_eq U). Proof. have lhsZ: linear lhsf by move=> a u v; apply/ffunP=> i; rewrite !ffunE linearP. apply: (iffP memv_imgP) => [] [u Uu sol_u]; exists u => //. by move=> i; rewrite -[tnth rhs i]ffunE sol_u (lfunE (Linear lhsZ)) ffunE. by apply/ffunP=> i; rewrite (lfunE (Linear lhsZ)) !ffunE sol_u. Qed. End Solver. Notation "@ 'limg_add'" := (deprecate limg_add limgD) (at level 10, only parsing) : fun_scope. Notation limg_add := (@limg_add _ _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/algebra/zmodp.v000066400000000000000000000335261375767750300220500ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype bigop finset prime fingroup. From mathcomp Require Import ssralg finalg countalg. (******************************************************************************) (* Definition of the additive group and ring Zp, represented as 'I_p *) (******************************************************************************) (* Definitions: *) (* From fintype.v: *) (* 'I_p == the subtype of integers less than p, taken here as the type of *) (* the integers mod p. *) (* This file: *) (* inZp == the natural projection from nat into the integers mod p, *) (* represented as 'I_p. Here p is implicit, but MUST be of the *) (* form n.+1. *) (* The operations: *) (* Zp0 == the identity element for addition *) (* Zp1 == the identity element for multiplication, and a generator of *) (* additive group *) (* Zp_opp == inverse function for addition *) (* Zp_add == addition *) (* Zp_mul == multiplication *) (* Zp_inv == inverse function for multiplication *) (* Note that while 'I_n.+1 has canonical finZmodType and finGroupType *) (* structures, only 'I_n.+2 has a canonical ring structure (it has, in fact, *) (* a canonical finComUnitRing structure), and hence an associated *) (* multiplicative unit finGroupType. To mitigate the issues caused by the *) (* trivial "ring" (which is, indeed is NOT a ring in the ssralg/finalg *) (* formalization), we define additional notation: *) (* 'Z_p == the type of integers mod (max p 2); this is always a proper *) (* ring, by constructions. Note that 'Z_p is provably equal to *) (* 'I_p if p > 1, and convertible to 'I_p if p is of the form *) (* n.+2. *) (* Zp p == the subgroup of integers mod (max p 1) in 'Z_p; this is thus *) (* all of 'Z_p if p > 1, and else the trivial group. *) (* units_Zp p == the group of all units of 'Z_p -- i.e., the group of *) (* (multiplicative) automorphisms of Zp p. *) (* We show that Zp and units_Zp are abelian, and compute their orders. *) (* We use a similar technique to represent the prime fields: *) (* 'F_p == the finite field of integers mod the first prime divisor of *) (* maxn p 2. This is provably equal to 'Z_p and 'I_p if p is *) (* provably prime, and indeed convertible to the above if p is *) (* a concrete prime such as 2, 5 or 23. *) (* Note finally that due to the canonical structures it is possible to use *) (* 0%R instead of Zp0, and 1%R instead of Zp1 (for the latter, p must be of *) (* the form n.+2, and 1%R : nat will simplify to 1%N). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Section ZpDef. (***********************************************************************) (* *) (* Mod p arithmetic on the finite set {0, 1, 2, ..., p - 1} *) (* *) (***********************************************************************) Variable p' : nat. Local Notation p := p'.+1. Implicit Types x y z : 'I_p. (* Standard injection; val (inZp i) = i %% p *) Definition inZp i := Ordinal (ltn_pmod i (ltn0Sn p')). Lemma modZp x : x %% p = x. Proof. by rewrite modn_small ?ltn_ord. Qed. Lemma valZpK x : inZp x = x. Proof. by apply: val_inj; rewrite /= modZp. Qed. (* Operations *) Definition Zp0 : 'I_p := ord0. Definition Zp1 := inZp 1. Definition Zp_opp x := inZp (p - x). Definition Zp_add x y := inZp (x + y). Definition Zp_mul x y := inZp (x * y). Definition Zp_inv x := if coprime p x then inZp (egcdn x p).1 else x. (* Additive group structure. *) Lemma Zp_add0z : left_id Zp0 Zp_add. Proof. exact: valZpK. Qed. Lemma Zp_addNz : left_inverse Zp0 Zp_opp Zp_add. Proof. by move=> x; apply: val_inj; rewrite /= modnDml subnK ?modnn // ltnW. Qed. Lemma Zp_addA : associative Zp_add. Proof. by move=> x y z; apply: val_inj; rewrite /= modnDml modnDmr addnA. Qed. Lemma Zp_addC : commutative Zp_add. Proof. by move=> x y; apply: val_inj; rewrite /= addnC. Qed. Definition Zp_zmodMixin := ZmodMixin Zp_addA Zp_addC Zp_add0z Zp_addNz. Canonical Zp_zmodType := Eval hnf in ZmodType 'I_p Zp_zmodMixin. Canonical Zp_finZmodType := Eval hnf in [finZmodType of 'I_p]. Canonical Zp_baseFinGroupType := Eval hnf in [baseFinGroupType of 'I_p for +%R]. Canonical Zp_finGroupType := Eval hnf in [finGroupType of 'I_p for +%R]. (* Ring operations *) Lemma Zp_mul1z : left_id Zp1 Zp_mul. Proof. by move=> x; apply: val_inj; rewrite /= modnMml mul1n modZp. Qed. Lemma Zp_mulC : commutative Zp_mul. Proof. by move=> x y; apply: val_inj; rewrite /= mulnC. Qed. Lemma Zp_mulz1 : right_id Zp1 Zp_mul. Proof. by move=> x; rewrite Zp_mulC Zp_mul1z. Qed. Lemma Zp_mulA : associative Zp_mul. Proof. by move=> x y z; apply: val_inj; rewrite /= modnMml modnMmr mulnA. Qed. Lemma Zp_mul_addr : right_distributive Zp_mul Zp_add. Proof. by move=> x y z; apply: val_inj; rewrite /= modnMmr modnDm mulnDr. Qed. Lemma Zp_mul_addl : left_distributive Zp_mul Zp_add. Proof. by move=> x y z; rewrite -!(Zp_mulC z) Zp_mul_addr. Qed. Lemma Zp_mulVz x : coprime p x -> Zp_mul (Zp_inv x) x = Zp1. Proof. move=> co_p_x; apply: val_inj; rewrite /Zp_inv co_p_x /= modnMml. by rewrite -(chinese_modl co_p_x 1 0) /chinese addn0 mul1n mulnC. Qed. Lemma Zp_mulzV x : coprime p x -> Zp_mul x (Zp_inv x) = Zp1. Proof. by move=> Ux; rewrite /= Zp_mulC Zp_mulVz. Qed. Lemma Zp_intro_unit x y : Zp_mul y x = Zp1 -> coprime p x. Proof. case=> yx1; have:= coprimen1 p. by rewrite -coprime_modr -yx1 coprime_modr coprimeMr; case/andP. Qed. Lemma Zp_inv_out x : ~~ coprime p x -> Zp_inv x = x. Proof. by rewrite /Zp_inv => /negPf->. Qed. Lemma Zp_mulrn x n : x *+ n = inZp (x * n). Proof. apply: val_inj => /=; elim: n => [|n IHn]; first by rewrite muln0 modn_small. by rewrite !GRing.mulrS /= IHn modnDmr mulnS. Qed. Import GroupScope. Lemma Zp_mulgC : @commutative 'I_p _ mulg. Proof. exact: Zp_addC. Qed. Lemma Zp_abelian : abelian [set: 'I_p]. Proof. exact: FinRing.zmod_abelian. Qed. Lemma Zp_expg x n : x ^+ n = inZp (x * n). Proof. exact: Zp_mulrn. Qed. Lemma Zp1_expgz x : Zp1 ^+ x = x. Proof. by rewrite Zp_expg; apply: Zp_mul1z. Qed. Lemma Zp_cycle : setT = <[Zp1]>. Proof. by apply/setP=> x; rewrite -[x]Zp1_expgz inE groupX ?mem_gen ?set11. Qed. Lemma order_Zp1 : #[Zp1] = p. Proof. by rewrite orderE -Zp_cycle cardsT card_ord. Qed. End ZpDef. Arguments Zp0 {p'}. Arguments Zp1 {p'}. Arguments inZp {p'} i. Arguments valZpK {p'} x. (* We redefine fintype.ord1 to specialize it with 0 instead of ord0 *) (* since 'I_n is now canonically a zmodType *) Lemma ord1 : all_equal_to (0 : 'I_1). Proof. exact: ord1. Qed. Lemma lshift0 m n : lshift m (0 : 'I_n.+1) = (0 : 'I_(n + m).+1). Proof. exact: val_inj. Qed. Lemma rshift1 n : @rshift 1 n =1 lift (0 : 'I_n.+1). Proof. by move=> i; apply: val_inj. Qed. Lemma split1 n i : split (i : 'I_(1 + n)) = oapp (@inr _ _) (inl _ 0) (unlift 0 i). Proof. case: unliftP => [i'|] -> /=. by rewrite -rshift1 (unsplitK (inr _ _)). by rewrite -(lshift0 n 0) (unsplitK (inl _ _)). Qed. Lemma big_ord1 R idx (op : @Monoid.law R idx) F : \big[op/idx]_(i < 1) F i = F 0. Proof. by rewrite big_ord_recl big_ord0 Monoid.mulm1. Qed. Lemma big_ord1_cond R idx (op : @Monoid.law R idx) P F : \big[op/idx]_(i < 1 | P i) F i = if P 0 then F 0 else idx. Proof. by rewrite big_mkcond big_ord1. Qed. Section ZpRing. Variable p' : nat. Local Notation p := p'.+2. Lemma Zp_nontrivial : Zp1 != 0 :> 'I_p. Proof. by []. Qed. Definition Zp_ringMixin := ComRingMixin (@Zp_mulA _) (@Zp_mulC _) (@Zp_mul1z _) (@Zp_mul_addl _) Zp_nontrivial. Canonical Zp_ringType := Eval hnf in RingType 'I_p Zp_ringMixin. Canonical Zp_finRingType := Eval hnf in [finRingType of 'I_p]. Canonical Zp_comRingType := Eval hnf in ComRingType 'I_p (@Zp_mulC _). Canonical Zp_finComRingType := Eval hnf in [finComRingType of 'I_p]. Definition Zp_unitRingMixin := ComUnitRingMixin (@Zp_mulVz _) (@Zp_intro_unit _) (@Zp_inv_out _). Canonical Zp_unitRingType := Eval hnf in UnitRingType 'I_p Zp_unitRingMixin. Canonical Zp_finUnitRingType := Eval hnf in [finUnitRingType of 'I_p]. Canonical Zp_comUnitRingType := Eval hnf in [comUnitRingType of 'I_p]. Canonical Zp_finComUnitRingType := Eval hnf in [finComUnitRingType of 'I_p]. Lemma Zp_nat n : n%:R = inZp n :> 'I_p. Proof. by apply: val_inj; rewrite [n%:R]Zp_mulrn /= modnMml mul1n. Qed. Lemma natr_Zp (x : 'I_p) : x%:R = x. Proof. by rewrite Zp_nat valZpK. Qed. Lemma natr_negZp (x : 'I_p) : (- x)%:R = - x. Proof. by apply: val_inj; rewrite /= Zp_nat /= modn_mod. Qed. Import GroupScope. Lemma unit_Zp_mulgC : @commutative {unit 'I_p} _ mulg. Proof. by move=> u v; apply: val_inj; rewrite /= GRing.mulrC. Qed. Lemma unit_Zp_expg (u : {unit 'I_p}) n : val (u ^+ n) = inZp (val u ^ n) :> 'I_p. Proof. apply: val_inj => /=; elim: n => [|n IHn] //. by rewrite expgS /= IHn expnS modnMmr. Qed. End ZpRing. Definition Zp_trunc p := p.-2. Notation "''Z_' p" := 'I_(Zp_trunc p).+2 (at level 8, p at level 2, format "''Z_' p") : type_scope. Notation "''F_' p" := 'Z_(pdiv p) (at level 8, p at level 2, format "''F_' p") : type_scope. Arguments natr_Zp {p'} x. Section Groups. Variable p : nat. Definition Zp := if p > 1 then [set: 'Z_p] else 1%g. Definition units_Zp := [set: {unit 'Z_p}]. Lemma Zp_cast : p > 1 -> (Zp_trunc p).+2 = p. Proof. by case: p => [|[]]. Qed. Lemma val_Zp_nat (p_gt1 : p > 1) n : (n%:R : 'Z_p) = (n %% p)%N :> nat. Proof. by rewrite Zp_nat /= Zp_cast. Qed. Lemma Zp_nat_mod (p_gt1 : p > 1)m : (m %% p)%:R = m%:R :> 'Z_p. Proof. by apply: ord_inj; rewrite !val_Zp_nat // modn_mod. Qed. Lemma char_Zp : p > 1 -> p%:R = 0 :> 'Z_p. Proof. by move=> p_gt1; rewrite -Zp_nat_mod ?modnn. Qed. Lemma unitZpE x : p > 1 -> ((x%:R : 'Z_p) \is a GRing.unit) = coprime p x. Proof. by move=> p_gt1; rewrite qualifE /= val_Zp_nat ?Zp_cast ?coprime_modr. Qed. Lemma Zp_group_set : group_set Zp. Proof. by rewrite /Zp; case: (p > 1); apply: groupP. Qed. Canonical Zp_group := Group Zp_group_set. Lemma card_Zp : p > 0 -> #|Zp| = p. Proof. rewrite /Zp; case: p => [|[|p']] //= _; first by rewrite cards1. by rewrite cardsT card_ord. Qed. Lemma mem_Zp x : p > 1 -> x \in Zp. Proof. by rewrite /Zp => ->. Qed. Canonical units_Zp_group := [group of units_Zp]. Lemma card_units_Zp : p > 0 -> #|units_Zp| = totient p. Proof. move=> p_gt0; transitivity (totient p.-2.+2); last by case: p p_gt0 => [|[|p']]. rewrite cardsT card_sub -sum1_card big_mkcond /=. by rewrite totient_count_coprime big_mkord. Qed. Lemma units_Zp_abelian : abelian units_Zp. Proof. by apply/centsP=> u _ v _; apply: unit_Zp_mulgC. Qed. End Groups. (* Field structure for primes. *) Section PrimeField. Open Scope ring_scope. Variable p : nat. Section F_prime. Hypothesis p_pr : prime p. Lemma Fp_Zcast : (Zp_trunc (pdiv p)).+2 = (Zp_trunc p).+2. Proof. by rewrite /pdiv primes_prime. Qed. Lemma Fp_cast : (Zp_trunc (pdiv p)).+2 = p. Proof. by rewrite Fp_Zcast ?Zp_cast ?prime_gt1. Qed. Lemma card_Fp : #|'F_p| = p. Proof. by rewrite card_ord Fp_cast. Qed. Lemma val_Fp_nat n : (n%:R : 'F_p) = (n %% p)%N :> nat. Proof. by rewrite Zp_nat /= Fp_cast. Qed. Lemma Fp_nat_mod m : (m %% p)%:R = m%:R :> 'F_p. Proof. by apply: ord_inj; rewrite !val_Fp_nat // modn_mod. Qed. Lemma char_Fp : p \in [char 'F_p]. Proof. by rewrite !inE -Fp_nat_mod p_pr ?modnn. Qed. Lemma char_Fp_0 : p%:R = 0 :> 'F_p. Proof. exact: GRing.charf0 char_Fp. Qed. Lemma unitFpE x : ((x%:R : 'F_p) \is a GRing.unit) = coprime p x. Proof. by rewrite pdiv_id // unitZpE // prime_gt1. Qed. End F_prime. Lemma Fp_fieldMixin : GRing.Field.mixin_of [the unitRingType of 'F_p]. Proof. move=> x nzx; rewrite qualifE /= prime_coprime ?gtnNdvd ?lt0n //. case: (ltnP 1 p) => [lt1p | ]; last by case: p => [|[|p']]. by rewrite Zp_cast ?prime_gt1 ?pdiv_prime. Qed. Definition Fp_idomainMixin := FieldIdomainMixin Fp_fieldMixin. Canonical Fp_idomainType := Eval hnf in IdomainType 'F_p Fp_idomainMixin. Canonical Fp_finIdomainType := Eval hnf in [finIdomainType of 'F_p]. Canonical Fp_fieldType := Eval hnf in FieldType 'F_p Fp_fieldMixin. Canonical Fp_finFieldType := Eval hnf in [finFieldType of 'F_p]. Canonical Fp_decFieldType := Eval hnf in [decFieldType of 'F_p for Fp_finFieldType]. End PrimeField. Canonical Zp_countZmodType m := [countZmodType of 'I_m.+1]. Canonical Zp_countRingType m := [countRingType of 'I_m.+2]. Canonical Zp_countComRingType m := [countComRingType of 'I_m.+2]. Canonical Zp_countUnitRingType m := [countUnitRingType of 'I_m.+2]. Canonical Zp_countComUnitRingType m := [countComUnitRingType of 'I_m.+2]. Canonical Fp_countIdomainType p := [countIdomainType of 'F_p]. Canonical Fp_countFieldType p := [countFieldType of 'F_p]. Canonical Fp_countDecFieldType p := [countDecFieldType of 'F_p]. math-comp-mathcomp-1.12.0/mathcomp/all/000077500000000000000000000000001375767750300176725ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/all/Makefile000066400000000000000000000002531375767750300213320ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory # -------------------------------------------------------------------- include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/all/all.v000066400000000000000000000004261375767750300206330ustar00rootroot00000000000000Require Export mathcomp.ssreflect.all_ssreflect. Require Export mathcomp.algebra.all_algebra. Require Export mathcomp.field.all_field. Require Export mathcomp.character.all_character. Require Export mathcomp.fingroup.all_fingroup. Require Export mathcomp.solvable.all_solvable. math-comp-mathcomp-1.12.0/mathcomp/character/000077500000000000000000000000001375767750300210565ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/character/AUTHORS000077700000000000000000000000001375767750300236172../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/character/CeCILL-B000077700000000000000000000000001375767750300236712../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/character/INSTALL.md000077700000000000000000000000001375767750300245572../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/character/Make000066400000000000000000000005321375767750300216560ustar00rootroot00000000000000all_character.v character.v classfun.v inertia.v integral_char.v mxabelem.v mxrepresentation.v vcharacter.v -R . mathcomp.character -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scope math-comp-mathcomp-1.12.0/mathcomp/character/Makefile000066400000000000000000000002531375767750300225160ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory # -------------------------------------------------------------------- include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/character/README.md000077700000000000000000000000001375767750300242352../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/character/all_character.v000066400000000000000000000004401375767750300240270ustar00rootroot00000000000000From mathcomp Require Export character. From mathcomp Require Export classfun. From mathcomp Require Export inertia. From mathcomp Require Export integral_char. From mathcomp Require Export mxabelem. From mathcomp Require Export mxrepresentation. From mathcomp Require Export vcharacter. math-comp-mathcomp-1.12.0/mathcomp/character/character.v000066400000000000000000003423221375767750300232070ustar00rootroot00000000000000(* (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 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. (******************************************************************************) (* This file contains the basic notions of character theory, based on Isaacs. *) (* irr G == tuple of the elements of 'CF(G) that are irreducible *) (* characters of G. *) (* Nirr G == number of irreducible characters of G. *) (* Iirr G == index type for the irreducible characters of G. *) (* := 'I_(Nirr G). *) (* 'chi_i == the i-th element of irr G, for i : Iirr G. *) (* 'chi[G]_i Note that 'chi_0 = 1, the principal character of G. *) (* 'Chi_i == an irreducible representation that affords 'chi_i. *) (* socle_of_Iirr i == the Wedderburn component of the regular representation *) (* of G, corresponding to 'Chi_i. *) (* Iirr_of_socle == the inverse of socle_of_Iirr (which is one-to-one). *) (* phi.[A]%CF == the image of A \in group_ring G under phi : 'CF(G). *) (* cfRepr rG == the character afforded by the representation rG of G. *) (* cfReg G == the regular character, afforded by the regular *) (* representation of G. *) (* detRepr rG == the linear character afforded by the determinant of rG. *) (* cfDet phi == the linear character afforded by the determinant of a *) (* representation affording phi. *) (* 'o(phi) == the "determinential order" of phi (the multiplicative *) (* order of cfDet phi. *) (* phi \is a character <=> phi : 'CF(G) is a character of G or 0. *) (* i \in irr_constt phi <=> 'chi_i is an irreducible constituent of phi: phi *) (* has a non-zero coordinate on 'chi_i over the basis irr G. *) (* xi \is a linear_char xi <=> xi : 'CF(G) is a linear character of G. *) (* 'Z(chi)%CF == the center of chi when chi is a character of G, i.e., *) (* rcenter rG where rG is a representation that affords phi. *) (* If phi is not a character then 'Z(chi)%CF = cfker phi. *) (* aut_Iirr u i == the index of cfAut u 'chi_i in irr G. *) (* conjC_Iirr i == the index of 'chi_i^*%CF in irr G. *) (* morph_Iirr i == the index of cfMorph 'chi[f @* G]_i in irr G. *) (* isom_Iirr isoG i == the index of cfIsom isoG 'chi[G]_i in irr R. *) (* mod_Iirr i == the index of ('chi[G / H]_i %% H)%CF in irr G. *) (* quo_Iirr i == the index of ('chi[G]_i / H)%CF in irr (G / H). *) (* Ind_Iirr G i == the index of 'Ind[G, H] 'chi_i, provided it is an *) (* irreducible character (such as when if H is the inertia *) (* group of 'chi_i). *) (* Res_Iirr H i == the index of 'Res[H, G] 'chi_i, provided it is an *) (* irreducible character (such as when 'chi_i is linear). *) (* sdprod_Iirr defG i == the index of cfSdprod defG 'chi_i in irr G, given *) (* defG : K ><| H = G. *) (* And, for KxK : K \x H = G. *) (* dprodl_Iirr KxH i == the index of cfDprodl KxH 'chi[K]_i in irr G. *) (* dprodr_Iirr KxH j == the index of cfDprodr KxH 'chi[H]_j in irr G. *) (* dprod_Iirr KxH (i, j) == the index of cfDprod KxH 'chi[K]_i 'chi[H]_j. *) (* inv_dprod_Iirr KxH == the inverse of dprod_Iirr KxH. *) (* The following are used to define and exploit the character table: *) (* character_table G == the character table of G, whose i-th row lists the *) (* values taken by 'chi_i on the conjugacy classes *) (* of G; this is a square Nirr G x NirrG matrix. *) (* irr_class i == the conjugacy class of G with index i : Iirr G. *) (* class_Iirr xG == the index of xG \in classes G, in Iirr G. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Notation algCF := [fieldType of algC]. Section AlgC. Variable (gT : finGroupType). Lemma groupC : group_closure_field algCF gT. Proof. exact: group_closure_closed_field. Qed. End AlgC. Section Tensor. Variable (F : fieldType). Fixpoint trow (n1 : nat) : forall (A : 'rV[F]_n1) m2 n2 (B : 'M[F]_(m2,n2)), 'M[F]_(m2,n1 * n2) := if n1 is n'1.+1 then fun (A : 'M[F]_(1,(1 + n'1))) m2 n2 (B : 'M[F]_(m2,n2)) => (row_mx (lsubmx A 0 0 *: B) (trow (rsubmx A) B)) else (fun _ _ _ _ => 0). Lemma trow0 n1 m2 n2 B : @trow n1 0 m2 n2 B = 0. Proof. elim: n1=> //= n1 IH. rewrite !mxE scale0r linear0. rewrite IH //; apply/matrixP=> i j; rewrite !mxE. by case: split=> *; rewrite mxE. Qed. Definition trowb n1 m2 n2 B A := @trow n1 A m2 n2 B. Lemma trowbE n1 m2 n2 A B : trowb B A = @trow n1 A m2 n2 B. Proof. by []. Qed. Lemma trowb_is_linear n1 m2 n2 (B : 'M_(m2,n2)) : linear (@trowb n1 m2 n2 B). Proof. elim: n1=> [|n1 IH] //= k A1 A2 /=; first by rewrite scaler0 add0r. rewrite linearD /= linearZ. apply/matrixP=> i j. rewrite !mxE. case: split=> a. by rewrite !mxE mulrDl mulrA. by rewrite linearD /= linearZ IH !mxE. Qed. Canonical Structure trowb_linear n1 m2 n2 B := Linear (@trowb_is_linear n1 m2 n2 B). Lemma trow_is_linear n1 m2 n2 (A : 'rV_n1) : linear (@trow n1 A m2 n2). Proof. elim: n1 A => [|n1 IH] //= A k A1 A2 /=; first by rewrite scaler0 add0r. rewrite linearD /= linearZ /=. apply/matrixP=> i j; rewrite !mxE. by case: split=> a; rewrite ?IH !mxE. Qed. Canonical Structure trow_linear n1 m2 n2 A := Linear (@trow_is_linear n1 m2 n2 A). Fixpoint tprod (m1 : nat) : forall n1 (A : 'M[F]_(m1,n1)) m2 n2 (B : 'M[F]_(m2,n2)), 'M[F]_(m1 * m2,n1 * n2) := if m1 is m'1.+1 return forall n1 (A : 'M[F]_(m1,n1)) m2 n2 (B : 'M[F]_(m2,n2)), 'M[F]_(m1 * m2,n1 * n2) then fun n1 (A : 'M[F]_(1 + m'1,n1)) m2 n2 B => (col_mx (trow (usubmx A) B) (tprod (dsubmx A) B)) else (fun _ _ _ _ _ => 0). Lemma dsumx_mul m1 m2 n p A B : dsubmx ((A *m B) : 'M[F]_(m1 + m2, n)) = dsubmx (A : 'M_(m1 + m2, p)) *m B. Proof. apply/matrixP=> i j; rewrite !mxE; apply: eq_bigr=> k _. by rewrite !mxE. Qed. Lemma usumx_mul m1 m2 n p A B : usubmx ((A *m B) : 'M[F]_(m1 + m2, n)) = usubmx (A : 'M_(m1 + m2, p)) *m B. Proof. by apply/matrixP=> i j; rewrite !mxE; apply: eq_bigr=> k _; rewrite !mxE. Qed. Let trow_mul (m1 m2 n2 p2 : nat) (A : 'rV_m1) (B1: 'M[F]_(m2,n2)) (B2 :'M[F]_(n2,p2)) : trow A (B1 *m B2) = B1 *m trow A B2. Proof. elim: m1 A => [|m1 IH] A /=; first by rewrite mulmx0. by rewrite IH mul_mx_row -scalemxAr. Qed. Lemma tprodE m1 n1 p1 (A1 :'M[F]_(m1,n1)) (A2 :'M[F]_(n1,p1)) m2 n2 p2 (B1 :'M[F]_(m2,n2)) (B2 :'M[F]_(n2,p2)) : tprod (A1 *m A2) (B1 *m B2) = (tprod A1 B1) *m (tprod A2 B2). Proof. elim: m1 n1 p1 A1 A2 m2 n2 p2 B1 B2 => /= [|m1 IH]. by move=> *; rewrite mul0mx. move=> n1 p1 A1 A2 m2 n2 p2 B1 B2. rewrite mul_col_mx -IH. congr col_mx; last by rewrite dsumx_mul. rewrite usumx_mul. elim: n1 {A1}(usubmx (A1: 'M_(1 + m1, n1))) p1 A2=> //= [u p1 A2|]. by rewrite [A2](flatmx0) !mulmx0 -trowbE linear0. move=> n1 IH1 A p1 A2 //=. set Al := lsubmx _; set Ar := rsubmx _. set Su := usubmx _; set Sd := dsubmx _. rewrite mul_row_col -IH1. rewrite -{1}(@hsubmxK F 1 1 n1 A). rewrite -{1}(@vsubmxK F 1 n1 p1 A2). rewrite (@mul_row_col F 1 1 n1 p1). rewrite -trowbE linearD /= trowbE -/Al. congr (_ + _). rewrite {1}[Al]mx11_scalar mul_scalar_mx. by rewrite -trowbE linearZ /= trowbE -/Su trow_mul scalemxAl. Qed. Let tprod_tr m1 n1 (A :'M[F]_(m1, 1 + n1)) m2 n2 (B :'M[F]_(m2, n2)) : tprod A B = row_mx (trow (lsubmx A)^T B^T)^T (tprod (rsubmx A) B). Proof. elim: m1 n1 A m2 n2 B=> [|m1 IH] n1 A m2 n2 B //=. by rewrite trmx0 row_mx0. rewrite !IH. pose A1 := A : 'M_(1 + m1, 1 + n1). have F1: dsubmx (rsubmx A1) = rsubmx (dsubmx A1). by apply/matrixP=> i j; rewrite !mxE. have F2: rsubmx (usubmx A1) = usubmx (rsubmx A1). by apply/matrixP=> i j; rewrite !mxE. have F3: lsubmx (dsubmx A1) = dsubmx (lsubmx A1). by apply/matrixP=> i j; rewrite !mxE. rewrite tr_row_mx -block_mxEv -block_mxEh !(F1,F2,F3); congr block_mx. - by rewrite !mxE linearZ /= trmxK. by rewrite -trmx_dsub. Qed. Lemma tprod1 m n : tprod (1%:M : 'M[F]_(m,m)) (1%:M : 'M[F]_(n,n)) = 1%:M. Proof. elim: m n => [|m IH] n //=; first by rewrite [1%:M]flatmx0. rewrite tprod_tr. set u := rsubmx _; have->: u = 0. apply/matrixP=> i j; rewrite !mxE. by case: i; case: j=> /= j Hj; case. set v := lsubmx (dsubmx _); have->: v = 0. apply/matrixP=> i j; rewrite !mxE. by case: i; case: j; case. set w := rsubmx _; have->: w = 1%:M. apply/matrixP=> i j; rewrite !mxE. by case: i; case: j; case. rewrite IH -!trowbE !linear0. rewrite -block_mxEv. set z := (lsubmx _) 0 0; have->: z = 1. by rewrite /z !mxE eqxx. by rewrite scale1r scalar_mx_block. Qed. Lemma mxtrace_prod m n (A :'M[F]_(m)) (B :'M[F]_(n)) : \tr (tprod A B) = \tr A * \tr B. Proof. elim: m n A B => [|m IH] n A B //=. by rewrite [A]flatmx0 mxtrace0 mul0r. rewrite tprod_tr -block_mxEv mxtrace_block IH. rewrite linearZ /= -mulrDl; congr (_ * _). rewrite -trace_mx11 . pose A1 := A : 'M_(1 + m). rewrite -{3}[A](@submxK _ 1 m 1 m A1). by rewrite (@mxtrace_block _ _ _ (ulsubmx A1)). Qed. End Tensor. (* Representation sigma type and standard representations. *) Section StandardRepresentation. Variables (R : fieldType) (gT : finGroupType) (G : {group gT}). Local Notation reprG := (mx_representation R G). Record representation := Representation {rdegree; mx_repr_of_repr :> reprG rdegree}. Lemma mx_repr0 : mx_repr G (fun _ : gT => 1%:M : 'M[R]_0). Proof. by split=> // g h Hg Hx; rewrite mulmx1. Qed. Definition grepr0 := Representation (MxRepresentation mx_repr0). Lemma add_mx_repr (rG1 rG2 : representation) : mx_repr G (fun g => block_mx (rG1 g) 0 0 (rG2 g)). Proof. split=> [|x y Hx Hy]; first by rewrite !repr_mx1 -scalar_mx_block. by rewrite mulmx_block !(mulmx0, mul0mx, addr0, add0r, repr_mxM). Qed. Definition dadd_grepr rG1 rG2 := Representation (MxRepresentation (add_mx_repr rG1 rG2)). Section DsumRepr. Variables (n : nat) (rG : reprG n). Lemma mx_rsim_dadd (U V W : 'M_n) (rU rV : representation) (modU : mxmodule rG U) (modV : mxmodule rG V) (modW : mxmodule rG W) : (U + V :=: W)%MS -> mxdirect (U + V) -> mx_rsim (submod_repr modU) rU -> mx_rsim (submod_repr modV) rV -> mx_rsim (submod_repr modW) (dadd_grepr rU rV). Proof. case: rU; case: rV=> nV rV nU rU defW dxUV /=. have tiUV := mxdirect_addsP dxUV. move=> [fU def_nU]; rewrite -{nU}def_nU in rU fU * => inv_fU hom_fU. move=> [fV def_nV]; rewrite -{nV}def_nV in rV fV * => inv_fV hom_fV. pose pU := in_submod U (proj_mx U V) *m fU. pose pV := in_submod V (proj_mx V U) *m fV. exists (val_submod 1%:M *m row_mx pU pV) => [||g Gg]. - by rewrite -defW (mxdirectP dxUV). - apply/row_freeP. pose pU' := invmx fU *m val_submod 1%:M. pose pV' := invmx fV *m val_submod 1%:M. exists (in_submod _ (col_mx pU' pV')). rewrite in_submodE mulmxA -in_submodE -mulmxA mul_row_col mulmxDr. rewrite -[pU *m _]mulmxA -[pV *m _]mulmxA !mulKVmx -?row_free_unit //. rewrite addrC (in_submodE V) 2![val_submod 1%:M *m _]mulmxA -in_submodE. rewrite addrC (in_submodE U) 2![val_submod 1%:M *m _]mulmxA -in_submodE. rewrite -!val_submodE !in_submodK ?proj_mx_sub //. by rewrite add_proj_mx ?val_submodK // val_submod1 defW. rewrite mulmxA -val_submodE -[submod_repr _ g]mul1mx val_submodJ //. rewrite -(mulmxA _ (rG g)) mul_mx_row -mulmxA mul_row_block !mulmx0 addr0 add0r. rewrite !mul_mx_row; set W' := val_submod 1%:M; congr (row_mx _ _). rewrite 3!mulmxA in_submodE mulmxA. have hom_pU: (W' <= dom_hom_mx rG (proj_mx U V))%MS. by rewrite val_submod1 -defW proj_mx_hom. rewrite (hom_mxP hom_pU) // -in_submodE (in_submodJ modU) ?proj_mx_sub //. rewrite -(mulmxA _ _ fU) hom_fU // in_submodE -2!(mulmxA W') -in_submodE. by rewrite -mulmxA (mulmxA _ fU). rewrite 3!mulmxA in_submodE mulmxA. have hom_pV: (W' <= dom_hom_mx rG (proj_mx V U))%MS. by rewrite val_submod1 -defW addsmxC proj_mx_hom // capmxC. rewrite (hom_mxP hom_pV) // -in_submodE (in_submodJ modV) ?proj_mx_sub //. rewrite -(mulmxA _ _ fV) hom_fV // in_submodE -2!(mulmxA W') -in_submodE. by rewrite -mulmxA (mulmxA _ fV). Qed. Lemma mx_rsim_dsum (I : finType) (P : pred I) U rU (W : 'M_n) (modU : forall i, mxmodule rG (U i)) (modW : mxmodule rG W) : let S := (\sum_(i | P i) U i)%MS in (S :=: W)%MS -> mxdirect S -> (forall i, mx_rsim (submod_repr (modU i)) (rU i : representation)) -> mx_rsim (submod_repr modW) (\big[dadd_grepr/grepr0]_(i | P i) rU i). Proof. move=> /= defW dxW rsimU. rewrite mxdirectE /= -!(big_filter _ P) in dxW defW *. elim: {P}(filter P _) => [|i e IHe] in W modW dxW defW *. rewrite !big_nil /= in defW *. by exists 0 => [||? _]; rewrite ?mul0mx ?mulmx0 // /row_free -defW !mxrank0. rewrite !big_cons /= in dxW defW *. rewrite 2!(big_nth i) !big_mkord /= in IHe dxW defW. set Wi := (\sum_i _)%MS in defW dxW IHe. rewrite -mxdirectE mxdirect_addsE !mxdirectE eqxx /= -/Wi in dxW. have modWi: mxmodule rG Wi by apply: sumsmx_module. case/andP: dxW; move/(IHe Wi modWi) {IHe}; move/(_ (eqmx_refl _))=> rsimWi. by move/eqP; move/mxdirect_addsP=> dxUiWi; apply: mx_rsim_dadd (rsimU i) rsimWi. Qed. Definition muln_grepr rW k := \big[dadd_grepr/grepr0]_(i < k) rW. Lemma mx_rsim_socle (sG : socleType rG) (W : sG) (rW : representation) : let modW : mxmodule rG W := component_mx_module rG (socle_base W) in mx_rsim (socle_repr W) rW -> mx_rsim (submod_repr modW) (muln_grepr rW (socle_mult W)). Proof. set M := socle_base W => modW rsimM. have simM: mxsimple rG M := socle_simple W. have rankM_gt0: (\rank M > 0)%N by rewrite lt0n mxrank_eq0; case: simM. have [I /= U_I simU]: mxsemisimple rG W by apply: component_mx_semisimple. pose U (i : 'I_#|I|) := U_I (enum_val i). have reindexI := reindex _ (onW_bij I (enum_val_bij I)). rewrite mxdirectE /= !reindexI -mxdirectE /= => defW dxW. have isoU: forall i, mx_iso rG M (U i). move=> i; have sUiW: (U i <= W)%MS by rewrite -defW (sumsmx_sup i). exact: component_mx_iso (simU _) sUiW. have ->: socle_mult W = #|I|. rewrite -(mulnK #|I| rankM_gt0); congr (_ %/ _)%N. rewrite -defW (mxdirectP dxW) /= -sum_nat_const reindexI /=. by apply: eq_bigr => i _; rewrite -(mxrank_iso (isoU i)). have modU: mxmodule rG (U _) := mxsimple_module (simU _). suff: mx_rsim (submod_repr (modU _)) rW by apply: mx_rsim_dsum defW dxW. by move=> i; apply: mx_rsim_trans (mx_rsim_sym _) rsimM; apply/mx_rsim_iso. Qed. End DsumRepr. Section ProdRepr. Variables (n1 n2 : nat) (rG1 : reprG n1) (rG2 : reprG n2). Lemma prod_mx_repr : mx_repr G (fun g => tprod (rG1 g) (rG2 g)). Proof. split=>[|i j InG JnG]; first by rewrite !repr_mx1 tprod1. by rewrite !repr_mxM // tprodE. Qed. Definition prod_repr := MxRepresentation prod_mx_repr. End ProdRepr. Lemma prod_repr_lin n2 (rG1 : reprG 1) (rG2 : reprG n2) : {in G, forall x, let cast_n2 := esym (mul1n n2) in prod_repr rG1 rG2 x = castmx (cast_n2, cast_n2) (rG1 x 0 0 *: rG2 x)}. Proof. move=> x Gx /=; set cast_n2 := esym _; rewrite /prod_repr /= !mxE !lshift0. apply/matrixP=> i j; rewrite castmxE /=. do 2![rewrite mxE; case: splitP => [? ? | []//]]. by congr ((_ *: rG2 x) _ _); apply: val_inj. Qed. End StandardRepresentation. Arguments grepr0 {R gT G}. Prenex Implicits dadd_grepr. Section Char. Variables (gT : finGroupType) (G : {group gT}). Fact cfRepr_subproof n (rG : mx_representation algCF G n) : is_class_fun <> [ffun x => \tr (rG x) *+ (x \in G)]. Proof. rewrite genGid; apply: intro_class_fun => [x y Gx Gy | _ /negbTE-> //]. by rewrite groupJr // !repr_mxM ?groupM ?groupV // mxtrace_mulC repr_mxK. Qed. Definition cfRepr n rG := Cfun 0 (@cfRepr_subproof n rG). Lemma cfRepr1 n rG : @cfRepr n rG 1%g = n%:R. Proof. by rewrite cfunE group1 repr_mx1 mxtrace1. Qed. Lemma cfRepr_sim n1 n2 rG1 rG2 : mx_rsim rG1 rG2 -> @cfRepr n1 rG1 = @cfRepr n2 rG2. Proof. case/mx_rsim_def=> f12 [f21] fK def_rG1; apply/cfun_inP=> x Gx. by rewrite !cfunE def_rG1 // mxtrace_mulC mulmxA fK mul1mx. Qed. Lemma cfRepr0 : cfRepr grepr0 = 0. Proof. by apply/cfun_inP=> x Gx; rewrite !cfunE Gx mxtrace1. Qed. Lemma cfRepr_dadd rG1 rG2 : cfRepr (dadd_grepr rG1 rG2) = cfRepr rG1 + cfRepr rG2. Proof. by apply/cfun_inP=> x Gx; rewrite !cfunE Gx mxtrace_block. Qed. Lemma cfRepr_dsum I r (P : pred I) rG : cfRepr (\big[dadd_grepr/grepr0]_(i <- r | P i) rG i) = \sum_(i <- r | P i) cfRepr (rG i). Proof. exact: (big_morph _ cfRepr_dadd cfRepr0). Qed. Lemma cfRepr_muln rG k : cfRepr (muln_grepr rG k) = cfRepr rG *+ k. Proof. by rewrite cfRepr_dsum /= sumr_const card_ord. Qed. Section StandardRepr. Variables (n : nat) (rG : mx_representation algCF G n). Let sG := DecSocleType rG. Let iG : irrType algCF G := DecSocleType _. Definition standard_irr (W : sG) := irr_comp iG (socle_repr W). Definition standard_socle i := pick [pred W | standard_irr W == i]. Local Notation soc := standard_socle. Definition standard_irr_coef i := oapp (fun W => socle_mult W) 0%N (soc i). Definition standard_grepr := \big[dadd_grepr/grepr0]_i muln_grepr (Representation (socle_repr i)) (standard_irr_coef i). Lemma mx_rsim_standard : mx_rsim rG standard_grepr. Proof. pose W i := oapp val 0 (soc i); pose S := (\sum_i W i)%MS. have C'G: [char algC]^'.-group G := algC'G G. have [defS dxS]: (S :=: 1%:M)%MS /\ mxdirect S. rewrite /S mxdirectE /= !(bigID soc xpredT) /=. rewrite addsmxC big1 => [|i]; last by rewrite /W; case (soc i). rewrite adds0mx_id addnC (@big1 nat) ?add0n => [|i]; last first. by rewrite /W; case: (soc i); rewrite ?mxrank0. have <-: Socle sG = 1%:M := reducible_Socle1 sG (mx_Maschke rG C'G). have [W0 _ | noW] := pickP sG; last first. suff no_i: (soc : pred iG) =1 xpred0 by rewrite /Socle !big_pred0 ?mxrank0. by move=> i; rewrite /soc; case: pickP => // W0; have:= noW W0. have irrK Wi: soc (standard_irr Wi) = Some Wi. rewrite /soc; case: pickP => [W' | /(_ Wi)] /= /eqP // eqWi. apply/eqP/socle_rsimP. apply: mx_rsim_trans (rsim_irr_comp iG C'G (socle_irr _)) (mx_rsim_sym _). by rewrite [irr_comp _ _]eqWi; apply: rsim_irr_comp (socle_irr _). have bij_irr: {on [pred i | soc i], bijective standard_irr}. exists (odflt W0 \o soc) => [Wi _ | i]; first by rewrite /= irrK. by rewrite inE /soc /=; case: pickP => //= Wi; move/eqP. rewrite !(reindex standard_irr) {bij_irr}//=. have all_soc Wi: soc (standard_irr Wi) by rewrite irrK. rewrite (eq_bigr val) => [|Wi _]; last by rewrite /W irrK. rewrite !(eq_bigl _ _ all_soc); split=> //. rewrite (eq_bigr (mxrank \o val)) => [|Wi _]; last by rewrite /W irrK. by rewrite -mxdirectE /= Socle_direct. pose modW i : mxmodule rG (W i) := if soc i is Some Wi as oWi return mxmodule rG (oapp val 0 oWi) then component_mx_module rG (socle_base Wi) else mxmodule0 rG n. apply: mx_rsim_trans (mx_rsim_sym (rsim_submod1 (mxmodule1 rG) _)) _ => //. apply: mx_rsim_dsum (modW) _ defS dxS _ => i. rewrite /W /standard_irr_coef /modW /soc; case: pickP => [Wi|_] /=; last first. rewrite /muln_grepr big_ord0. by exists 0 => [||x _]; rewrite ?mxrank0 ?mulmx0 ?mul0mx. by move/eqP=> <-; apply: mx_rsim_socle; apply: rsim_irr_comp (socle_irr Wi). Qed. End StandardRepr. Definition cfReg (B : {set gT}) : 'CF(B) := #|B|%:R *: '1_[1]. Lemma cfRegE x : @cfReg G x = #|G|%:R *+ (x == 1%g). Proof. by rewrite cfunE cfuniE ?normal1 // inE mulr_natr. Qed. (* This is Isaacs, Lemma (2.10). *) Lemma cfReprReg : cfRepr (regular_repr algCF G) = cfReg G. Proof. apply/cfun_inP=> x Gx; rewrite cfRegE. have [-> | ntx] := eqVneq x 1%g; first by rewrite cfRepr1. rewrite cfunE Gx [\tr _]big1 // => i _; rewrite 2!mxE /=. rewrite -(inj_eq enum_val_inj) gring_indexK ?groupM ?enum_valP //. by rewrite eq_mulVg1 mulKg (negbTE ntx). Qed. Definition xcfun (chi : 'CF(G)) A := (gring_row A *m (\col_(i < #|G|) chi (enum_val i))) 0 0. Lemma xcfun_is_additive phi : additive (xcfun phi). Proof. by move=> A B; rewrite /xcfun linearB mulmxBl !mxE. Qed. Canonical xcfun_additive phi := Additive (xcfun_is_additive phi). Lemma xcfunZr a phi A : xcfun phi (a *: A) = a * xcfun phi A. Proof. by rewrite /xcfun linearZ -scalemxAl mxE. Qed. (* In order to add a second canonical structure on xcfun *) Definition xcfun_r A phi := xcfun phi A. Arguments xcfun_r A phi /. Lemma xcfun_rE A chi : xcfun_r A chi = xcfun chi A. Proof. by []. Qed. Fact xcfun_r_is_additive A : additive (xcfun_r A). Proof. move=> phi psi; rewrite /= /xcfun !mxE -sumrB; apply: eq_bigr => i _. by rewrite !mxE !cfunE mulrBr. Qed. Canonical xcfun_r_additive A := Additive (xcfun_r_is_additive A). Lemma xcfunZl a phi A : xcfun (a *: phi) A = a * xcfun phi A. Proof. rewrite /xcfun !mxE big_distrr; apply: eq_bigr => i _ /=. by rewrite !mxE cfunE mulrCA. Qed. Lemma xcfun_repr n rG A : xcfun (@cfRepr n rG) A = \tr (gring_op rG A). Proof. rewrite gring_opE [gring_row A]row_sum_delta !linear_sum /xcfun !mxE. apply: eq_bigr => i _; rewrite !mxE /= !linearZ cfunE enum_valP /=. by congr (_ * \tr _) => {A} /=; rewrite /gring_mx /= -rowE rowK mxvecK. Qed. End Char. Arguments xcfun_r {_ _} A phi /. Notation "phi .[ A ]" := (xcfun phi A) : cfun_scope. Definition pred_Nirr gT B := #|@classes gT B|.-1. Arguments pred_Nirr {gT} B%g. Notation Nirr G := (pred_Nirr G).+1. Notation Iirr G := 'I_(Nirr G). Section IrrClassDef. Variables (gT : finGroupType) (G : {group gT}). Let sG := DecSocleType (regular_repr algCF G). Lemma NirrE : Nirr G = #|classes G|. Proof. by rewrite /pred_Nirr (cardD1 [1]) classes1. Qed. Fact Iirr_cast : Nirr G = #|sG|. Proof. by rewrite NirrE ?card_irr ?algC'G //; apply: groupC. Qed. Let offset := cast_ord (esym Iirr_cast) (enum_rank [1 sG]%irr). Definition socle_of_Iirr (i : Iirr G) : sG := enum_val (cast_ord Iirr_cast (i + offset)). Definition irr_of_socle (Wi : sG) : Iirr G := cast_ord (esym Iirr_cast) (enum_rank Wi) - offset. Local Notation W := socle_of_Iirr. Lemma socle_Iirr0 : W 0 = [1 sG]%irr. Proof. by rewrite /W add0r cast_ordKV enum_rankK. Qed. Lemma socle_of_IirrK : cancel W irr_of_socle. Proof. by move=> i; rewrite /irr_of_socle enum_valK cast_ordK addrK. Qed. Lemma irr_of_socleK : cancel irr_of_socle W. Proof. by move=> Wi; rewrite /W subrK cast_ordKV enum_rankK. Qed. Hint Resolve socle_of_IirrK irr_of_socleK : core. Lemma irr_of_socle_bij (A : {pred (Iirr G)}) : {on A, bijective irr_of_socle}. Proof. by apply: onW_bij; exists W. Qed. Lemma socle_of_Iirr_bij (A : {pred sG}) : {on A, bijective W}. Proof. by apply: onW_bij; exists irr_of_socle. Qed. End IrrClassDef. Prenex Implicits socle_of_IirrK irr_of_socleK. Arguments socle_of_Iirr {gT G%G} i%R. Notation "''Chi_' i" := (irr_repr (socle_of_Iirr i)) (at level 8, i at level 2, format "''Chi_' i"). Fact irr_key : unit. Proof. by []. Qed. Definition irr_def gT B : (Nirr B).-tuple 'CF(B) := let irr_of i := 'Res[B, <>] (@cfRepr gT _ _ 'Chi_(inord i)) in [tuple of mkseq irr_of (Nirr B)]. Definition irr := locked_with irr_key irr_def. Arguments irr {gT} B%g. Notation "''chi_' i" := (tnth (irr _) i%R) (at level 8, i at level 2, format "''chi_' i") : ring_scope. Notation "''chi[' G ]_ i" := (tnth (irr G) i%R) (at level 8, i at level 2, only parsing) : ring_scope. Section IrrClass. Variable (gT : finGroupType) (G : {group gT}). Implicit Types (i : Iirr G) (B : {set gT}). Open Scope group_ring_scope. Lemma congr_irr i1 i2 : i1 = i2 -> 'chi_i1 = 'chi_i2. Proof. by move->. Qed. Lemma Iirr1_neq0 : G :!=: 1%g -> inord 1 != 0 :> Iirr G. Proof. by rewrite -classes_gt1 -NirrE -val_eqE /= => /inordK->. Qed. Lemma has_nonprincipal_irr : G :!=: 1%g -> {i : Iirr G | i != 0}. Proof. by move/Iirr1_neq0; exists (inord 1). Qed. Lemma irrRepr i : cfRepr 'Chi_i = 'chi_i. Proof. rewrite [@irr]unlock (tnth_nth 0) nth_mkseq // -[<>]/(gval _) genGidG. by rewrite cfRes_id inord_val. Qed. Lemma irr0 : 'chi[G]_0 = 1. Proof. apply/cfun_inP=> x Gx; rewrite -irrRepr cfun1E cfunE Gx. by rewrite socle_Iirr0 irr1_repr // mxtrace1 degree_irr1. Qed. Lemma cfun1_irr : 1 \in irr G. Proof. by rewrite -irr0 mem_tnth. Qed. Lemma mem_irr i : 'chi_i \in irr G. Proof. exact: mem_tnth. Qed. Lemma irrP xi : reflect (exists i, xi = 'chi_i) (xi \in irr G). Proof. apply: (iffP idP) => [/(nthP 0)[i] | [i ->]]; last exact: mem_irr. rewrite size_tuple => lt_i_G <-. by exists (Ordinal lt_i_G); rewrite (tnth_nth 0). Qed. Let sG := DecSocleType (regular_repr algCF G). Let C'G := algC'G G. Let closG := @groupC _ G. Local Notation W i := (@socle_of_Iirr _ G i). Local Notation "''n_' i" := 'n_(W i). Local Notation "''R_' i" := 'R_(W i). Local Notation "''e_' i" := 'e_(W i). Lemma irr1_degree i : 'chi_i 1%g = ('n_i)%:R. Proof. by rewrite -irrRepr cfRepr1. Qed. Lemma Cnat_irr1 i : 'chi_i 1%g \in Cnat. Proof. by rewrite irr1_degree rpred_nat. Qed. 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 eq_le lt_geF ?irr1_gt0. Qed. Lemma irr_neq0 i : 'chi_i != 0. Proof. by apply: contraNneq (irr1_neq0 i) => ->; rewrite cfunE. Qed. Local Remark cfIirr_key : unit. Proof. by []. Qed. Definition cfIirr : forall B, 'CF(B) -> Iirr B := locked_with cfIirr_key (fun B chi => inord (index chi (irr B))). Lemma cfIirrE chi : chi \in irr G -> 'chi_(cfIirr chi) = chi. Proof. move=> chi_irr; rewrite (tnth_nth 0) [cfIirr]unlock inordK ?nth_index //. by rewrite -index_mem size_tuple in chi_irr. Qed. Lemma cfIirrPE J (f : J -> 'CF(G)) (P : pred J) : (forall j, P j -> f j \in irr G) -> forall j, P j -> 'chi_(cfIirr (f j)) = f j. Proof. by move=> irr_f j /irr_f; apply: cfIirrE. Qed. (* This is Isaacs, Corollary (2.7). *) Corollary irr_sum_square : \sum_i ('chi[G]_i 1%g) ^+ 2 = #|G|%:R. Proof. rewrite -(sum_irr_degree sG) // natr_sum (reindex _ (socle_of_Iirr_bij _)) /=. by apply: eq_bigr => i _; rewrite irr1_degree natrX. Qed. (* This is Isaacs, Lemma (2.11). *) Lemma cfReg_sum : cfReg G = \sum_i 'chi_i 1%g *: 'chi_i. Proof. apply/cfun_inP=> x Gx; rewrite -cfReprReg cfunE Gx (mxtrace_regular sG) //=. rewrite sum_cfunE (reindex _ (socle_of_Iirr_bij _)); apply: eq_bigr => i _. by rewrite -irrRepr cfRepr1 !cfunE Gx mulr_natl. Qed. Let aG := regular_repr algCF G. Let R_G := group_ring algCF G. Lemma xcfun_annihilate i j A : i != j -> (A \in 'R_j)%MS -> ('chi_i).[A]%CF = 0. Proof. move=> neq_ij RjA; rewrite -irrRepr xcfun_repr. by rewrite (irr_repr'_op0 _ _ RjA) ?raddf0 // eq_sym (can_eq socle_of_IirrK). Qed. Lemma xcfunG phi x : x \in G -> phi.[aG x]%CF = phi x. Proof. by move=> Gx; rewrite /xcfun /gring_row rowK -rowE !mxE !(gring_indexK, mul1g). Qed. Lemma xcfun_mul_id i A : (A \in R_G)%MS -> ('chi_i).['e_i *m A]%CF = ('chi_i).[A]%CF. Proof. move=> RG_A; rewrite -irrRepr !xcfun_repr gring_opM //. by rewrite op_Wedderburn_id ?mul1mx. Qed. Lemma xcfun_id i j : ('chi_i).['e_j]%CF = 'chi_i 1%g *+ (i == j). Proof. have [<-{j} | /xcfun_annihilate->//] := eqVneq; last exact: Wedderburn_id_mem. by rewrite -xcfunG // repr_mx1 -(xcfun_mul_id _ (envelop_mx1 _)) mulmx1. Qed. Lemma irr_free : free (irr G). Proof. apply/freeP=> s s0 i; apply: (mulIf (irr1_neq0 i)). rewrite mul0r -(raddf0 (xcfun_r_additive 'e_i)) -{}s0 raddf_sum /=. rewrite (bigD1 i)//= -tnth_nth xcfunZl xcfun_id eqxx big1 ?addr0 // => j ne_ji. by rewrite -tnth_nth xcfunZl xcfun_id (negbTE ne_ji) mulr0. Qed. Lemma irr_inj : injective (tnth (irr G)). Proof. by apply/injectiveP/free_uniq; rewrite map_tnth_enum irr_free. Qed. Lemma irrK : cancel (tnth (irr G)) (@cfIirr G). Proof. by move=> i; apply: irr_inj; rewrite cfIirrE ?mem_irr. Qed. Lemma irr_eq1 i : ('chi_i == 1) = (i == 0). Proof. by rewrite -irr0 (inj_eq irr_inj). Qed. Lemma cforder_irr_eq1 i : (#['chi_i]%CF == 1%N) = (i == 0). Proof. by rewrite -dvdn1 dvdn_cforder irr_eq1. Qed. Lemma irr_basis : basis_of 'CF(G)%VS (irr G). Proof. rewrite /basis_of irr_free andbT -dimv_leqif_eq ?subvf //. by rewrite dim_cfun (eqnP irr_free) size_tuple NirrE. Qed. Lemma eq_sum_nth_irr a : \sum_i a i *: 'chi[G]_i = \sum_i a i *: (irr G)`_i. Proof. by apply: eq_bigr => i; rewrite -tnth_nth. Qed. (* This is Isaacs, Theorem (2.8). *) Theorem cfun_irr_sum phi : {a | phi = \sum_i a i *: 'chi[G]_i}. Proof. rewrite (coord_basis irr_basis (memvf phi)) -eq_sum_nth_irr. by exists ((coord (irr G))^~ phi). Qed. Lemma cfRepr_standard n (rG : mx_representation algCF G n) : cfRepr (standard_grepr rG) = \sum_i (standard_irr_coef rG (W i))%:R *: 'chi_i. Proof. rewrite cfRepr_dsum (reindex _ (socle_of_Iirr_bij _)). by apply: eq_bigr => i _; rewrite scaler_nat cfRepr_muln irrRepr. Qed. Lemma cfRepr_inj n1 n2 rG1 rG2 : @cfRepr _ G n1 rG1 = @cfRepr _ G n2 rG2 -> mx_rsim rG1 rG2. Proof. move=> eq_repr12; pose c i : algC := (standard_irr_coef _ (W i))%:R. have [rsim1 rsim2] := (mx_rsim_standard rG1, mx_rsim_standard rG2). apply: mx_rsim_trans (rsim1) (mx_rsim_sym _). suffices ->: standard_grepr rG1 = standard_grepr rG2 by []. apply: eq_bigr => Wi _; congr (muln_grepr _ _); apply/eqP; rewrite -eqC_nat. rewrite -[Wi]irr_of_socleK -!/(c _ _ _) -!(coord_sum_free (c _ _) _ irr_free). rewrite -!eq_sum_nth_irr -!cfRepr_standard. by rewrite -(cfRepr_sim rsim1) -(cfRepr_sim rsim2) eq_repr12. Qed. Lemma cfRepr_rsimP n1 n2 rG1 rG2 : reflect (mx_rsim rG1 rG2) (@cfRepr _ G n1 rG1 == @cfRepr _ G n2 rG2). Proof. by apply: (iffP eqP) => [/cfRepr_inj | /cfRepr_sim]. Qed. Lemma irr_reprP xi : reflect (exists2 rG : representation _ G, mx_irreducible rG & xi = cfRepr rG) (xi \in irr G). Proof. apply: (iffP (irrP xi)) => [[i ->] | [[n rG] irr_rG ->]]. by exists (Representation 'Chi_i); [apply: socle_irr | rewrite irrRepr]. exists (irr_of_socle (irr_comp sG rG)); rewrite -irrRepr irr_of_socleK /=. exact/cfRepr_sim/rsim_irr_comp. Qed. (* This is Isaacs, Theorem (2.12). *) Lemma Wedderburn_id_expansion i : 'e_i = #|G|%:R^-1 *: \sum_(x in G) 'chi_i 1%g * 'chi_i x^-1%g *: aG x. Proof. have Rei: ('e_i \in 'R_i)%MS by apply: Wedderburn_id_mem. have /envelop_mxP[a def_e]: ('e_i \in R_G)%MS; last rewrite -/aG in def_e. by move: Rei; rewrite genmxE mem_sub_gring => /andP[]. apply: canRL (scalerK (neq0CG _)) _; rewrite def_e linear_sum /=. apply: eq_bigr => x Gx; have Gx' := groupVr Gx; rewrite scalerA; congr (_ *: _). transitivity (cfReg G).['e_i *m aG x^-1%g]%CF. rewrite def_e mulmx_suml raddf_sum (bigD1 x) //= -scalemxAl xcfunZr. rewrite -repr_mxM // mulgV xcfunG // cfRegE eqxx mulrC big1 ?addr0 //. move=> y /andP[Gy /negbTE neq_xy]; rewrite -scalemxAl xcfunZr -repr_mxM //. by rewrite xcfunG ?groupM // cfRegE -eq_mulgV1 neq_xy mulr0. rewrite cfReg_sum -xcfun_rE raddf_sum /= (bigD1 i) //= xcfunZl. rewrite xcfun_mul_id ?envelop_mx_id ?xcfunG ?groupV ?big1 ?addr0 // => j ne_ji. rewrite xcfunZl (xcfun_annihilate ne_ji) ?mulr0 //. have /andP[_ /(submx_trans _)-> //] := Wedderburn_ideal (W i). by rewrite mem_mulsmx // envelop_mx_id ?groupV. Qed. End IrrClass. Arguments cfReg {gT} B%g. Prenex Implicits cfIirr irrK. Arguments irrP {gT G xi}. Arguments irr_reprP {gT G xi}. Arguments irr_inj {gT G} [x1 x2]. Section IsChar. Variable gT : finGroupType. Definition character {G : {set gT}} := [qualify a phi : 'CF(G) | [forall i, coord (irr G) i phi \in Cnat]]. Fact character_key G : pred_key (@character G). Proof. by []. Qed. Canonical character_keyed G := KeyedQualifier (character_key G). Variable G : {group gT}. Implicit Types (phi chi xi : 'CF(G)) (i : Iirr G). Lemma irr_char i : 'chi_i \is a character. Proof. by apply/forallP=> j; rewrite (tnth_nth 0) coord_free ?irr_free ?isNatC_nat. Qed. Lemma cfun1_char : (1 : 'CF(G)) \is a character. Proof. by rewrite -irr0 irr_char. Qed. Lemma cfun0_char : (0 : 'CF(G)) \is a character. Proof. by apply/forallP=> i; rewrite linear0 rpred0. Qed. Fact add_char : addr_closed (@character G). Proof. split=> [|chi xi /forallP-Nchi /forallP-Nxi]; first exact: cfun0_char. by apply/forallP=> i; rewrite linearD rpredD /=. Qed. Canonical character_addrPred := AddrPred add_char. Lemma char_sum_irrP {phi} : reflect (exists n, phi = \sum_i (n i)%:R *: 'chi_i) (phi \is a character). Proof. apply: (iffP idP)=> [/forallP-Nphi | [n ->]]; last first. by apply: rpred_sum => i _; rewrite scaler_nat rpredMn // irr_char. do [have [a ->] := cfun_irr_sum phi] in Nphi *; exists (truncC \o a). apply: eq_bigr => i _; congr (_ *: _); have:= eqP (Nphi i). by rewrite eq_sum_nth_irr coord_sum_free ?irr_free. Qed. Lemma char_sum_irr chi : chi \is a character -> {r | chi = \sum_(i <- r) 'chi_i}. Proof. move=> Nchi; apply: sig_eqW; case/char_sum_irrP: Nchi => n {chi}->. elim/big_rec: _ => [|i _ _ [r ->]]; first by exists nil; rewrite big_nil. exists (ncons (n i) i r); rewrite scaler_nat. by elim: {n}(n i) => [|n IHn]; rewrite ?add0r //= big_cons mulrS -addrA IHn. Qed. Lemma Cnat_char1 chi : chi \is a character -> chi 1%g \in Cnat. Proof. case/char_sum_irr=> r ->{chi}. by elim/big_rec: _ => [|i chi _ Nchi1]; rewrite cfunE ?rpredD // Cnat_irr1. Qed. Lemma char1_ge0 chi : chi \is a character -> 0 <= chi 1%g. Proof. by move/Cnat_char1/Cnat_ge0. Qed. 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?ltW ?irr1_gt0 //. by rewrite (negbTE (irr1_neq0 i)). Qed. Lemma char1_gt0 chi : chi \is a character -> (0 < chi 1%g) = (chi != 0). Proof. by move=> Nchi; rewrite -char1_eq0 // Cnat_gt0 ?Cnat_char1. Qed. Lemma char_reprP phi : reflect (exists rG : representation algCF G, phi = cfRepr rG) (phi \is a character). Proof. apply: (iffP char_sum_irrP) => [[n ->] | [[n rG] ->]]; last first. exists (fun i => standard_irr_coef rG (socle_of_Iirr i)). by rewrite -cfRepr_standard (cfRepr_sim (mx_rsim_standard rG)). exists (\big[dadd_grepr/grepr0]_i muln_grepr (Representation 'Chi_i) (n i)). rewrite cfRepr_dsum; apply: eq_bigr => i _. by rewrite cfRepr_muln irrRepr scaler_nat. Qed. Local Notation reprG := (mx_representation algCF G). Lemma cfRepr_char n (rG : reprG n) : cfRepr rG \is a character. Proof. by apply/char_reprP; exists (Representation rG). Qed. Lemma cfReg_char : cfReg G \is a character. Proof. by rewrite -cfReprReg cfRepr_char. Qed. Lemma cfRepr_prod n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : cfRepr rG1 * cfRepr rG2 = cfRepr (prod_repr rG1 rG2). Proof. by apply/cfun_inP=> x Gx; rewrite !cfunE /= Gx mxtrace_prod. Qed. Lemma mul_char : mulr_closed (@character G). Proof. split=> [|_ _ /char_reprP[rG1 ->] /char_reprP[rG2 ->]]; first exact: cfun1_char. apply/char_reprP; exists (Representation (prod_repr rG1 rG2)). by rewrite cfRepr_prod. Qed. Canonical char_mulrPred := MulrPred mul_char. Canonical char_semiringPred := SemiringPred mul_char. End IsChar. Prenex Implicits character. Arguments char_reprP {gT G phi}. Section AutChar. Variables (gT : finGroupType) (G : {group gT}). Implicit Type u : {rmorphism algC -> algC}. Implicit Type chi : 'CF(G). Lemma cfRepr_map u n (rG : mx_representation algCF G n) : cfRepr (map_repr u rG) = cfAut u (cfRepr rG). Proof. by apply/cfun_inP=> x Gx; rewrite !cfunE Gx map_reprE trace_map_mx. Qed. Lemma cfAut_char u chi : (cfAut u chi \is a character) = (chi \is a character). Proof. without loss /char_reprP[rG ->]: u chi / chi \is a character. by move=> IHu; apply/idP/idP=> ?; first rewrite -(cfAutK u chi); rewrite IHu. rewrite cfRepr_char; apply/char_reprP. by exists (Representation (map_repr u rG)); rewrite cfRepr_map. Qed. Lemma cfConjC_char chi : (chi^*%CF \is a character) = (chi \is a character). Proof. exact: cfAut_char. Qed. Lemma cfAut_char1 u (chi : 'CF(G)) : chi \is a character -> cfAut u chi 1%g = chi 1%g. Proof. by move/Cnat_char1=> Nchi1; rewrite cfunE aut_Cnat. Qed. Lemma cfAut_irr1 u i : (cfAut u 'chi[G]_i) 1%g = 'chi_i 1%g. Proof. exact: cfAut_char1 (irr_char i). Qed. Lemma cfConjC_char1 (chi : 'CF(G)) : chi \is a character -> chi^*%CF 1%g = chi 1%g. Proof. exact: cfAut_char1. Qed. Lemma cfConjC_irr1 u i : ('chi[G]_i)^*%CF 1%g = 'chi_i 1%g. Proof. exact: cfAut_irr1. Qed. End AutChar. Section Linear. Variables (gT : finGroupType) (G : {group gT}). Definition linear_char {B : {set gT}} := [qualify a phi : 'CF(B) | (phi \is a character) && (phi 1%g == 1)]. Section OneChar. Variable xi : 'CF(G). Hypothesis CFxi : xi \is a linear_char. Lemma lin_char1: xi 1%g = 1. Proof. by case/andP: CFxi => _ /eqP. Qed. Lemma lin_charW : xi \is a character. Proof. by case/andP: CFxi. Qed. Lemma cfun1_lin_char : (1 : 'CF(G)) \is a linear_char. Proof. by rewrite qualifE cfun1_char /= cfun11. Qed. Lemma lin_charM : {in G &, {morph xi : x y / (x * y)%g >-> x * y}}. Proof. move=> x y Gx Gy; case/andP: CFxi => /char_reprP[[n rG] -> /=]. rewrite cfRepr1 pnatr_eq1 => /eqP n1; rewrite {n}n1 in rG *. rewrite !cfunE Gx Gy groupM //= !mulr1n repr_mxM //. by rewrite [rG x]mx11_scalar [rG y]mx11_scalar -scalar_mxM !mxtrace_scalar. Qed. Lemma lin_char_prod I r (P : pred I) (x : I -> gT) : (forall i, P i -> x i \in G) -> xi (\prod_(i <- r | P i) x i)%g = \prod_(i <- r | P i) xi (x i). Proof. move=> Gx; elim/(big_load (fun y => y \in G)): _. elim/big_rec2: _ => [|i a y Pi [Gy <-]]; first by rewrite lin_char1. by rewrite groupM ?lin_charM ?Gx. Qed. Let xiMV x : x \in G -> xi x * xi (x^-1)%g = 1. Proof. by move=> Gx; rewrite -lin_charM ?groupV // mulgV lin_char1. Qed. Lemma lin_char_neq0 x : x \in G -> xi x != 0. Proof. by move/xiMV/(congr1 (predC1 0)); rewrite /= oner_eq0 mulf_eq0 => /norP[]. Qed. Lemma lin_charV x : x \in G -> xi x^-1%g = (xi x)^-1. Proof. by move=> Gx; rewrite -[_^-1]mulr1 -(xiMV Gx) mulKf ?lin_char_neq0. Qed. Lemma lin_charX x n : x \in G -> xi (x ^+ n)%g = xi x ^+ n. Proof. move=> Gx; elim: n => [|n IHn]; first exact: lin_char1. by rewrite expgS exprS lin_charM ?groupX ?IHn. Qed. Lemma lin_char_unity_root x : x \in G -> xi x ^+ #[x] = 1. 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]) //. by rewrite -normrX // lin_char_unity_root ?normr1. Qed. Lemma lin_charV_conj x : x \in G -> xi x^-1%g = (xi x)^*. Proof. move=> Gx; rewrite lin_charV // invC_norm mulrC normC_lin_char //. by rewrite expr1n divr1. Qed. Lemma lin_char_irr : xi \in irr G. Proof. case/andP: CFxi => /char_reprP[rG ->]; rewrite cfRepr1 pnatr_eq1 => /eqP n1. by apply/irr_reprP; exists rG => //; apply/mx_abs_irrW/linear_mx_abs_irr. Qed. Lemma mul_conjC_lin_char : xi * xi^*%CF = 1. Proof. apply/cfun_inP=> x Gx. by rewrite !cfunE cfun1E Gx -normCK normC_lin_char ?expr1n. Qed. Lemma lin_char_unitr : xi \in GRing.unit. Proof. by apply/unitrPr; exists xi^*%CF; apply: mul_conjC_lin_char. Qed. Lemma invr_lin_char : xi^-1 = xi^*%CF. Proof. by rewrite -[_^-1]mulr1 -mul_conjC_lin_char mulKr ?lin_char_unitr. Qed. Lemma fful_lin_char_inj : cfaithful xi -> {in G &, injective xi}. Proof. move=> fful_phi x y Gx Gy xi_xy; apply/eqP; rewrite eq_mulgV1 -in_set1. rewrite (subsetP fful_phi) // inE groupM ?groupV //=; apply/forallP=> z. have [Gz | G'z] := boolP (z \in G); last by rewrite !cfun0 ?groupMl ?groupV. by rewrite -mulgA lin_charM ?xi_xy -?lin_charM ?groupM ?groupV // mulKVg. Qed. End OneChar. Lemma cfAut_lin_char u (xi : 'CF(G)) : (cfAut u xi \is a linear_char) = (xi \is a linear_char). Proof. by rewrite qualifE cfAut_char; apply/andb_id2l=> /cfAut_char1->. Qed. Lemma cfConjC_lin_char (xi : 'CF(G)) : (xi^*%CF \is a linear_char) = (xi \is a linear_char). Proof. exact: cfAut_lin_char. Qed. Lemma card_Iirr_abelian : abelian G -> #|Iirr G| = #|G|. Proof. by rewrite card_ord NirrE card_classes_abelian => /eqP. Qed. Lemma card_Iirr_cyclic : cyclic G -> #|Iirr G| = #|G|. Proof. by move/cyclic_abelian/card_Iirr_abelian. Qed. Lemma char_abelianP : reflect (forall i : Iirr G, 'chi_i \is a linear_char) (abelian G). Proof. apply: (iffP idP) => [cGG i | CF_G]. rewrite qualifE irr_char /= irr1_degree. by rewrite irr_degree_abelian //; last apply: groupC. rewrite card_classes_abelian -NirrE -eqC_nat -irr_sum_square //. rewrite -{1}[Nirr G]card_ord -sumr_const; apply/eqP/eq_bigr=> i _. by rewrite lin_char1 ?expr1n ?CF_G. Qed. Lemma irr_repr_lin_char (i : Iirr G) x : x \in G -> 'chi_i \is a linear_char -> irr_repr (socle_of_Iirr i) x = ('chi_i x)%:M. Proof. move=> Gx CFi; rewrite -irrRepr cfunE Gx. move: (_ x); rewrite -[irr_degree _]natCK -irr1_degree lin_char1 //. by rewrite (natCK 1) => A; rewrite trace_mx11 -mx11_scalar. Qed. Fact linear_char_key B : pred_key (@linear_char B). Proof. by []. Qed. Canonical linear_char_keted B := KeyedQualifier (linear_char_key B). Fact linear_char_divr : divr_closed (@linear_char G). Proof. split=> [|chi xi Lchi Lxi]; first exact: cfun1_lin_char. rewrite invr_lin_char // qualifE cfunE. by rewrite rpredM ?lin_char1 ?mulr1 ?lin_charW //= cfConjC_lin_char. Qed. Canonical lin_char_mulrPred := MulrPred linear_char_divr. Canonical lin_char_divrPred := DivrPred linear_char_divr. Lemma irr_cyclic_lin i : cyclic G -> 'chi[G]_i \is a linear_char. Proof. by move/cyclic_abelian/char_abelianP. Qed. Lemma irr_prime_lin i : prime #|G| -> 'chi[G]_i \is a linear_char. Proof. by move/prime_cyclic/irr_cyclic_lin. Qed. End Linear. Prenex Implicits linear_char. Section OrthogonalityRelations. Variables aT gT : finGroupType. (* This is Isaacs, Lemma (2.15) *) Lemma repr_rsim_diag (G : {group gT}) f (rG : mx_representation algCF G f) x : x \in G -> let chi := cfRepr rG in exists e, [/\ (*a*) exists2 B, B \in unitmx & rG x = invmx B *m diag_mx e *m B, (*b*) (forall i, e 0 i ^+ #[x] = 1) /\ (forall i, `|e 0 i| = 1), (*c*) chi x = \sum_i e 0 i /\ `|chi x| <= chi 1%g & (*d*) chi x^-1%g = (chi x)^*]. Proof. move=> Gx; without loss cGG: G rG Gx / abelian G. have sXG: <[x]> \subset G by rewrite cycle_subG. move/(_ _ (subg_repr rG sXG) (cycle_id x) (cycle_abelian x)). by rewrite /= !cfunE !groupV Gx (cycle_id x) !group1. have [I U W simU W1 dxW]: mxsemisimple rG 1%:M. rewrite -(reducible_Socle1 (DecSocleType rG) (mx_Maschke _ (algC'G G))). exact: Socle_semisimple. have linU i: \rank (U i) = 1%N. by apply: mxsimple_abelian_linear cGG (simU i); apply: groupC. have castI: f = #|I|. by rewrite -(mxrank1 algCF f) -W1 (eqnP dxW) /= -sum1_card; apply/eq_bigr. pose B := \matrix_j nz_row (U (enum_val (cast_ord castI j))). have rowU i: (nz_row (U i) :=: U i)%MS. apply/eqmxP; rewrite -(geq_leqif (mxrank_leqif_eq (nz_row_sub _))) linU. by rewrite lt0n mxrank_eq0 (nz_row_mxsimple (simU i)). have unitB: B \in unitmx. rewrite -row_full_unit -sub1mx -W1; apply/sumsmx_subP=> i _. pose j := cast_ord (esym castI) (enum_rank i). by rewrite (submx_trans _ (row_sub j B)) // rowK cast_ordKV enum_rankK rowU. pose e := \row_j row j (B *m rG x *m invmx B) 0 j. have rGx: rG x = invmx B *m diag_mx e *m B. rewrite -mulmxA; apply: canRL (mulKmx unitB) _. apply/row_matrixP=> j; rewrite 2!row_mul; set u := row j B. have /sub_rVP[a def_ux]: (u *m rG x <= u)%MS. rewrite /u rowK rowU (eqmxMr _ (rowU _)). exact: (mxmoduleP (mxsimple_module (simU _))). rewrite def_ux [u]rowE scalemxAl; congr (_ *m _). apply/rowP=> k; rewrite 5!mxE !row_mul def_ux [u]rowE scalemxAl mulmxK //. by rewrite !mxE !eqxx !mulr_natr eq_sym. have exp_e j: e 0 j ^+ #[x] = 1. suffices: (diag_mx e j j) ^+ #[x] = (B *m rG (x ^+ #[x])%g *m invmx B) j j. by rewrite expg_order repr_mx1 mulmx1 mulmxV // [e]lock !mxE eqxx. elim: #[x] => [|n IHn]; first by rewrite repr_mx1 mulmx1 mulmxV // !mxE eqxx. 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. 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: (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. rewrite -!mulmxA mulKVmx // (mulmxA d'). suffices->: d' *m diag_mx e = 1%:M by rewrite mul1mx mulKmx. rewrite mulmx_diag -diag_const_mx; congr diag_mx; apply/rowP=> j. by rewrite [e]lock !mxE mulrC -normCK -lock norm1_e expr1n. Qed. Variables (A : {group aT}) (G : {group gT}). (* This is Isaacs, Lemma (2.15) (d). *) Lemma char_inv (chi : 'CF(G)) x : chi \is a character -> chi x^-1%g = (chi x)^*. Proof. case Gx: (x \in G); last by rewrite !cfun0 ?rmorph0 ?groupV ?Gx. by case/char_reprP=> rG ->; have [e [_ _ _]] := repr_rsim_diag rG Gx. Qed. Lemma irr_inv i x : 'chi[G]_i x^-1%g = ('chi_i x)^*. Proof. exact/char_inv/irr_char. Qed. (* This is Isaacs, Theorem (2.13). *) Theorem generalized_orthogonality_relation y (i j : Iirr G) : #|G|%:R^-1 * (\sum_(x in G) 'chi_i (x * y)%g * 'chi_j x^-1%g) = (i == j)%:R * ('chi_i y / 'chi_i 1%g). Proof. pose W := @socle_of_Iirr _ G; pose e k := Wedderburn_id (W k). pose aG := regular_repr algCF G. have [Gy | notGy] := boolP (y \in G); last first. rewrite cfun0 // mul0r big1 ?mulr0 // => x Gx. by rewrite cfun0 ?groupMl ?mul0r. transitivity (('chi_i).[e j *m aG y]%CF / 'chi_j 1%g). rewrite [e j]Wedderburn_id_expansion -scalemxAl xcfunZr -mulrA; congr (_ * _). rewrite mulmx_suml raddf_sum big_distrl; apply: eq_bigr => x Gx /=. rewrite -scalemxAl xcfunZr -repr_mxM // xcfunG ?groupM // mulrAC mulrC. by congr (_ * _); rewrite mulrC mulKf ?irr1_neq0. rewrite mulr_natl mulrb; have [<-{j} | neq_ij] := eqVneq. by congr (_ / _); rewrite xcfun_mul_id ?envelop_mx_id ?xcfunG. rewrite (xcfun_annihilate neq_ij) ?mul0r //. case/andP: (Wedderburn_ideal (W j)) => _; apply: submx_trans. by rewrite mem_mulsmx ?Wedderburn_id_mem ?envelop_mx_id. Qed. (* This is Isaacs, Corollary (2.14). *) Corollary first_orthogonality_relation (i j : Iirr G) : #|G|%:R^-1 * (\sum_(x in G) 'chi_i x * 'chi_j x^-1%g) = (i == j)%:R. Proof. have:= generalized_orthogonality_relation 1 i j. rewrite mulrA mulfK ?irr1_neq0 // => <-; congr (_ * _). by apply: eq_bigr => x; rewrite mulg1. Qed. (* The character table. *) Definition irr_class i := enum_val (cast_ord (NirrE G) i). Definition class_Iirr xG := cast_ord (esym (NirrE G)) (enum_rank_in (classes1 G) xG). Local Notation c := irr_class. Local Notation g i := (repr (c i)). Local Notation iC := class_Iirr. Definition character_table := \matrix_(i, j) 'chi[G]_i (g j). Local Notation X := character_table. Lemma irr_classP i : c i \in classes G. Proof. exact: enum_valP. Qed. Lemma repr_irr_classK i : g i ^: G = c i. Proof. by case/repr_classesP: (irr_classP i). Qed. Lemma irr_classK : cancel c iC. Proof. by move=> i; rewrite /iC enum_valK_in cast_ordK. Qed. Lemma class_IirrK : {in classes G, cancel iC c}. Proof. by move=> xG GxG; rewrite /c cast_ordKV enum_rankK_in. Qed. Lemma reindex_irr_class R idx (op : @Monoid.com_law R idx) F : \big[op/idx]_(xG in classes G) F xG = \big[op/idx]_i F (c i). Proof. rewrite (reindex c); first by apply: eq_bigl => i; apply: enum_valP. by exists iC; [apply: in1W; apply: irr_classK | apply: class_IirrK]. Qed. (* The explicit value of the inverse is needed for the proof of the second *) (* orthogonality relation. *) Let X' := \matrix_(i, j) (#|'C_G[g i]|%:R^-1 * ('chi[G]_j (g i))^*). Let XX'_1: X *m X' = 1%:M. Proof. apply/matrixP=> i j; rewrite !mxE -first_orthogonality_relation mulr_sumr. rewrite sum_by_classes => [|u v Gu Gv]; last by rewrite -conjVg !cfunJ. rewrite reindex_irr_class /=; apply/esym/eq_bigr=> k _. rewrite !mxE irr_inv // -/(g k) -divg_index -indexgI /=. rewrite (char0_natf_div Cchar) ?dvdn_indexg // index_cent1 invfM invrK. by rewrite repr_irr_classK mulrCA mulrA mulrCA. Qed. Lemma character_table_unit : X \in unitmx. Proof. by case/mulmx1_unit: XX'_1. Qed. Let uX := character_table_unit. (* This is Isaacs, Theorem (2.18). *) Theorem second_orthogonality_relation x y : y \in G -> \sum_i 'chi[G]_i x * ('chi_i y)^* = #|'C_G[x]|%:R *+ (x \in y ^: G). Proof. move=> Gy; pose i_x := iC (x ^: G); pose i_y := iC (y ^: G). have [Gx | notGx] := boolP (x \in G); last first. rewrite (contraNF (subsetP _ x) notGx) ?class_subG ?big1 // => i _. by rewrite cfun0 ?mul0r. transitivity ((#|'C_G[repr (y ^: G)]|%:R *: (X' *m X)) i_y i_x). rewrite scalemxAl !mxE; apply: eq_bigr => k _; rewrite !mxE mulrC -!mulrA. by rewrite !class_IirrK ?mem_classes // !cfun_repr mulVKf ?neq0CG. rewrite mulmx1C // !mxE -!divg_index !(index_cent1, =^~ indexgI). rewrite (class_eqP (mem_repr y _)) ?class_refl // mulr_natr. rewrite (can_in_eq class_IirrK) ?mem_classes //. have [-> | not_yGx] := eqVneq; first by rewrite class_refl. by rewrite [x \in _](contraNF _ not_yGx) // => /class_eqP->. Qed. Lemma eq_irr_mem_classP x y : y \in G -> reflect (forall i, 'chi[G]_i x = 'chi_i y) (x \in y ^: G). Proof. move=> Gy; apply: (iffP idP) => [/imsetP[z Gz ->] i | xGy]; first exact: cfunJ. have Gx: x \in G. congr is_true: Gy; apply/eqP; rewrite -(can_eq oddb) -eqC_nat -!cfun1E. by rewrite -irr0 xGy. congr is_true: (class_refl G x); apply/eqP; rewrite -(can_eq oddb). rewrite -(eqn_pmul2l (cardG_gt0 'C_G[x])) -eqC_nat !mulrnA; apply/eqP. by rewrite -!second_orthogonality_relation //; apply/eq_bigr=> i _; rewrite xGy. Qed. (* This is Isaacs, Theorem (6.32) (due to Brauer). *) Lemma card_afix_irr_classes (ito : action A (Iirr G)) (cto : action A _) a : a \in A -> [acts A, on classes G | cto] -> (forall i x y, x \in G -> y \in cto (x ^: G) a -> 'chi_i x = 'chi_(ito i a) y) -> #|'Fix_ito[a]| = #|'Fix_(classes G | cto)[a]|. Proof. move=> Aa actsAG stabAchi; apply/eqP; rewrite -eqC_nat; apply/eqP. have [[cP cK] iCK] := (irr_classP, irr_classK, class_IirrK). pose icto b i := iC (cto (c i) b). have Gca i: cto (c i) a \in classes G by rewrite (acts_act actsAG). have inj_qa: injective (icto a). by apply: can_inj (icto a^-1%g) _ => i; rewrite /icto iCK ?actKin ?cK. pose Pa : 'M[algC]_(Nirr G) := perm_mx (actperm ito a). pose qa := perm inj_qa; pose Qa : 'M[algC]_(Nirr G) := perm_mx qa^-1^-1%g. transitivity (\tr Pa). rewrite -sumr_const big_mkcond; apply: eq_bigr => i _. by rewrite !mxE permE inE sub1set inE; case: ifP. symmetry; transitivity (\tr Qa). rewrite cardsE -sumr_const -big_filter_cond big_mkcond big_filter /=. rewrite reindex_irr_class; apply: eq_bigr => i _; rewrite !mxE invgK permE. by rewrite inE sub1set inE -(can_eq cK) iCK //; case: ifP. rewrite -[Pa](mulmxK uX) -[Qa](mulKmx uX) mxtrace_mulC; congr (\tr(_ *m _)). rewrite -row_permE -col_permE; apply/matrixP=> i j; rewrite !mxE. rewrite -{2}[j](permKV qa); move: {j}(_ j) => j; rewrite !permE iCK //. apply: stabAchi; first by case/repr_classesP: (cP j). by rewrite repr_irr_classK (mem_repr_classes (Gca _)). Qed. End OrthogonalityRelations. Prenex Implicits irr_class class_Iirr irr_classK. Arguments class_IirrK {gT G%G} [xG%g] GxG : rename. Arguments character_table {gT} G%g. Section InnerProduct. Variable (gT : finGroupType) (G : {group gT}). Lemma cfdot_irr i j : '['chi_i, 'chi_j]_G = (i == j)%:R. Proof. rewrite -first_orthogonality_relation; congr (_ * _). by apply: eq_bigr => x Gx; rewrite irr_inv. Qed. Lemma cfnorm_irr i : '['chi[G]_i] = 1. Proof. by rewrite cfdot_irr eqxx. Qed. Lemma irr_orthonormal : orthonormal (irr G). Proof. apply/orthonormalP; split; first exact: free_uniq (irr_free G). move=> _ _ /irrP[i ->] /irrP[j ->]. by rewrite cfdot_irr (inj_eq irr_inj). Qed. Lemma coord_cfdot phi i : coord (irr G) i phi = '[phi, 'chi_i]. Proof. rewrite {2}(coord_basis (irr_basis G) (memvf phi)). rewrite cfdot_suml (bigD1 i) // cfdotZl /= -tnth_nth cfdot_irr eqxx mulr1. rewrite big1 ?addr0 // => j neq_ji; rewrite cfdotZl /= -tnth_nth cfdot_irr. by rewrite (negbTE neq_ji) mulr0. Qed. Lemma cfun_sum_cfdot phi : phi = \sum_i '[phi, 'chi_i]_G *: 'chi_i. Proof. rewrite {1}(coord_basis (irr_basis G) (memvf phi)). by apply: eq_bigr => i _; rewrite coord_cfdot -tnth_nth. Qed. Lemma cfdot_sum_irr phi psi : '[phi, psi]_G = \sum_i '[phi, 'chi_i] * '[psi, 'chi_i]^*. Proof. rewrite {1}[phi]cfun_sum_cfdot cfdot_suml; apply: eq_bigr => i _. by rewrite cfdotZl -cfdotC. Qed. Lemma Cnat_cfdot_char_irr i phi : phi \is a character -> '[phi, 'chi_i]_G \in Cnat. Proof. by move/forallP/(_ i); rewrite coord_cfdot. Qed. Lemma cfdot_char_r phi chi : chi \is a character -> '[phi, chi]_G = \sum_i '[phi, 'chi_i] * '[chi, 'chi_i]. Proof. move=> Nchi; rewrite cfdot_sum_irr; apply: eq_bigr => i _; congr (_ * _). by rewrite conj_Cnat ?Cnat_cfdot_char_irr. Qed. Lemma Cnat_cfdot_char chi xi : chi \is a character -> xi \is a character -> '[chi, xi]_G \in Cnat. Proof. move=> Nchi Nxi; rewrite cfdot_char_r ?rpred_sum // => i _. by rewrite rpredM ?Cnat_cfdot_char_irr. Qed. Lemma cfdotC_char chi xi : chi \is a character-> xi \is a character -> '[chi, xi]_G = '[xi, chi]. Proof. by move=> Nchi Nxi; rewrite cfdotC conj_Cnat ?Cnat_cfdot_char. Qed. Lemma irrEchar chi : (chi \in irr G) = (chi \is a character) && ('[chi] == 1). Proof. apply/irrP/andP=> [[i ->] | [Nchi]]; first by rewrite irr_char cfnorm_irr. rewrite cfdot_sum_irr => /eqP/Cnat_sum_eq1[i _| i [_ ci1 cj0]]. by rewrite rpredM // ?conj_Cnat ?Cnat_cfdot_char_irr. exists i; rewrite [chi]cfun_sum_cfdot (bigD1 i) //=. rewrite -(@normr_idP _ _ (@Cnat_ge0 _ (Cnat_cfdot_char_irr i Nchi))). rewrite normC_def {}ci1 sqrtC1 scale1r big1 ?addr0 // => j neq_ji. by rewrite (('[_] =P 0) _) ?scale0r // -normr_eq0 normC_def cj0 ?sqrtC0. Qed. Lemma irrWchar chi : chi \in irr G -> chi \is a character. Proof. by rewrite irrEchar => /andP[]. Qed. Lemma irrWnorm chi : chi \in irr G -> '[chi] = 1. Proof. by rewrite irrEchar => /andP[_ /eqP]. Qed. Lemma mul_lin_irr xi chi : xi \is a linear_char -> chi \in irr G -> xi * chi \in irr G. Proof. move=> Lxi; rewrite !irrEchar => /andP[Nphi /eqP <-]. rewrite rpredM // ?lin_charW //=; apply/eqP; congr (_ * _). apply: eq_bigr => x Gx; rewrite !cfunE rmorphM mulrACA -(lin_charV_conj Lxi) //. by rewrite -lin_charM ?groupV // mulgV lin_char1 ?mul1r. Qed. Lemma eq_scaled_irr a b i j : (a *: 'chi[G]_i == b *: 'chi_j) = (a == b) && ((a == 0) || (i == j)). Proof. apply/eqP/andP=> [|[/eqP-> /pred2P[]-> //]]; last by rewrite !scale0r. move/(congr1 (cfdotr 'chi__)) => /= eq_ai_bj. move: {eq_ai_bj}(eq_ai_bj i) (esym (eq_ai_bj j)); rewrite !cfdotZl !cfdot_irr. by rewrite !mulr_natr !mulrb !eqxx eq_sym orbC; case: ifP => _ -> //= ->. Qed. Lemma eq_signed_irr (s t : bool) i j : ((-1) ^+ s *: 'chi[G]_i == (-1) ^+ t *: 'chi_j) = (s == t) && (i == j). Proof. by rewrite eq_scaled_irr signr_eq0 (inj_eq signr_inj). Qed. Lemma eq_scale_irr a (i j : Iirr G) : (a *: 'chi_i == a *: 'chi_j) = (a == 0) || (i == j). Proof. by rewrite eq_scaled_irr eqxx. Qed. Lemma eq_addZ_irr a b (i j r t : Iirr G) : (a *: 'chi_i + b *: 'chi_j == a *: 'chi_r + b *: 'chi_t) = [|| [&& (a == 0) || (i == r) & (b == 0) || (j == t)], [&& i == t, j == r & a == b] | [&& i == j, r == t & a == - b]]. Proof. rewrite -!eq_scale_irr; apply/eqP/idP; last first. case/orP; first by case/andP=> /eqP-> /eqP->. case/orP=> /and3P[/eqP-> /eqP-> /eqP->]; first by rewrite addrC. by rewrite !scaleNr !addNr. have [-> /addrI/eqP-> // | /=] := eqVneq. rewrite eq_scale_irr => /norP[/negP nz_a /negPf neq_ir]. move/(congr1 (cfdotr 'chi__))/esym/eqP => /= eq_cfdot. move: {eq_cfdot}(eq_cfdot i) (eq_cfdot r); rewrite eq_sym !cfdotDl !cfdotZl. rewrite !cfdot_irr !mulr_natr !mulrb !eqxx -!(eq_sym i) neq_ir !add0r. have [<- _ | _] := i =P t; first by rewrite neq_ir addr0; case: ifP => // _ ->. rewrite 2!fun_if if_arg addr0 addr_eq0; case: eqP => //= <- ->. by rewrite neq_ir 2!fun_if if_arg eq_sym addr0; case: ifP. Qed. Lemma eq_subZnat_irr (a b : nat) (i j r t : Iirr G) : (a%:R *: 'chi_i - b%:R *: 'chi_j == a%:R *: 'chi_r - b%:R *: 'chi_t) = [|| a == 0%N | i == r] && [|| b == 0%N | j == t] || [&& i == j, r == t & a == b]. Proof. rewrite -!scaleNr eq_addZ_irr oppr_eq0 opprK -addr_eq0 -natrD eqr_nat. by rewrite !pnatr_eq0 addn_eq0; case: a b => [|a] [|b]; rewrite ?andbF. Qed. End InnerProduct. Section IrrConstt. Variable (gT : finGroupType) (G H : {group gT}). Lemma char1_ge_norm (chi : 'CF(G)) x : chi \is a character -> `|chi x| <= chi 1%g. Proof. case/char_reprP=> rG ->; case Gx: (x \in G); last first. by rewrite cfunE cfRepr1 Gx normr0 ler0n. by have [e [_ _ []]] := repr_rsim_diag rG Gx. Qed. Lemma max_cfRepr_norm_scalar n (rG : mx_representation algCF G n) x : x \in G -> `|cfRepr rG x| = cfRepr rG 1%g -> exists2 c, `|c| = 1 & rG x = c%:M. Proof. move=> Gx; have [e [[B uB def_x] [_ e1] [-> _] _]] := repr_rsim_diag rG Gx. rewrite cfRepr1 -[n in n%:R]card_ord -sumr_const -(eq_bigr _ (in1W e1)). case/normC_sum_eq1=> [i _ | c /eqP norm_c_1 def_e]; first by rewrite e1. have{} def_e: e = const_mx c by apply/rowP=> i; rewrite mxE def_e ?andbT. by exists c => //; rewrite def_x def_e diag_const_mx scalar_mxC mulmxKV. Qed. Lemma max_cfRepr_mx1 n (rG : mx_representation algCF G n) x : x \in G -> cfRepr rG x = cfRepr rG 1%g -> rG x = 1%:M. Proof. move=> Gx kerGx; have [|c _ def_x] := @max_cfRepr_norm_scalar n rG x Gx. by rewrite kerGx cfRepr1 normr_nat. move/eqP: kerGx; rewrite cfRepr1 cfunE Gx {rG}def_x mxtrace_scalar. case: n => [_|n]; first by rewrite ![_%:M]flatmx0. rewrite mulrb -subr_eq0 -mulrnBl -mulr_natl mulf_eq0 pnatr_eq0 /=. by rewrite subr_eq0 => /eqP->. Qed. Definition irr_constt (B : {set gT}) phi := [pred i | '[phi, 'chi_i]_B != 0]. Lemma irr_consttE i phi : (i \in irr_constt phi) = ('[phi, 'chi_i]_G != 0). Proof. by []. Qed. Lemma constt_charP (i : Iirr G) chi : chi \is a character -> reflect (exists2 chi', chi' \is a character & chi = 'chi_i + chi') (i \in irr_constt chi). Proof. move=> Nchi; apply: (iffP idP) => [i_in_chi| [chi' Nchi' ->]]; last first. rewrite inE /= cfdotDl cfdot_irr eqxx -(eqP (Cnat_cfdot_char_irr i Nchi')). by rewrite -natrD pnatr_eq0. exists (chi - 'chi_i); last by rewrite addrC subrK. apply/forallP=> j; rewrite coord_cfdot cfdotBl cfdot_irr. have [<- | _] := eqP; last by rewrite subr0 Cnat_cfdot_char_irr. have := i_in_chi; rewrite inE /= -(eqP (Cnat_cfdot_char_irr i Nchi)) pnatr_eq0. by case: (truncC _) => // n _; rewrite mulrSr addrK ?isNatC_nat. Qed. Lemma cfun_sum_constt (phi : 'CF(G)) : phi = \sum_(i in irr_constt phi) '[phi, 'chi_i] *: 'chi_i. Proof. rewrite {1}[phi]cfun_sum_cfdot (bigID [pred i | '[phi, 'chi_i] == 0]) /=. by rewrite big1 ?add0r // => i /eqP->; rewrite scale0r. Qed. Lemma neq0_has_constt (phi : 'CF(G)) : phi != 0 -> exists i, i \in irr_constt phi. Proof. move=> nz_phi; apply/existsP; apply: contra nz_phi => /pred0P phi0. by rewrite [phi]cfun_sum_constt big_pred0. Qed. Lemma constt_irr i : irr_constt 'chi[G]_i =i pred1 i. Proof. by move=> j; rewrite !inE cfdot_irr pnatr_eq0 (eq_sym j); case: (i == j). Qed. Lemma char1_ge_constt (i : Iirr G) chi : chi \is a character -> i \in irr_constt chi -> 'chi_i 1%g <= chi 1%g. Proof. move=> {chi} _ /constt_charP[// | chi Nchi ->]. by rewrite cfunE addrC -subr_ge0 addrK char1_ge0. Qed. Lemma constt_ortho_char (phi psi : 'CF(G)) i j : phi \is a character -> psi \is a character -> i \in irr_constt phi -> j \in irr_constt psi -> '[phi, psi] = 0 -> '['chi_i, 'chi_j] = 0. Proof. move=> _ _ /constt_charP[//|phi1 Nphi1 ->] /constt_charP[//|psi1 Npsi1 ->]. rewrite cfdot_irr; case: eqP => // -> /eqP/idPn[]. rewrite cfdotDl !cfdotDr cfnorm_irr -addrA gt_eqF ?ltr_paddr ?ltr01 //. by rewrite Cnat_ge0 ?rpredD ?Cnat_cfdot_char ?irr_char. Qed. End IrrConstt. Arguments irr_constt {gT B%g} phi%CF. Section Kernel. Variable (gT : finGroupType) (G : {group gT}). Implicit Types (phi chi xi : 'CF(G)) (H : {group gT}). Lemma cfker_repr n (rG : mx_representation algCF G n) : cfker (cfRepr rG) = rker rG. Proof. apply/esym/setP=> x; rewrite inE mul1mx /=. case Gx: (x \in G); last by rewrite inE Gx. apply/eqP/idP=> Kx; last by rewrite max_cfRepr_mx1 // cfker1. rewrite inE Gx; apply/forallP=> y; rewrite !cfunE !mulrb groupMl //. by case: ifP => // Gy; rewrite repr_mxM // Kx mul1mx. Qed. Lemma cfkerEchar chi : chi \is a character -> cfker chi = [set x in G | chi x == chi 1%g]. Proof. move=> Nchi; apply/setP=> x; apply/idP/setIdP=> [Kx | [Gx /eqP chi_x]]. by rewrite (subsetP (cfker_sub chi)) // cfker1. case/char_reprP: Nchi => rG -> in chi_x *; rewrite inE Gx; apply/forallP=> y. rewrite !cfunE groupMl // !mulrb; case: ifP => // Gy. by rewrite repr_mxM // max_cfRepr_mx1 ?mul1mx. Qed. Lemma cfker_nzcharE chi : chi \is a character -> chi != 0 -> cfker chi = [set x | chi x == chi 1%g]. Proof. move=> Nchi nzchi; apply/setP=> x; rewrite cfkerEchar // !inE andb_idl //. by apply: contraLR => /cfun0-> //; rewrite eq_sym char1_eq0. Qed. Lemma cfkerEirr i : cfker 'chi[G]_i = [set x | 'chi_i x == 'chi_i 1%g]. Proof. by rewrite cfker_nzcharE ?irr_char ?irr_neq0. Qed. Lemma cfker_irr0 : cfker 'chi[G]_0 = G. Proof. by rewrite irr0 cfker_cfun1. Qed. Lemma cfaithful_reg : cfaithful (cfReg G). Proof. apply/subsetP=> x; rewrite cfkerEchar ?cfReg_char // !inE !cfRegE eqxx. by case/andP=> _; apply: contraLR => /negbTE->; rewrite eq_sym neq0CG. Qed. Lemma cfkerE chi : chi \is a character -> cfker chi = G :&: \bigcap_(i in irr_constt chi) cfker 'chi_i. Proof. move=> Nchi; rewrite cfkerEchar //; apply/setP=> x; rewrite !inE. apply: andb_id2l => Gx; rewrite {1 2}[chi]cfun_sum_constt !sum_cfunE. apply/eqP/bigcapP=> [Kx i Ci | Kx]; last first. by apply: eq_bigr => i /Kx Kx_i; rewrite !cfunE cfker1. rewrite cfkerEirr inE /= -(inj_eq (mulfI Ci)). have:= (normC_sum_upper _ Kx) i; rewrite !cfunE => -> // {Ci}i _. have chi_i_ge0: 0 <= '[chi, 'chi_i]. by rewrite Cnat_ge0 ?Cnat_cfdot_char_irr. by rewrite !cfunE normrM (normr_idP _) ?ler_wpmul2l ?char1_ge_norm ?irr_char. Qed. Lemma TI_cfker_irr : \bigcap_i cfker 'chi[G]_i = [1]. Proof. apply/trivgP; apply: subset_trans cfaithful_reg; rewrite cfkerE ?cfReg_char //. rewrite subsetI (bigcap_min 0) //=; last by rewrite cfker_irr0. by apply/bigcapsP=> i _; rewrite bigcap_inf. Qed. Lemma cfker_constt i chi : chi \is a character -> i \in irr_constt chi -> cfker chi \subset cfker 'chi[G]_i. Proof. by move=> Nchi Ci; rewrite cfkerE ?subIset ?(bigcap_min i) ?orbT. Qed. Section KerLin. Variable xi : 'CF(G). Hypothesis lin_xi : xi \is a linear_char. Let Nxi: xi \is a character. Proof. by have [] := andP lin_xi. Qed. Lemma lin_char_der1 : G^`(1)%g \subset cfker xi. Proof. rewrite gen_subG /=; apply/subsetP=> _ /imset2P[x y Gx Gy ->]. rewrite cfkerEchar // inE groupR //= !lin_charM ?lin_charV ?in_group //. by rewrite mulrCA mulKf ?mulVf ?lin_char_neq0 // lin_char1. Qed. Lemma cforder_lin_char : #[xi]%CF = exponent (G / cfker xi)%g. Proof. apply/eqP; rewrite eqn_dvd; apply/andP; split. apply/dvdn_cforderP=> x Gx; rewrite -lin_charX // -cfQuoEker ?groupX //. rewrite morphX ?(subsetP (cfker_norm xi)) //= expg_exponent ?mem_quotient //. by rewrite cfQuo1 ?cfker_normal ?lin_char1. have abGbar: abelian (G / cfker xi) := sub_der1_abelian lin_char_der1. have [_ /morphimP[x Nx Gx ->] ->] := exponent_witness (abelian_nil abGbar). rewrite order_dvdn -morphX //= coset_id cfkerEchar // !inE groupX //=. by rewrite lin_charX ?lin_char1 // (dvdn_cforderP _ _ _). Qed. Lemma cforder_lin_char_dvdG : #[xi]%CF %| #|G|. Proof. by rewrite cforder_lin_char (dvdn_trans (exponent_dvdn _)) ?dvdn_morphim. Qed. Lemma cforder_lin_char_gt0 : (0 < #[xi]%CF)%N. Proof. by rewrite cforder_lin_char exponent_gt0. Qed. End KerLin. End Kernel. Section Restrict. Variable (gT : finGroupType) (G H : {group gT}). Lemma cfRepr_sub n (rG : mx_representation algCF G n) (sHG : H \subset G) : cfRepr (subg_repr rG sHG) = 'Res[H] (cfRepr rG). Proof. by apply/cfun_inP => x Hx; rewrite cfResE // !cfunE Hx (subsetP sHG). Qed. Lemma cfRes_char chi : chi \is a character -> 'Res[H, G] chi \is a character. Proof. have [sHG | not_sHG] := boolP (H \subset G). by case/char_reprP=> rG ->; rewrite -(cfRepr_sub rG sHG) cfRepr_char. by move/Cnat_char1=> Nchi1; rewrite cfResEout // rpredZ_Cnat ?rpred1. Qed. Lemma cfRes_eq0 phi : phi \is a character -> ('Res[H, G] phi == 0) = (phi == 0). Proof. by move=> Nchi; rewrite -!char1_eq0 ?cfRes_char // cfRes1. Qed. Lemma cfRes_lin_char chi : chi \is a linear_char -> 'Res[H, G] chi \is a linear_char. Proof. by case/andP=> Nchi; rewrite qualifE cfRes_char ?cfRes1. Qed. Lemma Res_irr_neq0 i : 'Res[H, G] 'chi_i != 0. Proof. by rewrite cfRes_eq0 ?irr_neq0 ?irr_char. Qed. Lemma cfRes_lin_lin (chi : 'CF(G)) : chi \is a character -> 'Res[H] chi \is a linear_char -> chi \is a linear_char. Proof. by rewrite !qualifE cfRes1 => -> /andP[]. Qed. Lemma cfRes_irr_irr chi : chi \is a character -> 'Res[H] chi \in irr H -> chi \in irr G. Proof. have [sHG /char_reprP[rG ->] | not_sHG Nchi] := boolP (H \subset G). rewrite -(cfRepr_sub _ sHG) => /irr_reprP[rH irrH def_rH]; apply/irr_reprP. suffices /subg_mx_irr: mx_irreducible (subg_repr rG sHG) by exists rG. by apply: mx_rsim_irr irrH; apply/cfRepr_rsimP/eqP. rewrite cfResEout // => /irrP[j Dchi_j]; apply/lin_char_irr/cfRes_lin_lin=> //. suffices j0: j = 0 by rewrite cfResEout // Dchi_j j0 irr0 rpred1. apply: contraNeq (irr1_neq0 j) => nz_j. have:= xcfun_id j 0; rewrite -Dchi_j cfunE xcfunZl -irr0 xcfun_id eqxx => ->. by rewrite (negPf nz_j). Qed. Definition Res_Iirr (A B : {set gT}) i := cfIirr ('Res[B, A] 'chi_i). Lemma Res_Iirr0 : Res_Iirr H (0 : Iirr G) = 0. Proof. by rewrite /Res_Iirr irr0 rmorph1 -irr0 irrK. Qed. Lemma lin_Res_IirrE i : 'chi[G]_i 1%g = 1 -> 'chi_(Res_Iirr H i) = 'Res 'chi_i. Proof. move=> chi1; rewrite cfIirrE ?lin_char_irr ?cfRes_lin_char //. by rewrite qualifE irr_char /= chi1. Qed. End Restrict. Arguments Res_Iirr {gT A%g} B%g i%R. Section MoreConstt. Variables (gT : finGroupType) (G H : {group gT}). Lemma constt_Ind_Res i j : i \in irr_constt ('Ind[G] 'chi_j) = (j \in irr_constt ('Res[H] 'chi_i)). Proof. by rewrite !irr_consttE cfdotC conjC_eq0 -cfdot_Res_l. Qed. Lemma cfdot_Res_ge_constt i j psi : psi \is a character -> j \in irr_constt psi -> '['Res[H, G] 'chi_j, 'chi_i] <= '['Res[H] psi, 'chi_i]. Proof. move=> {psi} _ /constt_charP[// | psi Npsi ->]. rewrite linearD cfdotDl addrC -subr_ge0 addrK Cnat_ge0 //=. by rewrite Cnat_cfdot_char_irr // cfRes_char. Qed. 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 eq_le => {1}<-. rewrite cfdot_Res_ge_constt ?Cnat_ge0 ?Cnat_cfdot_char_irr //. by rewrite cfRes_char ?irr_char. Qed. End MoreConstt. Section Morphim. Variables (aT rT : finGroupType) (G D : {group aT}) (f : {morphism D >-> rT}). Implicit Type chi : 'CF(f @* G). Lemma cfRepr_morphim n (rfG : mx_representation algCF (f @* G) n) sGD : cfRepr (morphim_repr rfG sGD) = cfMorph (cfRepr rfG). Proof. apply/cfun_inP=> x Gx; have Dx: x \in D := subsetP sGD x Gx. by rewrite cfMorphE // !cfunE ?mem_morphim ?Gx. Qed. Lemma cfMorph_char chi : chi \is a character -> cfMorph chi \is a character. Proof. have [sGD /char_reprP[rfG ->] | outGD Nchi] := boolP (G \subset D); last first. by rewrite cfMorphEout // rpredZ_Cnat ?rpred1 ?Cnat_char1. apply/char_reprP; exists (Representation (morphim_repr rfG sGD)). by rewrite cfRepr_morphim. Qed. Lemma cfMorph_lin_char chi : chi \is a linear_char -> cfMorph chi \is a linear_char. Proof. by case/andP=> Nchi; rewrite qualifE cfMorph1 cfMorph_char. Qed. Lemma cfMorph_charE chi : G \subset D -> (cfMorph chi \is a character) = (chi \is a character). Proof. move=> sGD; apply/idP/idP=> [/char_reprP[[n rG] /=Dfchi] | /cfMorph_char//]. pose H := 'ker_G f; have kerH: H \subset rker rG. by rewrite -cfker_repr -Dfchi cfker_morph // setIS // ker_sub_pre. have nHG: G \subset 'N(H) by rewrite normsI // (subset_trans sGD) ?ker_norm. have [h injh im_h] := first_isom_loc f sGD; rewrite -/H in h injh im_h. have DfG: invm injh @*^-1 (G / H) == (f @* G)%g by rewrite morphpre_invm im_h. pose rfG := eqg_repr (morphpre_repr _ (quo_repr kerH nHG)) DfG. apply/char_reprP; exists (Representation rfG). apply/cfun_inP=> _ /morphimP[x Dx Gx ->]; rewrite -cfMorphE // Dfchi !cfunE Gx. pose xH := coset H x; have GxH: xH \in (G / H)%g by apply: mem_quotient. suffices Dfx: f x = h xH by rewrite mem_morphim //= Dfx invmE ?quo_repr_coset. by apply/set1_inj; rewrite -?morphim_set1 ?im_h ?(subsetP nHG) ?sub1set. Qed. Lemma cfMorph_lin_charE chi : G \subset D -> (cfMorph chi \is a linear_char) = (chi \is a linear_char). Proof. by rewrite qualifE cfMorph1 => /cfMorph_charE->. Qed. Lemma cfMorph_irr chi : G \subset D -> (cfMorph chi \in irr G) = (chi \in irr (f @* G)). Proof. by move=> sGD; rewrite !irrEchar cfMorph_charE // cfMorph_iso. Qed. Definition morph_Iirr i := cfIirr (cfMorph 'chi[f @* G]_i). Lemma morph_Iirr0 : morph_Iirr 0 = 0. Proof. by rewrite /morph_Iirr irr0 rmorph1 -irr0 irrK. Qed. Hypothesis sGD : G \subset D. Lemma morph_IirrE i : 'chi_(morph_Iirr i) = cfMorph 'chi_i. Proof. by rewrite cfIirrE ?cfMorph_irr ?mem_irr. Qed. Lemma morph_Iirr_inj : injective morph_Iirr. Proof. by move=> i j eq_ij; apply/irr_inj/cfMorph_inj; rewrite // -!morph_IirrE eq_ij. Qed. Lemma morph_Iirr_eq0 i : (morph_Iirr i == 0) = (i == 0). Proof. by rewrite -!irr_eq1 morph_IirrE cfMorph_eq1. Qed. End Morphim. Section Isom. Variables (aT rT : finGroupType) (G : {group aT}) (f : {morphism G >-> rT}). Variables (R : {group rT}) (isoGR : isom G R f). Implicit Type chi : 'CF(G). Lemma cfIsom_char chi : (cfIsom isoGR chi \is a character) = (chi \is a character). Proof. rewrite [cfIsom _]locked_withE cfMorph_charE //. by rewrite (isom_im (isom_sym _)) cfRes_id. Qed. Lemma cfIsom_lin_char chi : (cfIsom isoGR chi \is a linear_char) = (chi \is a linear_char). Proof. by rewrite qualifE cfIsom_char cfIsom1. Qed. Lemma cfIsom_irr chi : (cfIsom isoGR chi \in irr R) = (chi \in irr G). Proof. by rewrite !irrEchar cfIsom_char cfIsom_iso. Qed. Definition isom_Iirr i := cfIirr (cfIsom isoGR 'chi_i). Lemma isom_IirrE i : 'chi_(isom_Iirr i) = cfIsom isoGR 'chi_i. Proof. by rewrite cfIirrE ?cfIsom_irr ?mem_irr. Qed. Lemma isom_Iirr_inj : injective isom_Iirr. Proof. by move=> i j eqij; apply/irr_inj/(cfIsom_inj isoGR); rewrite -!isom_IirrE eqij. Qed. Lemma isom_Iirr_eq0 i : (isom_Iirr i == 0) = (i == 0). Proof. by rewrite -!irr_eq1 isom_IirrE cfIsom_eq1. Qed. Lemma isom_Iirr0 : isom_Iirr 0 = 0. Proof. by apply/eqP; rewrite isom_Iirr_eq0. Qed. End Isom. Arguments isom_Iirr_inj {aT rT G f R} isoGR [i1 i2] : rename. Section IsomInv. Variables (aT rT : finGroupType) (G : {group aT}) (f : {morphism G >-> rT}). Variables (R : {group rT}) (isoGR : isom G R f). Lemma isom_IirrK : cancel (isom_Iirr isoGR) (isom_Iirr (isom_sym isoGR)). Proof. by move=> i; apply: irr_inj; rewrite !isom_IirrE cfIsomK. Qed. Lemma isom_IirrKV : cancel (isom_Iirr (isom_sym isoGR)) (isom_Iirr isoGR). Proof. by move=> i; apply: irr_inj; rewrite !isom_IirrE cfIsomKV. Qed. End IsomInv. Section Sdprod. Variables (gT : finGroupType) (K H G : {group gT}). Hypothesis defG : K ><| H = G. Let nKG: G \subset 'N(K). Proof. by have [/andP[]] := sdprod_context defG. Qed. Lemma cfSdprod_char chi : (cfSdprod defG chi \is a character) = (chi \is a character). Proof. by rewrite unlock cfMorph_charE // cfIsom_char. Qed. Lemma cfSdprod_lin_char chi : (cfSdprod defG chi \is a linear_char) = (chi \is a linear_char). Proof. by rewrite qualifE cfSdprod_char cfSdprod1. Qed. Lemma cfSdprod_irr chi : (cfSdprod defG chi \in irr G) = (chi \in irr H). Proof. by rewrite !irrEchar cfSdprod_char cfSdprod_iso. Qed. Definition sdprod_Iirr j := cfIirr (cfSdprod defG 'chi_j). Lemma sdprod_IirrE j : 'chi_(sdprod_Iirr j) = cfSdprod defG 'chi_j. Proof. by rewrite cfIirrE ?cfSdprod_irr ?mem_irr. Qed. Lemma sdprod_IirrK : cancel sdprod_Iirr (Res_Iirr H). Proof. by move=> j; rewrite /Res_Iirr sdprod_IirrE cfSdprodK irrK. Qed. Lemma sdprod_Iirr_inj : injective sdprod_Iirr. Proof. exact: can_inj sdprod_IirrK. Qed. Lemma sdprod_Iirr_eq0 i : (sdprod_Iirr i == 0) = (i == 0). Proof. by rewrite -!irr_eq1 sdprod_IirrE cfSdprod_eq1. Qed. Lemma sdprod_Iirr0 : sdprod_Iirr 0 = 0. Proof. by apply/eqP; rewrite sdprod_Iirr_eq0. Qed. Lemma Res_sdprod_irr phi : K \subset cfker phi -> phi \in irr G -> 'Res phi \in irr H. Proof. move=> kerK /irrP[i Dphi]; rewrite irrEchar -(cfSdprod_iso defG). by rewrite cfRes_sdprodK // Dphi cfnorm_irr cfRes_char ?irr_char /=. Qed. Lemma sdprod_Res_IirrE i : K \subset cfker 'chi[G]_i -> 'chi_(Res_Iirr H i) = 'Res 'chi_i. Proof. by move=> kerK; rewrite cfIirrE ?Res_sdprod_irr ?mem_irr. Qed. Lemma sdprod_Res_IirrK i : K \subset cfker 'chi_i -> sdprod_Iirr (Res_Iirr H i) = i. Proof. by move=> kerK; rewrite /sdprod_Iirr sdprod_Res_IirrE ?cfRes_sdprodK ?irrK. Qed. End Sdprod. Arguments sdprod_Iirr_inj {gT K H G} defG [i1 i2] : rename. Section DProd. Variables (gT : finGroupType) (G K H : {group gT}). Hypothesis KxH : K \x H = G. Lemma cfDprodKl_abelian j : abelian H -> cancel ((cfDprod KxH)^~ 'chi_j) 'Res. Proof. by move=> cHH; apply: cfDprodKl; apply/lin_char1/char_abelianP. Qed. Lemma cfDprodKr_abelian i : abelian K -> cancel (cfDprod KxH 'chi_i) 'Res. Proof. by move=> cKK; apply: cfDprodKr; apply/lin_char1/char_abelianP. Qed. Lemma cfDprodl_char phi : (cfDprodl KxH phi \is a character) = (phi \is a character). Proof. exact: cfSdprod_char. Qed. Lemma cfDprodr_char psi : (cfDprodr KxH psi \is a character) = (psi \is a character). Proof. exact: cfSdprod_char. Qed. Lemma cfDprod_char phi psi : phi \is a character -> psi \is a character -> cfDprod KxH phi psi \is a character. Proof. by move=> Nphi Npsi; rewrite rpredM ?cfDprodl_char ?cfDprodr_char. Qed. Lemma cfDprod_eq1 phi psi : phi \is a character -> psi \is a character -> (cfDprod KxH phi psi == 1) = (phi == 1) && (psi == 1). Proof. move=> /Cnat_char1 Nphi /Cnat_char1 Npsi. apply/eqP/andP=> [phi_psi_1 | [/eqP-> /eqP->]]; last by rewrite cfDprod_cfun1. have /andP[/eqP phi1 /eqP psi1]: (phi 1%g == 1) && (psi 1%g == 1). by rewrite -Cnat_mul_eq1 // -(cfDprod1 KxH) phi_psi_1 cfun11. rewrite -[phi](cfDprodKl KxH psi1) -{2}[psi](cfDprodKr KxH phi1) phi_psi_1. by rewrite !rmorph1. Qed. Lemma cfDprodl_lin_char phi : (cfDprodl KxH phi \is a linear_char) = (phi \is a linear_char). Proof. exact: cfSdprod_lin_char. Qed. Lemma cfDprodr_lin_char psi : (cfDprodr KxH psi \is a linear_char) = (psi \is a linear_char). Proof. exact: cfSdprod_lin_char. Qed. Lemma cfDprod_lin_char phi psi : phi \is a linear_char -> psi \is a linear_char -> cfDprod KxH phi psi \is a linear_char. Proof. by move=> Nphi Npsi; rewrite rpredM ?cfSdprod_lin_char. Qed. Lemma cfDprodl_irr chi : (cfDprodl KxH chi \in irr G) = (chi \in irr K). Proof. exact: cfSdprod_irr. Qed. Lemma cfDprodr_irr chi : (cfDprodr KxH chi \in irr G) = (chi \in irr H). Proof. exact: cfSdprod_irr. Qed. Definition dprodl_Iirr i := cfIirr (cfDprodl KxH 'chi_i). Lemma dprodl_IirrE i : 'chi_(dprodl_Iirr i) = cfDprodl KxH 'chi_i. Proof. exact: sdprod_IirrE. Qed. Lemma dprodl_IirrK : cancel dprodl_Iirr (Res_Iirr K). Proof. exact: sdprod_IirrK. Qed. Lemma dprodl_Iirr_eq0 i : (dprodl_Iirr i == 0) = (i == 0). Proof. exact: sdprod_Iirr_eq0. Qed. Lemma dprodl_Iirr0 : dprodl_Iirr 0 = 0. Proof. exact: sdprod_Iirr0. Qed. Definition dprodr_Iirr j := cfIirr (cfDprodr KxH 'chi_j). Lemma dprodr_IirrE j : 'chi_(dprodr_Iirr j) = cfDprodr KxH 'chi_j. Proof. exact: sdprod_IirrE. Qed. Lemma dprodr_IirrK : cancel dprodr_Iirr (Res_Iirr H). Proof. exact: sdprod_IirrK. Qed. Lemma dprodr_Iirr_eq0 j : (dprodr_Iirr j == 0) = (j == 0). Proof. exact: sdprod_Iirr_eq0. Qed. Lemma dprodr_Iirr0 : dprodr_Iirr 0 = 0. Proof. exact: sdprod_Iirr0. Qed. Lemma cfDprod_irr i j : cfDprod KxH 'chi_i 'chi_j \in irr G. Proof. rewrite irrEchar cfDprod_char ?irr_char //=. by rewrite cfdot_dprod !cfdot_irr !eqxx mul1r. Qed. Definition dprod_Iirr ij := cfIirr (cfDprod KxH 'chi_ij.1 'chi_ij.2). Lemma dprod_IirrE i j : 'chi_(dprod_Iirr (i, j)) = cfDprod KxH 'chi_i 'chi_j. Proof. by rewrite cfIirrE ?cfDprod_irr. Qed. Lemma dprod_IirrEl i : 'chi_(dprod_Iirr (i, 0)) = cfDprodl KxH 'chi_i. Proof. by rewrite dprod_IirrE /cfDprod irr0 rmorph1 mulr1. Qed. Lemma dprod_IirrEr j : 'chi_(dprod_Iirr (0, j)) = cfDprodr KxH 'chi_j. Proof. by rewrite dprod_IirrE /cfDprod irr0 rmorph1 mul1r. Qed. Lemma dprod_Iirr_inj : injective dprod_Iirr. Proof. move=> [i1 j1] [i2 j2] /eqP; rewrite -[_ == _]oddb -(natCK (_ == _)). rewrite -cfdot_irr !dprod_IirrE cfdot_dprod !cfdot_irr -natrM mulnb. by rewrite natCK oddb -xpair_eqE => /eqP. Qed. Lemma dprod_Iirr0 : dprod_Iirr (0, 0) = 0. Proof. by apply/irr_inj; rewrite dprod_IirrE !irr0 cfDprod_cfun1. Qed. Lemma dprod_Iirr0l j : dprod_Iirr (0, j) = dprodr_Iirr j. Proof. by apply/irr_inj; rewrite dprod_IirrE irr0 dprodr_IirrE cfDprod_cfun1l. Qed. Lemma dprod_Iirr0r i : dprod_Iirr (i, 0) = dprodl_Iirr i. Proof. by apply/irr_inj; rewrite dprod_IirrE irr0 dprodl_IirrE cfDprod_cfun1r. Qed. Lemma dprod_Iirr_eq0 i j : (dprod_Iirr (i, j) == 0) = (i == 0) && (j == 0). Proof. by rewrite -xpair_eqE -(inj_eq dprod_Iirr_inj) dprod_Iirr0. Qed. Lemma cfdot_dprod_irr i1 i2 j1 j2 : '['chi_(dprod_Iirr (i1, j1)), 'chi_(dprod_Iirr (i2, j2))] = ((i1 == i2) && (j1 == j2))%:R. Proof. by rewrite cfdot_irr (inj_eq dprod_Iirr_inj). Qed. Lemma dprod_Iirr_onto k : k \in codom dprod_Iirr. Proof. set D := codom _; have Df: dprod_Iirr _ \in D := codom_f dprod_Iirr _. have: 'chi_k 1%g ^+ 2 != 0 by rewrite mulf_neq0 ?irr1_neq0. apply: contraR => notDk; move/eqP: (irr_sum_square G). rewrite (bigID (mem D)) (reindex _ (bij_on_codom dprod_Iirr_inj (0, 0))) /=. have ->: #|G|%:R = \sum_i \sum_j 'chi_(dprod_Iirr (i, j)) 1%g ^+ 2. rewrite -(dprod_card KxH) natrM. do 2![rewrite -irr_sum_square (mulr_suml, mulr_sumr); apply: eq_bigr => ? _]. by rewrite dprod_IirrE -exprMn -{3}(mulg1 1%g) cfDprodE. rewrite (eq_bigl _ _ Df) pair_bigA addrC -subr_eq0 addrK. by move/eqP/psumr_eq0P=> -> //= i _; rewrite irr1_degree -natrX ler0n. Qed. Definition inv_dprod_Iirr i := iinv (dprod_Iirr_onto i). Lemma dprod_IirrK : cancel dprod_Iirr inv_dprod_Iirr. Proof. by move=> p; apply: (iinv_f dprod_Iirr_inj). Qed. Lemma inv_dprod_IirrK : cancel inv_dprod_Iirr dprod_Iirr. Proof. by move=> i; apply: f_iinv. Qed. Lemma inv_dprod_Iirr0 : inv_dprod_Iirr 0 = (0, 0). Proof. by apply/(canLR dprod_IirrK); rewrite dprod_Iirr0. Qed. End DProd. Arguments dprod_Iirr_inj {gT G K H} KxH [i1 i2] : rename. Lemma dprod_IirrC (gT : finGroupType) (G K H : {group gT}) (KxH : K \x H = G) (HxK : H \x K = G) i j : dprod_Iirr KxH (i, j) = dprod_Iirr HxK (j, i). Proof. by apply: irr_inj; rewrite !dprod_IirrE; apply: cfDprodC. Qed. Section BigDprod. Variables (gT : finGroupType) (I : finType) (P : pred I). Variables (A : I -> {group gT}) (G : {group gT}). Hypothesis defG : \big[dprod/1%g]_(i | P i) A i = G. Let sAG i : P i -> A i \subset G. Proof. by move=> Pi; rewrite -(bigdprodWY defG) (bigD1 i) ?joing_subl. Qed. Lemma cfBigdprodi_char i (phi : 'CF(A i)) : phi \is a character -> cfBigdprodi defG phi \is a character. Proof. by move=> Nphi; rewrite cfDprodl_char cfRes_char. Qed. Lemma cfBigdprodi_charE i (phi : 'CF(A i)) : P i -> (cfBigdprodi defG phi \is a character) = (phi \is a character). Proof. by move=> Pi; rewrite cfDprodl_char Pi cfRes_id. Qed. Lemma cfBigdprod_char phi : (forall i, P i -> phi i \is a character) -> cfBigdprod defG phi \is a character. Proof. by move=> Nphi; apply: rpred_prod => i /Nphi; apply: cfBigdprodi_char. Qed. Lemma cfBigdprodi_lin_char i (phi : 'CF(A i)) : phi \is a linear_char -> cfBigdprodi defG phi \is a linear_char. Proof. by move=> Lphi; rewrite cfDprodl_lin_char ?cfRes_lin_char. Qed. Lemma cfBigdprodi_lin_charE i (phi : 'CF(A i)) : P i -> (cfBigdprodi defG phi \is a linear_char) = (phi \is a linear_char). Proof. by move=> Pi; rewrite qualifE cfBigdprodi_charE // cfBigdprodi1. Qed. Lemma cfBigdprod_lin_char phi : (forall i, P i -> phi i \is a linear_char) -> cfBigdprod defG phi \is a linear_char. Proof. by move=> Lphi; apply/rpred_prod=> i /Lphi; apply: cfBigdprodi_lin_char. Qed. Lemma cfBigdprodi_irr i chi : P i -> (cfBigdprodi defG chi \in irr G) = (chi \in irr (A i)). Proof. by move=> Pi; rewrite !irrEchar cfBigdprodi_charE ?cfBigdprodi_iso. Qed. Lemma cfBigdprod_irr chi : (forall i, P i -> chi i \in irr (A i)) -> cfBigdprod defG chi \in irr G. Proof. move=> Nchi; rewrite irrEchar cfBigdprod_char => [|i /Nchi/irrWchar] //=. by rewrite cfdot_bigdprod big1 // => i /Nchi/irrWnorm. Qed. Lemma cfBigdprod_eq1 phi : (forall i, P i -> phi i \is a character) -> (cfBigdprod defG phi == 1) = [forall (i | P i), phi i == 1]. Proof. move=> Nphi; set Phi := cfBigdprod defG phi. apply/eqP/eqfun_inP=> [Phi1 i Pi | phi1]; last first. by apply: big1 => i /phi1->; rewrite rmorph1. have Phi1_1: Phi 1%g = 1 by rewrite Phi1 cfun1E group1. have nz_Phi1: Phi 1%g != 0 by rewrite Phi1_1 oner_eq0. have [_ <-] := cfBigdprodK nz_Phi1 Pi. rewrite Phi1_1 divr1 -/Phi Phi1 rmorph1. rewrite prod_cfunE // in Phi1_1; have := Cnat_prod_eq1 _ Phi1_1 Pi. rewrite -(cfRes1 (A i)) cfBigdprodiK // => ->; first by rewrite scale1r. by move=> {i Pi} j /Nphi Nphi_j; rewrite Cnat_char1 ?cfBigdprodi_char. Qed. Lemma cfBigdprod_Res_lin chi : chi \is a linear_char -> cfBigdprod defG (fun i => 'Res[A i] chi) = chi. Proof. move=> Lchi; apply/cfun_inP=> _ /(mem_bigdprod defG)[x [Ax -> _]]. rewrite (lin_char_prod Lchi) ?cfBigdprodE // => [|i Pi]; last first. by rewrite (subsetP (sAG Pi)) ?Ax. by apply/eq_bigr=> i Pi; rewrite cfResE ?sAG ?Ax. Qed. Lemma cfBigdprodKlin phi : (forall i, P i -> phi i \is a linear_char) -> forall i, P i -> 'Res (cfBigdprod defG phi) = phi i. Proof. move=> Lphi i Pi; have Lpsi := cfBigdprod_lin_char Lphi. have [_ <-] := cfBigdprodK (lin_char_neq0 Lpsi (group1 G)) Pi. by rewrite !lin_char1 ?Lphi // divr1 scale1r. Qed. Lemma cfBigdprodKabelian Iphi (phi := fun i => 'chi_(Iphi i)) : abelian G -> forall i, P i -> 'Res (cfBigdprod defG phi) = 'chi_(Iphi i). Proof. move=> /(abelianS _) cGG. by apply: cfBigdprodKlin => i /sAG/cGG/char_abelianP->. Qed. End BigDprod. Section Aut. Variables (gT : finGroupType) (G : {group gT}). Implicit Type u : {rmorphism algC -> algC}. Lemma conjC_charAut u (chi : 'CF(G)) x : chi \is a character -> (u (chi x))^* = u (chi x)^*. Proof. have [Gx | /cfun0->] := boolP (x \in G); last by rewrite !rmorph0. case/char_reprP=> rG ->; have [e [_ [en1 _] [-> _] _]] := repr_rsim_diag rG Gx. by rewrite !rmorph_sum; apply: eq_bigr => i _; apply: aut_unity_rootC (en1 i). Qed. Lemma conjC_irrAut u i x : (u ('chi[G]_i x))^* = u ('chi_i x)^*. Proof. exact: conjC_charAut (irr_char i). Qed. Lemma cfdot_aut_char u (phi chi : 'CF(G)) : chi \is a character -> '[cfAut u phi, cfAut u chi] = u '[phi, chi]. Proof. by move/conjC_charAut=> Nchi; apply: cfdot_cfAut => _ /mapP[x _ ->]. Qed. Lemma cfdot_aut_irr u phi i : '[cfAut u phi, cfAut u 'chi[G]_i] = u '[phi, 'chi_i]. Proof. exact: cfdot_aut_char (irr_char i). Qed. Lemma cfAut_irr u chi : (cfAut u chi \in irr G) = (chi \in irr G). Proof. rewrite !irrEchar cfAut_char; apply/andb_id2l=> /cfdot_aut_char->. exact: fmorph_eq1. Qed. Lemma cfConjC_irr i : (('chi_i)^*)%CF \in irr G. Proof. by rewrite cfAut_irr mem_irr. Qed. Lemma irr_aut_closed u : cfAut_closed u (irr G). Proof. by move=> chi; rewrite /= cfAut_irr. Qed. Definition aut_Iirr u i := cfIirr (cfAut u 'chi[G]_i). Lemma aut_IirrE u i : 'chi_(aut_Iirr u i) = cfAut u 'chi_i. Proof. by rewrite cfIirrE ?cfAut_irr ?mem_irr. Qed. Definition conjC_Iirr := aut_Iirr conjC. Lemma conjC_IirrE i : 'chi[G]_(conjC_Iirr i) = ('chi_i)^*%CF. Proof. exact: aut_IirrE. Qed. Lemma conjC_IirrK : involutive conjC_Iirr. Proof. by move=> i; apply: irr_inj; rewrite !conjC_IirrE cfConjCK. Qed. Lemma aut_Iirr0 u : aut_Iirr u 0 = 0 :> Iirr G. Proof. by apply/irr_inj; rewrite aut_IirrE irr0 cfAut_cfun1. Qed. Lemma conjC_Iirr0 : conjC_Iirr 0 = 0 :> Iirr G. Proof. exact: aut_Iirr0. Qed. Lemma aut_Iirr_eq0 u i : (aut_Iirr u i == 0) = (i == 0). Proof. by rewrite -!irr_eq1 aut_IirrE cfAut_eq1. Qed. Lemma conjC_Iirr_eq0 i : (conjC_Iirr i == 0 :> Iirr G) = (i == 0). Proof. exact: aut_Iirr_eq0. Qed. Lemma aut_Iirr_inj u : injective (aut_Iirr u). Proof. by move=> i j eq_ij; apply/irr_inj/(cfAut_inj u); rewrite -!aut_IirrE eq_ij. Qed. End Aut. Arguments aut_Iirr_inj {gT G} u [i1 i2] : rename. Arguments conjC_IirrK {gT G} i : rename. Section Coset. Variable (gT : finGroupType). Implicit Types G H : {group gT}. Lemma cfQuo_char G H (chi : 'CF(G)) : chi \is a character -> (chi / H)%CF \is a character. Proof. move=> Nchi; without loss kerH: / H \subset cfker chi. move/contraNF=> IHchi; apply/wlog_neg=> N'chiH. suffices ->: (chi / H)%CF = (chi 1%g)%:A. by rewrite rpredZ_Cnat ?Cnat_char1 ?rpred1. by apply/cfunP=> x; rewrite cfunE cfun1E mulr_natr cfunElock IHchi. without loss nsHG: G chi Nchi kerH / H <| G. move=> IHchi; have nsHN := normalSG (subset_trans kerH (cfker_sub chi)). by rewrite cfQuoInorm ?(cfRes_char, IHchi) ?sub_cfker_Res // ?normal_sub. have [rG Dchi] := char_reprP Nchi; rewrite Dchi cfker_repr in kerH. apply/char_reprP; exists (Representation (quo_repr kerH (normal_norm nsHG))). apply/cfun_inP=> _ /morphimP[x nHx Gx ->]; rewrite Dchi cfQuoE ?cfker_repr //=. by rewrite !cfunE Gx quo_repr_coset ?mem_quotient. Qed. Lemma cfQuo_lin_char G H (chi : 'CF(G)) : chi \is a linear_char -> (chi / H)%CF \is a linear_char. Proof. by case/andP=> Nchi; rewrite qualifE cfQuo_char ?cfQuo1. Qed. Lemma cfMod_char G H (chi : 'CF(G / H)) : chi \is a character -> (chi %% H)%CF \is a character. Proof. exact: cfMorph_char. Qed. Lemma cfMod_lin_char G H (chi : 'CF(G / H)) : chi \is a linear_char -> (chi %% H)%CF \is a linear_char. Proof. exact: cfMorph_lin_char. Qed. Lemma cfMod_charE G H (chi : 'CF(G / H)) : H <| G -> (chi %% H \is a character)%CF = (chi \is a character). Proof. by case/andP=> _; apply: cfMorph_charE. Qed. Lemma cfMod_lin_charE G H (chi : 'CF(G / H)) : H <| G -> (chi %% H \is a linear_char)%CF = (chi \is a linear_char). Proof. by case/andP=> _; apply: cfMorph_lin_charE. Qed. Lemma cfQuo_charE G H (chi : 'CF(G)) : H <| G -> H \subset cfker chi -> (chi / H \is a character)%CF = (chi \is a character). Proof. by move=> nsHG kerH; rewrite -cfMod_charE ?cfQuoK. Qed. Lemma cfQuo_lin_charE G H (chi : 'CF(G)) : H <| G -> H \subset cfker chi -> (chi / H \is a linear_char)%CF = (chi \is a linear_char). Proof. by move=> nsHG kerH; rewrite -cfMod_lin_charE ?cfQuoK. Qed. Lemma cfMod_irr G H chi : H <| G -> (chi %% H \in irr G)%CF = (chi \in irr (G / H)). Proof. by case/andP=> _; apply: cfMorph_irr. Qed. Definition mod_Iirr G H i := cfIirr ('chi[G / H]_i %% H)%CF. Lemma mod_Iirr0 G H : mod_Iirr (0 : Iirr (G / H)) = 0. Proof. exact: morph_Iirr0. Qed. Lemma mod_IirrE G H i : H <| G -> 'chi_(mod_Iirr i) = ('chi[G / H]_i %% H)%CF. Proof. by move=> nsHG; rewrite cfIirrE ?cfMod_irr ?mem_irr. Qed. Lemma mod_Iirr_eq0 G H i : H <| G -> (mod_Iirr i == 0) = (i == 0 :> Iirr (G / H)). Proof. by case/andP=> _ /morph_Iirr_eq0->. Qed. Lemma cfQuo_irr G H chi : H <| G -> H \subset cfker chi -> ((chi / H)%CF \in irr (G / H)) = (chi \in irr G). Proof. by move=> nsHG kerH; rewrite -cfMod_irr ?cfQuoK. Qed. Definition quo_Iirr G H i := cfIirr ('chi[G]_i / H)%CF. Lemma quo_Iirr0 G H : quo_Iirr H (0 : Iirr G) = 0. Proof. by rewrite /quo_Iirr irr0 cfQuo_cfun1 -irr0 irrK. Qed. Lemma quo_IirrE G H i : H <| G -> H \subset cfker 'chi[G]_i -> 'chi_(quo_Iirr H i) = ('chi_i / H)%CF. Proof. by move=> nsHG kerH; rewrite cfIirrE ?cfQuo_irr ?mem_irr. Qed. Lemma quo_Iirr_eq0 G H i : H <| G -> H \subset cfker 'chi[G]_i -> (quo_Iirr H i == 0) = (i == 0). Proof. by move=> nsHG kerH; rewrite -!irr_eq1 quo_IirrE ?cfQuo_eq1. Qed. Lemma mod_IirrK G H : H <| G -> cancel (@mod_Iirr G H) (@quo_Iirr G H). Proof. move=> nsHG i; apply: irr_inj. by rewrite quo_IirrE ?mod_IirrE ?cfker_mod // cfModK. Qed. Lemma quo_IirrK G H i : H <| G -> H \subset cfker 'chi[G]_i -> mod_Iirr (quo_Iirr H i) = i. Proof. by move=> nsHG kerH; apply: irr_inj; rewrite mod_IirrE ?quo_IirrE ?cfQuoK. Qed. Lemma quo_IirrKeq G H : H <| G -> forall i, (mod_Iirr (quo_Iirr H i) == i) = (H \subset cfker 'chi[G]_i). Proof. move=> nsHG i; apply/eqP/idP=> [<- | ]; last exact: quo_IirrK. by rewrite mod_IirrE ?cfker_mod. Qed. Lemma mod_Iirr_bij H G : H <| G -> {on [pred i | H \subset cfker 'chi_i], bijective (@mod_Iirr G H)}. Proof. by exists (quo_Iirr H) => [i _ | i]; [apply: mod_IirrK | apply: quo_IirrK]. Qed. Lemma sum_norm_irr_quo H G x : x \in G -> H <| G -> \sum_i `|'chi[G / H]_i (coset H x)| ^+ 2 = \sum_(i | H \subset cfker 'chi_i) `|'chi[G]_i x| ^+ 2. Proof. move=> Gx nsHG; rewrite (reindex _ (mod_Iirr_bij nsHG)) /=. by apply/esym/eq_big=> [i | i _]; rewrite mod_IirrE ?cfker_mod ?cfModE. Qed. Lemma cap_cfker_normal G H : H <| G -> \bigcap_(i | H \subset cfker 'chi[G]_i) (cfker 'chi_i) = H. Proof. move=> nsHG; have [sHG nHG] := andP nsHG; set lhs := \bigcap_(i | _) _. have nHlhs: lhs \subset 'N(H) by rewrite (bigcap_min 0) ?cfker_irr0. apply/esym/eqP; rewrite eqEsubset (introT bigcapsP) //= -quotient_sub1 //. rewrite -(TI_cfker_irr (G / H)); apply/bigcapsP=> i _. rewrite sub_quotient_pre // (bigcap_min (mod_Iirr i)) ?mod_IirrE ?cfker_mod //. by rewrite cfker_morph ?subsetIr. Qed. Lemma cfker_reg_quo G H : H <| G -> cfker (cfReg (G / H)%g %% H) = H. Proof. move=> nsHG; have [sHG nHG] := andP nsHG. apply/setP=> x; rewrite cfkerEchar ?cfMod_char ?cfReg_char //. rewrite -[in RHS in _ = RHS](setIidPr sHG) !inE; apply: andb_id2l => Gx. rewrite !cfModE // !cfRegE // morph1 eqxx. rewrite (sameP eqP (kerP _ (subsetP nHG x Gx))) ker_coset. by rewrite -!mulrnA eqr_nat eqn_pmul2l ?cardG_gt0 // (can_eq oddb) eqb_id. Qed. End Coset. Section DerivedGroup. Variable gT : finGroupType. Implicit Types G H : {group gT}. Lemma lin_irr_der1 G i : ('chi_i \is a linear_char) = (G^`(1)%g \subset cfker 'chi[G]_i). Proof. apply/idP/idP=> [|sG'K]; first exact: lin_char_der1. have nsG'G: G^`(1) <| G := der_normal 1 G. rewrite qualifE irr_char -[i](quo_IirrK nsG'G) // mod_IirrE //=. by rewrite cfModE // morph1 lin_char1 //; apply/char_abelianP/der_abelian. Qed. Lemma subGcfker G i : (G \subset cfker 'chi[G]_i) = (i == 0). Proof. rewrite -irr_eq1; apply/idP/eqP=> [chiG1 | ->]; last by rewrite cfker_cfun1. apply/cfun_inP=> x Gx; rewrite cfun1E Gx cfker1 ?(subsetP chiG1) ?lin_char1 //. by rewrite lin_irr_der1 (subset_trans (der_sub 1 G)). Qed. Lemma irr_prime_injP G i : prime #|G| -> reflect {in G &, injective 'chi[G]_i} (i != 0). Proof. move=> pr_G; apply: (iffP idP) => [nz_i | inj_chi]. apply: fful_lin_char_inj (irr_prime_lin i pr_G) _. by rewrite cfaithfulE -(setIidPr (cfker_sub _)) prime_TIg // subGcfker. have /trivgPn[x Gx ntx]: G :!=: 1%g by rewrite -cardG_gt1 prime_gt1. apply: contraNneq ntx => i0; apply/eqP/inj_chi=> //. by rewrite i0 irr0 !cfun1E Gx group1. Qed. (* This is Isaacs (2.23)(a). *) Lemma cap_cfker_lin_irr G : \bigcap_(i | 'chi[G]_i \is a linear_char) (cfker 'chi_i) = G^`(1)%g. Proof. rewrite -(cap_cfker_normal (der_normal 1 G)). by apply: eq_bigl => i; rewrite lin_irr_der1. Qed. (* This is Isaacs (2.23)(b) *) Lemma card_lin_irr G : #|[pred i | 'chi[G]_i \is a linear_char]| = #|G : G^`(1)%g|. Proof. have nsG'G := der_normal 1 G; rewrite (eq_card (@lin_irr_der1 G)). rewrite -(on_card_preimset (mod_Iirr_bij nsG'G)). rewrite -card_quotient ?normal_norm //. move: (der_abelian 0 G); rewrite card_classes_abelian; move/eqP<-. rewrite -NirrE -[X in _ = X]card_ord. by apply: eq_card => i; rewrite !inE mod_IirrE ?cfker_mod. (* Alternative: use the equivalent result in modular representation theory transitivity #|@socle_of_Iirr _ G @^-1: linear_irr _|; last first. rewrite (on_card_preimset (socle_of_Iirr_bij _)). by rewrite card_linear_irr ?algC'G; last apply: groupC. by apply: eq_card => i; rewrite !inE /lin_char irr_char irr1_degree -eqC_nat. *) Qed. (* A non-trivial solvable group has a nonprincipal linear character. *) Lemma solvable_has_lin_char G : G :!=: 1%g -> solvable G -> exists2 i, 'chi[G]_i \is a linear_char & 'chi_i != 1. Proof. move=> ntG solG. suff /subsetPn[i]: ~~ ([pred i | 'chi[G]_i \is a linear_char] \subset pred1 0). by rewrite !inE -(inj_eq irr_inj) irr0; exists i. rewrite (contra (@subset_leq_card _ _ _)) // -ltnNge card1 card_lin_irr. by rewrite indexg_gt1 proper_subn // (sol_der1_proper solG). Qed. (* A combinatorial group isommorphic to the linear characters. *) Lemma lin_char_group G : {linG : finGroupType & {cF : linG -> 'CF(G) | [/\ injective cF, #|linG| = #|G : G^`(1)|, forall u, cF u \is a linear_char & forall phi, phi \is a linear_char -> exists u, phi = cF u] & [/\ cF 1%g = 1%R, {morph cF : u v / (u * v)%g >-> (u * v)%R}, forall k, {morph cF : u / (u^+ k)%g >-> u ^+ k}, {morph cF: u / u^-1%g >-> u^-1%CF} & {mono cF: u / #[u]%g >-> #[u]%CF} ]}}. Proof. pose linT := {i : Iirr G | 'chi_i \is a linear_char}. pose cF (u : linT) := 'chi_(sval u). have cFlin u: cF u \is a linear_char := svalP u. have cFinj: injective cF := inj_comp irr_inj val_inj. have inT xi : xi \is a linear_char -> {u | cF u = xi}. move=> lin_xi; have /irrP/sig_eqW[i Dxi] := lin_char_irr lin_xi. by apply: (exist _ (Sub i _)) => //; rewrite -Dxi. have [one cFone] := inT 1 (rpred1 _). pose inv u := sval (inT _ (rpredVr (cFlin u))). pose mul u v := sval (inT _ (rpredM (cFlin u) (cFlin v))). have cFmul u v: cF (mul u v) = cF u * cF v := svalP (inT _ _). have cFinv u: cF (inv u) = (cF u)^-1 := svalP (inT _ _). have mulA: associative mul by move=> u v w; apply: cFinj; rewrite !cFmul mulrA. have mul1: left_id one mul by move=> u; apply: cFinj; rewrite cFmul cFone mul1r. have mulV: left_inverse one inv mul. by move=> u; apply: cFinj; rewrite cFmul cFinv cFone mulVr ?lin_char_unitr. pose linGm := FinGroup.Mixin mulA mul1 mulV. pose linG := @FinGroupType (BaseFinGroupType linT linGm) mulV. have cFexp k: {morph cF : u / ((u : linG) ^+ k)%g >-> u ^+ k}. by move=> u; elim: k => // k IHk; rewrite expgS exprS cFmul IHk. do [exists linG, cF; split=> //] => [|xi /inT[u <-]|u]; first 2 [by exists u]. have inj_cFI: injective (cfIirr \o cF). apply: can_inj (insubd one) _ => u; apply: val_inj. by rewrite insubdK /= ?irrK //; apply: cFlin. rewrite -(card_image inj_cFI) -card_lin_irr. apply/eq_card=> i; rewrite inE; apply/codomP/idP=> [[u ->] | /inT[u Du]]. by rewrite /= irrK; apply: cFlin. by exists u; apply: irr_inj; rewrite /= irrK. apply/eqP; rewrite eqn_dvd; apply/andP; split. by rewrite dvdn_cforder; rewrite -cFexp expg_order cFone. by rewrite order_dvdn -(inj_eq cFinj) cFone cFexp exp_cforder. Qed. Lemma cfExp_prime_transitive G (i j : Iirr G) : prime #|G| -> i != 0 -> j != 0 -> exists2 k, coprime k #['chi_i]%CF & 'chi_j = 'chi_i ^+ k. Proof. set p := #|G| => pr_p nz_i nz_j; have cycG := prime_cyclic pr_p. have [L [h [injh oL Lh h_ontoL]] [h1 hM hX _ o_h]] := lin_char_group G. rewrite (derG1P (cyclic_abelian cycG)) indexg1 -/p in oL. have /fin_all_exists[h' h'K] := h_ontoL _ (irr_cyclic_lin _ cycG). have o_h' k: k != 0 -> #[h' k] = p. rewrite -cforder_irr_eq1 h'K -o_h => nt_h'k. by apply/prime_nt_dvdP=> //; rewrite cforder_lin_char_dvdG. have{oL} genL k: k != 0 -> generator [set: L] (h' k). move=> /o_h' o_h'k; rewrite /generator eq_sym eqEcard subsetT /=. by rewrite cardsT oL -o_h'k. have [/(_ =P <[_]>)-> gen_j] := (genL i nz_i, genL j nz_j). have /cycleP[k Dj] := cycle_generator gen_j. by rewrite !h'K Dj o_h hX generator_coprime coprime_sym in gen_j *; exists k. Qed. (* This is Isaacs (2.24). *) Lemma card_subcent1_coset G H x : x \in G -> H <| G -> (#|'C_(G / H)[coset H x]| <= #|'C_G[x]|)%N. Proof. move=> Gx nsHG; rewrite -leC_nat. move: (second_orthogonality_relation x Gx); rewrite mulrb class_refl => <-. have GHx: coset H x \in (G / H)%g by apply: mem_quotient. move: (second_orthogonality_relation (coset H x) GHx). rewrite mulrb class_refl => <-. rewrite -2!(eq_bigr _ (fun _ _ => normCK _)) sum_norm_irr_quo // -subr_ge0. rewrite (bigID (fun i => H \subset cfker 'chi[G]_i)) //= addrC addKr. by apply: sumr_ge0 => i _; rewrite normCK mul_conjC_ge0. Qed. End DerivedGroup. Arguments irr_prime_injP {gT G i}. (* Determinant characters and determinential order. *) Section DetOrder. Variables (gT : finGroupType) (G : {group gT}). Section DetRepr. Variables (n : nat) (rG : mx_representation [fieldType of algC] G n). Definition det_repr_mx x : 'M_1 := (\det (rG x))%:M. Fact det_is_repr : mx_repr G det_repr_mx. Proof. split=> [|g h Gg Gh]; first by rewrite /det_repr_mx repr_mx1 det1. by rewrite /det_repr_mx repr_mxM // det_mulmx !mulmxE scalar_mxM. Qed. Canonical det_repr := MxRepresentation det_is_repr. Definition detRepr := cfRepr det_repr. Lemma detRepr_lin_char : detRepr \is a linear_char. Proof. by rewrite qualifE cfRepr_char cfunE group1 repr_mx1 mxtrace1 mulr1n /=. Qed. End DetRepr. Definition cfDet phi := \prod_i detRepr 'Chi_i ^+ truncC '[phi, 'chi[G]_i]. Lemma cfDet_lin_char phi : cfDet phi \is a linear_char. Proof. by apply: rpred_prod => i _; apply: rpredX; apply: detRepr_lin_char. Qed. Lemma cfDetD : {in character &, {morph cfDet : phi psi / phi + psi >-> phi * psi}}. Proof. move=> phi psi Nphi Npsi; rewrite /= -big_split; apply: eq_bigr => i _ /=. by rewrite -exprD cfdotDl truncCD ?nnegrE ?Cnat_ge0 // Cnat_cfdot_char_irr. Qed. Lemma cfDet0 : cfDet 0 = 1. Proof. by rewrite /cfDet big1 // => i _; rewrite cfdot0l truncC0. Qed. Lemma cfDetMn k : {in character, {morph cfDet : phi / phi *+ k >-> phi ^+ k}}. Proof. move=> phi Nphi; elim: k => [|k IHk]; rewrite ?cfDet0 // mulrS exprS -{}IHk. by rewrite cfDetD ?rpredMn. Qed. Lemma cfDetRepr n rG : cfDet (cfRepr rG) = @detRepr n rG. Proof. transitivity (\prod_W detRepr (socle_repr W) ^+ standard_irr_coef rG W). rewrite (reindex _ (socle_of_Iirr_bij _)) /cfDet /=. apply: eq_bigr => i _; congr (_ ^+ _). rewrite (cfRepr_sim (mx_rsim_standard rG)) cfRepr_standard. rewrite cfdot_suml (bigD1 i) ?big1 //= => [|j i'j]; last first. by rewrite cfdotZl cfdot_irr (negPf i'j) mulr0. by rewrite cfdotZl cfnorm_irr mulr1 addr0 natCK. apply/cfun_inP=> x Gx; rewrite prod_cfunE //. transitivity (detRepr (standard_grepr rG) x); last first. rewrite !cfunE Gx !trace_mx11 !mxE eqxx !mulrb. case: (standard_grepr rG) (mx_rsim_standard rG) => /= n1 rG1 [B Dn1]. rewrite -{n1}Dn1 in rG1 B *; rewrite row_free_unit => uB rG_B. by rewrite -[rG x](mulmxK uB) rG_B // !det_mulmx mulrC -!det_mulmx mulKmx. rewrite /standard_grepr; elim/big_rec2: _ => [|W y _ _ ->]. by rewrite cfunE trace_mx11 mxE Gx det1. rewrite !cfunE Gx /= !{1}trace_mx11 !{1}mxE det_ublock; congr (_ * _). rewrite exp_cfunE //; elim: (standard_irr_coef rG W) => /= [|k IHk]. by rewrite /muln_grepr big_ord0 det1. rewrite exprS /muln_grepr big_ord_recl det_ublock -IHk; congr (_ * _). by rewrite cfunE trace_mx11 mxE Gx. Qed. Lemma cfDet_id xi : xi \is a linear_char -> cfDet xi = xi. Proof. move=> lin_xi; have /irrP[i Dxi] := lin_char_irr lin_xi. apply/cfun_inP=> x Gx; rewrite Dxi -irrRepr cfDetRepr !cfunE trace_mx11 mxE. move: lin_xi (_ x) => /andP[_]; rewrite Dxi irr1_degree pnatr_eq1 => /eqP-> X. by rewrite {1}[X]mx11_scalar det_scalar1 trace_mx11. Qed. Definition cfDet_order phi := #[cfDet phi]%CF. Definition cfDet_order_lin xi : xi \is a linear_char -> cfDet_order xi = #[xi]%CF. Proof. by rewrite /cfDet_order => /cfDet_id->. Qed. Definition cfDet_order_dvdG phi : cfDet_order phi %| #|G|. Proof. by rewrite cforder_lin_char_dvdG ?cfDet_lin_char. Qed. End DetOrder. Notation "''o' ( phi )" := (cfDet_order phi) (at level 8, format "''o' ( phi )") : cfun_scope. Section CfDetOps. Implicit Types gT aT rT : finGroupType. Lemma cfDetRes gT (G H : {group gT}) phi : phi \is a character -> cfDet ('Res[H, G] phi) = 'Res (cfDet phi). Proof. move=> Nphi; have [sGH | not_sHG] := boolP (H \subset G); last first. have /CnatP[n Dphi1] := Cnat_char1 Nphi. rewrite !cfResEout // Dphi1 lin_char1 ?cfDet_lin_char // scale1r. by rewrite scaler_nat cfDetMn ?cfDet_id ?rpred1 // expr1n. have [rG ->] := char_reprP Nphi; rewrite !(=^~ cfRepr_sub, cfDetRepr) //. apply: cfRepr_sim; exists 1%:M; rewrite ?row_free_unit ?unitmx1 // => x Hx. by rewrite mulmx1 mul1mx. Qed. Lemma cfDetMorph aT rT (D G : {group aT}) (f : {morphism D >-> rT}) (phi : 'CF(f @* G)) : phi \is a character -> cfDet (cfMorph phi) = cfMorph (cfDet phi). Proof. move=> Nphi; have [sGD | not_sGD] := boolP (G \subset D); last first. have /CnatP[n Dphi1] := Cnat_char1 Nphi. rewrite !cfMorphEout // Dphi1 lin_char1 ?cfDet_lin_char // scale1r. by rewrite scaler_nat cfDetMn ?cfDet_id ?rpred1 // expr1n. have [rG ->] := char_reprP Nphi; rewrite !(=^~ cfRepr_morphim, cfDetRepr) //. apply: cfRepr_sim; exists 1%:M; rewrite ?row_free_unit ?unitmx1 // => x Hx. by rewrite mulmx1 mul1mx. Qed. Lemma cfDetIsom aT rT (G : {group aT}) (R : {group rT}) (f : {morphism G >-> rT}) (isoGR : isom G R f) phi : cfDet (cfIsom isoGR phi) = cfIsom isoGR (cfDet phi). Proof. rewrite rmorph_prod /cfDet (reindex (isom_Iirr isoGR)); last first. by exists (isom_Iirr (isom_sym isoGR)) => i; rewrite ?isom_IirrK ?isom_IirrKV. apply: eq_bigr => i; rewrite -!cfDetRepr !irrRepr isom_IirrE rmorphX cfIsom_iso. by rewrite /= ![in cfIsom _]unlock cfDetMorph ?cfRes_char ?cfDetRes ?irr_char. Qed. Lemma cfDet_mul_lin gT (G : {group gT}) (lambda phi : 'CF(G)) : lambda \is a linear_char -> phi \is a character -> cfDet (lambda * phi) = lambda ^+ truncC (phi 1%g) * cfDet phi. Proof. case/andP=> /char_reprP[[n1 rG1] ->] /= n1_1 /char_reprP[[n2 rG2] ->] /=. do [rewrite !cfRepr1 pnatr_eq1 natCK; move/eqP] in n1_1 *. rewrite {n1}n1_1 in rG1 *; rewrite cfRepr_prod cfDetRepr. apply/cfun_inP=> x Gx; rewrite !cfunE cfDetRepr cfunE Gx !mulrb !trace_mx11. rewrite !mxE prod_repr_lin ?mulrb //=; case: _ / (esym _); rewrite detZ. congr (_ * _); case: {rG2}n2 => [|n2]; first by rewrite cfun1E Gx. by rewrite expS_cfunE //= cfunE Gx trace_mx11. Qed. End CfDetOps. Definition cfcenter (gT : finGroupType) (G : {set gT}) (phi : 'CF(G)) := if phi \is a character then [set g in G | `|phi g| == phi 1%g] else cfker phi. Notation "''Z' ( phi )" := (cfcenter phi) : cfun_scope. Section Center. Variable (gT : finGroupType) (G : {group gT}). Implicit Types (phi chi : 'CF(G)) (H : {group gT}). (* This is Isaacs (2.27)(a). *) Lemma cfcenter_repr n (rG : mx_representation algCF G n) : 'Z(cfRepr rG)%CF = rcenter rG. Proof. rewrite /cfcenter /rcenter cfRepr_char /=. apply/setP=> x; rewrite !inE; apply/andb_id2l=> Gx. apply/eqP/is_scalar_mxP=> [|[c rG_c]]. by case/max_cfRepr_norm_scalar=> // c; exists c. rewrite -(sqrCK (char1_ge0 (cfRepr_char rG))) normC_def; congr (sqrtC _). rewrite expr2 -{2}(mulgV x) -char_inv ?cfRepr_char ?cfunE ?groupM ?groupV //. rewrite Gx group1 repr_mx1 repr_mxM ?repr_mxV ?groupV // !mulrb rG_c. by rewrite invmx_scalar -scalar_mxM !mxtrace_scalar mulrnAr mulrnAl mulr_natl. Qed. (* This is part of Isaacs (2.27)(b). *) Fact cfcenter_group_set phi : group_set ('Z(phi))%CF. Proof. have [[rG ->] | /negbTE notNphi] := altP (@char_reprP _ G phi). by rewrite cfcenter_repr groupP. by rewrite /cfcenter notNphi groupP. Qed. Canonical cfcenter_group f := Group (cfcenter_group_set f). Lemma char_cfcenterE chi x : chi \is a character -> x \in G -> (x \in ('Z(chi))%CF) = (`|chi x| == chi 1%g). Proof. by move=> Nchi Gx; rewrite /cfcenter Nchi inE Gx. Qed. Lemma irr_cfcenterE i x : x \in G -> (x \in 'Z('chi[G]_i)%CF) = (`|'chi_i x| == 'chi_i 1%g). Proof. by move/char_cfcenterE->; rewrite ?irr_char. Qed. (* This is also Isaacs (2.27)(b). *) Lemma cfcenter_sub phi : ('Z(phi))%CF \subset G. Proof. by rewrite /cfcenter /cfker !setIdE -fun_if subsetIl. Qed. Lemma cfker_center_normal phi : cfker phi <| 'Z(phi)%CF. Proof. apply: normalS (cfcenter_sub phi) (cfker_normal phi). rewrite /= /cfcenter; case: ifP => // Hphi; rewrite cfkerEchar //. apply/subsetP=> x; rewrite !inE => /andP[-> /eqP->] /=. by rewrite ger0_norm ?char1_ge0. Qed. Lemma cfcenter_normal phi : 'Z(phi)%CF <| G. Proof. have [[rG ->] | /negbTE notNphi] := altP (@char_reprP _ _ phi). by rewrite cfcenter_repr rcenter_normal. by rewrite /cfcenter notNphi cfker_normal. Qed. (* This is Isaacs (2.27)(c). *) Lemma cfcenter_Res chi : exists2 chi1, chi1 \is a linear_char & 'Res['Z(chi)%CF] chi = chi 1%g *: chi1. Proof. have [[rG ->] | /negbTE notNphi] := altP (@char_reprP _ _ chi); last first. exists 1; first exact: cfun1_lin_char. rewrite /cfcenter notNphi; apply/cfun_inP=> x Kx. by rewrite cfunE cfun1E Kx mulr1 cfResE ?cfker_sub // cfker1. rewrite cfcenter_repr -(cfRepr_sub _ (normal_sub (rcenter_normal _))). case: rG => [[|n] rG] /=; rewrite cfRepr1. exists 1; first exact: cfun1_lin_char. by apply/cfun_inP=> x Zx; rewrite scale0r !cfunE flatmx0 raddf0 Zx. pose rZmx x := ((rG x 0 0)%:M : 'M_(1,1)). have rZmxP: mx_repr [group of rcenter rG] rZmx. split=> [|x y]; first by rewrite /rZmx repr_mx1 mxE eqxx. move=> /setIdP[Gx /is_scalar_mxP[a rGx]] /setIdP[Gy /is_scalar_mxP[b rGy]]. by rewrite /rZmx repr_mxM // rGx rGy -!scalar_mxM !mxE. exists (cfRepr (MxRepresentation rZmxP)). by rewrite qualifE cfRepr_char cfRepr1 eqxx. apply/cfun_inP=> x Zx; rewrite !cfunE Zx /= /rZmx mulr_natl. by case/setIdP: Zx => Gx /is_scalar_mxP[a ->]; rewrite mxE !mxtrace_scalar. Qed. (* This is Isaacs (2.27)(d). *) Lemma cfcenter_cyclic chi : cyclic ('Z(chi)%CF / cfker chi)%g. Proof. case Nchi: (chi \is a character); last first. by rewrite /cfcenter Nchi trivg_quotient cyclic1. have [-> | nz_chi] := eqVneq chi 0. rewrite quotientS1 ?cyclic1 //= /cfcenter cfkerEchar ?cfun0_char //. by apply/subsetP=> x /setIdP[Gx _]; rewrite inE Gx /= !cfunE. have [xi Lxi def_chi] := cfcenter_Res chi. set Z := ('Z(_))%CF in xi Lxi def_chi *. have sZG: Z \subset G by apply: cfcenter_sub. have ->: cfker chi = cfker xi. rewrite -(setIidPr (normal_sub (cfker_center_normal _))) -/Z. rewrite !cfkerEchar // ?lin_charW //= -/Z. apply/setP=> x; rewrite !inE; apply: andb_id2l => Zx. rewrite (subsetP sZG) //= -!(cfResE chi sZG) ?group1 // def_chi !cfunE. by rewrite (inj_eq (mulfI _)) ?char1_eq0. have: abelian (Z / cfker xi) by rewrite sub_der1_abelian ?lin_char_der1. have /irr_reprP[rG irrG ->] := lin_char_irr Lxi; rewrite cfker_repr. apply: mx_faithful_irr_abelian_cyclic (kquo_mx_faithful rG) _. exact/quo_mx_irr. Qed. (* This is Isaacs (2.27)(e). *) Lemma cfcenter_subset_center chi : ('Z(chi)%CF / cfker chi)%g \subset 'Z(G / cfker chi)%g. Proof. case Nchi: (chi \is a character); last first. by rewrite /cfcenter Nchi trivg_quotient sub1G. rewrite subsetI quotientS ?cfcenter_sub // quotient_cents2r //=. case/char_reprP: Nchi => rG ->{chi}; rewrite cfker_repr cfcenter_repr gen_subG. apply/subsetP=> _ /imset2P[x y /setIdP[Gx /is_scalar_mxP[c rGx]] Gy ->]. rewrite inE groupR //= !repr_mxM ?groupM ?groupV // rGx -(scalar_mxC c) -rGx. by rewrite !mulmxA !repr_mxKV. Qed. (* This is Isaacs (2.27)(f). *) Lemma cfcenter_eq_center (i : Iirr G) : ('Z('chi_i)%CF / cfker 'chi_i)%g = 'Z(G / cfker 'chi_i)%g. Proof. apply/eqP; rewrite eqEsubset; rewrite cfcenter_subset_center ?irr_char //. apply/subsetP=> _ /setIP[/morphimP[x /= _ Gx ->] cGx]; rewrite mem_quotient //=. rewrite -irrRepr cfker_repr cfcenter_repr inE Gx in cGx *. apply: mx_abs_irr_cent_scalar 'Chi_i _ _ _; first exact/groupC/socle_irr. have nKG: G \subset 'N(rker 'Chi_i) by apply: rker_norm. (* GG -- locking here is critical to prevent Coq kernel divergence. *) apply/centgmxP=> y Gy; rewrite [eq]lock -2?(quo_repr_coset (subxx _) nKG) //. move: (quo_repr _ _) => rG; rewrite -2?repr_mxM ?mem_quotient // -lock. by rewrite (centP cGx) // mem_quotient. Qed. (* This is Isaacs (2.28). *) Lemma cap_cfcenter_irr : \bigcap_i 'Z('chi[G]_i)%CF = 'Z(G). Proof. apply/esym/eqP; rewrite eqEsubset (introT bigcapsP) /= => [|i _]; last first. rewrite -(quotientSGK _ (normal_sub (cfker_center_normal _))). by rewrite cfcenter_eq_center morphim_center. by rewrite subIset // normal_norm // cfker_normal. set Z := \bigcap_i _. have sZG: Z \subset G by rewrite (bigcap_min 0) ?cfcenter_sub. rewrite subsetI sZG (sameP commG1P trivgP) -(TI_cfker_irr G). apply/bigcapsP=> i _; have nKiG := normal_norm (cfker_normal 'chi_i). rewrite -quotient_cents2 ?(subset_trans sZG) //. rewrite (subset_trans (quotientS _ (bigcap_inf i _))) //. by rewrite cfcenter_eq_center subsetIr. Qed. (* This is Isaacs (2.29). *) 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_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: 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. by rewrite cfdot_irr eqxx mulr1. Qed. (* This is Isaacs (2.31). *) Lemma irr1_abelian_bound (i : Iirr G) : abelian (G / 'Z('chi_i)%CF) -> ('chi_i 1%g) ^+ 2 = #|G : 'Z('chi_i)%CF|%:R. Proof. move=> AbGc; apply/eqP; rewrite irr1_bound cfun_onE; apply/subsetP=> x nz_chi_x. have Gx: x \in G by apply: contraR nz_chi_x => /cfun0->. have nKx := subsetP (normal_norm (cfker_normal 'chi_i)) _ Gx. rewrite -(quotientGK (cfker_center_normal _)) inE nKx inE /=. rewrite cfcenter_eq_center inE mem_quotient //=. apply/centP=> _ /morphimP[y nKy Gy ->]; apply/commgP; rewrite -morphR //=. set z := [~ x, y]; rewrite coset_id //. have: z \in 'Z('chi_i)%CF. apply: subsetP (mem_commg Gx Gy). by rewrite der1_min // normal_norm ?cfcenter_normal. rewrite -irrRepr cfker_repr cfcenter_repr !inE in nz_chi_x *. case/andP=> Gz /is_scalar_mxP[c Chi_z]; rewrite Gz Chi_z mul1mx /=. apply/eqP; congr _%:M; apply: (mulIf nz_chi_x); rewrite mul1r. rewrite -{2}(cfunJ _ x Gy) conjg_mulR -/z !cfunE Gx groupM // !{1}mulrb. by rewrite repr_mxM // Chi_z mul_mx_scalar mxtraceZ. Qed. (* This is Isaacs (2.32)(a). *) Lemma irr_faithful_center i : cfaithful 'chi[G]_i -> cyclic 'Z(G). Proof. rewrite (isog_cyclic (isog_center (quotient1_isog G))) /=. by move/trivgP <-; rewrite -cfcenter_eq_center cfcenter_cyclic. Qed. Lemma cfcenter_fful_irr i : cfaithful 'chi[G]_i -> 'Z('chi_i)%CF = 'Z(G). Proof. move/trivgP=> Ki1; have:= cfcenter_eq_center i; rewrite {}Ki1. have inj1: 'injm (@coset gT 1%g) by rewrite ker_coset. by rewrite -injm_center; first apply: injm_morphim_inj; rewrite ?norms1. Qed. (* This is Isaacs (2.32)(b). *) Lemma pgroup_cyclic_faithful (p : nat) : p.-group G -> cyclic 'Z(G) -> exists i, cfaithful 'chi[G]_i. Proof. pose Z := 'Ohm_1('Z(G)) => pG cycZG; have nilG := pgroup_nil pG. have [-> | ntG] := eqsVneq G [1]; first by exists 0; apply: cfker_sub. have{pG} [[p_pr _ _] pZ] := (pgroup_pdiv pG ntG, pgroupS (center_sub G) pG). have ntZ: 'Z(G) != [1] by rewrite center_nil_eq1. have{pZ} oZ: #|Z| = p by apply: Ohm1_cyclic_pgroup_prime. apply/existsP; apply: contraR ntZ => /existsPn-not_ffulG. rewrite -Ohm1_eq1 -subG1 /= -/Z -(TI_cfker_irr G); apply/bigcapsP=> i _. rewrite prime_meetG ?oZ // setIC meet_Ohm1 // meet_center_nil ?cfker_normal //. by rewrite -subG1 not_ffulG. Qed. End Center. Section Induced. Variables (gT : finGroupType) (G H : {group gT}). Implicit Types (phi : 'CF(G)) (chi : 'CF(H)). Lemma cfInd_char chi : chi \is a character -> 'Ind[G] chi \is a character. Proof. move=> Nchi; apply/forallP=> i; rewrite coord_cfdot -Frobenius_reciprocity //. by rewrite Cnat_cfdot_char ?cfRes_char ?irr_char. Qed. Lemma cfInd_eq0 chi : H \subset G -> chi \is a character -> ('Ind[G] chi == 0) = (chi == 0). Proof. move=> sHG Nchi; rewrite -!(char1_eq0) ?cfInd_char // cfInd1 //. by rewrite (mulrI_eq0 _ (mulfI _)) ?neq0CiG. Qed. Lemma Ind_irr_neq0 i : H \subset G -> 'Ind[G, H] 'chi_i != 0. Proof. by move/cfInd_eq0->; rewrite ?irr_neq0 ?irr_char. Qed. Definition Ind_Iirr (A B : {set gT}) i := cfIirr ('Ind[B, A] 'chi_i). Lemma constt_cfRes_irr i : {j | j \in irr_constt ('Res[H, G] 'chi_i)}. Proof. apply/sigW/neq0_has_constt/Res_irr_neq0. Qed. Lemma constt_cfInd_irr i : H \subset G -> {j | j \in irr_constt ('Ind[G, H] 'chi_i)}. Proof. by move=> sHG; apply/sigW/neq0_has_constt/Ind_irr_neq0. Qed. Lemma cfker_Res phi : H \subset G -> phi \is a character -> cfker ('Res[H] phi) = H :&: cfker phi. Proof. move=> sHG Nphi; apply/setP=> x; rewrite !cfkerEchar ?cfRes_char // !inE. by apply/andb_id2l=> Hx; rewrite (subsetP sHG) ?cfResE. Qed. (* This is Isaacs Lemma (5.11). *) Lemma cfker_Ind chi : H \subset G -> chi \is a character -> chi != 0 -> cfker ('Ind[G, H] chi) = gcore (cfker chi) G. Proof. move=> sHG Nchi nzchi; rewrite !cfker_nzcharE ?cfInd_char ?cfInd_eq0 //. apply/setP=> x; rewrite inE cfIndE // (can2_eq (mulVKf _) (mulKf _)) ?neq0CG //. rewrite cfInd1 // mulrA -natrM Lagrange // mulr_natl -sumr_const. apply/eqP/bigcapP=> [/normC_sum_upper ker_chiG_x y Gy | ker_chiG_x]. by rewrite mem_conjg inE ker_chiG_x ?groupV // => z _; apply: char1_ge_norm. by apply: eq_bigr => y /groupVr/ker_chiG_x; rewrite mem_conjgV inE => /eqP. Qed. Lemma cfker_Ind_irr i : H \subset G -> cfker ('Ind[G, H] 'chi_i) = gcore (cfker 'chi_i) G. Proof. by move/cfker_Ind->; rewrite ?irr_neq0 ?irr_char. Qed. End Induced. Arguments Ind_Iirr {gT A%g} B%g i%R. math-comp-mathcomp-1.12.0/mathcomp/character/classfun.v000066400000000000000000002775151375767750300231040ustar00rootroot00000000000000(* (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 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. From mathcomp Require Import matrix vector falgebra ssrnum algC algnum. (******************************************************************************) (* This file contains the basic theory of class functions: *) (* 'CF(G) == the type of class functions on G : {group gT}, i.e., *) (* which map gT to the type algC of complex algebraics, *) (* have support in G, and are constant on each conjugacy *) (* class of G. 'CF(G) implements the FalgType interface of *) (* finite-dimensional F-algebras. *) (* The identity 1 : 'CF(G) is the indicator function of G, *) (* and (later) the principal character. *) (* --> The %CF scope (cfun_scope) is bound to the 'CF(_) types. *) (* 'CF(G)%VS == the (total) vector space of 'CF(G). *) (* 'CF(G, A) == the subspace of functions in 'CF(G) with support in A. *) (* phi x == the image of x : gT under phi : 'CF(G). *) (* #[phi]%CF == the multiplicative order of phi : 'CF(G). *) (* cfker phi == the kernel of phi : 'CF(G); note that cfker phi <| G. *) (* cfaithful phi <=> phi : 'CF(G) is faithful (has a trivial kernel). *) (* '1_A == the indicator function of A as a function of 'CF(G). *) (* (Provided A <| G; G is determined by the context.) *) (* phi^*%CF == the function conjugate to phi : 'CF(G). *) (* cfAut u phi == the function conjugate to phi by an algC-automorphism u *) (* phi^u The notation "_ ^u" is only reserved; it is up to *) (* clients to set Notation "phi ^u" := (cfAut u phi). *) (* '[phi, psi] == the convolution of phi, psi : 'CF(G) over G, normalised *) (* '[phi, psi]_G by #|G| so that '[1, 1]_G = 1 (G is usually inferred). *) (* cfdotr psi phi == '[phi, psi] (self-expanding). *) (* '[phi], '[phi]_G == the squared norm '[phi, phi] of phi : 'CF(G). *) (* orthogonal R S <=> each phi in R : seq 'CF(G) is orthogonal to each psi in *) (* S, i.e., '[phi, psi] = 0. As 'CF(G) coerces to seq, one *) (* can write orthogonal phi S and orthogonal phi psi. *) (* pairwise_orthogonal S <=> the class functions in S are pairwise orthogonal *) (* AND non-zero. *) (* orthonormal S <=> S is pairwise orthogonal and all class functions in S *) (* have norm 1. *) (* isometry tau <-> tau : 'CF(D) -> 'CF(R) is an isometry, mapping *) (* '[_, _]_D to '[_, _]_R. *) (* {in CD, isometry tau, to CR} <-> in the domain CD, tau is an isometry *) (* whose range is contained in CR. *) (* cfReal phi <=> phi is real, i.e., phi^* == phi. *) (* cfAut_closed u S <-> S : seq 'CF(G) is closed under conjugation by u. *) (* cfConjC_closed S <-> S : seq 'CF(G) is closed under complex conjugation. *) (* conjC_subset S1 S2 <-> S1 : seq 'CF(G) represents a subset of S2 closed *) (* under complex conjugation. *) (* := [/\ uniq S1, {subset S1 <= S2} & cfConjC_closed S1]. *) (* 'Res[H] phi == the restriction of phi : 'CF(G) to a function of 'CF(H) *) (* 'Res[H, G] phi 'Res[H] phi x = phi x if x \in H (when H \subset G), *) (* 'Res phi 'Res[H] phi x = 0 if x \notin H. The syntax variants *) (* allow H and G to be inferred; the default is to specify *) (* H explicitly, and infer G from the type of phi. *) (* 'Ind[G] phi == the class function of 'CF(G) induced by phi : 'CF(H), *) (* 'Ind[G, H] phi when H \subset G. As with 'Res phi, both G and H can *) (* 'Ind phi be inferred, though usually G isn't. *) (* cfMorph phi == the class function in 'CF(G) that maps x to phi (f x), *) (* where phi : 'CF(f @* G), provided G \subset 'dom f. *) (* cfIsom isoGR phi == the class function in 'CF(R) that maps f x to phi x, *) (* given isoGR : isom G R f, f : {morphism G >-> rT} and *) (* phi : 'CF(G). *) (* (phi %% H)%CF == special case of cfMorph phi, when phi : 'CF(G / H). *) (* (phi / H)%CF == the class function in 'CF(G / H) that coincides with *) (* phi : 'CF(G) on cosets of H \subset cfker phi. *) (* For a group G that is a semidirect product (defG : K ><| H = G), we have *) (* cfSdprod KxH phi == for phi : 'CF(H), the class function of 'CF(G) that *) (* maps k * h to psi h when k \in K and h \in H. *) (* For a group G that is a direct product (with KxH : K \x H = G), we have *) (* cfDprodl KxH phi == for phi : 'CF(K), the class function of 'CF(G) that *) (* maps k * h to phi k when k \in K and h \in H. *) (* cfDprodr KxH psi == for psi : 'CF(H), the class function of 'CF(G) that *) (* maps k * h to psi h when k \in K and h \in H. *) (* cfDprod KxH phi psi == for phi : 'CF(K), psi : 'CF(H), the class function *) (* of 'CF(G) that maps k * h to phi k * psi h (this is *) (* the product of the two functions above). *) (* Finally, given defG : \big[dprod/1]_(i | P i) A i = G, with G and A i *) (* groups and i ranges over a finType, we have *) (* cfBigdprodi defG phi == for phi : 'CF(A i) s.t. P i, the class function *) (* of 'CF(G) that maps x to phi x_i, where x_i is the *) (* (A i)-component of x : G. *) (* cfBigdprod defG phi == for phi : forall i, 'CF(A i), the class function *) (* of 'CF(G) that maps x to \prod_(i | P i) phi i x_i, *) (* where x_i is the (A i)-component of x : G. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope cfun_scope. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Delimit Scope cfun_scope with CF. Reserved Notation "''CF' ( G , A )" (at level 8, format "''CF' ( G , A )"). Reserved Notation "''CF' ( G )" (at level 8, format "''CF' ( G )"). Reserved Notation "''1_' G" (at level 8, G at level 2, format "''1_' G"). Reserved Notation "''Res[' H , G ]" (at level 8). (* only parsing *) Reserved Notation "''Res[' H ]" (at level 8, format "''Res[' H ]"). Reserved Notation "''Res'" (at level 8). (* only parsing *) Reserved Notation "''Ind[' G , H ]" (at level 8). (* only parsing *) Reserved Notation "''Ind[' G ]" (at level 8). (* only "''Ind[' G ]" *) Reserved Notation "''Ind'" (at level 8). (* only parsing *) Reserved Notation "'[ phi , psi ]_ G" (at level 2). (* only parsing *) Reserved Notation "'[ phi , psi ]" (at level 2, format "'[hv' ''[' phi , '/ ' psi ] ']'"). Reserved Notation "'[ phi ]_ G" (at level 2). (* only parsing *) Reserved Notation "'[ phi ]" (at level 2, format "''[' phi ]"). Reserved Notation "phi ^u" (at level 3, format "phi ^u"). Section AlgC. (* Arithmetic properties of group orders in the characteristic 0 field algC. *) Variable (gT : finGroupType). Implicit Types (G : {group gT}) (B : {set gT}). Lemma neq0CG G : (#|G|)%:R != 0 :> algC. Proof. exact: natrG_neq0. Qed. Lemma neq0CiG G B : (#|G : B|)%:R != 0 :> algC. Proof. exact: natr_indexg_neq0. Qed. Lemma gt0CG G : 0 < #|G|%:R :> algC. Proof. exact: natrG_gt0. Qed. Lemma gt0CiG G B : 0 < #|G : B|%:R :> algC. Proof. exact: natr_indexg_gt0. Qed. Lemma algC'G G : [char algC]^'.-group G. Proof. by apply/pgroupP=> p _; rewrite inE /= char_num. Qed. End AlgC. Section Defs. Variable gT : finGroupType. Definition is_class_fun (B : {set gT}) (f : {ffun gT -> algC}) := [forall x, forall y in B, f (x ^ y) == f x] && (support f \subset B). Lemma intro_class_fun (G : {group gT}) f : {in G &, forall x y, f (x ^ y) = f x} -> (forall x, x \notin G -> f x = 0) -> is_class_fun G (finfun f). Proof. move=> fJ Gf; apply/andP; split; last first. by apply/supportP=> x notAf; rewrite ffunE Gf. apply/'forall_eqfun_inP=> x y Gy; rewrite !ffunE. by have [/fJ-> // | notGx] := boolP (x \in G); rewrite !Gf ?groupJr. Qed. Variable B : {set gT}. Local Notation G := <>. Record classfun : predArgType := Classfun {cfun_val; _ : is_class_fun G cfun_val}. Implicit Types phi psi xi : classfun. (* The default expansion lemma cfunE requires key = 0. *) Fact classfun_key : unit. Proof. by []. Qed. Definition Cfun := locked_with classfun_key (fun flag : nat => Classfun). Canonical cfun_subType := Eval hnf in [subType for cfun_val]. Definition cfun_eqMixin := Eval hnf in [eqMixin of classfun by <:]. Canonical cfun_eqType := Eval hnf in EqType classfun cfun_eqMixin. Definition cfun_choiceMixin := Eval hnf in [choiceMixin of classfun by <:]. Canonical cfun_choiceType := Eval hnf in ChoiceType classfun cfun_choiceMixin. Definition fun_of_cfun phi := cfun_val phi : gT -> algC. Coercion fun_of_cfun : classfun >-> Funclass. Lemma cfunElock k f fP : @Cfun k (finfun f) fP =1 f. Proof. by rewrite locked_withE; apply: ffunE. Qed. Lemma cfunE f fP : @Cfun 0 (finfun f) fP =1 f. Proof. exact: cfunElock. Qed. Lemma cfunP phi psi : phi =1 psi <-> phi = psi. Proof. by split=> [/ffunP/val_inj | ->]. Qed. Lemma cfun0gen phi x : x \notin G -> phi x = 0. Proof. by case: phi => f fP; case: (andP fP) => _ /supportP; apply. Qed. Lemma cfun_in_genP phi psi : {in G, phi =1 psi} -> phi = psi. Proof. move=> eq_phi; apply/cfunP=> x. by have [/eq_phi-> // | notAx] := boolP (x \in G); rewrite !cfun0gen. Qed. Lemma cfunJgen phi x y : y \in G -> phi (x ^ y) = phi x. Proof. case: phi => f fP Gy; apply/eqP. by case: (andP fP) => /'forall_forall_inP->. Qed. Fact cfun_zero_subproof : is_class_fun G (0 : {ffun _}). Proof. exact: intro_class_fun. Qed. Definition cfun_zero := Cfun 0 cfun_zero_subproof. Fact cfun_comp_subproof f phi : f 0 = 0 -> is_class_fun G [ffun x => f (phi x)]. Proof. by move=> f0; apply: intro_class_fun => [x y _ /cfunJgen | x /cfun0gen] ->. Qed. Definition cfun_comp f f0 phi := Cfun 0 (@cfun_comp_subproof f phi f0). Definition cfun_opp := cfun_comp (oppr0 _). Fact cfun_add_subproof phi psi : is_class_fun G [ffun x => phi x + psi x]. Proof. apply: intro_class_fun => [x y Gx Gy | x notGx]; rewrite ?cfunJgen //. by rewrite !cfun0gen ?add0r. Qed. Definition cfun_add phi psi := Cfun 0 (cfun_add_subproof phi psi). Fact cfun_indicator_subproof (A : {set gT}) : is_class_fun G [ffun x => ((x \in G) && (x ^: G \subset A))%:R]. Proof. apply: intro_class_fun => [x y Gx Gy | x /negbTE/= -> //]. by rewrite groupJr ?classGidl. Qed. Definition cfun_indicator A := Cfun 1 (cfun_indicator_subproof A). Local Notation "''1_' A" := (cfun_indicator A) : ring_scope. Lemma cfun1Egen x : '1_G x = (x \in G)%:R. Proof. by rewrite cfunElock andb_idr // => /class_subG->. Qed. Fact cfun_mul_subproof phi psi : is_class_fun G [ffun x => phi x * psi x]. Proof. apply: intro_class_fun => [x y Gx Gy | x notGx]; rewrite ?cfunJgen //. by rewrite cfun0gen ?mul0r. Qed. Definition cfun_mul phi psi := Cfun 0 (cfun_mul_subproof phi psi). Definition cfun_unit := [pred phi : classfun | [forall x in G, phi x != 0]]. Definition cfun_inv phi := if phi \in cfun_unit then cfun_comp (invr0 _) phi else phi. Definition cfun_scale a := cfun_comp (mulr0 a). Fact cfun_addA : associative cfun_add. Proof. by move=> phi psi xi; apply/cfunP=> x; rewrite !cfunE addrA. Qed. Fact cfun_addC : commutative cfun_add. Proof. by move=> phi psi; apply/cfunP=> x; rewrite !cfunE addrC. Qed. Fact cfun_add0 : left_id cfun_zero cfun_add. Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE add0r. Qed. Fact cfun_addN : left_inverse cfun_zero cfun_opp cfun_add. Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE addNr. Qed. Definition cfun_zmodMixin := ZmodMixin cfun_addA cfun_addC cfun_add0 cfun_addN. Canonical cfun_zmodType := ZmodType classfun cfun_zmodMixin. Lemma muln_cfunE phi n x : (phi *+ n) x = phi x *+ n. Proof. by elim: n => [|n IHn]; rewrite ?mulrS !cfunE ?IHn. Qed. Lemma sum_cfunE I r (P : pred I) (phi : I -> classfun) x : (\sum_(i <- r | P i) phi i) x = \sum_(i <- r | P i) (phi i) x. Proof. by elim/big_rec2: _ => [|i _ psi _ <-]; rewrite cfunE. Qed. Fact cfun_mulA : associative cfun_mul. Proof. by move=> phi psi xi; apply/cfunP=> x; rewrite !cfunE mulrA. Qed. Fact cfun_mulC : commutative cfun_mul. Proof. by move=> phi psi; apply/cfunP=> x; rewrite !cfunE mulrC. Qed. Fact cfun_mul1 : left_id '1_G cfun_mul. Proof. by move=> phi; apply: cfun_in_genP => x Gx; rewrite !cfunE cfun1Egen Gx mul1r. Qed. Fact cfun_mulD : left_distributive cfun_mul cfun_add. Proof. by move=> phi psi xi; apply/cfunP=> x; rewrite !cfunE mulrDl. Qed. Fact cfun_nz1 : '1_G != 0. Proof. by apply/eqP=> /cfunP/(_ 1%g)/eqP; rewrite cfun1Egen cfunE group1 oner_eq0. Qed. Definition cfun_ringMixin := ComRingMixin cfun_mulA cfun_mulC cfun_mul1 cfun_mulD cfun_nz1. Canonical cfun_ringType := RingType classfun cfun_ringMixin. Canonical cfun_comRingType := ComRingType classfun cfun_mulC. Lemma expS_cfunE phi n x : (phi ^+ n.+1) x = phi x ^+ n.+1. Proof. by elim: n => //= n IHn; rewrite !cfunE IHn. Qed. Fact cfun_mulV : {in cfun_unit, left_inverse 1 cfun_inv *%R}. Proof. move=> phi Uphi; rewrite /cfun_inv Uphi; apply/cfun_in_genP=> x Gx. by rewrite !cfunE cfun1Egen Gx mulVf ?(forall_inP Uphi). Qed. Fact cfun_unitP phi psi : psi * phi = 1 -> phi \in cfun_unit. Proof. move/cfunP=> phiK; apply/forall_inP=> x Gx; rewrite -unitfE; apply/unitrP. by exists (psi x); have:= phiK x; rewrite !cfunE cfun1Egen Gx mulrC. Qed. Fact cfun_inv0id : {in [predC cfun_unit], cfun_inv =1 id}. Proof. by rewrite /cfun_inv => phi /negbTE/= ->. Qed. Definition cfun_unitMixin := ComUnitRingMixin cfun_mulV cfun_unitP cfun_inv0id. Canonical cfun_unitRingType := UnitRingType classfun cfun_unitMixin. Canonical cfun_comUnitRingType := [comUnitRingType of classfun]. Fact cfun_scaleA a b phi : cfun_scale a (cfun_scale b phi) = cfun_scale (a * b) phi. Proof. by apply/cfunP=> x; rewrite !cfunE mulrA. Qed. Fact cfun_scale1 : left_id 1 cfun_scale. Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE mul1r. Qed. Fact cfun_scaleDr : right_distributive cfun_scale +%R. Proof. by move=> a phi psi; apply/cfunP=> x; rewrite !cfunE mulrDr. Qed. Fact cfun_scaleDl phi : {morph cfun_scale^~ phi : a b / a + b}. Proof. by move=> a b; apply/cfunP=> x; rewrite !cfunE mulrDl. Qed. Definition cfun_lmodMixin := LmodMixin cfun_scaleA cfun_scale1 cfun_scaleDr cfun_scaleDl. Canonical cfun_lmodType := LmodType algC classfun cfun_lmodMixin. Fact cfun_scaleAl a phi psi : a *: (phi * psi) = (a *: phi) * psi. Proof. by apply/cfunP=> x; rewrite !cfunE mulrA. Qed. Fact cfun_scaleAr a phi psi : a *: (phi * psi) = phi * (a *: psi). Proof. by rewrite !(mulrC phi) cfun_scaleAl. Qed. Canonical cfun_lalgType := LalgType algC classfun cfun_scaleAl. Canonical cfun_algType := AlgType algC classfun cfun_scaleAr. Canonical cfun_unitAlgType := [unitAlgType algC of classfun]. Section Automorphism. Variable u : {rmorphism algC -> algC}. Definition cfAut := cfun_comp (rmorph0 u). Lemma cfAut_cfun1i A : cfAut '1_A = '1_A. Proof. by apply/cfunP=> x; rewrite !cfunElock rmorph_nat. Qed. Lemma cfAutZ a phi : cfAut (a *: phi) = u a *: cfAut phi. Proof. by apply/cfunP=> x; rewrite !cfunE rmorphM. Qed. Lemma cfAut_is_rmorphism : rmorphism cfAut. Proof. by do 2?split=> [phi psi|]; apply/cfunP=> x; rewrite ?cfAut_cfun1i // !cfunE (rmorphB, rmorphM). Qed. Canonical cfAut_additive := Additive cfAut_is_rmorphism. Canonical cfAut_rmorphism := RMorphism cfAut_is_rmorphism. Lemma cfAut_cfun1 : cfAut 1 = 1. Proof. exact: rmorph1. Qed. Lemma cfAut_scalable : scalable_for (u \; *:%R) cfAut. Proof. by move=> a phi; apply/cfunP=> x; rewrite !cfunE rmorphM. Qed. Canonical cfAut_linear := AddLinear cfAut_scalable. Canonical cfAut_lrmorphism := [lrmorphism of cfAut]. Definition cfAut_closed (S : seq classfun) := {in S, forall phi, cfAut phi \in S}. End Automorphism. Definition cfReal phi := cfAut conjC phi == phi. Definition cfConjC_subset (S1 S2 : seq classfun) := [/\ uniq S1, {subset S1 <= S2} & cfAut_closed conjC S1]. Fact cfun_vect_iso : Vector.axiom #|classes G| classfun. Proof. exists (fun phi => \row_i phi (repr (enum_val i))) => [a phi psi|]. by apply/rowP=> i; rewrite !(mxE, cfunE). set n := #|_|; pose eK x : 'I_n := enum_rank_in (classes1 _) (x ^: G). have rV2vP v : is_class_fun G [ffun x => v (eK x) *+ (x \in G)]. apply: intro_class_fun => [x y Gx Gy | x /negbTE/=-> //]. by rewrite groupJr // /eK classGidl. exists (fun v : 'rV_n => Cfun 0 (rV2vP (v 0))) => [phi | v]. apply/cfun_in_genP=> x Gx; rewrite cfunE Gx mxE enum_rankK_in ?mem_classes //. by have [y Gy ->] := repr_class <> x; rewrite cfunJgen. apply/rowP=> i; rewrite mxE cfunE; have /imsetP[x Gx def_i] := enum_valP i. rewrite def_i; have [y Gy ->] := repr_class <> x. by rewrite groupJ // /eK classGidl // -def_i enum_valK_in. Qed. Definition cfun_vectMixin := VectMixin cfun_vect_iso. Canonical cfun_vectType := VectType algC classfun cfun_vectMixin. Canonical cfun_FalgType := [FalgType algC of classfun]. Definition cfun_base A : #|classes B ::&: A|.-tuple classfun := [tuple of [seq '1_xB | xB in classes B ::&: A]]. Definition classfun_on A := <>%VS. Definition cfdot phi psi := #|B|%:R^-1 * \sum_(x in B) phi x * (psi x)^*. Definition cfdotr psi phi := cfdot phi psi. Definition cfnorm phi := cfdot phi phi. Coercion seq_of_cfun phi := [:: phi]. Definition cforder phi := \big[lcmn/1%N]_(x in <>) #[phi x]%C. End Defs. Bind Scope cfun_scope with classfun. Arguments classfun {gT} B%g. Arguments classfun_on {gT} B%g A%g. Arguments cfun_indicator {gT} B%g. Arguments cfAut {gT B%g} u phi%CF. Arguments cfReal {gT B%g} phi%CF. Arguments cfdot {gT B%g} phi%CF psi%CF. Arguments cfdotr {gT B%g} psi%CF phi%CF /. Arguments cfnorm {gT B%g} phi%CF /. Notation "''CF' ( G )" := (classfun G) : type_scope. Notation "''CF' ( G )" := (@fullv _ (cfun_vectType G)) : vspace_scope. Notation "''1_' A" := (cfun_indicator _ A) : ring_scope. Notation "''CF' ( G , A )" := (classfun_on G A) : ring_scope. Notation "1" := (@GRing.one (cfun_ringType _)) (only parsing) : cfun_scope. Notation "phi ^*" := (cfAut conjC phi) : cfun_scope. Notation cfConjC_closed := (cfAut_closed conjC). Prenex Implicits cfReal. (* Workaround for overeager projection reduction. *) Notation eqcfP := (@eqP (cfun_eqType _) _ _) (only parsing). Notation "#[ phi ]" := (cforder phi) : cfun_scope. Notation "''[' u , v ]_ G":= (@cfdot _ G u v) (only parsing) : ring_scope. Notation "''[' u , v ]" := (cfdot u v) : ring_scope. Notation "''[' u ]_ G" := '[u, u]_G (only parsing) : ring_scope. Notation "''[' u ]" := '[u, u] : ring_scope. Section Predicates. Variables (gT rT : finGroupType) (D : {set gT}) (R : {set rT}). Implicit Types (phi psi : 'CF(D)) (S : seq 'CF(D)) (tau : 'CF(D) -> 'CF(R)). Definition cfker phi := [set x in D | [forall y, phi (x * y)%g == phi y]]. Definition cfaithful phi := cfker phi \subset [1]. Definition ortho_rec S1 S2 := all [pred phi | all [pred psi | '[phi, psi] == 0] S2] S1. Fixpoint pair_ortho_rec S := if S is psi :: S' then ortho_rec psi S' && pair_ortho_rec S' else true. (* We exclude 0 from pairwise orthogonal sets. *) Definition pairwise_orthogonal S := (0 \notin S) && pair_ortho_rec S. Definition orthonormal S := all [pred psi | '[psi] == 1] S && pair_ortho_rec S. Definition isometry tau := forall phi psi, '[tau phi, tau psi] = '[phi, psi]. Definition isometry_from_to mCFD tau mCFR := prop_in2 mCFD (inPhantom (isometry tau)) /\ prop_in1 mCFD (inPhantom (forall phi, in_mem (tau phi) mCFR)). End Predicates. (* Outside section so the nosimpl does not get "cooked" out. *) Definition orthogonal gT D S1 S2 := nosimpl (@ortho_rec gT D S1 S2). Arguments cfker {gT D%g} phi%CF. Arguments cfaithful {gT D%g} phi%CF. Arguments orthogonal {gT D%g} S1%CF S2%CF. Arguments pairwise_orthogonal {gT D%g} S%CF. Arguments orthonormal {gT D%g} S%CF. Arguments isometry {gT rT D%g R%g} tau%CF. Notation "{ 'in' CFD , 'isometry' tau , 'to' CFR }" := (isometry_from_to (mem CFD) tau (mem CFR)) (at level 0, format "{ 'in' CFD , 'isometry' tau , 'to' CFR }") : type_scope. Section ClassFun. Variables (gT : finGroupType) (G : {group gT}). Implicit Types (A B : {set gT}) (H K : {group gT}) (phi psi xi : 'CF(G)). Local Notation "''1_' A" := (cfun_indicator G A). Lemma cfun0 phi x : x \notin G -> phi x = 0. Proof. by rewrite -{1}(genGid G) => /(cfun0gen phi). Qed. Lemma support_cfun phi : support phi \subset G. Proof. by apply/subsetP=> g; apply: contraR => /cfun0->. Qed. Lemma cfunJ phi x y : y \in G -> phi (x ^ y) = phi x. Proof. by rewrite -{1}(genGid G) => /(cfunJgen phi)->. Qed. Lemma cfun_repr phi x : phi (repr (x ^: G)) = phi x. Proof. by have [y Gy ->] := repr_class G x; apply: cfunJ. Qed. Lemma cfun_inP phi psi : {in G, phi =1 psi} -> phi = psi. Proof. by rewrite -{1}genGid => /cfun_in_genP. Qed. Lemma cfuniE A x : A <| G -> '1_A x = (x \in A)%:R. Proof. case/andP=> sAG nAG; rewrite cfunElock genGid. by rewrite class_sub_norm // andb_idl // => /(subsetP sAG). Qed. Lemma support_cfuni A : A <| G -> support '1_A =i A. Proof. by move=> nsAG x; rewrite !inE cfuniE // pnatr_eq0 -lt0n lt0b. Qed. Lemma eq_mul_cfuni A phi : A <| G -> {in A, phi * '1_A =1 phi}. Proof. by move=> nsAG x Ax; rewrite cfunE cfuniE // Ax mulr1. Qed. Lemma eq_cfuni A : A <| G -> {in A, '1_A =1 (1 : 'CF(G))}. Proof. by rewrite -['1_A]mul1r; apply: eq_mul_cfuni. Qed. Lemma cfuniG : '1_G = 1. Proof. by rewrite -[G in '1_G]genGid. Qed. Lemma cfun1E g : (1 : 'CF(G)) g = (g \in G)%:R. Proof. by rewrite -cfuniG cfuniE. Qed. Lemma cfun11 : (1 : 'CF(G)) 1%g = 1. Proof. by rewrite cfun1E group1. Qed. Lemma prod_cfunE I r (P : pred I) (phi : I -> 'CF(G)) x : x \in G -> (\prod_(i <- r | P i) phi i) x = \prod_(i <- r | P i) (phi i) x. Proof. by move=> Gx; elim/big_rec2: _ => [|i _ psi _ <-]; rewrite ?cfunE ?cfun1E ?Gx. Qed. Lemma exp_cfunE phi n x : x \in G -> (phi ^+ n) x = phi x ^+ n. Proof. by rewrite -[n]card_ord -!prodr_const; apply: prod_cfunE. Qed. Lemma mul_cfuni A B : '1_A * '1_B = '1_(A :&: B) :> 'CF(G). Proof. apply/cfunP=> g; rewrite !cfunElock -natrM mulnb subsetI. by rewrite andbCA !andbA andbb. Qed. Lemma cfun_classE x y : '1_(x ^: G) y = ((x \in G) && (y \in x ^: G))%:R. Proof. rewrite cfunElock genGid class_sub_norm ?class_norm //; congr (_ : bool)%:R. by apply: andb_id2r => /imsetP[z Gz ->]; rewrite groupJr. Qed. Lemma cfun_on_sum A : 'CF(G, A) = (\sum_(xG in classes G | xG \subset A) <['1_xG]>)%VS. Proof. by rewrite ['CF(G, A)]span_def big_image; apply: eq_bigl => xG; rewrite !inE. Qed. Lemma cfun_onP A phi : reflect (forall x, x \notin A -> phi x = 0) (phi \in 'CF(G, A)). Proof. apply: (iffP idP) => [/coord_span-> x notAx | Aphi]. set b := cfun_base G A; rewrite sum_cfunE big1 // => i _; rewrite cfunE. have /mapP[xG]: b`_i \in b by rewrite -tnth_nth mem_tnth. rewrite mem_enum => /setIdP[/imsetP[y Gy ->] Ay] ->. by rewrite cfun_classE Gy (contraNF (subsetP Ay x)) ?mulr0. suffices <-: \sum_(xG in classes G) phi (repr xG) *: '1_xG = phi. apply: memv_suml => _ /imsetP[x Gx ->]; rewrite rpredZeq cfun_repr. have [s_xG_A | /subsetPn[_ /imsetP[y Gy ->]]] := boolP (x ^: G \subset A). by rewrite cfun_on_sum [_ \in _](sumv_sup (x ^: G)) ?mem_classes ?orbT. by move/Aphi; rewrite cfunJ // => ->; rewrite eqxx. apply/cfun_inP=> x Gx; rewrite sum_cfunE (bigD1 (x ^: G)) ?mem_classes //=. rewrite cfunE cfun_repr cfun_classE Gx class_refl mulr1. rewrite big1 ?addr0 // => _ /andP[/imsetP[y Gy ->]]; apply: contraNeq. rewrite cfunE cfun_repr cfun_classE Gy mulf_eq0 => /norP[_]. by rewrite pnatr_eq0 -lt0n lt0b => /class_eqP->. Qed. Arguments cfun_onP {A phi}. Lemma cfun_on0 A phi x : phi \in 'CF(G, A) -> x \notin A -> phi x = 0. Proof. by move/cfun_onP; apply. Qed. Lemma sum_by_classes (R : ringType) (F : gT -> R) : {in G &, forall g h, F (g ^ h) = F g} -> \sum_(g in G) F g = \sum_(xG in classes G) #|xG|%:R * F (repr xG). Proof. move=> FJ; rewrite {1}(partition_big _ _ ((@mem_classes gT)^~ G)) /=. apply: eq_bigr => _ /imsetP[x Gx ->]; have [y Gy ->] := repr_class G x. rewrite mulr_natl -sumr_const FJ {y Gy}//; apply/esym/eq_big=> y /=. apply/idP/andP=> [xGy | [Gy /eqP<-]]; last exact: class_refl. by rewrite (class_eqP xGy) (subsetP (class_subG Gx (subxx _))). by case/imsetP=> z Gz ->; rewrite FJ. Qed. Lemma cfun_base_free A : free (cfun_base G A). Proof. have b_i (i : 'I_#|classes G ::&: A|) : (cfun_base G A)`_i = '1_(enum_val i). by rewrite /enum_val -!tnth_nth tnth_map. apply/freeP => s S0 i; move/cfunP/(_ (repr (enum_val i))): S0. rewrite sum_cfunE (bigD1 i) //= big1 ?addr0 => [|j]. rewrite b_i !cfunE; have /setIdP[/imsetP[x Gx ->] _] := enum_valP i. by rewrite cfun_repr cfun_classE Gx class_refl mulr1. apply: contraNeq; rewrite b_i !cfunE mulf_eq0 => /norP[_]. rewrite -(inj_eq enum_val_inj). have /setIdP[/imsetP[x _ ->] _] := enum_valP i; rewrite cfun_repr. have /setIdP[/imsetP[y Gy ->] _] := enum_valP j; rewrite cfun_classE Gy. by rewrite pnatr_eq0 -lt0n lt0b => /class_eqP->. Qed. Lemma dim_cfun : \dim 'CF(G) = #|classes G|. Proof. by rewrite dimvf /Vector.dim /= genGid. Qed. Lemma dim_cfun_on A : \dim 'CF(G, A) = #|classes G ::&: A|. Proof. by rewrite (eqnP (cfun_base_free A)) size_tuple. Qed. Lemma dim_cfun_on_abelian A : abelian G -> A \subset G -> \dim 'CF(G, A) = #|A|. Proof. move/abelian_classP=> cGG sAG; rewrite -(card_imset _ set1_inj) dim_cfun_on. apply/eq_card=> xG; rewrite !inE. apply/andP/imsetP=> [[/imsetP[x Gx ->] Ax] | [x Ax ->]] {xG}. by rewrite cGG ?sub1set // in Ax *; exists x. by rewrite -{1}(cGG x) ?mem_classes ?(subsetP sAG) ?sub1set. Qed. Lemma cfuni_on A : '1_A \in 'CF(G, A). Proof. apply/cfun_onP=> x notAx; rewrite cfunElock genGid. by case: andP => // [[_ s_xG_A]]; rewrite (subsetP s_xG_A) ?class_refl in notAx. Qed. Lemma mul_cfuni_on A phi : phi * '1_A \in 'CF(G, A). Proof. by apply/cfun_onP=> x /(cfun_onP (cfuni_on A)) Ax0; rewrite cfunE Ax0 mulr0. Qed. Lemma cfun_onE phi A : (phi \in 'CF(G, A)) = (support phi \subset A). Proof. exact: (sameP cfun_onP supportP). Qed. Lemma cfun_onT phi : phi \in 'CF(G, [set: gT]). Proof. by rewrite cfun_onE. Qed. Lemma cfun_onD1 phi A : (phi \in 'CF(G, A^#)) = (phi \in 'CF(G, A)) && (phi 1%g == 0). Proof. by rewrite !cfun_onE -!(eq_subset (in_set (support _))) subsetD1 !inE negbK. Qed. Lemma cfun_onG phi : phi \in 'CF(G, G). Proof. by rewrite cfun_onE support_cfun. Qed. Lemma cfunD1E phi : (phi \in 'CF(G, G^#)) = (phi 1%g == 0). Proof. by rewrite cfun_onD1 cfun_onG. Qed. Lemma cfunGid : 'CF(G, G) = 'CF(G)%VS. Proof. by apply/vspaceP=> phi; rewrite cfun_onG memvf. Qed. Lemma cfun_onS A B phi : B \subset A -> phi \in 'CF(G, B) -> phi \in 'CF(G, A). Proof. by rewrite !cfun_onE => sBA /subset_trans->. Qed. Lemma cfun_complement A : A <| G -> ('CF(G, A) + 'CF(G, G :\: A)%SET = 'CF(G))%VS. Proof. case/andP=> sAG nAG; rewrite -cfunGid [rhs in _ = rhs]cfun_on_sum. rewrite (bigID (fun B => B \subset A)) /=. congr (_ + _)%VS; rewrite cfun_on_sum; apply: eq_bigl => /= xG. rewrite andbAC; apply/esym/andb_idr=> /andP[/imsetP[x Gx ->] _]. by rewrite class_subG. rewrite -andbA; apply: andb_id2l => /imsetP[x Gx ->]. by rewrite !class_sub_norm ?normsD ?normG // inE andbC. Qed. Lemma cfConjCE phi x : (phi^*)%CF x = (phi x)^*. Proof. by rewrite cfunE. Qed. Lemma cfConjCK : involutive (fun phi => phi^*)%CF. Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE conjCK. Qed. Lemma cfConjC_cfun1 : (1^*)%CF = 1 :> 'CF(G). Proof. exact: rmorph1. Qed. (* Class function kernel and faithful class functions *) Fact cfker_is_group phi : group_set (cfker phi). Proof. apply/group_setP; split=> [|x y]; rewrite !inE ?group1. by apply/forallP=> y; rewrite mul1g. case/andP=> Gx /forallP-Kx /andP[Gy /forallP-Ky]; rewrite groupM //. by apply/forallP=> z; rewrite -mulgA (eqP (Kx _)) Ky. Qed. Canonical cfker_group phi := Group (cfker_is_group phi). Lemma cfker_sub phi : cfker phi \subset G. Proof. by rewrite /cfker setIdE subsetIl. Qed. Lemma cfker_norm phi : G \subset 'N(cfker phi). Proof. apply/subsetP=> z Gz; have phiJz := cfunJ phi _ (groupVr Gz). rewrite inE; apply/subsetP=> _ /imsetP[x /setIdP[Gx /forallP-Kx] ->]. rewrite inE groupJ //; apply/forallP=> y. by rewrite -(phiJz y) -phiJz conjMg conjgK Kx. Qed. Lemma cfker_normal phi : cfker phi <| G. Proof. by rewrite /normal cfker_sub cfker_norm. Qed. Lemma cfkerMl phi x y : x \in cfker phi -> phi (x * y)%g = phi y. Proof. by case/setIdP=> _ /eqfunP->. Qed. Lemma cfkerMr phi x y : x \in cfker phi -> phi (y * x)%g = phi y. Proof. by move=> Kx; rewrite conjgC cfkerMl ?cfunJ ?(subsetP (cfker_sub phi)). Qed. Lemma cfker1 phi x : x \in cfker phi -> phi x = phi 1%g. Proof. by move=> Kx; rewrite -[x]mulg1 cfkerMl. Qed. Lemma cfker_cfun0 : @cfker _ G 0 = G. Proof. apply/setP=> x; rewrite !inE andb_idr // => Gx; apply/forallP=> y. by rewrite !cfunE. Qed. Lemma cfker_add phi psi : cfker phi :&: cfker psi \subset cfker (phi + psi). Proof. apply/subsetP=> x /setIP[Kphi_x Kpsi_x]; have [Gx _] := setIdP Kphi_x. by rewrite inE Gx; apply/forallP=> y; rewrite !cfunE !cfkerMl. Qed. Lemma cfker_sum I r (P : pred I) (Phi : I -> 'CF(G)) : G :&: \bigcap_(i <- r | P i) cfker (Phi i) \subset cfker (\sum_(i <- r | P i) Phi i). Proof. elim/big_rec2: _ => [|i K psi Pi sK_psi]; first by rewrite setIT cfker_cfun0. by rewrite setICA; apply: subset_trans (setIS _ sK_psi) (cfker_add _ _). Qed. Lemma cfker_scale a phi : cfker phi \subset cfker (a *: phi). Proof. apply/subsetP=> x Kphi_x; have [Gx _] := setIdP Kphi_x. by rewrite inE Gx; apply/forallP=> y; rewrite !cfunE cfkerMl. Qed. Lemma cfker_scale_nz a phi : a != 0 -> cfker (a *: phi) = cfker phi. Proof. move=> nz_a; apply/eqP. by rewrite eqEsubset -{2}(scalerK nz_a phi) !cfker_scale. Qed. Lemma cfker_opp phi : cfker (- phi) = cfker phi. Proof. by rewrite -scaleN1r cfker_scale_nz // oppr_eq0 oner_eq0. Qed. Lemma cfker_cfun1 : @cfker _ G 1 = G. Proof. apply/setP=> x; rewrite !inE andb_idr // => Gx; apply/forallP=> y. by rewrite !cfun1E groupMl. Qed. Lemma cfker_mul phi psi : cfker phi :&: cfker psi \subset cfker (phi * psi). Proof. apply/subsetP=> x /setIP[Kphi_x Kpsi_x]; have [Gx _] := setIdP Kphi_x. by rewrite inE Gx; apply/forallP=> y; rewrite !cfunE !cfkerMl. Qed. Lemma cfker_prod I r (P : pred I) (Phi : I -> 'CF(G)) : G :&: \bigcap_(i <- r | P i) cfker (Phi i) \subset cfker (\prod_(i <- r | P i) Phi i). Proof. elim/big_rec2: _ => [|i K psi Pi sK_psi]; first by rewrite setIT cfker_cfun1. by rewrite setICA; apply: subset_trans (setIS _ sK_psi) (cfker_mul _ _). Qed. Lemma cfaithfulE phi : cfaithful phi = (cfker phi \subset [1]). Proof. by []. Qed. End ClassFun. Arguments classfun_on {gT} B%g A%g. Notation "''CF' ( G , A )" := (classfun_on G A) : ring_scope. Arguments cfun_onP {gT G A phi}. Arguments cfConjCK {gT G} phi : rename. Hint Resolve cfun_onT : core. Section DotProduct. Variable (gT : finGroupType) (G : {group gT}). Implicit Types (M : {group gT}) (phi psi xi : 'CF(G)) (R S : seq 'CF(G)). Lemma cfdotE phi psi : '[phi, psi] = #|G|%:R^-1 * \sum_(x in G) phi x * (psi x)^*. Proof. by []. Qed. Lemma cfdotElr A B phi psi : phi \in 'CF(G, A) -> psi \in 'CF(G, B) -> '[phi, psi] = #|G|%:R^-1 * \sum_(x in A :&: B) phi x * (psi x)^*. Proof. move=> Aphi Bpsi; rewrite (big_setID G) cfdotE (big_setID (A :&: B)) setIC /=. congr (_ * (_ + _)); rewrite !big1 // => x /setDP[_]. by move/cfun0->; rewrite mul0r. rewrite inE; case/nandP=> notABx; first by rewrite (cfun_on0 Aphi) ?mul0r. by rewrite (cfun_on0 Bpsi) // rmorph0 mulr0. Qed. Lemma cfdotEl A phi psi : phi \in 'CF(G, A) -> '[phi, psi] = #|G|%:R^-1 * \sum_(x in A) phi x * (psi x)^*. Proof. by move=> Aphi; rewrite (cfdotElr Aphi (cfun_onT psi)) setIT. Qed. Lemma cfdotEr A phi psi : psi \in 'CF(G, A) -> '[phi, psi] = #|G|%:R^-1 * \sum_(x in A) phi x * (psi x)^*. Proof. by move=> Apsi; rewrite (cfdotElr (cfun_onT phi) Apsi) setTI. Qed. Lemma cfdot_complement A phi psi : phi \in 'CF(G, A) -> psi \in 'CF(G, G :\: A) -> '[phi, psi] = 0. Proof. move=> Aphi A'psi; rewrite (cfdotElr Aphi A'psi). by rewrite setDE setICA setICr setI0 big_set0 mulr0. Qed. Lemma cfnormE A phi : phi \in 'CF(G, A) -> '[phi] = #|G|%:R^-1 * (\sum_(x in A) `|phi x| ^+ 2). Proof. by move/cfdotEl->; rewrite (eq_bigr _ (fun _ _ => normCK _)). Qed. Lemma eq_cfdotl A phi1 phi2 psi : psi \in 'CF(G, A) -> {in A, phi1 =1 phi2} -> '[phi1, psi] = '[phi2, psi]. Proof. move/cfdotEr=> eq_dot eq_phi; rewrite !eq_dot; congr (_ * _). by apply: eq_bigr => x Ax; rewrite eq_phi. Qed. Lemma cfdot_cfuni A B : A <| G -> B <| G -> '['1_A, '1_B]_G = #|A :&: B|%:R / #|G|%:R. Proof. move=> nsAG nsBG; rewrite (cfdotElr (cfuni_on G A) (cfuni_on G B)) mulrC. congr (_ / _); rewrite -sumr_const; apply: eq_bigr => x /setIP[Ax Bx]. by rewrite !cfuniE // Ax Bx rmorph1 mulr1. Qed. Lemma cfnorm1 : '[1]_G = 1. Proof. by rewrite cfdot_cfuni ?genGid // setIid divff ?neq0CG. Qed. Lemma cfdotrE psi phi : cfdotr psi phi = '[phi, psi]. Proof. by []. Qed. Lemma cfdotr_is_linear xi : linear (cfdotr xi : 'CF(G) -> algC^o). Proof. move=> a phi psi; rewrite scalerAr -mulrDr; congr (_ * _). rewrite linear_sum -big_split; apply: eq_bigr => x _ /=. by rewrite !cfunE mulrDl -mulrA. Qed. Canonical cfdotr_additive xi := Additive (cfdotr_is_linear xi). Canonical cfdotr_linear xi := Linear (cfdotr_is_linear xi). Lemma cfdot0l xi : '[0, xi] = 0. Proof. by rewrite -cfdotrE linear0. Qed. Lemma cfdotNl xi phi : '[- phi, xi] = - '[phi, xi]. Proof. by rewrite -!cfdotrE linearN. Qed. Lemma cfdotDl xi phi psi : '[phi + psi, xi] = '[phi, xi] + '[psi, xi]. Proof. by rewrite -!cfdotrE linearD. Qed. Lemma cfdotBl xi phi psi : '[phi - psi, xi] = '[phi, xi] - '[psi, xi]. Proof. by rewrite -!cfdotrE linearB. Qed. Lemma cfdotMnl xi phi n : '[phi *+ n, xi] = '[phi, xi] *+ n. Proof. by rewrite -!cfdotrE linearMn. Qed. Lemma cfdot_suml xi I r (P : pred I) (phi : I -> 'CF(G)) : '[\sum_(i <- r | P i) phi i, xi] = \sum_(i <- r | P i) '[phi i, xi]. Proof. by rewrite -!cfdotrE linear_sum. Qed. Lemma cfdotZl xi a phi : '[a *: phi, xi] = a * '[phi, xi]. Proof. by rewrite -!cfdotrE linearZ. Qed. Lemma cfdotC phi psi : '[phi, psi] = ('[psi, phi])^*. Proof. rewrite /cfdot rmorphM fmorphV rmorph_nat rmorph_sum; congr (_ * _). by apply: eq_bigr=> x _; rewrite rmorphM conjCK mulrC. Qed. Lemma eq_cfdotr A phi psi1 psi2 : phi \in 'CF(G, A) -> {in A, psi1 =1 psi2} -> '[phi, psi1] = '[phi, psi2]. Proof. by move=> Aphi /eq_cfdotl eq_dot; rewrite cfdotC eq_dot // -cfdotC. Qed. Lemma cfdotBr xi phi psi : '[xi, phi - psi] = '[xi, phi] - '[xi, psi]. Proof. by rewrite !(cfdotC xi) -rmorphB cfdotBl. Qed. Canonical cfun_dot_additive xi := Additive (cfdotBr xi). Lemma cfdot0r xi : '[xi, 0] = 0. Proof. exact: raddf0. Qed. Lemma cfdotNr xi phi : '[xi, - phi] = - '[xi, phi]. Proof. exact: raddfN. Qed. Lemma cfdotDr xi phi psi : '[xi, phi + psi] = '[xi, phi] + '[xi, psi]. Proof. exact: raddfD. Qed. Lemma cfdotMnr xi phi n : '[xi, phi *+ n] = '[xi, phi] *+ n. Proof. exact: raddfMn. Qed. Lemma cfdot_sumr xi I r (P : pred I) (phi : I -> 'CF(G)) : '[xi, \sum_(i <- r | P i) phi i] = \sum_(i <- r | P i) '[xi, phi i]. Proof. exact: raddf_sum. Qed. Lemma cfdotZr a xi phi : '[xi, a *: phi] = a^* * '[xi, phi]. Proof. by rewrite !(cfdotC xi) cfdotZl rmorphM. Qed. Lemma cfdot_cfAut (u : {rmorphism algC -> algC}) phi psi : {in image psi G, {morph u : x / x^*}} -> '[cfAut u phi, cfAut u psi] = u '[phi, psi]. Proof. move=> uC; rewrite rmorphM fmorphV rmorph_nat rmorph_sum; congr (_ * _). by apply: eq_bigr => x Gx; rewrite !cfunE rmorphM uC ?map_f ?mem_enum. Qed. Lemma cfdot_conjC phi psi : '[phi^*, psi^*] = '[phi, psi]^*. Proof. by rewrite cfdot_cfAut. Qed. Lemma cfdot_conjCl phi psi : '[phi^*, psi] = '[phi, psi^*]^*. Proof. by rewrite -cfdot_conjC cfConjCK. Qed. Lemma cfdot_conjCr phi psi : '[phi, psi^*] = '[phi^*, psi]^*. Proof. by rewrite -cfdot_conjC cfConjCK. Qed. Lemma cfnorm_ge0 phi : 0 <= '[phi]. Proof. by rewrite mulr_ge0 ?invr_ge0 ?ler0n ?sumr_ge0 // => x _; apply: mul_conjC_ge0. Qed. Lemma cfnorm_eq0 phi : ('[phi] == 0) = (phi == 0). Proof. apply/idP/eqP=> [|->]; last by rewrite cfdot0r. rewrite mulf_eq0 invr_eq0 (negbTE (neq0CG G)) /= => /eqP/psumr_eq0P phi0. apply/cfun_inP=> x Gx; apply/eqP; rewrite cfunE -mul_conjC_eq0. by rewrite phi0 // => y _; apply: mul_conjC_ge0. Qed. Lemma cfnorm_gt0 phi : ('[phi] > 0) = (phi != 0). 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. Lemma sqrt_cfnorm_eq0 phi : (sqrtC '[phi] == 0) = (phi == 0). Proof. by rewrite sqrtC_eq0 cfnorm_eq0. Qed. Lemma sqrt_cfnorm_gt0 phi : (sqrtC '[phi] > 0) = (phi != 0). Proof. by rewrite sqrtC_gt0 cfnorm_gt0. Qed. Lemma cfnormZ a phi : '[a *: phi]= `|a| ^+ 2 * '[phi]_G. Proof. by rewrite cfdotZl cfdotZr mulrA normCK. Qed. Lemma cfnormN phi : '[- phi] = '[phi]. Proof. by rewrite cfdotNl raddfN opprK. Qed. Lemma cfnorm_sign n phi : '[(-1) ^+ n *: phi] = '[phi]. Proof. by rewrite -signr_odd scaler_sign; case: (odd n); rewrite ?cfnormN. Qed. Lemma cfnormD phi psi : let d := '[phi, psi] in '[phi + psi] = '[phi] + '[psi] + (d + d^*). Proof. by rewrite /= addrAC -cfdotC cfdotDl !cfdotDr !addrA. Qed. Lemma cfnormB phi psi : let d := '[phi, psi] in '[phi - psi] = '[phi] + '[psi] - (d + d^*). Proof. by rewrite /= cfnormD cfnormN cfdotNr rmorphN -opprD. Qed. Lemma cfnormDd phi psi : '[phi, psi] = 0 -> '[phi + psi] = '[phi] + '[psi]. Proof. by move=> ophipsi; rewrite cfnormD ophipsi rmorph0 !addr0. Qed. Lemma cfnormBd phi psi : '[phi, psi] = 0 -> '[phi - psi] = '[phi] + '[psi]. Proof. by move=> ophipsi; rewrite cfnormDd ?cfnormN // cfdotNr ophipsi oppr0. Qed. Lemma cfnorm_conjC phi : '[phi^*] = '[phi]. Proof. by rewrite cfdot_conjC geC0_conj // cfnorm_ge0. Qed. Lemma cfCauchySchwarz phi psi : `|'[phi, psi]| ^+ 2 <= '[phi] * '[psi] ?= iff ~~ free (phi :: psi). Proof. rewrite free_cons span_seq1 seq1_free -negb_or negbK orbC. have [-> | nz_psi] /= := eqVneq psi 0. 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. by rewrite cfdotBl cfdotZl divfK ?cfnorm_eq0 ?subrr. 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 -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. by rewrite cfnorm_eq0 => /eqP->; apply: rpred0. Qed. 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_leif (@ler_sqrtC _)) 1?rpredM ?qualifE ?cfnorm_ge0 //. exact: cfCauchySchwarz. Qed. 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_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_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] := eqVneq psi 0; first by rewrite cfdot0r coord0. case/vlineP=> [x ->]; rewrite cfdotZl linearZ pmulr_lge0 ?cfnorm_gt0 //=. by rewrite (coord_free 0) ?seq1_free // eqxx mulr1. Qed. Lemma orthogonal_cons phi R S : orthogonal (phi :: R) S = orthogonal phi S && orthogonal R S. Proof. by rewrite /orthogonal /= andbT. Qed. Lemma orthoP phi psi : reflect ('[phi, psi] = 0) (orthogonal phi psi). Proof. by rewrite /orthogonal /= !andbT; apply: eqP. Qed. Lemma orthogonalP S R : reflect {in S & R, forall phi psi, '[phi, psi] = 0} (orthogonal S R). Proof. apply: (iffP allP) => oSR phi => [psi /oSR/allP opS /opS/eqP // | /oSR opS]. by apply/allP=> psi /= /opS->. Qed. Lemma orthoPl phi S : reflect {in S, forall psi, '[phi, psi] = 0} (orthogonal phi S). Proof. by rewrite [orthogonal _ S]andbT /=; apply: (iffP allP) => ophiS ? /ophiS/eqP. Qed. Arguments orthoPl {phi S}. Lemma orthogonal_sym : symmetric (@orthogonal _ G). Proof. apply: symmetric_from_pre => R S /orthogonalP oRS. by apply/orthogonalP=> phi psi Rpsi Sphi; rewrite cfdotC oRS ?rmorph0. Qed. Lemma orthoPr S psi : reflect {in S, forall phi, '[phi, psi] = 0} (orthogonal S psi). Proof. rewrite orthogonal_sym. by apply: (iffP orthoPl) => oSpsi phi Sphi; rewrite cfdotC oSpsi ?conjC0. Qed. Lemma eq_orthogonal R1 R2 S1 S2 : R1 =i R2 -> S1 =i S2 -> orthogonal R1 S1 = orthogonal R2 S2. Proof. move=> eqR eqS; rewrite [orthogonal _ _](eq_all_r eqR). by apply: eq_all => psi /=; apply: eq_all_r. Qed. Lemma orthogonal_catl R1 R2 S : orthogonal (R1 ++ R2) S = orthogonal R1 S && orthogonal R2 S. Proof. exact: all_cat. Qed. Lemma orthogonal_catr R S1 S2 : orthogonal R (S1 ++ S2) = orthogonal R S1 && orthogonal R S2. Proof. by rewrite !(orthogonal_sym R) orthogonal_catl. Qed. Lemma span_orthogonal S1 S2 phi1 phi2 : orthogonal S1 S2 -> phi1 \in <>%VS -> phi2 \in <>%VS -> '[phi1, phi2] = 0. Proof. move/orthogonalP=> oS12; do 2!move/(@coord_span _ _ _ (in_tuple _))->. rewrite cfdot_suml big1 // => i _; rewrite cfdot_sumr big1 // => j _. by rewrite cfdotZl cfdotZr oS12 ?mem_nth ?mulr0. Qed. Lemma orthogonal_split S beta : {X : 'CF(G) & X \in <>%VS & {Y | [/\ beta = X + Y, '[X, Y] = 0 & orthogonal Y S]}}. Proof. suffices [X S_X [Y -> oYS]]: {X : _ & X \in <>%VS & {Y | beta = X + Y & orthogonal Y S}}. - exists X => //; exists Y. by rewrite cfdotC (span_orthogonal oYS) ?memv_span1 ?conjC0. elim: S beta => [|phi S IHS] beta. by exists 0; last exists beta; rewrite ?mem0v ?add0r. have [[U S_U [V -> oVS]] [X S_X [Y -> oYS]]] := (IHS phi, IHS beta). pose Z := '[Y, V] / '[V] *: V; exists (X + Z). rewrite /Z -{4}(addKr U V) scalerDr scalerN addrA addrC span_cons. by rewrite memv_add ?memvB ?memvZ ?memv_line. exists (Y - Z); first by rewrite addrCA !addrA addrK addrC. apply/orthoPl=> psi; rewrite !inE => /predU1P[-> | Spsi]; last first. by rewrite cfdotBl cfdotZl (orthoPl oVS _ Spsi) mulr0 subr0 (orthoPl oYS). rewrite cfdotBl !cfdotDr (span_orthogonal oYS) // ?memv_span ?mem_head //. rewrite !cfdotZl (span_orthogonal oVS _ S_U) ?mulr0 ?memv_span ?mem_head //. have [-> | nzV] := eqVneq V 0; first by rewrite cfdot0r !mul0r subrr. by rewrite divfK ?cfnorm_eq0 ?subrr. Qed. Lemma map_orthogonal M (nu : 'CF(G) -> 'CF(M)) S R (A : {pred 'CF(G)}) : {in A &, isometry nu} -> {subset S <= A} -> {subset R <= A} -> orthogonal (map nu S) (map nu R) = orthogonal S R. Proof. move=> Inu sSA sRA; rewrite [orthogonal _ _]all_map. apply: eq_in_all => phi Sphi; rewrite /= all_map. by apply: eq_in_all => psi Rpsi; rewrite /= Inu ?(sSA phi) ?(sRA psi). Qed. Lemma orthogonal_oppr S R : orthogonal S (map -%R R) = orthogonal S R. Proof. wlog suffices IH: S R / orthogonal S R -> orthogonal S (map -%R R). by apply/idP/idP=> /IH; rewrite ?mapK //; apply: opprK. move/orthogonalP=> oSR; apply/orthogonalP=> xi1 _ Sxi1 /mapP[xi2 Rxi2 ->]. by rewrite cfdotNr oSR ?oppr0. Qed. Lemma orthogonal_oppl S R : orthogonal (map -%R S) R = orthogonal S R. Proof. by rewrite -!(orthogonal_sym R) orthogonal_oppr. Qed. Lemma pairwise_orthogonalP S : reflect (uniq (0 :: S) /\ {in S &, forall phi psi, phi != psi -> '[phi, psi] = 0}) (pairwise_orthogonal S). Proof. rewrite /pairwise_orthogonal /=; case notS0: (~~ _); last by right; case. elim: S notS0 => [|phi S IH] /=; first by left. rewrite inE eq_sym andbT => /norP[nz_phi /IH{}IH]. have [opS | not_opS] := allP; last first. right=> [[/andP[notSp _] opS]]; case: not_opS => psi Spsi /=. by rewrite opS ?mem_head 1?mem_behead // (memPnC notSp). rewrite (contra (opS _)) /= ?cfnorm_eq0 //. apply: (iffP IH) => [] [uniqS oSS]; last first. by split=> //; apply: sub_in2 oSS => psi Spsi; apply: mem_behead. split=> // psi xi; rewrite !inE => /predU1P[-> // | Spsi]. by case/predU1P=> [-> | /opS] /eqP. case/predU1P=> [-> _ | Sxi /oSS-> //]. by apply/eqP; rewrite cfdotC conjC_eq0 [_ == 0]opS. Qed. Lemma pairwise_orthogonal_cat R S : pairwise_orthogonal (R ++ S) = [&& pairwise_orthogonal R, pairwise_orthogonal S & orthogonal R S]. Proof. rewrite /pairwise_orthogonal mem_cat negb_or -!andbA; do !bool_congr. elim: R => [|phi R /= ->]; rewrite ?andbT // orthogonal_cons all_cat -!andbA /=. by do !bool_congr. Qed. Lemma eq_pairwise_orthogonal R S : perm_eq R S -> pairwise_orthogonal R = pairwise_orthogonal S. Proof. apply: catCA_perm_subst R S => R S S'. rewrite !pairwise_orthogonal_cat !orthogonal_catr (orthogonal_sym R S) -!andbA. by do !bool_congr. Qed. Lemma sub_pairwise_orthogonal S1 S2 : {subset S1 <= S2} -> uniq S1 -> pairwise_orthogonal S2 -> pairwise_orthogonal S1. Proof. move=> sS12 uniqS1 /pairwise_orthogonalP[/andP[notS2_0 _] oS2]. apply/pairwise_orthogonalP; rewrite /= (contra (sS12 0)) //. by split=> //; apply: sub_in2 oS2. Qed. Lemma orthogonal_free S : pairwise_orthogonal S -> free S. Proof. case/pairwise_orthogonalP=> [/=/andP[notS0 uniqS] oSS]. rewrite -(in_tupleE S); apply/freeP => a aS0 i. have S_i: S`_i \in S by apply: mem_nth. have /eqP: '[S`_i, 0]_G = 0 := cfdot0r _. rewrite -{2}aS0 raddf_sum /= (bigD1 i) //= big1 => [|j neq_ji]; last 1 first. by rewrite cfdotZr oSS ?mulr0 ?mem_nth // eq_sym nth_uniq. rewrite addr0 cfdotZr mulf_eq0 conjC_eq0 cfnorm_eq0. by case/pred2P=> // Si0; rewrite -Si0 S_i in notS0. Qed. Lemma filter_pairwise_orthogonal S p : pairwise_orthogonal S -> pairwise_orthogonal (filter p S). Proof. move=> orthoS; apply: sub_pairwise_orthogonal (orthoS). exact: mem_subseq (filter_subseq p S). exact/filter_uniq/free_uniq/orthogonal_free. Qed. Lemma orthonormal_not0 S : orthonormal S -> 0 \notin S. Proof. by case/andP=> /allP S1 _; rewrite (contra (S1 _)) //= cfdot0r eq_sym oner_eq0. Qed. Lemma orthonormalE S : orthonormal S = all [pred phi | '[phi] == 1] S && pairwise_orthogonal S. Proof. by rewrite -(andb_idl (@orthonormal_not0 S)) andbCA. Qed. Lemma orthonormal_orthogonal S : orthonormal S -> pairwise_orthogonal S. Proof. by rewrite orthonormalE => /andP[_]. Qed. Lemma orthonormal_cat R S : orthonormal (R ++ S) = [&& orthonormal R, orthonormal S & orthogonal R S]. Proof. rewrite !orthonormalE pairwise_orthogonal_cat all_cat -!andbA. by do !bool_congr. Qed. Lemma eq_orthonormal R S : perm_eq R S -> orthonormal R = orthonormal S. Proof. move=> eqRS; rewrite !orthonormalE (eq_all_r (perm_mem eqRS)). by rewrite (eq_pairwise_orthogonal eqRS). Qed. Lemma orthonormal_free S : orthonormal S -> free S. Proof. by move/orthonormal_orthogonal/orthogonal_free. Qed. Lemma orthonormalP S : reflect (uniq S /\ {in S &, forall phi psi, '[phi, psi]_G = (phi == psi)%:R}) (orthonormal S). Proof. rewrite orthonormalE; have [/= normS | not_normS] := allP; last first. by right=> [[_ o1S]]; case: not_normS => phi Sphi; rewrite /= o1S ?eqxx. apply: (iffP (pairwise_orthogonalP S)) => [] [uniqS oSS]. split=> // [|phi psi]; first by case/andP: uniqS. by have [-> _ /normS/eqP | /oSS] := eqVneq. split=> // [|phi psi Sphi Spsi /negbTE]; last by rewrite oSS // => ->. by rewrite /= (contra (normS _)) // cfdot0r eq_sym oner_eq0. Qed. Lemma sub_orthonormal S1 S2 : {subset S1 <= S2} -> uniq S1 -> orthonormal S2 -> orthonormal S1. Proof. move=> sS12 uniqS1 /orthonormalP[_ oS1]. by apply/orthonormalP; split; last apply: sub_in2 sS12 _ _. Qed. Lemma orthonormal2P phi psi : reflect [/\ '[phi, psi] = 0, '[phi] = 1 & '[psi] = 1] (orthonormal [:: phi; psi]). Proof. rewrite /orthonormal /= !andbT andbC. by apply: (iffP and3P) => [] []; do 3!move/eqP->. Qed. Lemma conjC_pair_orthogonal S chi : cfConjC_closed S -> ~~ has cfReal S -> pairwise_orthogonal S -> chi \in S -> pairwise_orthogonal (chi :: chi^*%CF). Proof. move=> ccS /hasPn nrS oSS Schi; apply: sub_pairwise_orthogonal oSS. by apply/allP; rewrite /= Schi ccS. by rewrite /= inE eq_sym nrS. Qed. Lemma cfdot_real_conjC phi psi : cfReal phi -> '[phi, psi^*]_G = '[phi, psi]^*. Proof. by rewrite -cfdot_conjC => /eqcfP->. Qed. Lemma extend_cfConjC_subset S X phi : cfConjC_closed S -> ~~ has cfReal S -> phi \in S -> phi \notin X -> cfConjC_subset X S -> cfConjC_subset [:: phi, phi^* & X]%CF S. Proof. move=> ccS nrS Sphi X'phi [uniqX /allP-sXS ccX]. split; last 1 [by apply/allP; rewrite /= Sphi ccS | apply/allP]; rewrite /= inE. by rewrite negb_or X'phi eq_sym (hasPn nrS) // (contra (ccX _)) ?cfConjCK. by rewrite cfConjCK !mem_head orbT; apply/allP=> xi Xxi; rewrite !inE ccX ?orbT. Qed. (* Note: other isometry lemmas, and the dot product lemmas for orthogonal *) (* and orthonormal sequences are in vcharacter, because we need the 'Z[S] *) (* notation for the isometry domains. Alternatively, this could be moved to *) (* cfun. *) End DotProduct. Arguments orthoP {gT G phi psi}. Arguments orthoPl {gT G phi S}. Arguments orthoPr {gT G S psi}. Arguments orthogonalP {gT G S R}. Arguments pairwise_orthogonalP {gT G S}. Arguments orthonormalP {gT G S}. Section CfunOrder. Variables (gT : finGroupType) (G : {group gT}) (phi : 'CF(G)). Lemma dvdn_cforderP n : reflect {in G, forall x, phi x ^+ n = 1} (#[phi]%CF %| n)%N. Proof. apply: (iffP (dvdn_biglcmP _ _ _)); rewrite genGid => phiG1 x Gx. by apply/eqP; rewrite -dvdn_orderC phiG1. by rewrite dvdn_orderC phiG1. Qed. Lemma dvdn_cforder n : (#[phi]%CF %| n) = (phi ^+ n == 1). Proof. apply/dvdn_cforderP/eqP=> phi_n_1 => [|x Gx]. by apply/cfun_inP=> x Gx; rewrite exp_cfunE // cfun1E Gx phi_n_1. by rewrite -exp_cfunE // phi_n_1 // cfun1E Gx. Qed. Lemma exp_cforder : phi ^+ #[phi]%CF = 1. Proof. by apply/eqP; rewrite -dvdn_cforder. Qed. End CfunOrder. Arguments dvdn_cforderP {gT G phi n}. Section MorphOrder. Variables (aT rT : finGroupType) (G : {group aT}) (R : {group rT}). Variable f : {rmorphism 'CF(G) -> 'CF(R)}. Lemma cforder_rmorph phi : #[f phi]%CF %| #[phi]%CF. Proof. by rewrite dvdn_cforder -rmorphX exp_cforder rmorph1. Qed. Lemma cforder_inj_rmorph phi : injective f -> #[f phi]%CF = #[phi]%CF. Proof. move=> inj_f; apply/eqP; rewrite eqn_dvd cforder_rmorph dvdn_cforder /=. by rewrite -(rmorph_eq1 _ inj_f) rmorphX exp_cforder. Qed. End MorphOrder. Section BuildIsometries. Variable (gT : finGroupType) (L G : {group gT}). Implicit Types (phi psi xi : 'CF(L)) (R S : seq 'CF(L)). Implicit Types (U : {pred 'CF(L)}) (W : {pred 'CF(G)}). Lemma sub_iso_to U1 U2 W1 W2 tau : {subset U2 <= U1} -> {subset W1 <= W2} -> {in U1, isometry tau, to W1} -> {in U2, isometry tau, to W2}. Proof. by move=> sU sW [Itau Wtau]; split=> [|u /sU/Wtau/sW //]; apply: sub_in2 Itau. Qed. Lemma isometry_of_free S f : free S -> {in S &, isometry f} -> {tau : {linear 'CF(L) -> 'CF(G)} | {in S, tau =1 f} & {in <>%VS &, isometry tau}}. Proof. move=> freeS If; have defS := free_span freeS. have [tau /(_ freeS (size_map f S))Dtau] := linear_of_free S (map f S). have{} Dtau: {in S, tau =1 f}. by move=> _ /(nthP 0)[i ltiS <-]; rewrite -!(nth_map 0 0) ?Dtau. exists tau => // _ _ /defS[a -> _] /defS[b -> _]. rewrite !{1}linear_sum !{1}cfdot_suml; apply/eq_big_seq=> xi1 Sxi1. rewrite !{1}cfdot_sumr; apply/eq_big_seq=> xi2 Sxi2. by rewrite !linearZ /= !Dtau // !cfdotZl !cfdotZr If. Qed. Lemma isometry_of_cfnorm S tauS : pairwise_orthogonal S -> pairwise_orthogonal tauS -> map cfnorm tauS = map cfnorm S -> {tau : {linear 'CF(L) -> 'CF(G)} | map tau S = tauS & {in <>%VS &, isometry tau}}. Proof. move=> oS oT eq_nST; have freeS := orthogonal_free oS. have eq_sz: size tauS = size S by have:= congr1 size eq_nST; rewrite !size_map. have [tau defT] := linear_of_free S tauS; rewrite -[S]/(tval (in_tuple S)). exists tau => [|u v /coord_span-> /coord_span->]; rewrite ?raddf_sum ?defT //=. apply: eq_bigr => i _ /=; rewrite linearZ !cfdotZr !cfdot_suml; congr (_ * _). apply: eq_bigr => j _ /=; rewrite linearZ !cfdotZl; congr (_ * _). rewrite -!(nth_map 0 0 tau) ?{}defT //; have [-> | neq_ji] := eqVneq j i. by rewrite -!['[_]](nth_map 0 0 cfnorm) ?eq_sz // eq_nST. have{oS} [/=/andP[_ uS] oS] := pairwise_orthogonalP oS. have{oT} [/=/andP[_ uT] oT] := pairwise_orthogonalP oT. by rewrite oS ?oT ?mem_nth ?nth_uniq ?eq_sz. Qed. Lemma isometry_raddf_inj U (tau : {additive 'CF(L) -> 'CF(G)}) : {in U &, isometry tau} -> {in U &, forall u v, u - v \in U} -> {in U &, injective tau}. Proof. move=> Itau linU phi psi Uphi Upsi /eqP; rewrite -subr_eq0 -raddfB. by rewrite -cfnorm_eq0 Itau ?linU // cfnorm_eq0 subr_eq0 => /eqP. Qed. Lemma opp_isometry : @isometry _ _ G G -%R. Proof. by move=> x y; rewrite cfdotNl cfdotNr opprK. Qed. End BuildIsometries. Section Restrict. Variables (gT : finGroupType) (A B : {set gT}). Local Notation H := <>. Local Notation G := <>. Fact cfRes_subproof (phi : 'CF(B)) : is_class_fun H [ffun x => phi (if H \subset G then x else 1%g) *+ (x \in H)]. Proof. apply: intro_class_fun => /= [x y Hx Hy | x /negbTE/=-> //]. by rewrite Hx (groupJ Hx) //; case: subsetP => // sHG; rewrite cfunJgen ?sHG. Qed. Definition cfRes phi := Cfun 1 (cfRes_subproof phi). Lemma cfResE phi : A \subset B -> {in A, cfRes phi =1 phi}. Proof. by move=> sAB x Ax; rewrite cfunElock mem_gen ?genS. Qed. Lemma cfRes1 phi : cfRes phi 1%g = phi 1%g. Proof. by rewrite cfunElock if_same group1. Qed. Lemma cfRes_is_linear : linear cfRes. Proof. by move=> a phi psi; apply/cfunP=> x; rewrite !cfunElock mulrnAr mulrnDl. Qed. Canonical cfRes_additive := Additive cfRes_is_linear. Canonical cfRes_linear := Linear cfRes_is_linear. Lemma cfRes_cfun1 : cfRes 1 = 1. Proof. apply: cfun_in_genP => x Hx; rewrite cfunElock Hx !cfun1Egen Hx. by case: subsetP => [-> // | _]; rewrite group1. Qed. Lemma cfRes_is_multiplicative : multiplicative cfRes. Proof. split=> [phi psi|]; [apply/cfunP=> x | exact: cfRes_cfun1]. by rewrite !cfunElock mulrnAr mulrnAl -mulrnA mulnb andbb. Qed. Canonical cfRes_rmorphism := AddRMorphism cfRes_is_multiplicative. Canonical cfRes_lrmorphism := [lrmorphism of cfRes]. End Restrict. Arguments cfRes {gT} A%g {B%g} phi%CF. Notation "''Res[' H , G ]" := (@cfRes _ H G) (only parsing) : ring_scope. Notation "''Res[' H ]" := 'Res[H, _] : ring_scope. Notation "''Res'" := 'Res[_] (only parsing) : ring_scope. Section MoreRestrict. Variables (gT : finGroupType) (G H : {group gT}). Implicit Types (A : {set gT}) (phi : 'CF(G)). Lemma cfResEout phi : ~~ (H \subset G) -> 'Res[H] phi = (phi 1%g)%:A. Proof. move/negPf=> not_sHG; apply/cfunP=> x. by rewrite cfunE cfun1E mulr_natr cfunElock !genGid not_sHG. Qed. Lemma cfResRes A phi : A \subset H -> H \subset G -> 'Res[A] ('Res[H] phi) = 'Res[A] phi. Proof. move=> sAH sHG; apply/cfunP=> x; rewrite !cfunElock !genGid !gen_subG sAH sHG. by rewrite (subset_trans sAH) // -mulrnA mulnb -in_setI (setIidPr _) ?gen_subG. Qed. Lemma cfRes_id A psi : 'Res[A] psi = psi. Proof. by apply/cfun_in_genP=> x Ax; rewrite cfunElock Ax subxx. Qed. Lemma sub_cfker_Res A phi : A \subset H -> A \subset cfker phi -> A \subset cfker ('Res[H, G] phi). Proof. move=> sAH kerA; apply/subsetP=> x Ax; have Hx := subsetP sAH x Ax. rewrite inE Hx; apply/forallP=> y; rewrite !cfunElock !genGid groupMl //. by rewrite !(fun_if phi) cfkerMl // (subsetP kerA). Qed. Lemma eq_cfker_Res phi : H \subset cfker phi -> cfker ('Res[H, G] phi) = H. Proof. by move=> kH; apply/eqP; rewrite eqEsubset cfker_sub sub_cfker_Res. Qed. Lemma cfRes_sub_ker phi : H \subset cfker phi -> 'Res[H, G] phi = (phi 1%g)%:A. Proof. move=> kerHphi; have sHG := subset_trans kerHphi (cfker_sub phi). apply/cfun_inP=> x Hx; have ker_x := subsetP kerHphi x Hx. by rewrite cfResE // cfunE cfun1E Hx mulr1 cfker1. Qed. Lemma cforder_Res phi : #['Res[H] phi]%CF %| #[phi]%CF. Proof. exact: cforder_rmorph. Qed. End MoreRestrict. Section Morphim. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Section Main. Variable G : {group aT}. Implicit Type phi : 'CF(f @* G). Fact cfMorph_subproof phi : is_class_fun <> [ffun x => phi (if G \subset D then f x else 1%g) *+ (x \in G)]. Proof. rewrite genGid; apply: intro_class_fun => [x y Gx Gy | x /negPf-> //]. rewrite Gx groupJ //; case subsetP => // sGD. by rewrite morphJ ?cfunJ ?mem_morphim ?sGD. Qed. Definition cfMorph phi := Cfun 1 (cfMorph_subproof phi). Lemma cfMorphE phi x : G \subset D -> x \in G -> cfMorph phi x = phi (f x). Proof. by rewrite cfunElock => -> ->. Qed. Lemma cfMorph1 phi : cfMorph phi 1%g = phi 1%g. Proof. by rewrite cfunElock morph1 if_same group1. Qed. Lemma cfMorphEout phi : ~~ (G \subset D) -> cfMorph phi = (phi 1%g)%:A. Proof. move/negPf=> not_sGD; apply/cfunP=> x; rewrite cfunE cfun1E mulr_natr. by rewrite cfunElock not_sGD. Qed. Lemma cfMorph_cfun1 : cfMorph 1 = 1. Proof. apply/cfun_inP=> x Gx; rewrite cfunElock !cfun1E Gx. by case: subsetP => [sGD | _]; rewrite ?group1 // mem_morphim ?sGD. Qed. Fact cfMorph_is_linear : linear cfMorph. Proof. by move=> a phi psi; apply/cfunP=> x; rewrite !cfunElock mulrnAr -mulrnDl. Qed. Canonical cfMorph_additive := Additive cfMorph_is_linear. Canonical cfMorph_linear := Linear cfMorph_is_linear. Fact cfMorph_is_multiplicative : multiplicative cfMorph. Proof. split=> [phi psi|]; [apply/cfunP=> x | exact: cfMorph_cfun1]. by rewrite !cfunElock mulrnAr mulrnAl -mulrnA mulnb andbb. Qed. Canonical cfMorph_rmorphism := AddRMorphism cfMorph_is_multiplicative. Canonical cfMorph_lrmorphism := [lrmorphism of cfMorph]. Hypothesis sGD : G \subset D. Lemma cfMorph_inj : injective cfMorph. Proof. move=> phi1 phi2 eq_phi; apply/cfun_inP=> _ /morphimP[x Dx Gx ->]. by rewrite -!cfMorphE // eq_phi. Qed. Lemma cfMorph_eq1 phi : (cfMorph phi == 1) = (phi == 1). Proof. exact/rmorph_eq1/cfMorph_inj. Qed. Lemma cfker_morph phi : cfker (cfMorph phi) = G :&: f @*^-1 (cfker phi). Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. have Dx := subsetP sGD x Gx; rewrite Dx mem_morphim //=. apply/forallP/forallP=> Kx y. have [{y} /morphimP[y Dy Gy ->] | fG'y] := boolP (y \in f @* G). by rewrite -morphM // -!(cfMorphE phi) ?groupM. by rewrite !cfun0 ?groupMl // mem_morphim. have [Gy | G'y] := boolP (y \in G); last by rewrite !cfun0 ?groupMl. by rewrite !cfMorphE ?groupM ?morphM // (subsetP sGD). Qed. Lemma cfker_morph_im phi : f @* cfker (cfMorph phi) = cfker phi. Proof. by rewrite cfker_morph // morphim_setIpre (setIidPr (cfker_sub _)). Qed. Lemma sub_cfker_morph phi (A : {set aT}) : (A \subset cfker (cfMorph phi)) = (A \subset G) && (f @* A \subset cfker phi). Proof. rewrite cfker_morph // subsetI; apply: andb_id2l => sAG. by rewrite sub_morphim_pre // (subset_trans sAG). Qed. Lemma sub_morphim_cfker phi (A : {set aT}) : A \subset G -> (f @* A \subset cfker phi) = (A \subset cfker (cfMorph phi)). Proof. by move=> sAG; rewrite sub_cfker_morph ?sAG. Qed. Lemma cforder_morph phi : #[cfMorph phi]%CF = #[phi]%CF. Proof. exact/cforder_inj_rmorph/cfMorph_inj. Qed. End Main. Lemma cfResMorph (G H : {group aT}) (phi : 'CF(f @* G)) : H \subset G -> G \subset D -> 'Res (cfMorph phi) = cfMorph ('Res[f @* H] phi). Proof. move=> sHG sGD; have sHD := subset_trans sHG sGD. apply/cfun_inP=> x Hx; have [Gx Dx] := (subsetP sHG x Hx, subsetP sHD x Hx). by rewrite !(cfMorphE, cfResE) ?morphimS ?mem_morphim //. Qed. End Morphim. Prenex Implicits cfMorph. Section Isomorphism. Variables (aT rT : finGroupType) (G : {group aT}) (f : {morphism G >-> rT}). Variable R : {group rT}. Hypothesis isoGR : isom G R f. Let defR := isom_im isoGR. Local Notation G1 := (isom_inv isoGR @* R). Let defG : G1 = G := isom_im (isom_sym isoGR). Fact cfIsom_key : unit. Proof. by []. Qed. Definition cfIsom := locked_with cfIsom_key (cfMorph \o 'Res[G1] : 'CF(G) -> 'CF(R)). Canonical cfIsom_unlockable := [unlockable of cfIsom]. Lemma cfIsomE phi x : x \in G -> cfIsom phi (f x) = phi x. Proof. move=> Gx; rewrite unlock cfMorphE //= /restrm ?defG ?cfRes_id ?invmE //. by rewrite -defR mem_morphim. Qed. Lemma cfIsom1 phi : cfIsom phi 1%g = phi 1%g. Proof. by rewrite -(morph1 f) cfIsomE. Qed. Canonical cfIsom_additive := [additive of cfIsom]. Canonical cfIsom_linear := [linear of cfIsom]. Canonical cfIsom_rmorphism := [rmorphism of cfIsom]. Canonical cfIsom_lrmorphism := [lrmorphism of cfIsom]. Lemma cfIsom_cfun1 : cfIsom 1 = 1. Proof. exact: rmorph1. Qed. Lemma cfker_isom phi : cfker (cfIsom phi) = f @* cfker phi. Proof. rewrite unlock cfker_morph // defG cfRes_id morphpre_restrm morphpre_invm. by rewrite -defR !morphimIim. Qed. End Isomorphism. Prenex Implicits cfIsom. Section InvMorphism. Variables (aT rT : finGroupType) (G : {group aT}) (f : {morphism G >-> rT}). Variable R : {group rT}. Hypothesis isoGR : isom G R f. Lemma cfIsomK : cancel (cfIsom isoGR) (cfIsom (isom_sym isoGR)). Proof. move=> phi; apply/cfun_inP=> x Gx; rewrite -{1}(invmE (isom_inj isoGR) Gx). by rewrite !cfIsomE // -(isom_im isoGR) mem_morphim. Qed. Lemma cfIsomKV : cancel (cfIsom (isom_sym isoGR)) (cfIsom isoGR). Proof. move=> phi; apply/cfun_inP=> y Ry; pose injGR := isom_inj isoGR. rewrite -{1}[y](invmK injGR) ?(isom_im isoGR) //. suffices /morphpreP[fGy Gf'y]: y \in invm injGR @*^-1 G by rewrite !cfIsomE. by rewrite morphpre_invm (isom_im isoGR). Qed. Lemma cfIsom_inj : injective (cfIsom isoGR). Proof. exact: can_inj cfIsomK. Qed. Lemma cfIsom_eq1 phi : (cfIsom isoGR phi == 1) = (phi == 1). Proof. exact/rmorph_eq1/cfIsom_inj. Qed. Lemma cforder_isom phi : #[cfIsom isoGR phi]%CF = #[phi]%CF. Proof. exact: cforder_inj_rmorph cfIsom_inj. Qed. End InvMorphism. Arguments cfIsom_inj {aT rT G f R} isoGR [phi1 phi2] : rename. Section Coset. Variables (gT : finGroupType) (G : {group gT}) (B : {set gT}). Implicit Type rT : finGroupType. Local Notation H := <>%g. Definition cfMod : 'CF(G / B) -> 'CF(G) := cfMorph. Definition ffun_Quo (phi : 'CF(G)) := [ffun Hx : coset_of B => phi (if B \subset cfker phi then repr Hx else 1%g) *+ (Hx \in G / B)%g]. Fact cfQuo_subproof phi : is_class_fun <> (ffun_Quo phi). Proof. rewrite genGid; apply: intro_class_fun => [|Hx /negPf-> //]. move=> _ _ /morphimP[x Nx Gx ->] /morphimP[z Nz Gz ->]. rewrite -morphJ ?mem_morphim ?val_coset_prim ?groupJ //= -gen_subG. case: subsetP => // KphiH; do 2!case: repr_rcosetP => _ /KphiH/cfkerMl->. by rewrite cfunJ. Qed. Definition cfQuo phi := Cfun 1 (cfQuo_subproof phi). Local Notation "phi / 'B'" := (cfQuo phi) (at level 40) : cfun_scope. Local Notation "phi %% 'B'" := (cfMod phi) (at level 40) : cfun_scope. (* We specialize the cfMorph lemmas to cfMod by strengthening the domain *) (* condition G \subset 'N(H) to H <| G; the cfMorph lemmas can be used if the *) (* stronger results are needed. *) Lemma cfModE phi x : B <| G -> x \in G -> (phi %% B)%CF x = phi (coset B x). Proof. by move/normal_norm=> nBG; apply: cfMorphE. Qed. Lemma cfMod1 phi : (phi %% B)%CF 1%g = phi 1%g. Proof. exact: cfMorph1. Qed. Canonical cfMod_additive := [additive of cfMod]. Canonical cfMod_rmorphism := [rmorphism of cfMod]. Canonical cfMod_linear := [linear of cfMod]. Canonical cfMod_lrmorphism := [lrmorphism of cfMod]. Lemma cfMod_cfun1 : (1 %% B)%CF = 1. Proof. exact: rmorph1. Qed. Lemma cfker_mod phi : B <| G -> B \subset cfker (phi %% B). Proof. case/andP=> sBG nBG; rewrite cfker_morph // subsetI sBG. apply: subset_trans _ (ker_sub_pre _ _); rewrite ker_coset_prim subsetI. by rewrite (subset_trans sBG nBG) sub_gen. Qed. (* Note that cfQuo is nondegenerate even when G does not normalize B. *) Lemma cfQuoEnorm (phi : 'CF(G)) x : B \subset cfker phi -> x \in 'N_G(B) -> (phi / B)%CF (coset B x) = phi x. Proof. rewrite cfunElock -gen_subG => sHK /setIP[Gx nHx]; rewrite sHK /=. rewrite mem_morphim // val_coset_prim //. by case: repr_rcosetP => _ /(subsetP sHK)/cfkerMl->. Qed. Lemma cfQuoE (phi : 'CF(G)) x : B <| G -> B \subset cfker phi -> x \in G -> (phi / B)%CF (coset B x) = phi x. Proof. by case/andP=> _ nBG sBK Gx; rewrite cfQuoEnorm // (setIidPl _). Qed. Lemma cfQuo1 (phi : 'CF(G)) : (phi / B)%CF 1%g = phi 1%g. Proof. by rewrite cfunElock repr_coset1 group1 if_same. Qed. Lemma cfQuoEout (phi : 'CF(G)) : ~~ (B \subset cfker phi) -> (phi / B)%CF = (phi 1%g)%:A. Proof. move/negPf=> not_kerB; apply/cfunP=> x; rewrite cfunE cfun1E mulr_natr. by rewrite cfunElock not_kerB. Qed. (* cfQuo is only linear on the class functions that have H in their kernel. *) Lemma cfQuo_cfun1 : (1 / B)%CF = 1. Proof. apply/cfun_inP=> Hx G_Hx; rewrite cfunElock !cfun1E G_Hx cfker_cfun1 -gen_subG. have [x nHx Gx ->] := morphimP G_Hx. case: subsetP=> [sHG | _]; last by rewrite group1. by rewrite val_coset_prim //; case: repr_rcosetP => y /sHG/groupM->. Qed. (* Cancellation properties *) Lemma cfModK : B <| G -> cancel cfMod cfQuo. Proof. move=> nsBG phi; apply/cfun_inP=> _ /morphimP[x Nx Gx ->] //. by rewrite cfQuoE ?cfker_mod ?cfModE. Qed. Lemma cfQuoK : B <| G -> forall phi, B \subset cfker phi -> (phi / B %% B)%CF = phi. Proof. by move=> nsHG phi sHK; apply/cfun_inP=> x Gx; rewrite cfModE ?cfQuoE. Qed. Lemma cfMod_eq1 psi : B <| G -> (psi %% B == 1)%CF = (psi == 1). Proof. by move/cfModK/can_eq <-; rewrite rmorph1. Qed. Lemma cfQuo_eq1 phi : B <| G -> B \subset cfker phi -> (phi / B == 1)%CF = (phi == 1). Proof. by move=> nsBG kerH; rewrite -cfMod_eq1 // cfQuoK. Qed. End Coset. Arguments cfQuo {gT G%G} B%g phi%CF. Arguments cfMod {gT G%G B%g} phi%CF. Notation "phi / H" := (cfQuo H phi) : cfun_scope. Notation "phi %% H" := (@cfMod _ _ H phi) : cfun_scope. Section MoreCoset. Variables (gT : finGroupType) (G : {group gT}). Implicit Types (H K : {group gT}) (phi : 'CF(G)). Lemma cfResMod H K (psi : 'CF(G / K)) : H \subset G -> K <| G -> ('Res (psi %% K) = 'Res[H / K] psi %% K)%CF. Proof. by move=> sHG /andP[_]; apply: cfResMorph. Qed. Lemma quotient_cfker_mod (A : {set gT}) K (psi : 'CF(G / K)) : K <| G -> (cfker (psi %% K) / K)%g = cfker psi. Proof. by case/andP=> _ /cfker_morph_im <-. Qed. Lemma sub_cfker_mod (A : {set gT}) K (psi : 'CF(G / K)) : K <| G -> A \subset 'N(K) -> (A \subset cfker (psi %% K)) = (A / K \subset cfker psi)%g. Proof. by move=> nsKG nKA; rewrite -(quotientSGK nKA) ?quotient_cfker_mod ?cfker_mod. Qed. Lemma cfker_quo H phi : H <| G -> H \subset cfker (phi) -> cfker (phi / H) = (cfker phi / H)%g. Proof. move=> nsHG /cfQuoK {2}<- //; have [sHG nHG] := andP nsHG. by rewrite cfker_morph 1?quotientGI // cosetpreK (setIidPr _) ?cfker_sub. Qed. Lemma cfQuoEker phi x : x \in G -> (phi / cfker phi)%CF (coset (cfker phi) x) = phi x. Proof. by move/cfQuoE->; rewrite ?cfker_normal. Qed. Lemma cfaithful_quo phi : cfaithful (phi / cfker phi). Proof. by rewrite cfaithfulE cfker_quo ?cfker_normal ?trivg_quotient. Qed. (* Note that there is no requirement that K be normal in H or G. *) Lemma cfResQuo H K phi : K \subset cfker phi -> K \subset H -> H \subset G -> ('Res[H / K] (phi / K) = 'Res[H] phi / K)%CF. Proof. move=> kerK sKH sHG; apply/cfun_inP=> xb Hxb; rewrite cfResE ?quotientS //. have{xb Hxb} [x nKx Hx ->] := morphimP Hxb. by rewrite !cfQuoEnorm ?cfResE ?sub_cfker_Res // inE ?Hx ?(subsetP sHG). Qed. Lemma cfQuoInorm K phi : K \subset cfker phi -> (phi / K)%CF = 'Res ('Res['N_G(K)] phi / K)%CF. Proof. move=> kerK; rewrite -cfResQuo ?subsetIl ?quotientInorm ?cfRes_id //. by rewrite subsetI normG (subset_trans kerK) ?cfker_sub. Qed. Lemma cforder_mod H (psi : 'CF(G / H)) : H <| G -> #[psi %% H]%CF = #[psi]%CF. Proof. by move/cfModK/can_inj/cforder_inj_rmorph->. Qed. Lemma cforder_quo H phi : H <| G -> H \subset cfker phi -> #[phi / H]%CF = #[phi]%CF. Proof. by move=> nsHG kerHphi; rewrite -cforder_mod ?cfQuoK. Qed. End MoreCoset. Section Product. Variable (gT : finGroupType) (G : {group gT}). Lemma cfunM_onI A B phi psi : phi \in 'CF(G, A) -> psi \in 'CF(G, B) -> phi * psi \in 'CF(G, A :&: B). Proof. rewrite !cfun_onE => Aphi Bpsi; apply/subsetP=> x; rewrite !inE cfunE mulf_eq0. by case/norP=> /(subsetP Aphi)-> /(subsetP Bpsi). Qed. Lemma cfunM_on A phi psi : phi \in 'CF(G, A) -> psi \in 'CF(G, A) -> phi * psi \in 'CF(G, A). Proof. by move=> Aphi Bpsi; rewrite -[A]setIid cfunM_onI. Qed. End Product. Section SDproduct. Variables (gT : finGroupType) (G K H : {group gT}). Hypothesis defG : K ><| H = G. Fact cfSdprodKey : unit. Proof. by []. Qed. Definition cfSdprod := locked_with cfSdprodKey (cfMorph \o cfIsom (tagged (sdprod_isom defG)) : 'CF(H) -> 'CF(G)). Canonical cfSdprod_unlockable := [unlockable of cfSdprod]. Canonical cfSdprod_additive := [additive of cfSdprod]. Canonical cfSdprod_linear := [linear of cfSdprod]. Canonical cfSdprod_rmorphism := [rmorphism of cfSdprod]. Canonical cfSdprod_lrmorphism := [lrmorphism of cfSdprod]. Lemma cfSdprod1 phi : cfSdprod phi 1%g = phi 1%g. Proof. by rewrite unlock /= cfMorph1 cfIsom1. Qed. Let nsKG : K <| G. Proof. by have [] := sdprod_context defG. Qed. Let sHG : H \subset G. Proof. by have [] := sdprod_context defG. Qed. Let sKG : K \subset G. Proof. by have [] := andP nsKG. Qed. Lemma cfker_sdprod phi : K \subset cfker (cfSdprod phi). Proof. by rewrite unlock_with cfker_mod. Qed. Lemma cfSdprodEr phi : {in H, cfSdprod phi =1 phi}. Proof. by move=> y Hy; rewrite unlock cfModE ?cfIsomE ?(subsetP sHG). Qed. Lemma cfSdprodE phi : {in K & H, forall x y, cfSdprod phi (x * y)%g = phi y}. Proof. by move=> x y Kx Hy; rewrite /= cfkerMl ?(subsetP (cfker_sdprod _)) ?cfSdprodEr. Qed. Lemma cfSdprodK : cancel cfSdprod 'Res[H]. Proof. by move=> phi; apply/cfun_inP=> x Hx; rewrite cfResE ?cfSdprodEr. Qed. Lemma cfSdprod_inj : injective cfSdprod. Proof. exact: can_inj cfSdprodK. Qed. Lemma cfSdprod_eq1 phi : (cfSdprod phi == 1) = (phi == 1). Proof. exact: rmorph_eq1 cfSdprod_inj. Qed. Lemma cfRes_sdprodK phi : K \subset cfker phi -> cfSdprod ('Res[H] phi) = phi. Proof. move=> kerK; apply/cfun_inP=> _ /(mem_sdprod defG)[x [y [Kx Hy -> _]]]. by rewrite cfSdprodE // cfResE // cfkerMl ?(subsetP kerK). Qed. Lemma sdprod_cfker phi : K ><| cfker phi = cfker (cfSdprod phi). Proof. have [skerH [_ _ nKH tiKH]] := (cfker_sub phi, sdprodP defG). rewrite unlock cfker_morph ?normal_norm // cfker_isom restrmEsub //=. rewrite -(sdprod_modl defG) ?sub_cosetpre //=; congr (_ ><| _). by rewrite quotientK ?(subset_trans skerH) // -group_modr //= setIC tiKH mul1g. Qed. Lemma cforder_sdprod phi : #[cfSdprod phi]%CF = #[phi]%CF. Proof. exact: cforder_inj_rmorph cfSdprod_inj. Qed. End SDproduct. Section DProduct. Variables (gT : finGroupType) (G K H : {group gT}). Hypothesis KxH : K \x H = G. Lemma reindex_dprod R idx (op : Monoid.com_law idx) (F : gT -> R) : \big[op/idx]_(g in G) F g = \big[op/idx]_(k in K) \big[op/idx]_(h in H) F (k * h)%g. Proof. have /mulgmP/misomP[fM /isomP[injf im_f]] := KxH. rewrite pair_big_dep -im_f morphimEdom big_imset; last exact/injmP. by apply: eq_big => [][x y]; rewrite ?inE. Qed. Definition cfDprodr := cfSdprod (dprodWsd KxH). Definition cfDprodl := cfSdprod (dprodWsdC KxH). Definition cfDprod phi psi := cfDprodl phi * cfDprodr psi. Canonical cfDprodl_additive := [additive of cfDprodl]. Canonical cfDprodl_linear := [linear of cfDprodl]. Canonical cfDprodl_rmorphism := [rmorphism of cfDprodl]. Canonical cfDprodl_lrmorphism := [lrmorphism of cfDprodl]. Canonical cfDprodr_additive := [additive of cfDprodr]. Canonical cfDprodr_linear := [linear of cfDprodr]. Canonical cfDprodr_rmorphism := [rmorphism of cfDprodr]. Canonical cfDprodr_lrmorphism := [lrmorphism of cfDprodr]. Lemma cfDprodl1 phi : cfDprodl phi 1%g = phi 1%g. Proof. exact: cfSdprod1. Qed. Lemma cfDprodr1 psi : cfDprodr psi 1%g = psi 1%g. Proof. exact: cfSdprod1. Qed. Lemma cfDprod1 phi psi : cfDprod phi psi 1%g = phi 1%g * psi 1%g. Proof. by rewrite cfunE /= !cfSdprod1. Qed. Lemma cfDprodl_eq1 phi : (cfDprodl phi == 1) = (phi == 1). Proof. exact: cfSdprod_eq1. Qed. Lemma cfDprodr_eq1 psi : (cfDprodr psi == 1) = (psi == 1). Proof. exact: cfSdprod_eq1. Qed. Lemma cfDprod_cfun1r phi : cfDprod phi 1 = cfDprodl phi. Proof. by rewrite /cfDprod rmorph1 mulr1. Qed. Lemma cfDprod_cfun1l psi : cfDprod 1 psi = cfDprodr psi. Proof. by rewrite /cfDprod rmorph1 mul1r. Qed. Lemma cfDprod_cfun1 : cfDprod 1 1 = 1. Proof. by rewrite cfDprod_cfun1l rmorph1. Qed. Lemma cfDprod_split phi psi : cfDprod phi psi = cfDprod phi 1 * cfDprod 1 psi. Proof. by rewrite cfDprod_cfun1l cfDprod_cfun1r. Qed. Let nsKG : K <| G. Proof. by have [] := dprod_normal2 KxH. Qed. Let nsHG : H <| G. Proof. by have [] := dprod_normal2 KxH. Qed. Let cKH : H \subset 'C(K). Proof. by have [] := dprodP KxH. Qed. Let sKG := normal_sub nsKG. Let sHG := normal_sub nsHG. Lemma cfDprodlK : cancel cfDprodl 'Res[K]. Proof. exact: cfSdprodK. Qed. Lemma cfDprodrK : cancel cfDprodr 'Res[H]. Proof. exact: cfSdprodK. Qed. Lemma cfker_dprodl phi : cfker phi \x H = cfker (cfDprodl phi). Proof. by rewrite dprodC -sdprod_cfker dprodEsd // centsC (centsS (cfker_sub _)). Qed. Lemma cfker_dprodr psi : K \x cfker psi = cfker (cfDprodr psi). Proof. by rewrite -sdprod_cfker dprodEsd // (subset_trans (cfker_sub _)). Qed. Lemma cfDprodEl phi : {in K & H, forall k h, cfDprodl phi (k * h)%g = phi k}. Proof. by move=> k h Kk Hh /=; rewrite -(centsP cKH) // cfSdprodE. Qed. Lemma cfDprodEr psi : {in K & H, forall k h, cfDprodr psi (k * h)%g = psi h}. Proof. exact: cfSdprodE. Qed. Lemma cfDprodE phi psi : {in K & H, forall h k, cfDprod phi psi (h * k)%g = phi h * psi k}. Proof. by move=> k h Kk Hh /=; rewrite cfunE cfDprodEl ?cfDprodEr. Qed. Lemma cfDprod_Resl phi psi : 'Res[K] (cfDprod phi psi) = psi 1%g *: phi. Proof. by apply/cfun_inP=> x Kx; rewrite cfunE cfResE // -{1}[x]mulg1 mulrC cfDprodE. Qed. Lemma cfDprod_Resr phi psi : 'Res[H] (cfDprod phi psi) = phi 1%g *: psi. Proof. by apply/cfun_inP=> y Hy; rewrite cfunE cfResE // -{1}[y]mul1g cfDprodE. Qed. Lemma cfDprodKl (psi : 'CF(H)) : psi 1%g = 1 -> cancel (cfDprod^~ psi) 'Res. Proof. by move=> psi1 phi; rewrite cfDprod_Resl psi1 scale1r. Qed. Lemma cfDprodKr (phi : 'CF(K)) : phi 1%g = 1 -> cancel (cfDprod phi) 'Res. Proof. by move=> phi1 psi; rewrite cfDprod_Resr phi1 scale1r. Qed. (* Note that equality holds here iff either cfker phi = K and cfker psi = H, *) (* or else phi != 0, psi != 0 and coprime #|K : cfker phi| #|H : cfker phi|. *) Lemma cfker_dprod phi psi : cfker phi <*> cfker psi \subset cfker (cfDprod phi psi). Proof. rewrite -genM_join gen_subG; apply/subsetP=> _ /mulsgP[x y kKx kHy ->] /=. have [[Kx _] [Hy _]] := (setIdP kKx, setIdP kHy). have Gxy: (x * y)%g \in G by rewrite -(dprodW KxH) mem_mulg. rewrite inE Gxy; apply/forallP=> g. have [Gg | G'g] := boolP (g \in G); last by rewrite !cfun0 1?groupMl. have{g Gg} [k [h [Kk Hh -> _]]] := mem_dprod KxH Gg. rewrite mulgA -(mulgA x) (centsP cKH y) // mulgA -mulgA !cfDprodE ?groupM //. by rewrite !cfkerMl. Qed. Lemma cfdot_dprod phi1 phi2 psi1 psi2 : '[cfDprod phi1 psi1, cfDprod phi2 psi2] = '[phi1, phi2] * '[psi1, psi2]. Proof. rewrite !cfdotE mulrCA -mulrA mulrCA mulrA -invfM -natrM (dprod_card KxH). congr (_ * _); rewrite big_distrl reindex_dprod /=; apply: eq_bigr => k Kk. rewrite big_distrr; apply: eq_bigr => h Hh /=. by rewrite mulrCA -mulrA -rmorphM mulrCA mulrA !cfDprodE. Qed. Lemma cfDprodl_iso : isometry cfDprodl. Proof. by move=> phi1 phi2; rewrite -!cfDprod_cfun1r cfdot_dprod cfnorm1 mulr1. Qed. Lemma cfDprodr_iso : isometry cfDprodr. Proof. by move=> psi1 psi2; rewrite -!cfDprod_cfun1l cfdot_dprod cfnorm1 mul1r. Qed. Lemma cforder_dprodl phi : #[cfDprodl phi]%CF = #[phi]%CF. Proof. exact: cforder_sdprod. Qed. Lemma cforder_dprodr psi : #[cfDprodr psi]%CF = #[psi]%CF. Proof. exact: cforder_sdprod. Qed. End DProduct. Lemma cfDprodC (gT : finGroupType) (G K H : {group gT}) (KxH : K \x H = G) (HxK : H \x K = G) chi psi : cfDprod KxH chi psi = cfDprod HxK psi chi. Proof. rewrite /cfDprod mulrC. by congr (_ * _); congr (cfSdprod _ _); apply: eq_irrelevance. Qed. Section Bigdproduct. Variables (gT : finGroupType) (I : finType) (P : pred I). Variables (A : I -> {group gT}) (G : {group gT}). Hypothesis defG : \big[dprod/1%g]_(i | P i) A i = G. Let sAG i : P i -> A i \subset G. Proof. by move=> Pi; rewrite -(bigdprodWY defG) (bigD1 i) ?joing_subl. Qed. Fact cfBigdprodi_subproof i : gval (if P i then A i else 1%G) \x <<\bigcup_(j | P j && (j != i)) A j>> = G. Proof. have:= defG; rewrite fun_if big_mkcond (bigD1 i) // -big_mkcondl /= => defGi. by have [[_ Gi' _ defGi']] := dprodP defGi; rewrite (bigdprodWY defGi') -defGi'. Qed. Definition cfBigdprodi i := cfDprodl (cfBigdprodi_subproof i) \o 'Res[_, A i]. Canonical cfBigdprodi_additive i := [additive of @cfBigdprodi i]. Canonical cfBigdprodi_linear i := [linear of @cfBigdprodi i]. Canonical cfBigdprodi_rmorphism i := [rmorphism of @cfBigdprodi i]. Canonical cfBigdprodi_lrmorphism i := [lrmorphism of @cfBigdprodi i]. Lemma cfBigdprodi1 i (phi : 'CF(A i)) : cfBigdprodi phi 1%g = phi 1%g. Proof. by rewrite cfDprodl1 cfRes1. Qed. Lemma cfBigdprodi_eq1 i (phi : 'CF(A i)) : P i -> (cfBigdprodi phi == 1) = (phi == 1). Proof. by move=> Pi; rewrite cfSdprod_eq1 Pi cfRes_id. Qed. Lemma cfBigdprodiK i : P i -> cancel (@cfBigdprodi i) 'Res[A i]. Proof. move=> Pi phi; have:= cfDprodlK (cfBigdprodi_subproof i) ('Res phi). by rewrite -[cfDprodl _ _]/(cfBigdprodi phi) Pi cfRes_id. Qed. Lemma cfBigdprodi_inj i : P i -> injective (@cfBigdprodi i). Proof. by move/cfBigdprodiK; apply: can_inj. Qed. Lemma cfBigdprodEi i (phi : 'CF(A i)) x : P i -> (forall j, P j -> x j \in A j) -> cfBigdprodi phi (\prod_(j | P j) x j)%g = phi (x i). Proof. have [r big_r [Ur mem_r] _] := big_enumP P => Pi AxP. have:= bigdprodWcp defG; rewrite -!big_r => defGr. have{AxP} [r_i Axr]: i \in r /\ {in r, forall j, x j \in A j}. by split=> [|j]; rewrite mem_r // => /AxP. rewrite (perm_bigcprod defGr Axr (perm_to_rem r_i)) big_cons. rewrite cfDprodEl ?Pi ?cfRes_id ?Axr // big_seq group_prod // => j. rewrite mem_rem_uniq // => /andP[i'j /= r_j]. by apply/mem_gen/bigcupP; exists j; [rewrite -mem_r r_j | apply: Axr]. Qed. Lemma cfBigdprodi_iso i : P i -> isometry (@cfBigdprodi i). Proof. by move=> Pi phi psi; rewrite cfDprodl_iso Pi !cfRes_id. Qed. Definition cfBigdprod (phi : forall i, 'CF(A i)) := \prod_(i | P i) cfBigdprodi (phi i). Lemma cfBigdprodE phi x : (forall i, P i -> x i \in A i) -> cfBigdprod phi (\prod_(i | P i) x i)%g = \prod_(i | P i) phi i (x i). Proof. move=> Ax; rewrite prod_cfunE; last by rewrite -(bigdprodW defG) mem_prodg. by apply: eq_bigr => i Pi; rewrite cfBigdprodEi. Qed. Lemma cfBigdprod1 phi : cfBigdprod phi 1%g = \prod_(i | P i) phi i 1%g. Proof. by rewrite prod_cfunE //; apply/eq_bigr=> i _; apply: cfBigdprodi1. Qed. Lemma cfBigdprodK phi (Phi := cfBigdprod phi) i (a := phi i 1%g / Phi 1%g) : Phi 1%g != 0 -> P i -> a != 0 /\ a *: 'Res[A i] Phi = phi i. Proof. move=> nzPhi Pi; split. rewrite mulf_neq0 ?invr_eq0 // (contraNneq _ nzPhi) // => phi_i0. by rewrite cfBigdprod1 (bigD1 i) //= phi_i0 mul0r. apply/cfun_inP=> x Aix; rewrite cfunE cfResE ?sAG // mulrAC. have {1}->: x = (\prod_(j | P j) (if j == i then x else 1))%g. rewrite -big_mkcondr (big_pred1 i) ?eqxx // => j /=. by apply: andb_idl => /eqP->. rewrite cfBigdprodE => [|j _]; last by case: eqP => // ->. apply: canLR (mulfK nzPhi) _; rewrite cfBigdprod1 !(bigD1 i Pi) /= eqxx. by rewrite mulrCA !mulrA; congr (_ * _); apply: eq_bigr => j /andP[_ /negPf->]. Qed. Lemma cfdot_bigdprod phi psi : '[cfBigdprod phi, cfBigdprod psi] = \prod_(i | P i) '[phi i, psi i]. Proof. apply: canLR (mulKf (neq0CG G)) _; rewrite -(bigdprod_card defG). rewrite (big_morph _ (@natrM _) (erefl _)) -big_split /=. rewrite (eq_bigr _ (fun i _ => mulVKf (neq0CG _) _)) (big_distr_big_dep 1%g) /=. set F := pfamily _ _ _; pose h (f : {ffun I -> gT}) := (\prod_(i | P i) f i)%g. pose is_hK x f := forall f1, (f1 \in F) && (h f1 == x) = (f == f1). have /fin_all_exists[h1 Dh1] x: exists f, x \in G -> is_hK x f. case Gx: (x \in G); last by exists [ffun _ => x]. have [f [Af fK Uf]] := mem_bigdprod defG Gx. exists [ffun i => if P i then f i else 1%g] => _ f1. apply/andP/eqP=> [[/pfamilyP[Pf1 Af1] /eqP Dx] | <-]. by apply/ffunP=> i; rewrite ffunE; case: ifPn => [/Uf-> | /(supportP Pf1)]. split; last by rewrite fK; apply/eqP/eq_bigr=> i Pi; rewrite ffunE Pi. by apply/familyP=> i; rewrite ffunE !unfold_in; case: ifP => //= /Af. rewrite (reindex_onto h h1) /= => [|x /Dh1/(_ (h1 x))]; last first. by rewrite eqxx => /andP[_ /eqP]. apply/eq_big => [f | f /andP[/Dh1<- /andP[/pfamilyP[_ Af] _]]]; last first. by rewrite !cfBigdprodE // rmorph_prod -big_split /=. apply/idP/idP=> [/andP[/Dh1<-] | Ff]; first by rewrite eqxx andbT. have /pfamilyP[_ Af] := Ff; suffices Ghf: h f \in G by rewrite -Dh1 ?Ghf ?Ff /=. by apply/group_prod=> i Pi; rewrite (subsetP (sAG Pi)) ?Af. Qed. End Bigdproduct. Section MorphIsometry. Variable gT : finGroupType. Implicit Types (D G H K : {group gT}) (aT rT : finGroupType). Lemma cfMorph_iso aT rT (G D : {group aT}) (f : {morphism D >-> rT}) : G \subset D -> isometry (cfMorph : 'CF(f @* G) -> 'CF(G)). Proof. move=> sGD phi psi; rewrite !cfdotE card_morphim (setIidPr sGD). rewrite -(LagrangeI G ('ker f)) /= mulnC natrM invfM -mulrA. congr (_ * _); apply: (canLR (mulKf (neq0CG _))). rewrite mulr_sumr (partition_big_imset f) /= -morphimEsub //. apply: eq_bigr => _ /morphimP[x Dx Gx ->]. rewrite -(card_rcoset _ x) mulr_natl -sumr_const. apply/eq_big => [y | y /andP[Gy /eqP <-]]; last by rewrite !cfMorphE. rewrite mem_rcoset inE groupMr ?groupV // -mem_rcoset. by apply: andb_id2l => /(subsetP sGD) Dy; apply: sameP eqP (rcoset_kerP f _ _). Qed. Lemma cfIsom_iso rT G (R : {group rT}) (f : {morphism G >-> rT}) : forall isoG : isom G R f, isometry (cfIsom isoG). Proof. move=> isoG phi psi; rewrite unlock cfMorph_iso //; set G1 := _ @* R. by rewrite -(isom_im (isom_sym isoG)) -/G1 in phi psi *; rewrite !cfRes_id. Qed. Lemma cfMod_iso H G : H <| G -> isometry (@cfMod _ G H). Proof. by case/andP=> _; apply: cfMorph_iso. Qed. Lemma cfQuo_iso H G : H <| G -> {in [pred phi | H \subset cfker phi] &, isometry (@cfQuo _ G H)}. Proof. by move=> nsHG phi psi sHkphi sHkpsi; rewrite -(cfMod_iso nsHG) !cfQuoK. Qed. Lemma cfnorm_quo H G phi : H <| G -> H \subset cfker phi -> '[phi / H] = '[phi]_G. Proof. by move=> nsHG sHker; apply: cfQuo_iso. Qed. Lemma cfSdprod_iso K H G (defG : K ><| H = G) : isometry (cfSdprod defG). Proof. move=> phi psi; have [/andP[_ nKG] _ _ _ _] := sdprod_context defG. by rewrite [cfSdprod _]locked_withE cfMorph_iso ?cfIsom_iso. Qed. End MorphIsometry. Section Induced. Variable gT : finGroupType. Section Def. Variables B A : {set gT}. Local Notation G := <>. Local Notation H := <>. (* The defalut value for the ~~ (H \subset G) case matches the one for cfRes *) (* so that Frobenius reciprocity holds even in this degenerate case. *) Definition ffun_cfInd (phi : 'CF(A)) := [ffun x => if H \subset G then #|A|%:R^-1 * (\sum_(y in G) phi (x ^ y)) else #|G|%:R * '[phi, 1] *+ (x == 1%g)]. Fact cfInd_subproof phi : is_class_fun G (ffun_cfInd phi). Proof. apply: intro_class_fun => [x y Gx Gy | x H'x]; last first. case: subsetP => [sHG | _]; last by rewrite (negPf (group1_contra H'x)). rewrite big1 ?mulr0 // => y Gy; rewrite cfun0gen ?(contra _ H'x) //= => /sHG. by rewrite memJ_norm ?(subsetP (normG _)). rewrite conjg_eq1 (reindex_inj (mulgI y^-1)%g); congr (if _ then _ * _ else _). by apply: eq_big => [z | z Gz]; rewrite ?groupMl ?groupV // -conjgM mulKVg. Qed. Definition cfInd phi := Cfun 1 (cfInd_subproof phi). Lemma cfInd_is_linear : linear cfInd. Proof. move=> c phi psi; apply/cfunP=> x; rewrite !cfunElock; case: ifP => _. rewrite mulrCA -mulrDr [c * _]mulr_sumr -big_split /=. by congr (_ * _); apply: eq_bigr => y _; rewrite !cfunE. rewrite mulrnAr -mulrnDl !(mulrCA c) -!mulrDr [c * _]mulr_sumr -big_split /=. by congr (_ * (_ * _) *+ _); apply: eq_bigr => y; rewrite !cfunE mulrA mulrDl. Qed. Canonical cfInd_additive := Additive cfInd_is_linear. Canonical cfInd_linear := Linear cfInd_is_linear. End Def. Local Notation "''Ind[' B , A ]" := (@cfInd B A) : ring_scope. Local Notation "''Ind[' B ]" := 'Ind[B, _] : ring_scope. Lemma cfIndE (G H : {group gT}) phi x : H \subset G -> 'Ind[G, H] phi x = #|H|%:R^-1 * (\sum_(y in G) phi (x ^ y)). Proof. by rewrite cfunElock !genGid => ->. Qed. Variables G K H : {group gT}. Implicit Types (phi : 'CF(H)) (psi : 'CF(G)). Lemma cfIndEout phi : ~~ (H \subset G) -> 'Ind[G] phi = (#|G|%:R * '[phi, 1]) *: '1_1%G. Proof. move/negPf=> not_sHG; apply/cfunP=> x; rewrite cfunE cfuniE ?normal1 // inE. by rewrite mulr_natr cfunElock !genGid not_sHG. Qed. Lemma cfIndEsdprod (phi : 'CF(K)) x : K ><| H = G -> 'Ind[G] phi x = \sum_(w in H) phi (x ^ w)%g. Proof. move=> defG; have [/andP[sKG _] _ mulKH nKH _] := sdprod_context defG. rewrite cfIndE //; apply: canLR (mulKf (neq0CG _)) _; rewrite -mulKH mulr_sumr. rewrite (set_partition_big _ (rcosets_partition_mul H K)) ?big_imset /=. apply: eq_bigr => y Hy; rewrite rcosetE norm_rlcoset ?(subsetP nKH) //. rewrite -lcosetE mulr_natl big_imset /=; last exact: in2W (mulgI _). by rewrite -sumr_const; apply: eq_bigr => z Kz; rewrite conjgM cfunJ. have [{}nKH /isomP[injf _]] := sdprod_isom defG. apply: can_in_inj (fun Ky => invm injf (coset K (repr Ky))) _ => y Hy. by rewrite rcosetE -val_coset ?(subsetP nKH) // coset_reprK invmE. Qed. Lemma cfInd_on A phi : H \subset G -> phi \in 'CF(H, A) -> 'Ind[G] phi \in 'CF(G, class_support A G). Proof. move=> sHG Af; apply/cfun_onP=> g AG'g; rewrite cfIndE ?big1 ?mulr0 // => h Gh. apply: (cfun_on0 Af); apply: contra AG'g => Agh. by rewrite -[g](conjgK h) memJ_class_support // groupV. Qed. Lemma cfInd_id phi : 'Ind[H] phi = phi. Proof. apply/cfun_inP=> x Hx; rewrite cfIndE // (eq_bigr _ (cfunJ phi x)) sumr_const. by rewrite -[phi x *+ _]mulr_natl mulKf ?neq0CG. Qed. Lemma cfInd_normal phi : H <| G -> 'Ind[G] phi \in 'CF(G, H). Proof. case/andP=> sHG nHG; apply: (cfun_onS (class_support_sub_norm (subxx _) nHG)). by rewrite cfInd_on ?cfun_onG. Qed. Lemma cfInd1 phi : H \subset G -> 'Ind[G] phi 1%g = #|G : H|%:R * phi 1%g. Proof. move=> sHG; rewrite cfIndE // natf_indexg // -mulrA mulrCA; congr (_ * _). by rewrite mulr_natl -sumr_const; apply: eq_bigr => x; rewrite conj1g. Qed. Lemma cfInd_cfun1 : H <| G -> 'Ind[G, H] 1 = #|G : H|%:R *: '1_H. Proof. move=> nsHG; have [sHG nHG] := andP nsHG; rewrite natf_indexg // mulrC. apply/cfunP=> x; rewrite cfIndE ?cfunE ?cfuniE // -mulrA; congr (_ * _). rewrite mulr_natl -sumr_const; apply: eq_bigr => y Gy. by rewrite cfun1E -{1}(normsP nHG y Gy) memJ_conjg. Qed. Lemma cfnorm_Ind_cfun1 : H <| G -> '['Ind[G, H] 1] = #|G : H|%:R. Proof. move=> nsHG; rewrite cfInd_cfun1 // cfnormZ normr_nat cfdot_cfuni // setIid. by rewrite expr2 {2}natf_indexg ?normal_sub // !mulrA divfK ?mulfK ?neq0CG. Qed. Lemma cfIndInd phi : K \subset G -> H \subset K -> 'Ind[G] ('Ind[K] phi) = 'Ind[G] phi. Proof. move=> sKG sHK; apply/cfun_inP=> x Gx; rewrite !cfIndE ?(subset_trans sHK) //. apply: canLR (mulKf (neq0CG K)) _; rewrite mulr_sumr mulr_natl. transitivity (\sum_(y in G) \sum_(z in K) #|H|%:R^-1 * phi ((x ^ y) ^ z)). by apply: eq_bigr => y Gy; rewrite cfIndE // -mulr_sumr. symmetry; rewrite exchange_big /= -sumr_const; apply: eq_bigr => z Kz. rewrite (reindex_inj (mulIg z)). by apply: eq_big => [y | y _]; rewrite ?conjgM // groupMr // (subsetP sKG). Qed. (* This is Isaacs, Lemma (5.2). *) Lemma Frobenius_reciprocity phi psi : '[phi, 'Res[H] psi] = '['Ind[G] phi, psi]. Proof. have [sHG | not_sHG] := boolP (H \subset G); last first. rewrite cfResEout // cfIndEout // cfdotZr cfdotZl mulrAC; congr (_ * _). rewrite (cfdotEl _ (cfuni_on _ _)) mulVKf ?neq0CG // big_set1. by rewrite cfuniE ?normal1 ?set11 ?mul1r. transitivity (#|H|%:R^-1 * \sum_(x in G) phi x * (psi x)^*). rewrite (big_setID H) /= (setIidPr sHG) addrC big1 ?add0r; last first. by move=> x /setDP[_ /cfun0->]; rewrite mul0r. by congr (_ * _); apply: eq_bigr => x Hx; rewrite cfResE. set h' := _^-1; apply: canRL (mulKf (neq0CG G)) _. transitivity (h' * \sum_(y in G) \sum_(x in G) phi (x ^ y) * (psi (x ^ y))^*). rewrite mulrCA mulr_natl -sumr_const; congr (_ * _); apply: eq_bigr => y Gy. by rewrite (reindex_acts 'J _ Gy) ?astabsJ ?normG. rewrite exchange_big mulr_sumr; apply: eq_bigr => x _; rewrite cfIndE //=. by rewrite -mulrA mulr_suml; congr (_ * _); apply: eq_bigr => y /(cfunJ psi)->. Qed. Definition cfdot_Res_r := Frobenius_reciprocity. Lemma cfdot_Res_l psi phi : '['Res[H] psi, phi] = '[psi, 'Ind[G] phi]. Proof. by rewrite cfdotC cfdot_Res_r -cfdotC. Qed. Lemma cfIndM phi psi: H \subset G -> 'Ind[G] (phi * ('Res[H] psi)) = 'Ind[G] phi * psi. Proof. move=> HsG; apply/cfun_inP=> x Gx; rewrite !cfIndE // !cfunE !cfIndE // -mulrA. congr (_ * _); rewrite mulr_suml; apply: eq_bigr=> i iG; rewrite !cfunE. case: (boolP (x^i \in H))=> xJi; last by rewrite cfun0gen ?mul0r ?genGid. by rewrite !cfResE //; congr (_*_); rewrite cfunJgen ?genGid. Qed. End Induced. Arguments cfInd {gT} B%g {A%g} phi%CF. Notation "''Ind[' G , H ]" := (@cfInd _ G H) (only parsing) : ring_scope. Notation "''Ind[' G ]" := 'Ind[G, _] : ring_scope. Notation "''Ind'" := 'Ind[_] (only parsing) : ring_scope. Section MorphInduced. Variables (aT rT : finGroupType) (D G H : {group aT}) (R S : {group rT}). Lemma cfIndMorph (f : {morphism D >-> rT}) (phi : 'CF(f @* H)) : 'ker f \subset H -> H \subset G -> G \subset D -> 'Ind[G] (cfMorph phi) = cfMorph ('Ind[f @* G] phi). Proof. move=> sKH sHG sGD; have [sHD inD] := (subset_trans sHG sGD, subsetP sGD). apply/cfun_inP=> /= x Gx; have [Dx sKG] := (inD x Gx, subset_trans sKH sHG). rewrite cfMorphE ?cfIndE ?morphimS // (partition_big_imset f) -morphimEsub //=. rewrite card_morphim (setIidPr sHD) natf_indexg // invfM invrK -mulrA. congr (_ * _); rewrite mulr_sumr; apply: eq_bigr => _ /morphimP[y Dy Gy ->]. rewrite -(card_rcoset _ y) mulr_natl -sumr_const. apply: eq_big => [z | z /andP[Gz /eqP <-]]. have [Gz | G'z] := boolP (z \in G). by rewrite (sameP eqP (rcoset_kerP _ _ _)) ?inD. by case: rcosetP G'z => // [[t Kt ->]]; rewrite groupM // (subsetP sKG). have [Dz Dxz] := (inD z Gz, inD (x ^ z) (groupJ Gx Gz)); rewrite -morphJ //. have [Hxz | notHxz] := boolP (x ^ z \in H); first by rewrite cfMorphE. by rewrite !cfun0 // -sub1set -morphim_set1 // morphimSGK ?sub1set. Qed. Variables (g : {morphism G >-> rT}) (h : {morphism H >-> rT}). Hypotheses (isoG : isom G R g) (isoH : isom H S h) (eq_hg : {in H, h =1 g}). Hypothesis sHG : H \subset G. Lemma cfResIsom phi : 'Res[S] (cfIsom isoG phi) = cfIsom isoH ('Res[H] phi). Proof. have [[injg defR] [injh defS]] := (isomP isoG, isomP isoH). rewrite !morphimEdom in defS defR; apply/cfun_inP=> s. rewrite -{1}defS => /imsetP[x Hx ->] {s}; have Gx := subsetP sHG x Hx. rewrite {1}eq_hg ?(cfResE, cfIsomE) // -defS -?eq_hg ?imset_f // -defR. by rewrite (eq_in_imset eq_hg) imsetS. Qed. Lemma cfIndIsom phi : 'Ind[R] (cfIsom isoH phi) = cfIsom isoG ('Ind[G] phi). Proof. have [[injg defR] [_ defS]] := (isomP isoG, isomP isoH). rewrite morphimEdom (eq_in_imset eq_hg) -morphimEsub // in defS. apply/cfun_inP=> s; rewrite -{1}defR => /morphimP[x _ Gx ->]{s}. rewrite cfIsomE ?cfIndE // -defR -{1}defS ?morphimS ?card_injm // morphimEdom. congr (_ * _); rewrite big_imset //=; last exact/injmP. apply: eq_bigr => y Gy; rewrite -morphJ //. have [Hxy | H'xy] := boolP (x ^ y \in H); first by rewrite -eq_hg ?cfIsomE. by rewrite !cfun0 -?defS // -sub1set -morphim_set1 ?injmSK ?sub1set // groupJ. Qed. End MorphInduced. Section FieldAutomorphism. Variables (u : {rmorphism algC -> algC}) (gT rT : finGroupType). Variables (G K H : {group gT}) (f : {morphism G >-> rT}) (R : {group rT}). Implicit Types (phi : 'CF(G)) (S : seq 'CF(G)). Local Notation "phi ^u" := (cfAut u phi) (at level 3, format "phi ^u"). Lemma cfAutZ_nat n phi : (n%:R *: phi)^u = n%:R *: phi^u. Proof. exact: raddfZnat. Qed. Lemma cfAutZ_Cnat z phi : z \in Cnat -> (z *: phi)^u = z *: phi^u. Proof. exact: raddfZ_Cnat. Qed. Lemma cfAutZ_Cint z phi : z \in Cint -> (z *: phi)^u = z *: phi^u. Proof. exact: raddfZ_Cint. Qed. Lemma cfAutK : cancel (@cfAut gT G u) (cfAut (algC_invaut_rmorphism u)). Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE /= algC_autK. Qed. Lemma cfAutVK : cancel (cfAut (algC_invaut_rmorphism u)) (@cfAut gT G u). Proof. by move=> phi; apply/cfunP=> x; rewrite !cfunE /= algC_invautK. Qed. Lemma cfAut_inj : injective (@cfAut gT G u). Proof. exact: can_inj cfAutK. Qed. Lemma cfAut_eq1 phi : (cfAut u phi == 1) = (phi == 1). Proof. by rewrite rmorph_eq1 //; apply: cfAut_inj. Qed. Lemma support_cfAut phi : support phi^u =i support phi. Proof. by move=> x; rewrite !inE cfunE fmorph_eq0. Qed. Lemma map_cfAut_free S : cfAut_closed u S -> free S -> free (map (cfAut u) S). Proof. set Su := map _ S => sSuS freeS; have uniqS := free_uniq freeS. have uniqSu: uniq Su by rewrite (map_inj_uniq cfAut_inj). have{} sSuS: {subset Su <= S} by move=> _ /mapP[phi Sphi ->]; apply: sSuS. have [|_ eqSuS] := uniq_min_size uniqSu sSuS; first by rewrite size_map. by rewrite (perm_free (uniq_perm uniqSu uniqS eqSuS)). Qed. Lemma cfAut_on A phi : (phi^u \in 'CF(G, A)) = (phi \in 'CF(G, A)). Proof. by rewrite !cfun_onE (eq_subset (support_cfAut phi)). Qed. Lemma cfker_aut phi : cfker phi^u = cfker phi. Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. by apply/forallP/forallP=> Kx y; have:= Kx y; rewrite !cfunE (inj_eq (fmorph_inj u)). Qed. Lemma cfAut_cfuni A : ('1_A)^u = '1_A :> 'CF(G). Proof. by apply/cfunP=> x; rewrite !cfunElock rmorph_nat. Qed. Lemma cforder_aut phi : #[phi^u]%CF = #[phi]%CF. Proof. exact: cforder_inj_rmorph cfAut_inj. Qed. Lemma cfAutRes phi : ('Res[H] phi)^u = 'Res phi^u. Proof. by apply/cfunP=> x; rewrite !cfunElock rmorphMn. Qed. Lemma cfAutMorph (psi : 'CF(f @* H)) : (cfMorph psi)^u = cfMorph psi^u. Proof. by apply/cfun_inP=> x Hx; rewrite !cfunElock Hx. Qed. Lemma cfAutIsom (isoGR : isom G R f) phi : (cfIsom isoGR phi)^u = cfIsom isoGR phi^u. Proof. apply/cfun_inP=> y; have [_ {1}<-] := isomP isoGR => /morphimP[x _ Gx ->{y}]. by rewrite !(cfunE, cfIsomE). Qed. Lemma cfAutQuo phi : (phi / H)^u = (phi^u / H)%CF. Proof. by apply/cfunP=> Hx; rewrite !cfunElock cfker_aut rmorphMn. Qed. Lemma cfAutMod (psi : 'CF(G / H)) : (psi %% H)^u = (psi^u %% H)%CF. Proof. by apply/cfunP=> x; rewrite !cfunElock rmorphMn. Qed. Lemma cfAutInd (psi : 'CF(H)) : ('Ind[G] psi)^u = 'Ind psi^u. Proof. have [sHG | not_sHG] := boolP (H \subset G). apply/cfunP=> x; rewrite !(cfunE, cfIndE) // rmorphM fmorphV rmorph_nat. by congr (_ * _); rewrite rmorph_sum; apply: eq_bigr => y; rewrite !cfunE. rewrite !cfIndEout // linearZ /= cfAut_cfuni rmorphM rmorph_nat. rewrite -cfdot_cfAut ?rmorph1 // => _ /imageP[x Hx ->]. by rewrite cfun1E Hx !rmorph1. Qed. Hypothesis KxH : K \x H = G. Lemma cfAutDprodl (phi : 'CF(K)) : (cfDprodl KxH phi)^u = cfDprodl KxH phi^u. Proof. apply/cfun_inP=> _ /(mem_dprod KxH)[x [y [Kx Hy -> _]]]. by rewrite !(cfunE, cfDprodEl). Qed. Lemma cfAutDprodr (psi : 'CF(H)) : (cfDprodr KxH psi)^u = cfDprodr KxH psi^u. Proof. apply/cfun_inP=> _ /(mem_dprod KxH)[x [y [Kx Hy -> _]]]. by rewrite !(cfunE, cfDprodEr). Qed. Lemma cfAutDprod (phi : 'CF(K)) (psi : 'CF(H)) : (cfDprod KxH phi psi)^u = cfDprod KxH phi^u psi^u. Proof. by rewrite rmorphM /= cfAutDprodl cfAutDprodr. Qed. End FieldAutomorphism. Arguments cfAutK u {gT G}. Arguments cfAutVK u {gT G}. Arguments cfAut_inj u {gT G} [phi1 phi2] : rename. Definition conj_cfRes := cfAutRes conjC. Definition cfker_conjC := cfker_aut conjC. Definition conj_cfQuo := cfAutQuo conjC. Definition conj_cfMod := cfAutMod conjC. Definition conj_cfInd := cfAutInd conjC. Definition cfconjC_eq1 := cfAut_eq1 conjC. Notation "@ 'cf_triangle_lerif'" := (deprecate cf_triangle_lerif cf_triangle_leif) (at level 10, only parsing). Notation cf_triangle_lerif := (@cf_triangle_lerif _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/character/inertia.v000066400000000000000000002111771375767750300227110ustar00rootroot00000000000000(* (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 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. From mathcomp Require Import sylow maximal frobenius matrix mxalgebra. From mathcomp Require Import mxrepresentation vector algC classfun character. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. (******************************************************************************) (* This file contains the definitions and properties of inertia groups: *) (* (phi ^ y)%CF == the y-conjugate of phi : 'CF(G), i.e., the class *) (* function mapping x ^ y to phi x provided y normalises G. *) (* We take (phi ^ y)%CF = phi when y \notin 'N(G). *) (* (phi ^: G)%CF == the sequence of all distinct conjugates of phi : 'CF(H) *) (* by all y in G. *) (* 'I[phi] == the inertia group of phi : CF(H), i.e., the set of y *) (* such that (phi ^ y)%CF = phi AND H :^ y = y. *) (* 'I_G[phi] == the inertia group of phi in G, i.e., G :&: 'I[phi]. *) (* conjg_Iirr i y == the index j : Iirr G such that ('chi_i ^ y)%CF = 'chi_j. *) (* cfclass_Iirr G i == the image of G under conjg_Iirr i, i.e., the set of j *) (* such that 'chi_j \in ('chi_i ^: G)%CF. *) (* mul_Iirr i j == the index k such that 'chi_j * 'chi_i = 'chi[G]_k, *) (* or 0 if 'chi_j * 'chi_i is reducible. *) (* mul_mod_Iirr i j := mul_Iirr i (mod_Iirr j), for j : Iirr (G / H). *) (******************************************************************************) Reserved Notation "''I[' phi ]" (at level 8, format "''I[' phi ]"). Reserved Notation "''I_' G [ phi ]" (at level 8, G at level 2, format "''I_' G [ phi ]"). Section ConjDef. Variables (gT : finGroupType) (B : {set gT}) (y : gT) (phi : 'CF(B)). Local Notation G := <>. Fact cfConjg_subproof : is_class_fun G [ffun x => phi (if y \in 'N(G) then x ^ y^-1 else x)]. Proof. apply: intro_class_fun => [x z _ Gz | x notGx]. have [nGy | _] := ifP; last by rewrite cfunJgen. by rewrite -conjgM conjgC conjgM cfunJgen // memJ_norm ?groupV. by rewrite cfun0gen //; case: ifP => // nGy; rewrite memJ_norm ?groupV. Qed. Definition cfConjg := Cfun 1 cfConjg_subproof. End ConjDef. Prenex Implicits cfConjg. Notation "f ^ y" := (cfConjg y f) : cfun_scope. Section Conj. Variables (gT : finGroupType) (G : {group gT}). Implicit Type phi : 'CF(G). Lemma cfConjgE phi y x : y \in 'N(G) -> (phi ^ y)%CF x = phi (x ^ y^-1)%g. Proof. by rewrite cfunElock genGid => ->. Qed. Lemma cfConjgEJ phi y x : y \in 'N(G) -> (phi ^ y)%CF (x ^ y) = phi x. Proof. by move/cfConjgE->; rewrite conjgK. Qed. Lemma cfConjgEout phi y : y \notin 'N(G) -> (phi ^ y = phi)%CF. Proof. by move/negbTE=> notNy; apply/cfunP=> x; rewrite !cfunElock genGid notNy. Qed. Lemma cfConjgEin phi y (nGy : y \in 'N(G)) : (phi ^ y)%CF = cfIsom (norm_conj_isom nGy) phi. Proof. apply/cfun_inP=> x Gx. by rewrite cfConjgE // -{2}[x](conjgKV y) cfIsomE ?memJ_norm ?groupV. Qed. Lemma cfConjgMnorm phi : {in 'N(G) &, forall y z, phi ^ (y * z) = (phi ^ y) ^ z}%CF. Proof. move=> y z nGy nGz. by apply/cfunP=> x; rewrite !cfConjgE ?groupM // invMg conjgM. Qed. Lemma cfConjg_id phi y : y \in G -> (phi ^ y)%CF = phi. Proof. move=> Gy; apply/cfunP=> x; have nGy := subsetP (normG G) y Gy. by rewrite -(cfunJ _ _ Gy) cfConjgEJ. Qed. (* Isaacs' 6.1.b *) Lemma cfConjgM L phi : G <| L -> {in L &, forall y z, phi ^ (y * z) = (phi ^ y) ^ z}%CF. Proof. by case/andP=> _ /subsetP nGL; apply: sub_in2 (cfConjgMnorm phi). Qed. Lemma cfConjgJ1 phi : (phi ^ 1)%CF = phi. Proof. by apply/cfunP=> x; rewrite cfConjgE ?group1 // invg1 conjg1. Qed. Lemma cfConjgK y : cancel (cfConjg y) (cfConjg y^-1 : 'CF(G) -> 'CF(G)). Proof. move=> phi; apply/cfunP=> x; rewrite !cfunElock groupV /=. by case: ifP => -> //; rewrite conjgKV. Qed. Lemma cfConjgKV y : cancel (cfConjg y^-1) (cfConjg y : 'CF(G) -> 'CF(G)). Proof. by move=> phi /=; rewrite -{1}[y]invgK cfConjgK. Qed. Lemma cfConjg1 phi y : (phi ^ y)%CF 1%g = phi 1%g. Proof. by rewrite cfunElock conj1g if_same. Qed. Fact cfConjg_is_linear y : linear (cfConjg y : 'CF(G) -> 'CF(G)). Proof. by move=> a phi psi; apply/cfunP=> x; rewrite !cfunElock. Qed. Canonical cfConjg_additive y := Additive (cfConjg_is_linear y). Canonical cfConjg_linear y := AddLinear (cfConjg_is_linear y). Lemma cfConjg_cfuniJ A y : y \in 'N(G) -> ('1_A ^ y)%CF = '1_(A :^ y) :> 'CF(G). Proof. move=> nGy; apply/cfunP=> x; rewrite !cfunElock genGid nGy -sub_conjgV. by rewrite -class_lcoset -class_rcoset norm_rlcoset ?memJ_norm ?groupV. Qed. Lemma cfConjg_cfuni A y : y \in 'N(A) -> ('1_A ^ y)%CF = '1_A :> 'CF(G). Proof. by have [/cfConjg_cfuniJ-> /normP-> | /cfConjgEout] := boolP (y \in 'N(G)). Qed. Lemma cfConjg_cfun1 y : (1 ^ y)%CF = 1 :> 'CF(G). Proof. by rewrite -cfuniG; have [/cfConjg_cfuni|/cfConjgEout] := boolP (y \in 'N(G)). Qed. Fact cfConjg_is_multiplicative y : multiplicative (cfConjg y : _ -> 'CF(G)). Proof. split=> [phi psi|]; last exact: cfConjg_cfun1. by apply/cfunP=> x; rewrite !cfunElock. Qed. Canonical cfConjg_rmorphism y := AddRMorphism (cfConjg_is_multiplicative y). Canonical cfConjg_lrmorphism y := [lrmorphism of cfConjg y]. Lemma cfConjg_eq1 phi y : ((phi ^ y)%CF == 1) = (phi == 1). Proof. by apply: rmorph_eq1; apply: can_inj (cfConjgK y). Qed. Lemma cfAutConjg phi u y : cfAut u (phi ^ y) = (cfAut u phi ^ y)%CF. Proof. by apply/cfunP=> x; rewrite !cfunElock. Qed. Lemma conj_cfConjg phi y : (phi ^ y)^*%CF = (phi^* ^ y)%CF. Proof. exact: cfAutConjg. Qed. Lemma cfker_conjg phi y : y \in 'N(G) -> cfker (phi ^ y) = cfker phi :^ y. Proof. move=> nGy; rewrite cfConjgEin // cfker_isom. by rewrite morphim_conj (setIidPr (cfker_sub _)). Qed. Lemma cfDetConjg phi y : cfDet (phi ^ y) = (cfDet phi ^ y)%CF. Proof. have [nGy | not_nGy] := boolP (y \in 'N(G)); last by rewrite !cfConjgEout. by rewrite !cfConjgEin cfDetIsom. Qed. End Conj. Section Inertia. Variable gT : finGroupType. Definition inertia (B : {set gT}) (phi : 'CF(B)) := [set y in 'N(B) | (phi ^ y)%CF == phi]. Local Notation "''I[' phi ]" := (inertia phi) : group_scope. Local Notation "''I_' G [ phi ]" := (G%g :&: 'I[phi]) : group_scope. Fact group_set_inertia (H : {group gT}) phi : group_set 'I[phi : 'CF(H)]. Proof. apply/group_setP; split; first by rewrite inE group1 /= cfConjgJ1. move=> y z /setIdP[nHy /eqP n_phi_y] /setIdP[nHz n_phi_z]. by rewrite inE groupM //= cfConjgMnorm ?n_phi_y. Qed. Canonical inertia_group H phi := Group (@group_set_inertia H phi). Local Notation "''I[' phi ]" := (inertia_group phi) : Group_scope. Local Notation "''I_' G [ phi ]" := (G :&: 'I[phi])%G : Group_scope. Variables G H : {group gT}. Implicit Type phi : 'CF(H). Lemma inertiaJ phi y : y \in 'I[phi] -> (phi ^ y)%CF = phi. Proof. by case/setIdP=> _ /eqP->. Qed. Lemma inertia_valJ phi x y : y \in 'I[phi] -> phi (x ^ y)%g = phi x. Proof. by case/setIdP=> nHy /eqP {1}<-; rewrite cfConjgEJ. Qed. (* To disambiguate basic inclucion lemma names we capitalize Inertia for *) (* lemmas concerning the localized inertia group 'I_G[phi]. *) Lemma Inertia_sub phi : 'I_G[phi] \subset G. Proof. exact: subsetIl. Qed. Lemma norm_inertia phi : 'I[phi] \subset 'N(H). Proof. by rewrite ['I[_]]setIdE subsetIl. Qed. Lemma sub_inertia phi : H \subset 'I[phi]. Proof. by apply/subsetP=> y Hy; rewrite inE cfConjg_id ?(subsetP (normG H)) /=. Qed. Lemma normal_inertia phi : H <| 'I[phi]. Proof. by rewrite /normal sub_inertia norm_inertia. Qed. Lemma sub_Inertia phi : H \subset G -> H \subset 'I_G[phi]. Proof. by rewrite subsetI sub_inertia andbT. Qed. Lemma norm_Inertia phi : 'I_G[phi] \subset 'N(H). Proof. by rewrite setIC subIset ?norm_inertia. Qed. Lemma normal_Inertia phi : H \subset G -> H <| 'I_G[phi]. Proof. by rewrite /normal norm_Inertia andbT; apply: sub_Inertia. Qed. Lemma cfConjg_eqE phi : H <| G -> {in G &, forall y z, (phi ^ y == phi ^ z)%CF = (z \in 'I_G[phi] :* y)}. Proof. case/andP=> _ nHG y z Gy; rewrite -{1 2}[z](mulgKV y) groupMr // mem_rcoset. move: {z}(z * _)%g => z Gz; rewrite 2!inE Gz cfConjgMnorm ?(subsetP nHG) //=. by rewrite eq_sym (can_eq (cfConjgK y)). Qed. Lemma cent_sub_inertia phi : 'C(H) \subset 'I[phi]. Proof. apply/subsetP=> y cHy; have nHy := subsetP (cent_sub H) y cHy. rewrite inE nHy; apply/eqP/cfun_inP=> x Hx; rewrite cfConjgE //. by rewrite /conjg invgK mulgA (centP cHy) ?mulgK. Qed. Lemma cent_sub_Inertia phi : 'C_G(H) \subset 'I_G[phi]. Proof. exact: setIS (cent_sub_inertia phi). Qed. Lemma center_sub_Inertia phi : H \subset G -> 'Z(G) \subset 'I_G[phi]. Proof. by move/centS=> sHG; rewrite setIS // (subset_trans sHG) // cent_sub_inertia. Qed. Lemma conjg_inertia phi y : y \in 'N(H) -> 'I[phi] :^ y = 'I[phi ^ y]. Proof. move=> nHy; apply/setP=> z; rewrite !['I[_]]setIdE conjIg conjGid // !in_setI. apply/andb_id2l=> nHz; rewrite mem_conjg !inE. by rewrite !cfConjgMnorm ?in_group ?(can2_eq (cfConjgKV y) (cfConjgK y)) ?invgK. Qed. Lemma inertia0 : 'I[0 : 'CF(H)] = 'N(H). Proof. by apply/setP=> x; rewrite !inE linear0 eqxx andbT. Qed. Lemma inertia_add phi psi : 'I[phi] :&: 'I[psi] \subset 'I[phi + psi]. Proof. rewrite !['I[_]]setIdE -setIIr setIS //. by apply/subsetP=> x; rewrite !inE linearD /= => /andP[/eqP-> /eqP->]. Qed. Lemma inertia_sum I r (P : pred I) (Phi : I -> 'CF(H)) : 'N(H) :&: \bigcap_(i <- r | P i) 'I[Phi i] \subset 'I[\sum_(i <- r | P i) Phi i]. Proof. elim/big_rec2: _ => [|i K psi Pi sK_Ipsi]; first by rewrite setIT inertia0. by rewrite setICA; apply: subset_trans (setIS _ sK_Ipsi) (inertia_add _ _). Qed. Lemma inertia_scale a phi : 'I[phi] \subset 'I[a *: phi]. Proof. apply/subsetP=> x /setIdP[nHx /eqP Iphi_x]. by rewrite inE nHx linearZ /= Iphi_x. Qed. Lemma inertia_scale_nz a phi : a != 0 -> 'I[a *: phi] = 'I[phi]. Proof. move=> nz_a; apply/eqP. by rewrite eqEsubset -{2}(scalerK nz_a phi) !inertia_scale. Qed. Lemma inertia_opp phi : 'I[- phi] = 'I[phi]. Proof. by rewrite -scaleN1r inertia_scale_nz // oppr_eq0 oner_eq0. Qed. Lemma inertia1 : 'I[1 : 'CF(H)] = 'N(H). Proof. by apply/setP=> x; rewrite inE rmorph1 eqxx andbT. Qed. Lemma Inertia1 : H <| G -> 'I_G[1 : 'CF(H)] = G. Proof. by rewrite inertia1 => /normal_norm/setIidPl. Qed. Lemma inertia_mul phi psi : 'I[phi] :&: 'I[psi] \subset 'I[phi * psi]. Proof. rewrite !['I[_]]setIdE -setIIr setIS //. by apply/subsetP=> x; rewrite !inE rmorphM /= => /andP[/eqP-> /eqP->]. Qed. Lemma inertia_prod I r (P : pred I) (Phi : I -> 'CF(H)) : 'N(H) :&: \bigcap_(i <- r | P i) 'I[Phi i] \subset 'I[\prod_(i <- r | P i) Phi i]. Proof. elim/big_rec2: _ => [|i K psi Pi sK_psi]; first by rewrite inertia1 setIT. by rewrite setICA; apply: subset_trans (setIS _ sK_psi) (inertia_mul _ _). Qed. Lemma inertia_injective (chi : 'CF(H)) : {in H &, injective chi} -> 'I[chi] = 'C(H). Proof. move=> inj_chi; apply/eqP; rewrite eqEsubset cent_sub_inertia andbT. apply/subsetP=> y Ichi_y; have /setIdP[nHy _] := Ichi_y. apply/centP=> x Hx; apply/esym/commgP/conjg_fixP. by apply/inj_chi; rewrite ?memJ_norm ?(inertia_valJ _ Ichi_y). Qed. Lemma inertia_irr_prime p i : #|H| = p -> prime p -> i != 0 -> 'I['chi[H]_i] = 'C(H). Proof. by move=> <- pr_H /(irr_prime_injP pr_H); apply: inertia_injective. Qed. Lemma inertia_irr0 : 'I['chi[H]_0] = 'N(H). Proof. by rewrite irr0 inertia1. Qed. (* Isaacs' 6.1.c *) Lemma cfConjg_iso y : isometry (cfConjg y : 'CF(H) -> 'CF(H)). Proof. move=> phi psi; congr (_ * _). have [nHy | not_nHy] := boolP (y \in 'N(H)); last by rewrite !cfConjgEout. rewrite (reindex_astabs 'J y) ?astabsJ //=. by apply: eq_bigr=> x _; rewrite !cfConjgEJ. Qed. (* Isaacs' 6.1.d *) Lemma cfdot_Res_conjg psi phi y : y \in G -> '['Res[H, G] psi, phi ^ y] = '['Res[H] psi, phi]. Proof. move=> Gy; rewrite -(cfConjg_iso y _ phi); congr '[_, _]; apply/cfunP=> x. rewrite !cfunElock !genGid; case nHy: (y \in 'N(H)) => //. by rewrite !(fun_if psi) cfunJ ?memJ_norm ?groupV. Qed. (* Isaac's 6.1.e *) Lemma cfConjg_char (chi : 'CF(H)) y : chi \is a character -> (chi ^ y)%CF \is a character. Proof. have [nHy Nchi | /cfConjgEout-> //] := boolP (y \in 'N(H)). by rewrite cfConjgEin cfIsom_char. Qed. Lemma cfConjg_lin_char (chi : 'CF(H)) y : chi \is a linear_char -> (chi ^ y)%CF \is a linear_char. Proof. by case/andP=> Nchi chi1; rewrite qualifE cfConjg1 cfConjg_char. Qed. Lemma cfConjg_irr y chi : chi \in irr H -> (chi ^ y)%CF \in irr H. Proof. by rewrite !irrEchar cfConjg_iso => /andP[/cfConjg_char->]. Qed. Definition conjg_Iirr i y := cfIirr ('chi[H]_i ^ y)%CF. Lemma conjg_IirrE i y : 'chi_(conjg_Iirr i y) = ('chi_i ^ y)%CF. Proof. by rewrite cfIirrE ?cfConjg_irr ?mem_irr. Qed. Lemma conjg_IirrK y : cancel (conjg_Iirr^~ y) (conjg_Iirr^~ y^-1%g). Proof. by move=> i; apply/irr_inj; rewrite !conjg_IirrE cfConjgK. Qed. Lemma conjg_IirrKV y : cancel (conjg_Iirr^~ y^-1%g) (conjg_Iirr^~ y). Proof. by rewrite -{2}[y]invgK; apply: conjg_IirrK. Qed. Lemma conjg_Iirr_inj y : injective (conjg_Iirr^~ y). Proof. exact: can_inj (conjg_IirrK y). Qed. Lemma conjg_Iirr_eq0 i y : (conjg_Iirr i y == 0) = (i == 0). Proof. by rewrite -!irr_eq1 conjg_IirrE cfConjg_eq1. Qed. Lemma conjg_Iirr0 x : conjg_Iirr 0 x = 0. Proof. by apply/eqP; rewrite conjg_Iirr_eq0. Qed. Lemma cfdot_irr_conjg i y : H <| G -> y \in G -> '['chi_i, 'chi_i ^ y]_H = (y \in 'I_G['chi_i])%:R. Proof. move=> nsHG Gy; rewrite -conjg_IirrE cfdot_irr -(inj_eq irr_inj) conjg_IirrE. by rewrite -{1}['chi_i]cfConjgJ1 cfConjg_eqE ?mulg1. Qed. Definition cfclass (A : {set gT}) (phi : 'CF(A)) (B : {set gT}) := [seq (phi ^ repr Tx)%CF | Tx in rcosets 'I_B[phi] B]. Local Notation "phi ^: G" := (cfclass phi G) : cfun_scope. Lemma size_cfclass i : size ('chi[H]_i ^: G)%CF = #|G : 'I_G['chi_i]|. Proof. by rewrite size_map -cardE. Qed. Lemma cfclassP (A : {group gT}) phi psi : reflect (exists2 y, y \in A & psi = phi ^ y)%CF (psi \in phi ^: A)%CF. Proof. apply: (iffP imageP) => [[_ /rcosetsP[y Ay ->] ->] | [y Ay ->]]. by case: repr_rcosetP => z /setIdP[Az _]; exists (z * y)%g; rewrite ?groupM. without loss nHy: y Ay / y \in 'N(H). have [nHy | /cfConjgEout->] := boolP (y \in 'N(H)); first exact. by move/(_ 1%g); rewrite !group1 !cfConjgJ1; apply. exists ('I_A[phi] :* y); first by rewrite -rcosetE imset_f. case: repr_rcosetP => z /setIP[_ /setIdP[nHz /eqP Tz]]. by rewrite cfConjgMnorm ?Tz. Qed. Lemma cfclassInorm phi : (phi ^: 'N_G(H) =i phi ^: G)%CF. Proof. move=> xi; apply/cfclassP/cfclassP=> [[x /setIP[Gx _] ->] | [x Gx ->]]. by exists x. have [Nx | /cfConjgEout-> //] := boolP (x \in 'N(H)). by exists x; first apply/setIP. by exists 1%g; rewrite ?group1 ?cfConjgJ1. Qed. Lemma cfclass_refl phi : phi \in (phi ^: G)%CF. Proof. by apply/cfclassP; exists 1%g => //; rewrite cfConjgJ1. Qed. Lemma cfclass_transr phi psi : (psi \in phi ^: G)%CF -> (phi ^: G =i psi ^: G)%CF. Proof. rewrite -cfclassInorm; case/cfclassP=> x Gx -> xi; rewrite -!cfclassInorm. have nHN: {subset 'N_G(H) <= 'N(H)} by apply/subsetP; apply: subsetIr. apply/cfclassP/cfclassP=> [[y Gy ->] | [y Gy ->]]. by exists (x^-1 * y)%g; rewrite -?cfConjgMnorm ?groupM ?groupV ?nHN // mulKVg. by exists (x * y)%g; rewrite -?cfConjgMnorm ?groupM ?nHN. Qed. Lemma cfclass_sym phi psi : (psi \in phi ^: G)%CF = (phi \in psi ^: G)%CF. Proof. by apply/idP/idP=> /cfclass_transr <-; apply: cfclass_refl. Qed. Lemma cfclass_uniq phi : H <| G -> uniq (phi ^: G)%CF. Proof. move=> nsHG; rewrite map_inj_in_uniq ?enum_uniq // => Ty Tz; rewrite !mem_enum. move=> {Ty}/rcosetsP[y Gy ->] {Tz}/rcosetsP[z Gz ->] /eqP. case: repr_rcosetP => u Iphi_u; case: repr_rcosetP => v Iphi_v. have [[Gu _] [Gv _]] := (setIdP Iphi_u, setIdP Iphi_v). rewrite cfConjg_eqE ?groupM // => /rcoset_eqP. by rewrite !rcosetM (rcoset_id Iphi_v) (rcoset_id Iphi_u). Qed. Lemma cfclass_invariant phi : G \subset 'I[phi] -> (phi ^: G)%CF = phi. Proof. move/setIidPl=> IGphi; rewrite /cfclass IGphi // rcosets_id. by rewrite /(image _ _) enum_set1 /= repr_group cfConjgJ1. Qed. Lemma cfclass1 : H <| G -> (1 ^: G)%CF = [:: 1 : 'CF(H)]. Proof. by move/normal_norm=> nHG; rewrite cfclass_invariant ?inertia1. Qed. Definition cfclass_Iirr (A : {set gT}) i := conjg_Iirr i @: A. Lemma cfclass_IirrE i j : (j \in cfclass_Iirr G i) = ('chi_j \in 'chi_i ^: G)%CF. Proof. apply/imsetP/cfclassP=> [[y Gy ->] | [y]]; exists y; rewrite ?conjg_IirrE //. by apply: irr_inj; rewrite conjg_IirrE. Qed. Lemma eq_cfclass_IirrE i j : (cfclass_Iirr G j == cfclass_Iirr G i) = (j \in cfclass_Iirr G i). Proof. apply/eqP/idP=> [<- | iGj]; first by rewrite cfclass_IirrE cfclass_refl. by apply/setP=> k; rewrite !cfclass_IirrE in iGj *; apply/esym/cfclass_transr. Qed. Lemma im_cfclass_Iirr i : H <| G -> perm_eq [seq 'chi_j | j in cfclass_Iirr G i] ('chi_i ^: G)%CF. Proof. move=> nsHG; have UchiG := cfclass_uniq 'chi_i nsHG. apply: uniq_perm; rewrite ?(map_inj_uniq irr_inj) ?enum_uniq // => phi. apply/imageP/idP=> [[j iGj ->] | /cfclassP[y]]; first by rewrite -cfclass_IirrE. by exists (conjg_Iirr i y); rewrite ?imset_f ?conjg_IirrE. Qed. Lemma card_cfclass_Iirr i : H <| G -> #|cfclass_Iirr G i| = #|G : 'I_G['chi_i]|. Proof. move=> nsHG; rewrite -size_cfclass -(perm_size (im_cfclass_Iirr i nsHG)). by rewrite size_map -cardE. Qed. Lemma reindex_cfclass R idx (op : Monoid.com_law idx) (F : 'CF(H) -> R) i : H <| G -> \big[op/idx]_(chi <- ('chi_i ^: G)%CF) F chi = \big[op/idx]_(j | 'chi_j \in ('chi_i ^: G)%CF) F 'chi_j. Proof. move/im_cfclass_Iirr/(perm_big _) <-; rewrite big_image /=. by apply: eq_bigl => j; rewrite cfclass_IirrE. Qed. Lemma cfResInd j: H <| G -> 'Res[H] ('Ind[G] 'chi_j) = #|H|%:R^-1 *: (\sum_(y in G) 'chi_j ^ y)%CF. Proof. case/andP=> [sHG /subsetP nHG]. rewrite (reindex_inj invg_inj); apply/cfun_inP=> x Hx. rewrite cfResE // cfIndE // ?cfunE ?sum_cfunE; congr (_ * _). by apply: eq_big => [y | y Gy]; rewrite ?cfConjgE ?groupV ?invgK ?nHG. Qed. (* This is Isaacs, Theorem (6.2) *) Lemma Clifford_Res_sum_cfclass i j : H <| G -> j \in irr_constt ('Res[H, G] 'chi_i) -> 'Res[H] 'chi_i = '['Res[H] 'chi_i, 'chi_j] *: (\sum_(chi <- ('chi_j ^: G)%CF) chi). Proof. move=> nsHG chiHj; have [sHG /subsetP nHG] := andP nsHG. rewrite reindex_cfclass //= big_mkcond. rewrite {1}['Res _]cfun_sum_cfdot linear_sum /=; apply: eq_bigr => k _. have [[y Gy ->] | ] := altP (cfclassP _ _ _); first by rewrite cfdot_Res_conjg. apply: contraNeq; rewrite scaler0 scaler_eq0 orbC => /norP[_ chiHk]. have{chiHk chiHj}: '['Res[H] ('Ind[G] 'chi_j), 'chi_k] != 0. rewrite !inE !cfdot_Res_l in chiHj chiHk *. apply: contraNneq chiHk; rewrite cfdot_sum_irr => /psumr_eq0P/(_ i isT)/eqP. rewrite -cfdotC cfdotC mulf_eq0 conjC_eq0 (negbTE chiHj) /= => -> // i1. by rewrite -cfdotC Cnat_ge0 // rpredM ?Cnat_cfdot_char ?cfInd_char ?irr_char. rewrite cfResInd // cfdotZl mulf_eq0 cfdot_suml => /norP[_]. apply: contraR => chiGk'j; rewrite big1 // => x Gx; apply: contraNeq chiGk'j. rewrite -conjg_IirrE cfdot_irr pnatr_eq0; case: (_ =P k) => // <- _. by rewrite conjg_IirrE; apply/cfclassP; exists x. Qed. Lemma cfRes_Ind_invariant psi : H <| G -> G \subset 'I[psi] -> 'Res ('Ind[G, H] psi) = #|G : H|%:R *: psi. Proof. case/andP=> sHG _ /subsetP IGpsi; apply/cfun_inP=> x Hx. rewrite cfResE ?cfIndE ?natf_indexg // cfunE -mulrA mulrCA; congr (_ * _). by rewrite mulr_natl -sumr_const; apply: eq_bigr => y /IGpsi/inertia_valJ->. Qed. (* This is Isaacs, Corollary (6.7). *) Corollary constt0_Res_cfker i : H <| G -> 0 \in irr_constt ('Res[H] 'chi[G]_i) -> H \subset cfker 'chi[G]_i. Proof. move=> nsHG /(Clifford_Res_sum_cfclass nsHG); have [sHG nHG] := andP nsHG. rewrite irr0 cfdot_Res_l cfclass1 // big_seq1 cfInd_cfun1 //. rewrite cfdotZr conjC_nat => def_chiH. apply/subsetP=> x Hx; rewrite cfkerEirr inE -!(cfResE _ sHG) //. by rewrite def_chiH !cfunE cfun11 cfun1E Hx. Qed. (* This is Isaacs, Lemma (6.8). *) Lemma dvdn_constt_Res1_irr1 i j : H <| G -> j \in irr_constt ('Res[H, G] 'chi_i) -> exists n, 'chi_i 1%g = n%:R * 'chi_j 1%g. Proof. move=> nsHG chiHj; have [sHG nHG] := andP nsHG; rewrite -(cfResE _ sHG) //. rewrite {1}(Clifford_Res_sum_cfclass nsHG chiHj) cfunE sum_cfunE. have /CnatP[n ->]: '['Res[H] 'chi_i, 'chi_j] \in Cnat. by rewrite Cnat_cfdot_char ?cfRes_char ?irr_char. exists (n * size ('chi_j ^: G)%CF)%N; rewrite natrM -mulrA; congr (_ * _). rewrite mulr_natl -[size _]card_ord big_tnth -sumr_const; apply: eq_bigr => k _. by have /cfclassP[y Gy ->]:= mem_tnth k (in_tuple _); rewrite cfConjg1. Qed. Lemma cfclass_Ind phi psi : H <| G -> psi \in (phi ^: G)%CF -> 'Ind[G] phi = 'Ind[G] psi. Proof. move=> nsHG /cfclassP[y Gy ->]; have [sHG /subsetP nHG] := andP nsHG. apply/cfun_inP=> x Hx; rewrite !cfIndE //; congr (_ * _). rewrite (reindex_acts 'R _ (groupVr Gy)) ?astabsR //=. by apply: eq_bigr => z Gz; rewrite conjgM cfConjgE ?nHG. Qed. End Inertia. Arguments inertia {gT B%g} phi%CF. Arguments cfclass {gT A%g} phi%CF B%g. Arguments conjg_Iirr_inj {gT H} y [i1 i2] : rename. Notation "''I[' phi ] " := (inertia phi) : group_scope. Notation "''I[' phi ] " := (inertia_group phi) : Group_scope. Notation "''I_' G [ phi ] " := (G%g :&: 'I[phi]) : group_scope. Notation "''I_' G [ phi ] " := (G :&: 'I[phi])%G : Group_scope. Notation "phi ^: G" := (cfclass phi G) : cfun_scope. Section ConjRestrict. Variables (gT : finGroupType) (G H K : {group gT}). Lemma cfConjgRes_norm phi y : y \in 'N(K) -> y \in 'N(H) -> ('Res[K, H] phi ^ y)%CF = 'Res (phi ^ y)%CF. Proof. move=> nKy nHy; have [sKH | not_sKH] := boolP (K \subset H); last first. by rewrite !cfResEout // linearZ rmorph1 cfConjg1. by apply/cfun_inP=> x Kx; rewrite !(cfConjgE, cfResE) ?memJ_norm ?groupV. Qed. Lemma cfConjgRes phi y : H <| G -> K <| G -> y \in G -> ('Res[K, H] phi ^ y)%CF = 'Res (phi ^ y)%CF. Proof. move=> /andP[_ nHG] /andP[_ nKG] Gy. by rewrite cfConjgRes_norm ?(subsetP nHG) ?(subsetP nKG). Qed. Lemma sub_inertia_Res phi : G \subset 'N(K) -> 'I_G[phi] \subset 'I_G['Res[K, H] phi]. Proof. move=> nKG; apply/subsetP=> y /setIP[Gy /setIdP[nHy /eqP Iphi_y]]. by rewrite 2!inE Gy cfConjgRes_norm ?(subsetP nKG) ?Iphi_y /=. Qed. Lemma cfConjgInd_norm phi y : y \in 'N(K) -> y \in 'N(H) -> ('Ind[H, K] phi ^ y)%CF = 'Ind (phi ^ y)%CF. Proof. move=> nKy nHy; have [sKH | not_sKH] := boolP (K \subset H). by rewrite !cfConjgEin (cfIndIsom (norm_conj_isom nHy)). rewrite !cfIndEout // linearZ -(cfConjg_iso y) rmorph1 /=; congr (_ *: _). by rewrite cfConjg_cfuni ?norm1 ?inE. Qed. Lemma cfConjgInd phi y : H <| G -> K <| G -> y \in G -> ('Ind[H, K] phi ^ y)%CF = 'Ind (phi ^ y)%CF. Proof. move=> /andP[_ nHG] /andP[_ nKG] Gy. by rewrite cfConjgInd_norm ?(subsetP nHG) ?(subsetP nKG). Qed. Lemma sub_inertia_Ind phi : G \subset 'N(H) -> 'I_G[phi] \subset 'I_G['Ind[H, K] phi]. Proof. move=> nHG; apply/subsetP=> y /setIP[Gy /setIdP[nKy /eqP Iphi_y]]. by rewrite 2!inE Gy cfConjgInd_norm ?(subsetP nHG) ?Iphi_y /=. Qed. End ConjRestrict. Section MoreInertia. Variables (gT : finGroupType) (G H : {group gT}) (i : Iirr H). Let T := 'I_G['chi_i]. Lemma inertia_id : 'I_T['chi_i] = T. Proof. by rewrite -setIA setIid. Qed. Lemma cfclass_inertia : ('chi[H]_i ^: T)%CF = [:: 'chi_i]. Proof. rewrite /cfclass inertia_id rcosets_id /(image _ _) enum_set1 /=. by rewrite repr_group cfConjgJ1. Qed. End MoreInertia. Section ConjMorph. Variables (aT rT : finGroupType) (D G H : {group aT}) (f : {morphism D >-> rT}). Lemma cfConjgMorph (phi : 'CF(f @* H)) y : y \in D -> y \in 'N(H) -> (cfMorph phi ^ y)%CF = cfMorph (phi ^ f y). Proof. move=> Dy nHy; have [sHD | not_sHD] := boolP (H \subset D); last first. by rewrite !cfMorphEout // linearZ rmorph1 cfConjg1. apply/cfun_inP=> x Gx; rewrite !(cfConjgE, cfMorphE) ?memJ_norm ?groupV //. by rewrite morphJ ?morphV ?groupV // (subsetP sHD). by rewrite (subsetP (morphim_norm _ _)) ?mem_morphim. Qed. Lemma inertia_morph_pre (phi : 'CF(f @* H)) : H <| G -> G \subset D -> 'I_G[cfMorph phi] = G :&: f @*^-1 'I_(f @* G)[phi]. Proof. case/andP=> sHG nHG sGD; have sHD := subset_trans sHG sGD. apply/setP=> y; rewrite !in_setI; apply: andb_id2l => Gy. have [Dy nHy] := (subsetP sGD y Gy, subsetP nHG y Gy). rewrite Dy inE nHy 4!inE mem_morphim // -morphimJ ?(normP nHy) // subxx /=. rewrite cfConjgMorph //; apply/eqP/eqP=> [Iphi_y | -> //]. by apply/cfun_inP=> _ /morphimP[x Dx Hx ->]; rewrite -!cfMorphE ?Iphi_y. Qed. Lemma inertia_morph_im (phi : 'CF(f @* H)) : H <| G -> G \subset D -> f @* 'I_G[cfMorph phi] = 'I_(f @* G)[phi]. Proof. move=> nsHG sGD; rewrite inertia_morph_pre // morphim_setIpre. by rewrite (setIidPr _) ?Inertia_sub. Qed. Variables (R S : {group rT}). Variables (g : {morphism G >-> rT}) (h : {morphism H >-> rT}). Hypotheses (isoG : isom G R g) (isoH : isom H S h). Hypotheses (eq_hg : {in H, h =1 g}) (sHG : H \subset G). (* This does not depend on the (isoG : isom G R g) assumption. *) Lemma cfConjgIsom phi y : y \in G -> y \in 'N(H) -> (cfIsom isoH phi ^ g y)%CF = cfIsom isoH (phi ^ y). Proof. move=> Gy nHy; have [_ defS] := isomP isoH. rewrite morphimEdom (eq_in_imset eq_hg) -morphimEsub // in defS. apply/cfun_inP=> gx; rewrite -{1}defS => /morphimP[x Gx Hx ->] {gx}. rewrite cfConjgE; last by rewrite -defS inE -morphimJ ?(normP nHy). by rewrite -morphV -?morphJ -?eq_hg ?cfIsomE ?cfConjgE ?memJ_norm ?groupV. Qed. Lemma inertia_isom phi : 'I_R[cfIsom isoH phi] = g @* 'I_G[phi]. Proof. have [[_ defS] [injg <-]] := (isomP isoH, isomP isoG). rewrite morphimEdom (eq_in_imset eq_hg) -morphimEsub // in defS. rewrite /inertia !setIdE morphimIdom setIA -{1}defS -injm_norm ?injmI //. apply/setP=> gy; rewrite !inE; apply: andb_id2l => /morphimP[y Gy nHy ->] {gy}. rewrite cfConjgIsom // -sub1set -morphim_set1 // injmSK ?sub1set //= inE. apply/eqP/eqP=> [Iphi_y | -> //]. by apply/cfun_inP=> x Hx; rewrite -!(cfIsomE isoH) ?Iphi_y. Qed. End ConjMorph. Section ConjQuotient. Variables gT : finGroupType. Implicit Types G H K : {group gT}. Lemma cfConjgMod_norm H K (phi : 'CF(H / K)) y : y \in 'N(K) -> y \in 'N(H) -> ((phi %% K) ^ y)%CF = (phi ^ coset K y %% K)%CF. Proof. exact: cfConjgMorph. Qed. Lemma cfConjgMod G H K (phi : 'CF(H / K)) y : H <| G -> K <| G -> y \in G -> ((phi %% K) ^ y)%CF = (phi ^ coset K y %% K)%CF. Proof. move=> /andP[_ nHG] /andP[_ nKG] Gy. by rewrite cfConjgMod_norm ?(subsetP nHG) ?(subsetP nKG). Qed. Lemma cfConjgQuo_norm H K (phi : 'CF(H)) y : y \in 'N(K) -> y \in 'N(H) -> ((phi / K) ^ coset K y)%CF = (phi ^ y / K)%CF. Proof. move=> nKy nHy; have keryK: (K \subset cfker (phi ^ y)) = (K \subset cfker phi). by rewrite cfker_conjg // -{1}(normP nKy) conjSg. have [kerK | not_kerK] := boolP (K \subset cfker phi); last first. by rewrite !cfQuoEout ?linearZ ?rmorph1 ?cfConjg1 ?keryK. apply/cfun_inP=> _ /morphimP[x nKx Hx ->]. have nHyb: coset K y \in 'N(H / K) by rewrite inE -morphimJ ?(normP nHy). rewrite !(cfConjgE, cfQuoEnorm) ?keryK // ?in_setI ?Hx //. rewrite -morphV -?morphJ ?groupV // cfQuoEnorm //. by rewrite inE memJ_norm ?Hx ?groupJ ?groupV. Qed. Lemma cfConjgQuo G H K (phi : 'CF(H)) y : H <| G -> K <| G -> y \in G -> ((phi / K) ^ coset K y)%CF = (phi ^ y / K)%CF. Proof. move=> /andP[_ nHG] /andP[_ nKG] Gy. by rewrite cfConjgQuo_norm ?(subsetP nHG) ?(subsetP nKG). Qed. Lemma inertia_mod_pre G H K (phi : 'CF(H / K)) : H <| G -> K <| G -> 'I_G[phi %% K] = G :&: coset K @*^-1 'I_(G / K)[phi]. Proof. by move=> nsHG /andP[_]; apply: inertia_morph_pre. Qed. Lemma inertia_mod_quo G H K (phi : 'CF(H / K)) : H <| G -> K <| G -> ('I_G[phi %% K] / K)%g = 'I_(G / K)[phi]. Proof. by move=> nsHG /andP[_]; apply: inertia_morph_im. Qed. Lemma inertia_quo G H K (phi : 'CF(H)) : H <| G -> K <| G -> K \subset cfker phi -> 'I_(G / K)[phi / K] = ('I_G[phi] / K)%g. Proof. move=> nsHG nsKG kerK; rewrite -inertia_mod_quo ?cfQuoK //. by rewrite (normalS _ (normal_sub nsHG)) // (subset_trans _ (cfker_sub phi)). Qed. End ConjQuotient. Section InertiaSdprod. Variables (gT : finGroupType) (K H G : {group gT}). Hypothesis defG : K ><| H = G. Lemma cfConjgSdprod phi y : y \in 'N(K) -> y \in 'N(H) -> (cfSdprod defG phi ^ y = cfSdprod defG (phi ^ y))%CF. Proof. move=> nKy nHy. have nGy: y \in 'N(G) by rewrite -sub1set -(sdprodW defG) normsM ?sub1set. rewrite -{2}[phi](cfSdprodK defG) cfConjgRes_norm // cfRes_sdprodK //. by rewrite cfker_conjg // -{1}(normP nKy) conjSg cfker_sdprod. Qed. Lemma inertia_sdprod (L : {group gT}) phi : L \subset 'N(K) -> L \subset 'N(H) -> 'I_L[cfSdprod defG phi] = 'I_L[phi]. Proof. move=> nKL nHL; have nGL: L \subset 'N(G) by rewrite -(sdprodW defG) normsM. apply/setP=> z; rewrite !in_setI ![z \in 'I[_]]inE; apply: andb_id2l => Lz. rewrite cfConjgSdprod ?(subsetP nKL) ?(subsetP nHL) ?(subsetP nGL) //=. by rewrite (can_eq (cfSdprodK defG)). Qed. End InertiaSdprod. Section InertiaDprod. Variables (gT : finGroupType) (G K H : {group gT}). Implicit Type L : {group gT}. Hypothesis KxH : K \x H = G. Lemma cfConjgDprodl phi y : y \in 'N(K) -> y \in 'N(H) -> (cfDprodl KxH phi ^ y = cfDprodl KxH (phi ^ y))%CF. Proof. by move=> nKy nHy; apply: cfConjgSdprod. Qed. Lemma cfConjgDprodr psi y : y \in 'N(K) -> y \in 'N(H) -> (cfDprodr KxH psi ^ y = cfDprodr KxH (psi ^ y))%CF. Proof. by move=> nKy nHy; apply: cfConjgSdprod. Qed. Lemma cfConjgDprod phi psi y : y \in 'N(K) -> y \in 'N(H) -> (cfDprod KxH phi psi ^ y = cfDprod KxH (phi ^ y) (psi ^ y))%CF. Proof. by move=> nKy nHy; rewrite rmorphM /= cfConjgDprodl ?cfConjgDprodr. Qed. Lemma inertia_dprodl L phi : L \subset 'N(K) -> L \subset 'N(H) -> 'I_L[cfDprodl KxH phi] = 'I_L[phi]. Proof. by move=> nKL nHL; apply: inertia_sdprod. Qed. Lemma inertia_dprodr L psi : L \subset 'N(K) -> L \subset 'N(H) -> 'I_L[cfDprodr KxH psi] = 'I_L[psi]. Proof. by move=> nKL nHL; apply: inertia_sdprod. Qed. Lemma inertia_dprod L (phi : 'CF(K)) (psi : 'CF(H)) : L \subset 'N(K) -> L \subset 'N(H) -> phi 1%g != 0 -> psi 1%g != 0 -> 'I_L[cfDprod KxH phi psi] = 'I_L[phi] :&: 'I_L[psi]. Proof. move=> nKL nHL nz_phi nz_psi; apply/eqP; rewrite eqEsubset subsetI. rewrite -{1}(inertia_scale_nz psi nz_phi) -{1}(inertia_scale_nz phi nz_psi). rewrite -(cfDprod_Resl KxH) -(cfDprod_Resr KxH) !sub_inertia_Res //=. by rewrite -inertia_dprodl -?inertia_dprodr // -setIIr setIS ?inertia_mul. Qed. Lemma inertia_dprod_irr L i j : L \subset 'N(K) -> L \subset 'N(H) -> 'I_L[cfDprod KxH 'chi_i 'chi_j] = 'I_L['chi_i] :&: 'I_L['chi_j]. Proof. by move=> nKL nHL; rewrite inertia_dprod ?irr1_neq0. Qed. End InertiaDprod. Section InertiaBigdprod. Variables (gT : finGroupType) (I : finType) (P : pred I). Variables (A : I -> {group gT}) (G : {group gT}). Implicit Type L : {group gT}. Hypothesis defG : \big[dprod/1%g]_(i | P i) A i = G. Section ConjBig. Variable y : gT. Hypothesis nAy: forall i, P i -> y \in 'N(A i). Lemma cfConjgBigdprodi i (phi : 'CF(A i)) : (cfBigdprodi defG phi ^ y = cfBigdprodi defG (phi ^ y))%CF. Proof. rewrite cfConjgDprodl; try by case: ifP => [/nAy// | _]; rewrite norm1 inE. congr (cfDprodl _ _); case: ifP => [Pi | _]. by rewrite cfConjgRes_norm ?nAy. by apply/cfun_inP=> _ /set1P->; rewrite !(cfRes1, cfConjg1). rewrite -sub1set norms_gen ?norms_bigcup // sub1set. by apply/bigcapP=> j /andP[/nAy]. Qed. Lemma cfConjgBigdprod phi : (cfBigdprod defG phi ^ y = cfBigdprod defG (fun i => phi i ^ y))%CF. Proof. by rewrite rmorph_prod /=; apply: eq_bigr => i _; apply: cfConjgBigdprodi. Qed. End ConjBig. Section InertiaBig. Variable L : {group gT}. Hypothesis nAL : forall i, P i -> L \subset 'N(A i). Lemma inertia_bigdprodi i (phi : 'CF(A i)) : P i -> 'I_L[cfBigdprodi defG phi] = 'I_L[phi]. Proof. move=> Pi; rewrite inertia_dprodl ?Pi ?cfRes_id ?nAL //. by apply/norms_gen/norms_bigcup/bigcapsP=> j /andP[/nAL]. Qed. Lemma inertia_bigdprod phi (Phi := cfBigdprod defG phi) : Phi 1%g != 0 -> 'I_L[Phi] = L :&: \bigcap_(i | P i) 'I_L[phi i]. Proof. move=> nz_Phi; apply/eqP; rewrite eqEsubset; apply/andP; split. rewrite subsetI Inertia_sub; apply/bigcapsP=> i Pi. have [] := cfBigdprodK nz_Phi Pi; move: (_ / _) => a nz_a <-. by rewrite inertia_scale_nz ?sub_inertia_Res //= ?nAL. rewrite subsetI subsetIl; apply: subset_trans (inertia_prod _ _ _). apply: setISS. by rewrite -(bigdprodWY defG) norms_gen ?norms_bigcup //; apply/bigcapsP. apply/bigcapsP=> i Pi; rewrite (bigcap_min i) //. by rewrite -inertia_bigdprodi ?subsetIr. Qed. Lemma inertia_bigdprod_irr Iphi (phi := fun i => 'chi_(Iphi i)) : 'I_L[cfBigdprod defG phi] = L :&: \bigcap_(i | P i) 'I_L[phi i]. Proof. rewrite inertia_bigdprod // -[cfBigdprod _ _]cfIirrE ?irr1_neq0 //. by apply: cfBigdprod_irr => i _; apply: mem_irr. Qed. End InertiaBig. End InertiaBigdprod. Section ConsttInertiaBijection. Variables (gT : finGroupType) (H G : {group gT}) (t : Iirr H). Hypothesis nsHG : H <| G. Local Notation theta := 'chi_t. Local Notation T := 'I_G[theta]%G. Local Notation "` 'T'" := 'I_(gval G)[theta] (at level 0, format "` 'T'") : group_scope. Let calA := irr_constt ('Ind[T] theta). Let calB := irr_constt ('Ind[G] theta). Local Notation AtoB := (Ind_Iirr G). (* This is Isaacs, Theorem (6.11). *) Theorem constt_Inertia_bijection : [/\ (*a*) {in calA, forall s, 'Ind[G] 'chi_s \in irr G}, (*b*) {in calA &, injective (Ind_Iirr G)}, Ind_Iirr G @: calA =i calB, (*c*) {in calA, forall s (psi := 'chi_s) (chi := 'Ind[G] psi), [predI irr_constt ('Res chi) & calA] =i pred1 s} & (*d*) {in calA, forall s (psi := 'chi_s) (chi := 'Ind[G] psi), '['Res psi, theta] = '['Res chi, theta]}]. Proof. have [sHG sTG]: H \subset G /\ T \subset G by rewrite subsetIl normal_sub. have nsHT : H <| T := normal_Inertia theta sHG; have sHT := normal_sub nsHT. have AtoB_P s (psi := 'chi_s) (chi := 'Ind[G] psi): s \in calA -> [/\ chi \in irr G, AtoB s \in calB & '['Res psi, theta] = '['Res chi, theta]]. - rewrite !constt_Ind_Res => sHt; have [r sGr] := constt_cfInd_irr s sTG. have rTs: s \in irr_constt ('Res[T] 'chi_r) by rewrite -constt_Ind_Res. have NrT: 'Res[T] 'chi_r \is a character by rewrite cfRes_char ?irr_char. have rHt: t \in irr_constt ('Res[H] 'chi_r). by have:= constt_Res_trans NrT rTs sHt; rewrite cfResRes. pose e := '['Res[H] 'chi_r, theta]; set f := '['Res[H] psi, theta]. have DrH: 'Res[H] 'chi_r = e *: \sum_(xi <- (theta ^: G)%CF) xi. exact: Clifford_Res_sum_cfclass. have DpsiH: 'Res[H] psi = f *: theta. rewrite (Clifford_Res_sum_cfclass nsHT sHt). by rewrite cfclass_invariant ?subsetIr ?big_seq1. 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 -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. rewrite (eq_big_seq (fun _ => theta 1%g)) => [|i]; last first. by case/cfclassP=> y _ ->; rewrite cfConjg1. rewrite reindex_cfclass //= sumr_const -(eq_card (cfclass_IirrE _ _)). rewrite mulr_natl mulrnAr card_cfclass_Iirr //. 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] := 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}. - move=> s As chi s1; have [irr_chi _ /eqP Dchi_theta] := AtoB_P s As. 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 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 ?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]. have [[irr_s1G _ _] [irr_s2G _ _]] := (AtoB_P _ As1, AtoB_P _ As2). move/(congr1 (tnth (irr G))); rewrite !cfIirrE // => eq_s12_G. apply/eqP; rewrite -[_ == _]part_c // inE /= As1 -eq_s12_G. by rewrite -As1 [_ && _]part_c // inE /=. apply/imsetP/idP=> [[s /AtoB_P[_ BsG _] -> //] | Br]. have /exists_inP[s rTs As]: [exists s in irr_constt ('Res 'chi_r), s \in calA]. rewrite -negb_forall_in; apply: contra Br => /eqfun_inP => o_tT_rT. rewrite -(cfIndInd _ sTG sHT) -cfdot_Res_r ['Res _]cfun_sum_constt. by rewrite cfdot_sumr big1 // => i rTi; rewrite cfdotZr o_tT_rT ?mulr0. exists s => //; have [/irrP[r1 DsG] _ _] := AtoB_P s As. by apply/eqP; rewrite /AtoB -constt_Ind_Res DsG irrK constt_irr in rTs *. Qed. End ConsttInertiaBijection. Section ExtendInvariantIrr. Variable gT : finGroupType. Implicit Types G H K L M N : {group gT}. Section ConsttIndExtendible. Variables (G N : {group gT}) (t : Iirr N) (c : Iirr G). Let theta := 'chi_t. Let chi := 'chi_c. Definition mul_Iirr b := cfIirr ('chi_b * chi). Definition mul_mod_Iirr (b : Iirr (G / N)) := mul_Iirr (mod_Iirr b). Hypotheses (nsNG : N <| G) (cNt : 'Res[N] chi = theta). Let sNG : N \subset G. Proof. exact: normal_sub. Qed. Let nNG : G \subset 'N(N). Proof. exact: normal_norm. Qed. Lemma extendible_irr_invariant : G \subset 'I[theta]. Proof. apply/subsetP=> y Gy; have nNy := subsetP nNG y Gy. rewrite inE nNy; apply/eqP/cfun_inP=> x Nx; rewrite cfConjgE // -cNt. by rewrite !cfResE ?memJ_norm ?cfunJ ?groupV. Qed. Let IGtheta := extendible_irr_invariant. (* This is Isaacs, Theorem (6.16) *) Theorem constt_Ind_mul_ext f (phi := 'chi_f) (psi := phi * theta) : G \subset 'I[phi] -> psi \in irr N -> let calS := irr_constt ('Ind phi) in [/\ {in calS, forall b, 'chi_b * chi \in irr G}, {in calS &, injective mul_Iirr}, irr_constt ('Ind psi) =i [seq mul_Iirr b | b in calS] & 'Ind psi = \sum_(b in calS) '['Ind phi, 'chi_b] *: 'chi_(mul_Iirr b)]. Proof. move=> IGphi irr_psi calS. have IGpsi: G \subset 'I[psi]. by rewrite (subset_trans _ (inertia_mul _ _)) // subsetI IGphi. pose e b := '['Ind[G] phi, 'chi_b]; pose d b g := '['chi_b * chi, 'chi_g * chi]. have Ne b: e b \in Cnat by rewrite Cnat_cfdot_char ?cfInd_char ?irr_char. have egt0 b: b \in calS -> e b > 0 by rewrite Cnat_gt0. have DphiG: 'Ind phi = \sum_(b in calS) e b *: 'chi_b := cfun_sum_constt _. have DpsiG: 'Ind psi = \sum_(b in calS) e b *: 'chi_b * chi. by rewrite /psi -cNt cfIndM // DphiG mulr_suml. pose d_delta := [forall b in calS, forall g in calS, d b g == (b == g)%:R]. have charMchi b: 'chi_b * chi \is a character by rewrite rpredM ?irr_char. have [_]: '['Ind[G] phi] <= '['Ind[G] psi] ?= iff d_delta. pose sum_delta := \sum_(b in calS) e b * \sum_(g in calS) e g * (b == g)%:R. pose sum_d := \sum_(b in calS) e b * \sum_(g in calS) e g * d b g. have ->: '['Ind[G] phi] = sum_delta. rewrite DphiG cfdot_suml; apply: eq_bigr => b _; rewrite cfdotZl cfdot_sumr. by congr (_ * _); apply: eq_bigr => g; rewrite cfdotZr cfdot_irr conj_Cnat. have ->: '['Ind[G] psi] = sum_d. 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_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. by rewrite -char1_eq0 // cfunE mulf_neq0 ?irr1_neq0. rewrite -!cfdot_Res_l ?cfRes_Ind_invariant // !cfdotZl cfnorm_irr irrWnorm //. rewrite eqxx => /esym/forall_inP/(_ _ _)/eqfun_inP; rewrite /d /= => Dd. have irrMchi: {in calS, forall b, 'chi_b * chi \in irr G}. by move=> b Sb; rewrite /= irrEchar charMchi Dd ?eqxx. have injMchi: {in calS &, injective mul_Iirr}. move=> b g Sb Sg /(congr1 (fun s => '['chi_s, 'chi_(mul_Iirr g)]))/eqP. by rewrite cfnorm_irr !cfIirrE ?irrMchi ?Dd // pnatr_eq1; case: (b =P g). have{DpsiG} ->: 'Ind psi = \sum_(b in calS) e b *: 'chi_(mul_Iirr b). by rewrite DpsiG; apply: eq_bigr => b Sb; rewrite -scalerAl cfIirrE ?irrMchi. split=> // i; rewrite irr_consttE cfdot_suml; 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 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. (* This is Isaacs, Corollary (6.17) (due to Gallagher). *) Corollary constt_Ind_ext : [/\ forall b : Iirr (G / N), 'chi_(mod_Iirr b) * chi \in irr G, injective mul_mod_Iirr, irr_constt ('Ind theta) =i codom mul_mod_Iirr & 'Ind theta = \sum_b 'chi_b 1%g *: 'chi_(mul_mod_Iirr b)]. Proof. have IHchi0: G \subset 'I['chi[N]_0] by rewrite inertia_irr0. have [] := constt_Ind_mul_ext IHchi0; rewrite irr0 ?mul1r ?mem_irr //. set psiG := 'Ind 1 => irrMchi injMchi constt_theta {2}->. have dot_psiG b: '[psiG, 'chi_(mod_Iirr b)] = 'chi[G / N]_b 1%g. rewrite mod_IirrE // -cfdot_Res_r cfRes_sub_ker ?cfker_mod //. by rewrite cfdotZr cfnorm1 mulr1 conj_Cnat ?cfMod1 ?Cnat_irr1. have mem_psiG (b : Iirr (G / N)): mod_Iirr b \in irr_constt psiG. by rewrite irr_consttE dot_psiG irr1_neq0. have constt_psiG b: (b \in irr_constt psiG) = (N \subset cfker 'chi_b). apply/idP/idP=> [psiGb | /quo_IirrK <- //]. by rewrite constt0_Res_cfker // -constt_Ind_Res irr0. split=> [b | b g /injMchi/(can_inj (mod_IirrK nsNG))-> // | b0 | ]. - exact: irrMchi. - rewrite constt_theta. apply/imageP/imageP=> [][b psiGb ->]; last by exists (mod_Iirr b). by exists (quo_Iirr N b) => //; rewrite /mul_mod_Iirr quo_IirrK -?constt_psiG. rewrite (reindex_onto _ _ (in1W (mod_IirrK nsNG))) /=. apply/esym/eq_big => b; first by rewrite constt_psiG quo_IirrKeq. by rewrite -dot_psiG /mul_mod_Iirr => /eqP->. Qed. End ConsttIndExtendible. (* This is Isaacs, Theorem (6.19). *) Theorem invariant_chief_irr_cases G K L s (theta := 'chi[K]_s) : chief_factor G L K -> abelian (K / L) -> G \subset 'I[theta] -> let t := #|K : L| in [\/ 'Res[L] theta \in irr L, exists2 e, exists p, 'Res[L] theta = e%:R *: 'chi_p & (e ^ 2)%N = t | exists2 p, injective p & 'Res[L] theta = \sum_(i < t) 'chi_(p i)]. Proof. case/andP=> /maxgroupP[/andP[ltLK nLG] maxL] nsKG abKbar IGtheta t. have [sKG nKG] := andP nsKG; have sLG := subset_trans (proper_sub ltLK) sKG. have nsLG: L <| G by apply/andP. have nsLK := normalS (proper_sub ltLK) sKG nsLG; have [sLK nLK] := andP nsLK. have [p0 sLp0] := constt_cfRes_irr L s; rewrite -/theta in sLp0. pose phi := 'chi_p0; pose T := 'I_G[phi]. have sTG: T \subset G := subsetIl G _. have /eqP mulKT: (K * T)%g == G. rewrite eqEcard mulG_subG sKG sTG -LagrangeMr -indexgI -(Lagrange sTG) /= -/T. rewrite mulnC leq_mul // setIA (setIidPl sKG) -!size_cfclass // -/phi. rewrite uniq_leq_size ?cfclass_uniq // => _ /cfclassP[x Gx ->]. have: conjg_Iirr p0 x \in irr_constt ('Res theta). have /inertiaJ <-: x \in 'I[theta] := subsetP IGtheta x Gx. by rewrite -(cfConjgRes _ nsKG) // irr_consttE conjg_IirrE // cfConjg_iso. apply: contraR; rewrite -conjg_IirrE // => not_sLp0x. rewrite (Clifford_Res_sum_cfclass nsLK sLp0) cfdotZl cfdot_suml. rewrite big1_seq ?mulr0 // => _ /cfclassP[y Ky ->]; rewrite -conjg_IirrE //. rewrite cfdot_irr mulrb ifN_eq ?(contraNneq _ not_sLp0x) // => <-. by rewrite conjg_IirrE //; apply/cfclassP; exists y. have nsKT_G: K :&: T <| G. rewrite /normal subIset ?sKG // -mulKT setIA (setIidPl sKG) mulG_subG. rewrite normsIG // sub_der1_norm ?subsetIl //. exact: subset_trans (der1_min nLK abKbar) (sub_Inertia _ sLK). have [e DthL]: exists e, 'Res theta = e%:R *: \sum_(xi <- (phi ^: K)%CF) xi. rewrite (Clifford_Res_sum_cfclass nsLK sLp0) -/phi; set e := '[_, _]. by exists (truncC e); rewrite truncCK ?Cnat_cfdot_char ?cfRes_char ?irr_char. have [defKT | ltKT_K] := eqVneq (K :&: T) K; last first. have defKT: K :&: T = L. apply: maxL; last by rewrite subsetI sLK sub_Inertia. by rewrite normal_norm // properEneq ltKT_K subsetIl. have t_cast: size (phi ^: K)%CF = t. by rewrite size_cfclass //= -{2}(setIidPl sKG) -setIA defKT. pose phiKt := Tuple (introT eqP t_cast); pose p i := cfIirr (tnth phiKt i). have pK i: 'chi_(p i) = (phi ^: K)%CF`_i. rewrite cfIirrE; first by rewrite (tnth_nth 0). by have /cfclassP[y _ ->] := mem_tnth i phiKt; rewrite cfConjg_irr ?mem_irr. constructor 3; exists p => [i j /(congr1 (tnth (irr L)))/eqP| ]. by apply: contraTeq; rewrite !pK !nth_uniq ?t_cast ?cfclass_uniq. have{} DthL: 'Res theta = e%:R *: \sum_(i < t) (phi ^: K)%CF`_i. by rewrite DthL (big_nth 0) big_mkord t_cast. suffices /eqP e1: e == 1%N by rewrite DthL e1 scale1r; apply: eq_bigr. have Dth1: theta 1%g = e%:R * t%:R * phi 1%g. rewrite -[t]card_ord -mulrA -(cfRes1 L) DthL cfunE; congr (_ * _). rewrite mulr_natl -sumr_const sum_cfunE -t_cast; apply: eq_bigr => i _. by have /cfclassP[y _ ->] := mem_nth 0 (valP i); rewrite cfConjg1. rewrite eqn_leq lt0n (contraNneq _ (irr1_neq0 s)); last first. by rewrite Dth1 => ->; rewrite !mul0r. rewrite -leC_nat -(ler_pmul2r (gt0CiG K L)) -/t -(ler_pmul2r (irr1_gt0 p0)). rewrite mul1r -Dth1 -cfInd1 //. by rewrite char1_ge_constt ?cfInd_char ?irr_char ?constt_Ind_Res. have IKphi: 'I_K[phi] = K by rewrite -{1}(setIidPl sKG) -setIA. have{} DthL: 'Res[L] theta = e%:R *: phi. by rewrite DthL -[rhs in (_ ^: rhs)%CF]IKphi cfclass_inertia big_seq1. pose mmLth := @mul_mod_Iirr K L s. have linKbar := char_abelianP _ abKbar. have LmodL i: ('chi_i %% L)%CF \is a linear_char := cfMod_lin_char (linKbar i). have mmLthE i: 'chi_(mmLth i) = ('chi_i %% L)%CF * theta. by rewrite cfIirrE ?mod_IirrE // mul_lin_irr ?mem_irr. have mmLthL i: 'Res[L] 'chi_(mmLth i) = 'Res[L] theta. rewrite mmLthE rmorphM /= cfRes_sub_ker ?cfker_mod ?lin_char1 //. by rewrite scale1r mul1r. have [inj_Mphi | /injectivePn[i [j i'j eq_mm_ij]]] := boolP (injectiveb mmLth). suffices /eqP e1: e == 1%N by constructor 1; rewrite DthL e1 scale1r mem_irr. rewrite eqn_leq lt0n (contraNneq _ (irr1_neq0 s)); last first. by rewrite -(cfRes1 L) DthL cfunE => ->; rewrite !mul0r. rewrite -leq_sqr -leC_nat natrX -(ler_pmul2r (irr1_gt0 p0)) -mulrA mul1r. have ->: e%:R * 'chi_p0 1%g = 'Res[L] theta 1%g by rewrite DthL cfunE. rewrite cfRes1 -(ler_pmul2l (gt0CiG K L)) -cfInd1 // -/phi. rewrite -card_quotient // -card_Iirr_abelian // mulr_natl. rewrite ['Ind phi]cfun_sum_cfdot sum_cfunE (bigID (mem (codom mmLth))) /=. rewrite ler_paddr ?sumr_ge0 // => [i _|]. by rewrite char1_ge0 ?rpredZ_Cnat ?Cnat_cfdot_char ?cfInd_char ?irr_char. rewrite -big_uniq //= big_image -sumr_const ler_sum // => i _. rewrite cfunE -[in rhs in _ <= rhs](cfRes1 L) -cfdot_Res_r mmLthL cfRes1. by rewrite DthL cfdotZr rmorph_nat cfnorm_irr mulr1. constructor 2; exists e; first by exists p0. pose mu := (('chi_i / 'chi_j)%R %% L)%CF; pose U := cfker mu. have lin_mu: mu \is a linear_char by rewrite cfMod_lin_char ?rpred_div. have Uj := lin_char_unitr (linKbar j). have ltUK: U \proper K. rewrite /proper cfker_sub /U; have /irrP[k Dmu] := lin_char_irr lin_mu. 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_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. by rewrite gcore_norm (sub_proper_trans (gcore_sub _ _)). apply/cfun_onP=> x; apply: contraNeq => nz_th_x. apply/bigcapP=> y /(subsetP IGtheta)/setIdP[nKy /eqP th_y]. apply: contraR nz_th_x; rewrite mem_conjg -{}th_y cfConjgE {nKy}//. move: {x y}(x ^ _) => x U'x; have [Kx | /cfun0-> //] := boolP (x \in K). have /eqP := congr1 (fun k => (('chi_j %% L)%CF^-1 * 'chi_k) x) eq_mm_ij. rewrite -rmorphV // !mmLthE !mulrA -!rmorphM mulVr //= rmorph1 !cfunE. rewrite (mulrC _^-1) -/mu -subr_eq0 -mulrBl cfun1E Kx mulf_eq0 => /orP[]//. rewrite mulrb subr_eq0 -(lin_char1 lin_mu) [_ == _](contraNF _ U'x) //. by rewrite /U cfkerEchar ?lin_charW // inE Kx. Qed. (* This is Isaacs, Corollary (6.19). *) Corollary cfRes_prime_irr_cases G N s p (chi := 'chi[G]_s) : N <| G -> #|G : N| = p -> prime p -> [\/ 'Res[N] chi \in irr N | exists2 c, injective c & 'Res[N] chi = \sum_(i < p) 'chi_(c i)]. Proof. move=> /andP[sNG nNG] iGN pr_p. have chiefGN: chief_factor G N G. apply/andP; split=> //; apply/maxgroupP. split=> [|M /andP[/andP[sMG ltMG] _] sNM]. by rewrite /proper sNG -indexg_gt1 iGN prime_gt1. apply/esym/eqP; rewrite eqEsubset sNM -indexg_eq1 /= eq_sym. rewrite -(eqn_pmul2l (indexg_gt0 G M)) muln1 Lagrange_index // iGN. by apply/eqP/prime_nt_dvdP; rewrite ?indexg_eq1 // -iGN indexgS. have abGbar: abelian (G / N). by rewrite cyclic_abelian ?prime_cyclic ?card_quotient ?iGN. have IGchi: G \subset 'I[chi] by apply: sub_inertia. have [] := invariant_chief_irr_cases chiefGN abGbar IGchi; first by left. case=> e _ /(congr1 (fun m => odd (logn p m)))/eqP/idPn[]. by rewrite lognX mul2n odd_double iGN logn_prime // eqxx. by rewrite iGN; right. Qed. (* This is Isaacs, Corollary (6.20). *) Corollary prime_invariant_irr_extendible G N s p : N <| G -> #|G : N| = p -> prime p -> G \subset 'I['chi_s] -> {t | 'Res[N, G] 'chi_t = 'chi_s}. Proof. move=> nsNG iGN pr_p IGchi. have [t sGt] := constt_cfInd_irr s (normal_sub nsNG); exists t. have [e DtN]: exists e, 'Res 'chi_t = e%:R *: 'chi_s. rewrite constt_Ind_Res in sGt. rewrite (Clifford_Res_sum_cfclass nsNG sGt); set e := '[_, _]. rewrite cfclass_invariant // big_seq1. by exists (truncC e); rewrite truncCK ?Cnat_cfdot_char ?cfRes_char ?irr_char. have [/irrWnorm/eqP | [c injc DtNc]] := cfRes_prime_irr_cases t nsNG iGN pr_p. rewrite DtN cfnormZ cfnorm_irr normr_nat mulr1 -natrX pnatr_eq1. by rewrite muln_eq1 andbb => /eqP->; rewrite scale1r. have nz_e: e != 0%N. have: 'Res[N] 'chi_t != 0 by rewrite cfRes_eq0 // ?irr_char ?irr_neq0. by rewrite DtN; apply: contraNneq => ->; rewrite scale0r. have [i s'ci]: exists i, c i != s. pose i0 := Ordinal (prime_gt0 pr_p); pose i1 := Ordinal (prime_gt1 pr_p). have [<- | ] := eqVneq (c i0) s; last by exists i0. by exists i1; rewrite (inj_eq injc). have /esym/eqP/idPn[] := congr1 (cfdotr 'chi_(c i)) DtNc; rewrite {1}DtN /=. rewrite cfdot_suml cfdotZl cfdot_irr mulrb ifN_eqC // mulr0. rewrite (bigD1 i) //= cfnorm_irr big1 ?addr0 ?oner_eq0 // => j i'j. by rewrite cfdot_irr mulrb ifN_eq ?(inj_eq injc). Qed. (* This is Isaacs, Lemma (6.24). *) Lemma extend_to_cfdet G N s c0 u : let theta := 'chi_s in let lambda := cfDet theta in let mu := 'chi_u in N <| G -> coprime #|G : N| (truncC (theta 1%g)) -> 'Res[N, G] 'chi_c0 = theta -> 'Res[N, G] mu = lambda -> exists2 c, 'Res 'chi_c = theta /\ cfDet 'chi_c = mu & forall c1, 'Res 'chi_c1 = theta -> cfDet 'chi_c1 = mu -> c1 = c. Proof. move=> theta lambda mu nsNG; set e := #|G : N|; set f := truncC _. set eta := 'chi_c0 => co_e_f etaNth muNlam; have [sNG nNG] := andP nsNG. have fE: f%:R = theta 1%g by rewrite truncCK ?Cnat_irr1. pose nu := cfDet eta; have lin_nu: nu \is a linear_char := cfDet_lin_char _. have nuNlam: 'Res nu = lambda by rewrite -cfDetRes ?irr_char ?etaNth. have lin_lam: lambda \is a linear_char := cfDet_lin_char _. have lin_mu: mu \is a linear_char. by have:= lin_lam; rewrite -muNlam; apply: cfRes_lin_lin; apply: irr_char. have [Unu Ulam] := (lin_char_unitr lin_nu, lin_char_unitr lin_lam). pose alpha := mu / nu. have alphaN_1: 'Res[N] alpha = 1 by rewrite rmorph_div //= muNlam nuNlam divrr. have lin_alpha: alpha \is a linear_char by apply: rpred_div. have alpha_e: alpha ^+ e = 1. have kerNalpha: N \subset cfker alpha. by rewrite -subsetIidl -cfker_Res ?lin_charW // alphaN_1 cfker_cfun1. apply/eqP; rewrite -(cfQuoK nsNG kerNalpha) -rmorphX cfMod_eq1 //. rewrite -dvdn_cforder /e -card_quotient //. by rewrite cforder_lin_char_dvdG ?cfQuo_lin_char. have det_alphaXeta b: cfDet (alpha ^+ b * eta) = alpha ^+ (b * f) * nu. by rewrite cfDet_mul_lin ?rpredX ?irr_char // -exprM -(cfRes1 N) etaNth. have [b bf_mod_e]: exists b, b * f = 1 %[mod e]. rewrite -(chinese_modl co_e_f 1 0) /chinese !mul0n addn0 !mul1n mulnC. by exists (egcdn f e).1. have alpha_bf: alpha ^+ (b * f) = alpha. by rewrite -(expr_mod _ alpha_e) bf_mod_e expr_mod. have /irrP[c Dc]: alpha ^+ b * eta \in irr G. by rewrite mul_lin_irr ?rpredX ?mem_irr. have chiN: 'Res 'chi_c = theta. by rewrite -Dc rmorphM rmorphX /= alphaN_1 expr1n mul1r. have det_chi: cfDet 'chi_c = mu by rewrite -Dc det_alphaXeta alpha_bf divrK. exists c => // c2 c2Nth det_c2_mu; apply: irr_inj. have [irrMc _ imMc _] := constt_Ind_ext nsNG chiN. have /codomP[s2 Dc2]: c2 \in codom (@mul_mod_Iirr G N c). by rewrite -imMc constt_Ind_Res c2Nth constt_irr ?inE. have{} Dc2: 'chi_c2 = ('chi_s2 %% N)%CF * 'chi_c. by rewrite Dc2 cfIirrE // mod_IirrE. have s2_lin: 'chi_s2 \is a linear_char. rewrite qualifE irr_char; apply/eqP/(mulIf (irr1_neq0 c)). rewrite mul1r -[in rhs in _ = rhs](cfRes1 N) chiN -c2Nth cfRes1. by rewrite Dc2 cfunE cfMod1. have s2Xf_1: 'chi_s2 ^+ f = 1. apply/(can_inj (cfModK nsNG))/(mulIr (lin_char_unitr lin_mu))/esym. rewrite rmorph1 rmorphX /= mul1r -{1}det_c2_mu Dc2 -det_chi. by rewrite cfDet_mul_lin ?cfMod_lin_char ?irr_char // -(cfRes1 N) chiN. suffices /eqP s2_1: 'chi_s2 == 1 by rewrite Dc2 s2_1 rmorph1 mul1r. rewrite -['chi_s2]expr1 -dvdn_cforder -(eqnP co_e_f) dvdn_gcd. by rewrite /e -card_quotient ?cforder_lin_char_dvdG //= dvdn_cforder s2Xf_1. Qed. (* This is Isaacs, Theorem (6.25). *) Theorem solvable_irr_extendible_from_det G N s (theta := 'chi[N]_s) : N <| G -> solvable (G / N) -> G \subset 'I[theta] -> coprime #|G : N| (truncC (theta 1%g)) -> [exists c, 'Res 'chi[G]_c == theta] = [exists u, 'Res 'chi[G]_u == cfDet theta]. Proof. set e := #|G : N|; set f := truncC _ => nsNG solG IGtheta co_e_f. apply/exists_eqP/exists_eqP=> [[c cNth] | [u uNdth]]. have /lin_char_irr/irrP[u Du] := cfDet_lin_char 'chi_c. by exists u; rewrite -Du -cfDetRes ?irr_char ?cNth. move: {2}e.+1 (ltnSn e) => m. elim: m => // m IHm in G u e nsNG solG IGtheta co_e_f uNdth *. rewrite ltnS => le_e; have [sNG nNG] := andP nsNG. have [<- | ltNG] := eqsVneq N G; first by exists s; rewrite cfRes_id. have [G0 maxG0 sNG0]: {G0 | maxnormal (gval G0) G G & N \subset G0}. by apply: maxgroup_exists; rewrite properEneq ltNG sNG. have [/andP[ltG0G nG0G] maxG0_P] := maxgroupP maxG0. set mu := 'chi_u in uNdth; have lin_mu: mu \is a linear_char. by rewrite qualifE irr_char -(cfRes1 N) uNdth /= lin_char1 ?cfDet_lin_char. have sG0G := proper_sub ltG0G; have nsNG0 := normalS sNG0 sG0G nsNG. have nsG0G: G0 <| G by apply/andP. have /lin_char_irr/irrP[u0 Du0] := cfRes_lin_char G0 lin_mu. have u0Ndth: 'Res 'chi_u0 = cfDet theta by rewrite -Du0 cfResRes. have IG0theta: G0 \subset 'I[theta]. by rewrite (subset_trans sG0G) // -IGtheta subsetIr. have coG0f: coprime #|G0 : N| f by rewrite (coprime_dvdl _ co_e_f) ?indexSg. have{m IHm le_e} [c0 c0Ns]: exists c0, 'Res 'chi[G0]_c0 = theta. have solG0: solvable (G0 / N) := solvableS (quotientS N sG0G) solG. apply: IHm nsNG0 solG0 IG0theta coG0f u0Ndth (leq_trans _ le_e). by rewrite -(ltn_pmul2l (cardG_gt0 N)) !Lagrange ?proper_card. have{c0 c0Ns} [c0 [c0Ns dc0_u0] Uc0] := extend_to_cfdet nsNG0 coG0f c0Ns u0Ndth. have IGc0: G \subset 'I['chi_c0]. apply/subsetP=> x Gx; rewrite inE (subsetP nG0G) //= -conjg_IirrE. apply/eqP; congr 'chi__; apply: Uc0; rewrite conjg_IirrE. by rewrite -(cfConjgRes _ nsG0G nsNG) // c0Ns inertiaJ ?(subsetP IGtheta). by rewrite cfDetConjg dc0_u0 -Du0 (cfConjgRes _ _ nsG0G) // cfConjg_id. have prG0G: prime #|G : G0|. have [h injh im_h] := third_isom sNG0 nsNG nsG0G. rewrite -card_quotient // -im_h // card_injm //. rewrite simple_sol_prime 1?quotient_sol //. by rewrite /simple -(injm_minnormal injh) // im_h // maxnormal_minnormal. have [t tG0c0] := prime_invariant_irr_extendible nsG0G (erefl _) prG0G IGc0. by exists t; rewrite /theta -c0Ns -tG0c0 cfResRes. Qed. (* This is Isaacs, Theorem (6.26). *) Theorem extend_linear_char_from_Sylow G N (lambda : 'CF(N)) : N <| G -> lambda \is a linear_char -> G \subset 'I[lambda] -> (forall p, p \in \pi('o(lambda)%CF) -> exists2 Hp : {group gT}, [/\ N \subset Hp, Hp \subset G & p.-Sylow(G / N) (Hp / N)%g] & exists u, 'Res 'chi[Hp]_u = lambda) -> exists u, 'Res[N, G] 'chi_u = lambda. Proof. set m := 'o(lambda)%CF => nsNG lam_lin IGlam p_ext_lam. have [sNG nNG] := andP nsNG; have linN := @cfRes_lin_lin _ _ N. wlog [p p_lam]: lambda @m lam_lin IGlam p_ext_lam / exists p : nat, \pi(m) =i (p : nat_pred). - move=> IHp; have [linG [cf [inj_cf _ lin_cf onto_cf]]] := lin_char_group N. case=> cf1 cfM cfX _ cf_order; have [lam cf_lam] := onto_cf _ lam_lin. pose mu p := cf lam.`_p; pose pi_m p := p \in \pi(m). have Dm: m = #[lam] by rewrite /m cfDet_order_lin // cf_lam cf_order. have Dlambda: lambda = \prod_(p < m.+1 | pi_m p) mu p. rewrite -(big_morph cf cfM cf1) big_mkcond cf_lam /pi_m Dm; congr (cf _). rewrite -{1}[lam]prod_constt big_mkord; apply: eq_bigr => p _. by case: ifPn => // p'lam; apply/constt1P; rewrite /p_elt p'natEpi. have lin_mu p: mu p \is a linear_char by rewrite /mu cfX -cf_lam rpredX. suffices /fin_all_exists [u uNlam] (p : 'I_m.+1): exists u, pi_m p -> 'Res[N, G] 'chi_u = mu p. - pose nu := \prod_(p < m.+1 | pi_m p) 'chi_(u p). have lin_nu: nu \is a linear_char. by apply: rpred_prod => p m_p; rewrite linN ?irr_char ?uNlam. have /irrP[u1 Dnu] := lin_char_irr lin_nu. by exists u1; rewrite Dlambda -Dnu rmorph_prod; apply: eq_bigr. have [m_p | _] := boolP (pi_m p); last by exists 0. have o_mu: \pi('o(mu p)%CF) =i (p : nat_pred). rewrite cfDet_order_lin // cf_order orderE /=. have [|pr_p _ [k ->]] := pgroup_pdiv (p_elt_constt p lam). by rewrite cycle_eq1 (sameP eqP constt1P) /p_elt p'natEpi // negbK -Dm. by move=> q; rewrite pi_of_exp // pi_of_prime. have IGmu: G \subset 'I[mu p]. rewrite (subset_trans IGlam) // /mu cfX -cf_lam. elim: (chinese _ _ _ _) => [|k IHk]; first by rewrite inertia1 norm_inertia. by rewrite exprS (subset_trans _ (inertia_mul _ _)) // subsetIidl. have [q||u] := IHp _ (lin_mu p) IGmu; [ | by exists p | by exists u]. rewrite o_mu => /eqnP-> {q}. have [Hp sylHp [u uNlam]] := p_ext_lam p m_p; exists Hp => //. rewrite /mu cfX -cf_lam -uNlam -rmorphX /=; set nu := _ ^+ _. have /lin_char_irr/irrP[v ->]: nu \is a linear_char; last by exists v. by rewrite rpredX // linN ?irr_char ?uNlam. have pi_m_p: p \in \pi(m) by rewrite p_lam !inE. have [pr_p mgt0]: prime p /\ (m > 0)%N. by have:= pi_m_p; rewrite mem_primes => /and3P[]. have p_m: p.-nat m by rewrite -(eq_pnat _ p_lam) pnat_pi. have{p_ext_lam} [H [sNH sHG sylHbar] [v vNlam]] := p_ext_lam p pi_m_p. have co_p_GH: coprime p #|G : H|. rewrite -(index_quotient_eq _ sHG nNG) ?subIset ?sNH ?orbT //. by rewrite (pnat_coprime (pnat_id pr_p)) //; have [] := and3P sylHbar. have lin_v: 'chi_v \is a linear_char by rewrite linN ?irr_char ?vNlam. pose nuG := 'Ind[G] 'chi_v. have [c vGc co_p_f]: exists2 c, c \in irr_constt nuG & ~~ (p %| 'chi_c 1%g)%C. apply/exists_inP; rewrite -negb_forall_in. apply: contraL co_p_GH => /forall_inP p_dv_v1. rewrite prime_coprime // negbK -dvdC_nat -[rhs in (_ %| rhs)%C]mulr1. rewrite -(lin_char1 lin_v) -cfInd1 // ['Ind _]cfun_sum_constt /=. rewrite sum_cfunE rpred_sum // => i /p_dv_v1 p_dv_chi1i. rewrite cfunE dvdC_mull // rpred_Cnat //. by rewrite Cnat_cfdot_char ?cfInd_char ?irr_char. pose f := truncC ('chi_c 1%g); pose b := (egcdn f m).1. have fK: f%:R = 'chi_c 1%g by rewrite truncCK ?Cnat_irr1. have fb_mod_m: f * b = 1 %[mod m]. have co_m_f: coprime m f. by rewrite (pnat_coprime p_m) ?p'natE // -dvdC_nat CdivE fK. by rewrite -(chinese_modl co_m_f 1 0) /chinese !mul0n addn0 mul1n. have /irrP[s Dlam] := lin_char_irr lam_lin. have cHv: v \in irr_constt ('Res[H] 'chi_c) by rewrite -constt_Ind_Res. have{cHv} cNs: s \in irr_constt ('Res[N] 'chi_c). rewrite -(cfResRes _ sNH) ?(constt_Res_trans _ cHv) ?cfRes_char ?irr_char //. by rewrite vNlam Dlam constt_irr !inE. have DcN: 'Res[N] 'chi_c = lambda *+ f. have:= Clifford_Res_sum_cfclass nsNG cNs. rewrite cfclass_invariant -Dlam // big_seq1 Dlam => DcN. have:= cfRes1 N 'chi_c; rewrite DcN cfunE -Dlam lin_char1 // mulr1 => ->. by rewrite -scaler_nat fK. have /lin_char_irr/irrP[d Dd]: cfDet 'chi_c ^+ b \is a linear_char. by rewrite rpredX // cfDet_lin_char. exists d; rewrite -{}Dd rmorphX /= -cfDetRes ?irr_char // DcN. rewrite cfDetMn ?lin_charW // -exprM cfDet_id //. rewrite -(expr_mod _ (exp_cforder _)) -cfDet_order_lin // -/m. by rewrite fb_mod_m /m cfDet_order_lin // expr_mod ?exp_cforder. Qed. (* This is Isaacs, Corollary (6.27). *) Corollary extend_coprime_linear_char G N (lambda : 'CF(N)) : N <| G -> lambda \is a linear_char -> G \subset 'I[lambda] -> coprime #|G : N| 'o(lambda)%CF -> exists u, [/\ 'Res 'chi[G]_u = lambda, 'o('chi_u)%CF = 'o(lambda)%CF & forall v, 'Res 'chi_v = lambda -> coprime #|G : N| 'o('chi_v)%CF -> v = u]. Proof. set e := #|G : N| => nsNG lam_lin IGlam co_e_lam; have [sNG nNG] := andP nsNG. have [p lam_p | v vNlam] := extend_linear_char_from_Sylow nsNG lam_lin IGlam. exists N; last first. by have /irrP[u ->] := lin_char_irr lam_lin; exists u; rewrite cfRes_id. split=> //; rewrite trivg_quotient /pHall sub1G pgroup1 indexg1. rewrite card_quotient //= -/e (pi'_p'nat _ lam_p) //. rewrite -coprime_pi' ?indexg_gt0 1?coprime_sym //. by have:= lam_p; rewrite mem_primes => /and3P[]. set nu := 'chi_v in vNlam. have lin_nu: nu \is a linear_char. by rewrite (@cfRes_lin_lin _ _ N) ?vNlam ?irr_char. have [b be_mod_lam]: exists b, b * e = 1 %[mod 'o(lambda)%CF]. rewrite -(chinese_modr co_e_lam 0 1) /chinese !mul0n !mul1n mulnC. by set b := _.1; exists b. have /irrP[u Du]: nu ^+ (b * e) \in irr G by rewrite lin_char_irr ?rpredX. exists u; set mu := 'chi_u in Du *. have uNlam: 'Res mu = lambda. rewrite cfDet_order_lin // in be_mod_lam. rewrite -Du rmorphX /= vNlam -(expr_mod _ (exp_cforder _)) //. by rewrite be_mod_lam expr_mod ?exp_cforder. have lin_mu: mu \is a linear_char by rewrite -Du rpredX. have o_mu: ('o(mu) = 'o(lambda))%CF. have dv_o_lam_mu: 'o(lambda)%CF %| 'o(mu)%CF. by rewrite !cfDet_order_lin // -uNlam cforder_Res. have kerNnu_olam: N \subset cfker (nu ^+ 'o(lambda)%CF). rewrite -subsetIidl -cfker_Res ?rpredX ?irr_char //. by rewrite rmorphX /= vNlam cfDet_order_lin // exp_cforder cfker_cfun1. apply/eqP; rewrite eqn_dvd dv_o_lam_mu andbT cfDet_order_lin //. rewrite dvdn_cforder -Du exprAC -dvdn_cforder dvdn_mull //. rewrite -(cfQuoK nsNG kerNnu_olam) cforder_mod // /e -card_quotient //. by rewrite cforder_lin_char_dvdG ?cfQuo_lin_char ?rpredX. split=> // t tNlam co_e_t. have lin_t: 'chi_t \is a linear_char. by rewrite (@cfRes_lin_lin _ _ N) ?tNlam ?irr_char. have Ut := lin_char_unitr lin_t. have kerN_mu_t: N \subset cfker (mu / 'chi_t)%R. rewrite -subsetIidl -cfker_Res ?lin_charW ?rpred_div ?rmorph_div //. by rewrite /= uNlam tNlam divrr ?lin_char_unitr ?cfker_cfun1. have co_e_mu_t: coprime e #[(mu / 'chi_t)%R]%CF. suffices dv_o_mu_t: #[(mu / 'chi_t)%R]%CF %| 'o(mu)%CF * 'o('chi_t)%CF. by rewrite (coprime_dvdr dv_o_mu_t) // coprimeMr o_mu co_e_lam. rewrite !cfDet_order_lin //; apply/dvdn_cforderP=> x Gx. rewrite invr_lin_char // !cfunE exprMn -rmorphX {2}mulnC. by rewrite !(dvdn_cforderP _) ?conjC1 ?mulr1 // dvdn_mulr. have /eqP mu_t_1: mu / 'chi_t == 1. rewrite -(dvdn_cforder (_ / _)%R 1) -(eqnP co_e_mu_t) dvdn_gcd dvdnn andbT. rewrite -(cfQuoK nsNG kerN_mu_t) cforder_mod // /e -card_quotient //. by rewrite cforder_lin_char_dvdG ?cfQuo_lin_char ?rpred_div. by apply: irr_inj; rewrite -['chi_t]mul1r -mu_t_1 divrK. Qed. (* This is Isaacs, Corollary (6.28). *) Corollary extend_solvable_coprime_irr G N t (theta := 'chi[N]_t) : N <| G -> solvable (G / N) -> G \subset 'I[theta] -> coprime #|G : N| ('o(theta)%CF * truncC (theta 1%g)) -> exists c, [/\ 'Res 'chi[G]_c = theta, 'o('chi_c)%CF = 'o(theta)%CF & forall d, 'Res 'chi_d = theta -> coprime #|G : N| 'o('chi_d)%CF -> d = c]. Proof. set e := #|G : N|; set f := truncC _ => nsNG solG IGtheta. rewrite coprimeMr => /andP[co_e_th co_e_f]. have [sNG nNG] := andP nsNG; pose lambda := cfDet theta. have lin_lam: lambda \is a linear_char := cfDet_lin_char theta. have IGlam: G \subset 'I[lambda]. apply/subsetP=> y /(subsetP IGtheta)/setIdP[nNy /eqP th_y]. by rewrite inE nNy /= -cfDetConjg th_y. have co_e_lam: coprime e 'o(lambda)%CF by rewrite cfDet_order_lin. have [//|u [uNlam o_u Uu]] := extend_coprime_linear_char nsNG lin_lam IGlam. have /exists_eqP[c cNth]: [exists c, 'Res 'chi[G]_c == theta]. rewrite solvable_irr_extendible_from_det //. by apply/exists_eqP; exists u. have{c cNth} [c [cNth det_c] Uc] := extend_to_cfdet nsNG co_e_f cNth uNlam. have lin_u: 'chi_u \is a linear_char by rewrite -det_c cfDet_lin_char. exists c; split=> // [|c0 c0Nth co_e_c0]. by rewrite !cfDet_order_lin // -det_c in o_u. have lin_u0: cfDet 'chi_c0 \is a linear_char := cfDet_lin_char 'chi_c0. have /irrP[u0 Du0] := lin_char_irr lin_u0. have co_e_u0: coprime e 'o('chi_u0)%CF by rewrite -Du0 cfDet_order_lin. have eq_u0u: u0 = u by apply: Uu; rewrite // -Du0 -cfDetRes ?irr_char ?c0Nth. by apply: Uc; rewrite // Du0 eq_u0u. Qed. End ExtendInvariantIrr. Section Frobenius. Variables (gT : finGroupType) (G K : {group gT}). (* Because he only defines Frobenius groups in chapter 7, Isaacs does not *) (* state these theorems using the Frobenius property. *) Hypothesis frobGK : [Frobenius G with kernel K]. (* This is Isaacs, Theorem 6.34(a1). *) Theorem inertia_Frobenius_ker i : i != 0 -> 'I_G['chi[K]_i] = K. Proof. have [_ _ nsKG regK] := Frobenius_kerP frobGK; have [sKG nKG] := andP nsKG. move=> nzi; apply/eqP; rewrite eqEsubset sub_Inertia // andbT. apply/subsetP=> x /setIP[Gx /setIdP[nKx /eqP x_stab_i]]. have actIirrK: is_action G (@conjg_Iirr _ K). split=> [y j k eq_jk | j y z Gy Gz]. by apply/irr_inj/(can_inj (cfConjgK y)); rewrite -!conjg_IirrE eq_jk. by apply: irr_inj; rewrite !conjg_IirrE (cfConjgM _ nsKG). pose ito := Action actIirrK; pose cto := ('Js \ (subsetT G))%act. have acts_Js : [acts G, on classes K | 'Js]. apply/subsetP=> y Gy; have nKy := subsetP nKG y Gy. rewrite !inE; apply/subsetP=> _ /imsetP[z Gz ->]; rewrite !inE /=. rewrite -class_rcoset norm_rlcoset // class_lcoset. by apply: imset_f; rewrite memJ_norm. have acts_cto : [acts G, on classes K | cto] by rewrite astabs_ract subsetIidl. pose m := #|'Fix_(classes K | cto)[x]|. have def_m: #|'Fix_ito[x]| = m. apply: card_afix_irr_classes => // j y _ Ky /imsetP[_ /imsetP[z Kz ->] ->]. by rewrite conjg_IirrE cfConjgEJ // cfunJ. have: (m != 1)%N. rewrite -def_m (cardD1 (0 : Iirr K)) (cardD1 i) !(inE, sub1set) /=. by rewrite conjg_Iirr0 nzi eqxx -(inj_eq irr_inj) conjg_IirrE x_stab_i eqxx. apply: contraR => notKx; apply/cards1P; exists 1%g; apply/esym/eqP. rewrite eqEsubset !(sub1set, inE) classes1 /= conjs1g eqxx /=. apply/subsetP=> _ /setIP[/imsetP[y Ky ->] /afix1P /= cyKx]. have /imsetP[z Kz def_yx]: y ^ x \in y ^: K. by rewrite -cyKx; apply: imset_f; apply: class_refl. rewrite inE classG_eq1; apply: contraR notKx => nty. rewrite -(groupMr x (groupVr Kz)). apply: (subsetP (regK y _)); first exact/setD1P. rewrite !inE groupMl // groupV (subsetP sKG) //=. by rewrite conjg_set1 conjgM def_yx conjgK. Qed. (* This is Isaacs, Theorem 6.34(a2) *) Theorem irr_induced_Frobenius_ker i : i != 0 -> 'Ind[G, K] 'chi_i \in irr G. Proof. move/inertia_Frobenius_ker/group_inj=> defK. have [_ _ nsKG _] := Frobenius_kerP frobGK. have [] := constt_Inertia_bijection i nsKG; rewrite defK cfInd_id => -> //. by rewrite constt_irr !inE. Qed. (* This is Isaacs, Theorem 6.34(b) *) Theorem Frobenius_Ind_irrP j : reflect (exists2 i, i != 0 & 'chi_j = 'Ind[G, K] 'chi_i) (~~ (K \subset cfker 'chi_j)). Proof. have [_ _ nsKG _] := Frobenius_kerP frobGK; have [sKG nKG] := andP nsKG. apply: (iffP idP) => [not_chijK1 | [i nzi ->]]; last first. by rewrite cfker_Ind_irr ?sub_gcore // subGcfker. have /neq0_has_constt[i chijKi]: 'Res[K] 'chi_j != 0 by apply: Res_irr_neq0. have nz_i: i != 0. by apply: contraNneq not_chijK1 => i0; rewrite constt0_Res_cfker // -i0. have /irrP[k def_chik] := irr_induced_Frobenius_ker nz_i. have: '['chi_j, 'chi_k] != 0 by rewrite -def_chik -cfdot_Res_l. by rewrite cfdot_irr pnatr_eq0; case: (j =P k) => // ->; exists i. Qed. End Frobenius. math-comp-mathcomp-1.12.0/mathcomp/character/integral_char.v000066400000000000000000001067311375767750300240570ustar00rootroot00000000000000(* (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 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. From mathcomp Require Import nilpotent abelian ssrnum ssrint polydiv rat. From mathcomp Require Import matrix mxalgebra intdiv mxpoly vector falgebra. From mathcomp Require Import fieldext separable galois algC cyclotomic algnum. From mathcomp Require Import mxrepresentation classfun character. (******************************************************************************) (* This file provides some standard results based on integrality properties *) (* of characters, such as theorem asserting that the degree of an irreducible *) (* character of G divides the order of G (Isaacs 3.11), or the famous p^a.q^b *) (* solvability theorem of Burnside. *) (* Defined here: *) (* 'K_k == the kth class sum in gring F G, where k : 'I_#|classes G|, and *) (* F is inferred from the context. *) (* := gset_mx F G (enum_val k) (see mxrepresentation.v). *) (* --> The 'K_k form a basis of 'Z(group_ring F G)%MS. *) (* gring_classM_coef i j k == the coordinate of 'K_i *m 'K_j on 'K_k; this *) (* is usually abbreviated as a i j k. *) (* gring_classM_coef_set A B z == the set of all (x, y) in setX A B such *) (* that x * y = z; if A and B are respectively the ith and jth *) (* conjugacy class of G, and z is in the kth conjugacy class, then *) (* gring_classM_coef i j k is exactly the cardinal of this set. *) (* 'omega_i[A] == the mode of 'chi[G]_i on (A \in 'Z(group_ring algC G))%MS, *) (* i.e., the z such that gring_op 'Chi_i A = z%:M. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Lemma group_num_field_exists (gT : finGroupType) (G : {group gT}) : {Qn : splittingFieldType rat & galois 1 {:Qn} & {QnC : {rmorphism Qn -> algC} & forall nuQn : argumentType (mem ('Gal({:Qn}%VS / 1%VS))), {nu : {rmorphism algC -> algC} | {morph QnC: a / nuQn a >-> nu a}} & {w : Qn & #|G|.-primitive_root w /\ <<1; w>>%VS = fullv & forall (hT : finGroupType) (H : {group hT}) (phi : 'CF(H)), phi \is a character -> forall x, (#[x] %| #|G|)%N -> {a | QnC a = phi x}}}}. Proof. have [z prim_z] := C_prim_root_exists (cardG_gt0 G); set n := #|G| in prim_z *. have [Qn [QnC [[|w []] // [Dz] genQn]]] := num_field_exists [:: z]. have prim_w: n.-primitive_root w by rewrite -Dz fmorph_primitive_root in prim_z. have Q_Xn1: ('X^n - 1 : {poly Qn}) \is a polyOver 1%AS. by rewrite rpredB ?rpred1 ?rpredX //= polyOverX. have splitXn1: splittingFieldFor 1 ('X^n - 1) {:Qn}. pose r := codom (fun i : 'I_n => w ^+ i). have Dr: 'X^n - 1 = \prod_(y <- r) ('X - y%:P). by rewrite -(factor_Xn_sub_1 prim_w) big_mkord big_image. exists r; first by rewrite -Dr eqpxx. apply/eqP; rewrite eqEsubv subvf -genQn adjoin_seqSr //; apply/allP=> /=. by rewrite andbT -root_prod_XsubC -Dr; apply/unity_rootP/prim_expr_order. have Qn_ax : SplittingField.axiom Qn by exists ('X^n - 1). exists (SplittingFieldType _ _ Qn_ax). apply/splitting_galoisField. exists ('X^n - 1); split => //. apply: separable_Xn_sub_1; rewrite -(fmorph_eq0 QnC) rmorph_nat. by rewrite pnatr_eq0 -lt0n cardG_gt0. exists QnC => [// nuQn|]. exact: (extend_algC_subfield_aut QnC [rmorphism of nuQn]). rewrite span_seq1 in genQn. exists w => // hT H phi Nphi x x_dv_n. apply: sig_eqW; have [rH ->] := char_reprP Nphi. have [Hx | /cfun0->] := boolP (x \in H); last by exists 0; rewrite rmorph0. have [e [_ [enx1 _] [-> _] _]] := repr_rsim_diag rH Hx. have /fin_all_exists[k Dk] i: exists k, e 0 i = z ^+ k. have [|k ->] := (prim_rootP prim_z) (e 0 i); last by exists k. by have /dvdnP[q ->] := x_dv_n; rewrite mulnC exprM enx1 expr1n. exists (\sum_i w ^+ k i); rewrite rmorph_sum; apply/eq_bigr => i _. by rewrite rmorphX Dz Dk. Qed. Section GenericClassSums. (* This is Isaacs, Theorem (2.4), generalized to an arbitrary field, and with *) (* the combinatorial definition of the coefficients exposed. *) (* This part could move to mxrepresentation.*) Variable (gT : finGroupType) (G : {group gT}) (F : fieldType). Definition gring_classM_coef_set (Ki Kj : {set gT}) g := [set xy in [predX Ki & Kj] | let: (x, y) := xy in x * y == g]%g. Definition gring_classM_coef (i j k : 'I_#|classes G|) := #|gring_classM_coef_set (enum_val i) (enum_val j) (repr (enum_val k))|. Definition gring_class_sum (i : 'I_#|classes G|) := gset_mx F G (enum_val i). Local Notation "''K_' i" := (gring_class_sum i) (at level 8, i at level 2, format "''K_' i") : ring_scope. Local Notation a := gring_classM_coef. Lemma gring_class_sum_central i : ('K_i \in 'Z(group_ring F G))%MS. Proof. by rewrite -classg_base_center (eq_row_sub i) // rowK. Qed. Lemma set_gring_classM_coef (i j k : 'I_#|classes G|) g : g \in enum_val k -> a i j k = #|gring_classM_coef_set (enum_val i) (enum_val j) g|. Proof. rewrite /a; have /repr_classesP[] := enum_valP k; move: (repr _) => g1 Gg1 ->. have [/imsetP[zi Gzi ->] /imsetP[zj Gzj ->]] := (enum_valP i, enum_valP j). move=> g1Gg; have Gg := subsetP (class_subG Gg1 (subxx _)) _ g1Gg. set Aij := gring_classM_coef_set _ _. without loss suffices IH: g g1 Gg Gg1 g1Gg / (#|Aij g1| <= #|Aij g|)%N. by apply/eqP; rewrite eqn_leq !IH // class_sym. have [w Gw Dg] := imsetP g1Gg; pose J2 (v : gT) xy := (xy.1 ^ v, xy.2 ^ v)%g. have J2inj: injective (J2 w). by apply: can_inj (J2 w^-1)%g _ => [[x y]]; rewrite /J2 /= !conjgK. rewrite -(card_imset _ J2inj) subset_leq_card //; apply/subsetP. move=> _ /imsetP[[x y] /setIdP[/andP[/= x1Gx y1Gy] Dxy1] ->]; rewrite !inE /=. rewrite !(class_sym _ (_ ^ _)) !classGidl // class_sym x1Gx class_sym y1Gy. by rewrite -conjMg (eqP Dxy1) /= -Dg. Qed. Theorem gring_classM_expansion i j : 'K_i *m 'K_j = \sum_k (a i j k)%:R *: 'K_k. Proof. have [/imsetP[zi Gzi dKi] /imsetP[zj Gzj dKj]] := (enum_valP i, enum_valP j). pose aG := regular_repr F G; have sKG := subsetP (class_subG _ (subxx G)). transitivity (\sum_(x in zi ^: G) \sum_(y in zj ^: G) aG (x * y)%g). rewrite mulmx_suml -/aG dKi; apply: eq_bigr => x /sKG Gx. rewrite mulmx_sumr -/aG dKj; apply: eq_bigr => y /sKG Gy. by rewrite repr_mxM ?Gx ?Gy. pose h2 xy : gT := (xy.1 * xy.2)%g. pose h1 xy := enum_rank_in (classes1 G) (h2 xy ^: G). rewrite pair_big (partition_big h1 xpredT) //=; apply: eq_bigr => k _. rewrite (partition_big h2 (mem (enum_val k))) /= => [|[x y]]; last first. case/andP=> /andP[/= /sKG Gx /sKG Gy] /eqP <-. by rewrite enum_rankK_in ?class_refl ?mem_classes ?groupM ?Gx ?Gy. rewrite scaler_sumr; apply: eq_bigr => g Kk_g; rewrite scaler_nat. rewrite (set_gring_classM_coef _ _ Kk_g) -sumr_const; apply: eq_big => [] [x y]. rewrite !inE /= dKi dKj /h1 /h2 /=; apply: andb_id2r => /eqP ->. have /imsetP[zk Gzk dKk] := enum_valP k; rewrite dKk in Kk_g. by rewrite (class_eqP Kk_g) -dKk enum_valK_in eqxx andbT. by rewrite /h2 /= => /andP[_ /eqP->]. Qed. Fact gring_irr_mode_key : unit. Proof. by []. Qed. Definition gring_irr_mode_def (i : Iirr G) := ('chi_i 1%g)^-1 *: 'chi_i. Definition gring_irr_mode := locked_with gring_irr_mode_key gring_irr_mode_def. Canonical gring_irr_mode_unlockable := [unlockable fun gring_irr_mode]. End GenericClassSums. Arguments gring_irr_mode {gT G%G} i%R _%g : extra scopes. Notation "''K_' i" := (gring_class_sum _ i) (at level 8, i at level 2, format "''K_' i") : ring_scope. Notation "''omega_' i [ A ]" := (xcfun (gring_irr_mode i) A) (at level 8, i at level 2, format "''omega_' i [ A ]") : ring_scope. Section IntegralChar. Variables (gT : finGroupType) (G : {group gT}). (* This is Isaacs, Corollary (3.6). *) Lemma Aint_char (chi : 'CF(G)) x : chi \is a character -> chi x \in Aint. Proof. have [Gx /char_reprP[rG ->] {chi} | /cfun0->//] := boolP (x \in G). have [e [_ [unit_e _] [-> _] _]] := repr_rsim_diag rG Gx. rewrite rpred_sum // => i _; apply: (@Aint_unity_root #[x]) => //. exact/unity_rootP. Qed. Lemma Aint_irr i x : 'chi[G]_i x \in Aint. Proof. exact/Aint_char/irr_char. Qed. Local Notation R_G := (group_ring algCfield G). Local Notation a := gring_classM_coef. (* This is Isaacs (2.25). *) Lemma mx_irr_gring_op_center_scalar n (rG : mx_representation algCfield G n) A : mx_irreducible rG -> (A \in 'Z(R_G))%MS -> is_scalar_mx (gring_op rG A). Proof. move/groupC=> irrG /center_mxP[R_A cGA]. apply: mx_abs_irr_cent_scalar irrG _ _; apply/centgmxP => x Gx. by rewrite -(gring_opG rG Gx) -!gring_opM ?cGA // envelop_mx_id. Qed. Section GringIrrMode. Variable i : Iirr G. Let n := irr_degree (socle_of_Iirr i). Let mxZn_inj: injective (@scalar_mx algCfield n). Proof. by rewrite -[n]prednK ?irr_degree_gt0 //; apply: fmorph_inj. Qed. Lemma cfRepr_gring_center n1 (rG : mx_representation algCfield G n1) A : cfRepr rG = 'chi_i -> (A \in 'Z(R_G))%MS -> gring_op rG A = 'omega_i[A]%:M. Proof. move=> def_rG Z_A; rewrite unlock xcfunZl -{2}def_rG xcfun_repr. have irr_rG: mx_irreducible rG. have sim_rG: mx_rsim 'Chi_i rG by apply: cfRepr_inj; rewrite irrRepr. exact: mx_rsim_irr sim_rG (socle_irr _). have /is_scalar_mxP[e ->] := mx_irr_gring_op_center_scalar irr_rG Z_A. congr _%:M; apply: (canRL (mulKf (irr1_neq0 i))). by rewrite mulrC -def_rG cfunE repr_mx1 group1 -mxtraceZ scalemx1. Qed. Lemma irr_gring_center A : (A \in 'Z(R_G))%MS -> gring_op 'Chi_i A = 'omega_i[A]%:M. Proof. exact: cfRepr_gring_center (irrRepr i). Qed. Lemma gring_irr_modeM A B : (A \in 'Z(R_G))%MS -> (B \in 'Z(R_G))%MS -> 'omega_i[A *m B] = 'omega_i[A] * 'omega_i[B]. Proof. move=> Z_A Z_B; have [[R_A cRA] [R_B cRB]] := (center_mxP Z_A, center_mxP Z_B). apply: mxZn_inj; rewrite scalar_mxM -!irr_gring_center ?gring_opM //. apply/center_mxP; split=> [|C R_C]; first exact: envelop_mxM. by rewrite mulmxA cRA // -!mulmxA cRB. Qed. Lemma gring_mode_class_sum_eq (k : 'I_#|classes G|) g : g \in enum_val k -> 'omega_i['K_k] = #|g ^: G|%:R * 'chi_i g / 'chi_i 1%g. Proof. have /imsetP[x Gx DxG] := enum_valP k; rewrite DxG => /imsetP[u Gu ->{g}]. rewrite unlock classGidl ?cfunJ {u Gu}// mulrC mulr_natl. rewrite xcfunZl raddf_sum DxG -sumr_const /=; congr (_ * _). by apply: eq_bigr => _ /imsetP[u Gu ->]; rewrite xcfunG ?groupJ ?cfunJ. Qed. (* This is Isaacs, Theorem (3.7). *) Lemma Aint_gring_mode_class_sum k : 'omega_i['K_k] \in Aint. Proof. move: k; pose X := [tuple 'omega_i['K_k] | k < #|classes G| ]. have memX k: 'omega_i['K_k] \in X by apply: image_f. have S_P := Cint_spanP X; set S := Cint_span X in S_P. have S_X: {subset X <= S} by apply: mem_Cint_span. have S_1: 1 \in S. apply: S_X; apply/codomP; exists (enum_rank_in (classes1 G) 1%g). rewrite (@gring_mode_class_sum_eq _ 1%g) ?enum_rankK_in ?classes1 //. by rewrite mulfK ?irr1_neq0 // class1G cards1. suffices Smul: mulr_closed S. by move=> k; apply: fin_Csubring_Aint S_P _ _; rewrite ?S_X. split=> // _ _ /S_P[x ->] /S_P[y ->]. rewrite mulr_sumr rpred_sum // => j _. rewrite mulrzAr mulr_suml rpredMz ?rpred_sum // => k _. rewrite mulrzAl rpredMz {x y}// !nth_mktuple. rewrite -gring_irr_modeM ?gring_class_sum_central //. rewrite gring_classM_expansion raddf_sum rpred_sum // => jk _. by rewrite scaler_nat raddfMn rpredMn ?S_X ?memX. Qed. (* A more usable reformulation that does not involve the class sums. *) Corollary Aint_class_div_irr1 x : x \in G -> #|x ^: G|%:R * 'chi_i x / 'chi_i 1%g \in Aint. Proof. move=> Gx; have clGxG := mem_classes Gx; pose k := enum_rank_in clGxG (x ^: G). have k_x: x \in enum_val k by rewrite enum_rankK_in // class_refl. by rewrite -(gring_mode_class_sum_eq k_x) Aint_gring_mode_class_sum. Qed. (* This is Isaacs, Theorem (3.8). *) Theorem coprime_degree_support_cfcenter g : coprime (truncC ('chi_i 1%g)) #|g ^: G| -> g \notin ('Z('chi_i))%CF -> 'chi_i g = 0. Proof. set m := truncC _ => co_m_gG notZg. have [Gg | /cfun0-> //] := boolP (g \in G). have Dm: 'chi_i 1%g = m%:R by rewrite truncCK ?Cnat_irr1. have m_gt0: (0 < m)%N by rewrite -ltC_nat -Dm irr1_gt0. 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 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. suffices ->: alpha = v%:R * 'chi_i g - u%:R * (alpha * #|g ^: G|%:R). rewrite rpredB // rpredM ?rpred_nat ?Aint_irr //. by rewrite mulrC mulrA -Dm Aint_class_div_irr1. rewrite -mulrCA -[v%:R](mulfK nz_m) -!natrM -eq_uv (eqnP co_m_gG). by rewrite mulrAC -mulrA -/alpha mulr_natl mulr_natr mulrS addrK. have [Qn galQn [QnC gQnC [_ _ Qn_g]]] := group_num_field_exists <[g]>. have{Qn_g} [a Da]: exists a, QnC a = alpha. rewrite /alpha; have [a <-] := Qn_g _ G _ (irr_char i) g (dvdnn _). by exists (a / m%:R); rewrite fmorph_div rmorph_nat. have Za_nu nu: sval (gQnC nu) alpha \in Aint by rewrite Aint_aut. have norm_a_nu nu: `|sval (gQnC nu) alpha| <= 1. move: {nu}(sval _) => nu; rewrite fmorph_div rmorph_nat normrM normfV. rewrite normr_nat -Dm -(ler_pmul2r (irr1_gt0 (aut_Iirr nu i))) mul1r. congr (_ <= _): (char1_ge_norm g (irr_char (aut_Iirr nu i))). by rewrite !aut_IirrE !cfunE Dm rmorph_nat divfK. pose beta := QnC (galNorm 1 {:Qn} a). have Dbeta: beta = \prod_(nu in 'Gal({:Qn} / 1)) sval (gQnC nu) alpha. rewrite /beta rmorph_prod. apply: eq_bigr => nu _. by case: (gQnC nu) => f /= ->; rewrite Da. have Zbeta: beta \in Cint. apply: Cint_rat_Aint; last by rewrite Dbeta rpred_prod. rewrite /beta; have /vlineP[/= c ->] := mem_galNorm galQn (memvf a). by rewrite alg_num_field fmorph_rat rpred_rat. 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 lt_geF //; apply: le_lt_trans a_lt1. rewrite -[`|alpha|]mulr1 Dbeta (bigD1 1%g) ?group1 //= -Da. 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. (* This is Isaacs, Theorem (3.9). *) Theorem primes_class_simple_gt1 C : simple G -> ~~ abelian G -> C \in (classes G)^# -> (size (primes #|C|) > 1)%N. Proof. move=> simpleG not_cGG /setD1P[ntC /imsetP[g Gg defC]]. have{ntC} nt_g: g != 1%g by rewrite defC classG_eq1 in ntC. rewrite ltnNge {C}defC; set m := #|_|; apply/negP=> p_natC. have{p_natC} [p p_pr [a Dm]]: {p : nat & prime p & {a | m = p ^ a}%N}. have /prod_prime_decomp->: (0 < m)%N by rewrite /m -index_cent1. rewrite prime_decompE; case Dpr: (primes _) p_natC => [|p []] // _. by exists 2 => //; rewrite big_nil; exists 0%N. rewrite big_seq1; exists p; last by exists (logn p m). by have:= mem_primes p m; rewrite Dpr mem_head => /esym/and3P[]. have{simpleG} [ntG minG] := simpleP _ simpleG. pose p_dv1 i := (p %| 'chi[G]_i 1%g)%C. have p_dvd_supp_g i: ~~ p_dv1 i && (i != 0) -> 'chi_i g = 0. rewrite /p_dv1 irr1_degree dvdC_nat -prime_coprime // => /andP[co_p_i1 nz_i]. have fful_i: cfker 'chi_i = [1]. have /minG[//|/eqP] := cfker_normal 'chi_i. by rewrite eqEsubset subGcfker (negPf nz_i) andbF. have trivZ: 'Z(G) = [1] by have /minG[|/center_idP/idPn] := center_normal G. have trivZi: ('Z('chi_i))%CF = [1]. apply/trivgP; rewrite -quotient_sub1 ?norms1 //= -fful_i cfcenter_eq_center. rewrite fful_i subG1 -(isog_eq1 (isog_center (quotient1_isog G))) /=. by rewrite trivZ. rewrite coprime_degree_support_cfcenter ?trivZi ?inE //. by rewrite -/m Dm irr1_degree natCK coprime_sym coprimeXl. pose alpha := \sum_(i | p_dv1 i && (i != 0)) 'chi_i 1%g / p%:R * 'chi_i g. have nz_p: p%:R != 0 :> algC by rewrite pnatr_eq0 -lt0n prime_gt0. have Dalpha: alpha = - 1 / p%:R. apply/(canRL (mulfK nz_p))/eqP; rewrite -addr_eq0 addrC; apply/eqP/esym. transitivity (cfReg G g); first by rewrite cfRegE (negPf nt_g). rewrite cfReg_sum sum_cfunE (bigD1 0) //= irr0 !cfunE cfun11 cfun1E Gg. rewrite mulr1; congr (1 + _); rewrite (bigID p_dv1) /= addrC big_andbC. rewrite big1 => [|i /p_dvd_supp_g chig0]; last by rewrite cfunE chig0 mulr0. rewrite add0r big_andbC mulr_suml; apply: eq_bigr => i _. by rewrite mulrAC divfK // cfunE. suffices: (p %| 1)%C by rewrite (dvdC_nat p 1) dvdn1 -(subnKC (prime_gt1 p_pr)). rewrite unfold_in (negPf nz_p). rewrite Cint_rat_Aint ?rpred_div ?rpred1 ?rpred_nat //. rewrite -rpredN // -mulNr -Dalpha rpred_sum // => i /andP[/dvdCP[c Zc ->] _]. by rewrite mulfK // rpredM ?Aint_irr ?Aint_Cint. Qed. End IntegralChar. Section MoreIntegralChar. Implicit Type gT : finGroupType. (* This is Burnside's famous p^a.q^b theorem (Isaacs, Theorem (3.10)). *) Theorem Burnside_p_a_q_b gT (G : {group gT}) : (size (primes #|G|) <= 2)%N -> solvable G. Proof. move: {2}_.+1 (ltnSn #|G|) => n; elim: n => // n IHn in gT G *. rewrite ltnS => leGn piGle2; have [simpleG | ] := boolP (simple G); last first. rewrite negb_forall_in => /exists_inP[N sNG]; rewrite eq_sym. have [->|] := eqVneq N G. rewrite groupP /= genGid normG andbT eqb_id negbK => /eqP->. exact: solvable1. rewrite [N == G]eqEproper sNG eqbF_neg !negbK => ltNG /and3P[grN]. case/isgroupP: grN => {}N -> in sNG ltNG *; rewrite /= genGid => ntN nNG. have nsNG: N <| G by apply/andP. have dv_le_pi m: (m %| #|G| -> size (primes m) <= 2)%N. move=> m_dv_G; apply: leq_trans piGle2. by rewrite uniq_leq_size ?primes_uniq //; apply: pi_of_dvd. rewrite (series_sol nsNG) !IHn ?dv_le_pi ?cardSg ?dvdn_quotient //. by apply: leq_trans leGn; apply: ltn_quotient. by apply: leq_trans leGn; apply: proper_card. have [->|[p p_pr p_dv_G]] := trivgVpdiv G; first exact: solvable1. have piGp: p \in \pi(G) by rewrite mem_primes p_pr cardG_gt0. have [P sylP] := Sylow_exists p G; have [sPG pP p'GP] := and3P sylP. have ntP: P :!=: 1%g by rewrite -rank_gt0 (rank_Sylow sylP) p_rank_gt0. have /trivgPn[g /setIP[Pg cPg] nt_g]: 'Z(P) != 1%g. by rewrite center_nil_eq1 // (pgroup_nil pP). apply: abelian_sol; have: (size (primes #|g ^: G|) <= 1)%N. rewrite -ltnS -[_.+1]/(size (p :: _)) (leq_trans _ piGle2) //. rewrite -index_cent1 uniq_leq_size // => [/= | q]. rewrite primes_uniq -p'natEpi ?(pnat_dvd _ p'GP) ?indexgS //. by rewrite subsetI sPG sub_cent1. by rewrite inE => /predU1P[-> // |]; apply: pi_of_dvd; rewrite ?dvdn_indexg. rewrite leqNgt; apply: contraR => /primes_class_simple_gt1-> //. by rewrite !inE classG_eq1 nt_g mem_classes // (subsetP sPG). Qed. (* This is Isaacs, Theorem (3.11). *) Theorem dvd_irr1_cardG gT (G : {group gT}) i : ('chi[G]_i 1%g %| #|G|)%C. Proof. rewrite unfold_in -if_neg irr1_neq0 Cint_rat_Aint //=. by rewrite rpred_div ?rpred_nat // rpred_Cnat ?Cnat_irr1. rewrite -[n in n / _]/(_ *+ true) -(eqxx i) -mulr_natr. rewrite -first_orthogonality_relation mulVKf ?neq0CG //. rewrite sum_by_classes => [|x y Gx Gy]; rewrite -?conjVg ?cfunJ //. rewrite mulr_suml rpred_sum // => K /repr_classesP[Gx {1}->]. by rewrite !mulrA mulrAC rpredM ?Aint_irr ?Aint_class_div_irr1. Qed. (* This is Isaacs, Theorem (3.12). *) Theorem dvd_irr1_index_center gT (G : {group gT}) i : ('chi[G]_i 1%g %| #|G : 'Z('chi_i)%CF|)%C. Proof. without loss fful: gT G i / cfaithful 'chi_i. rewrite -{2}[i](quo_IirrK _ (subxx _)) 1?mod_IirrE ?cfModE ?cfker_normal //. rewrite morph1; set i1 := quo_Iirr _ i => /(_ _ _ i1) IH. have fful_i1: cfaithful 'chi_i1. by rewrite quo_IirrE ?cfker_normal ?cfaithful_quo. have:= IH fful_i1; rewrite cfcenter_fful_irr // -cfcenter_eq_center. rewrite index_quotient_eq ?cfcenter_sub ?cfker_norm //. by rewrite setIC subIset // normal_sub ?cfker_center_normal. have [lambda lin_lambda Dlambda] := cfcenter_Res 'chi_i. have DchiZ: {in G & 'Z(G), forall x y, 'chi_i (x * y)%g = 'chi_i x * lambda y}. rewrite -(cfcenter_fful_irr fful) => x y Gx Zy. apply: (mulfI (irr1_neq0 i)); rewrite mulrCA. transitivity ('chi_i x * ('chi_i 1%g *: lambda) y); last by rewrite !cfunE. rewrite -Dlambda cfResE ?cfcenter_sub //. rewrite -irrRepr cfcenter_repr !cfunE in Zy *. case/setIdP: Zy => Gy /is_scalar_mxP[e De]. rewrite repr_mx1 group1 (groupM Gx Gy) (repr_mxM _ Gx Gy) Gx Gy De. by rewrite mul_mx_scalar mxtraceZ mulrCA mulrA mulrC -mxtraceZ scalemx1. have inj_lambda: {in 'Z(G) &, injective lambda}. rewrite -(cfcenter_fful_irr fful) => x y Zx Zy eq_xy. apply/eqP; rewrite eq_mulVg1 -in_set1 (subsetP fful) // cfkerEirr inE. apply/eqP; transitivity ('Res['Z('chi_i)%CF] 'chi_i (x^-1 * y)%g). by rewrite cfResE ?cfcenter_sub // groupM ?groupV. rewrite Dlambda !cfunE lin_charM ?groupV // -eq_xy -lin_charM ?groupV //. by rewrite mulrC mulVg lin_char1 ?mul1r. rewrite unfold_in -if_neg irr1_neq0 Cint_rat_Aint //. by rewrite rpred_div ?rpred_nat // rpred_Cnat ?Cnat_irr1. rewrite (cfcenter_fful_irr fful) nCdivE natf_indexg ?center_sub //=. have ->: #|G|%:R = \sum_(x in G) 'chi_i x * 'chi_i (x^-1)%g. rewrite -[_%:R]mulr1; apply: canLR (mulVKf (neq0CG G)) _. by rewrite first_orthogonality_relation eqxx. rewrite (big_setID [set x | 'chi_i x == 0]) /= -setIdE. rewrite big1 ?add0r => [| x /setIdP[_ /eqP->]]; last by rewrite mul0r. pose h x := (x ^: G * 'Z(G))%g; rewrite (partition_big_imset h). rewrite !mulr_suml rpred_sum //= => _ /imsetP[x /setDP[Gx nz_chi_x] ->]. have: #|x ^: G|%:R * ('chi_i x * 'chi_i x^-1%g) / 'chi_i 1%g \in Aint. by rewrite !mulrA mulrAC rpredM ?Aint_irr ?Aint_class_div_irr1. congr 2 (_ * _ \in Aint); apply: canRL (mulfK (neq0CG _)) _. rewrite inE in nz_chi_x. transitivity ('chi_i x * 'chi_i (x^-1)%g *+ #|h x|); last first. rewrite -sumr_const. apply: eq_big => [y | _ /mulsgP[_ z /imsetP[u Gu ->] Zz] ->]. rewrite !inE -andbA; apply/idP/and3P=> [|[_ _ /eqP <-]]; last first. by rewrite -{1}[y]mulg1 mem_mulg ?class_refl. case/mulsgP=> _ z /imsetP[u Gu ->] Zz ->; have /centerP[Gz cGz] := Zz. rewrite groupM 1?DchiZ ?groupJ ?cfunJ //; split=> //. by rewrite mulf_neq0 // lin_char_neq0 /= ?cfcenter_fful_irr. rewrite -[z](mulKg u) -cGz // -conjMg /h classGidl {u Gu}//. apply/eqP/setP=> w; apply/mulsgP/mulsgP=> [][_ z1 /imsetP[v Gv ->] Zz1 ->]. exists (x ^ v)%g (z * z1)%g; rewrite ?imset_f ?groupM //. by rewrite conjMg -mulgA /(z ^ v)%g cGz // mulKg. exists ((x * z) ^ v)%g (z^-1 * z1)%g; rewrite ?imset_f ?groupM ?groupV //. by rewrite conjMg -mulgA /(z ^ v)%g cGz // mulKg mulKVg. rewrite !irr_inv DchiZ ?groupJ ?cfunJ // rmorphM mulrACA -!normCK -exprMn. by rewrite (normC_lin_char lin_lambda) ?mulr1 //= cfcenter_fful_irr. rewrite mulrAC -natrM mulr_natl; congr (_ *+ _). symmetry; rewrite /h /mulg /= /set_mulg [in _ @2: (_, _)]unlock cardsE. rewrite -cardX card_in_image // => [] [y1 z1] [y2 z2] /=. move=> /andP[/=/imsetP[u1 Gu1 ->] Zz1] /andP[/=/imsetP[u2 Gu2 ->] Zz2] {y1 y2}. move=> eq12; have /eqP := congr1 'chi_i eq12. rewrite !(cfunJ, DchiZ) ?groupJ // (can_eq (mulKf nz_chi_x)). rewrite (inj_in_eq inj_lambda) // => /eqP eq_z12; rewrite eq_z12 in eq12 *. by rewrite (mulIg _ _ _ eq12). Qed. (* This is Isaacs, Problem (3.7). *) Lemma gring_classM_coef_sum_eq gT (G : {group gT}) j1 j2 k g1 g2 g : let a := @gring_classM_coef gT G j1 j2 in let a_k := a k in g1 \in enum_val j1 -> g2 \in enum_val j2 -> g \in enum_val k -> let sum12g := \sum_i 'chi[G]_i g1 * 'chi_i g2 * ('chi_i g)^* / 'chi_i 1%g in a_k%:R = (#|enum_val j1| * #|enum_val j2|)%:R / #|G|%:R * sum12g. Proof. move=> a /= Kg1 Kg2 Kg; rewrite mulrAC; apply: canRL (mulfK (neq0CG G)) _. transitivity (\sum_j (#|G| * a j)%:R *+ (j == k) : algC). by rewrite (bigD1 k) //= eqxx -natrM mulnC big1 ?addr0 // => j /negPf->. have defK (j : 'I_#|classes G|) x: x \in enum_val j -> enum_val j = x ^: G. by have /imsetP[y Gy ->] := enum_valP j => /class_eqP. have Gg: g \in G. by case/imsetP: (enum_valP k) Kg => x Gx -> /imsetP[y Gy ->]; apply: groupJ. transitivity (\sum_j \sum_i 'omega_i['K_j] * 'chi_i 1%g * ('chi_i g)^* *+ a j). apply: eq_bigr => j _; have /imsetP[z Gz Dj] := enum_valP j. have Kz: z \in enum_val j by rewrite Dj class_refl. rewrite -(Lagrange (subsetIl G 'C[z])) index_cent1 -mulnA natrM -mulrnAl. have ->: (j == k) = (z \in enum_val k). by rewrite -(inj_eq enum_val_inj); apply/eqP/idP=> [<-|/defK->]. rewrite (defK _ g) // -second_orthogonality_relation // mulr_suml. apply: eq_bigr=> i _; rewrite natrM mulrA mulr_natr mulrC mulrA. by rewrite (gring_mode_class_sum_eq i Kz) divfK ?irr1_neq0. rewrite exchange_big /= mulr_sumr; apply: eq_bigr => i _. transitivity ('omega_i['K_j1 *m 'K_j2] * 'chi_i 1%g * ('chi_i g)^*). rewrite gring_classM_expansion -/a raddf_sum !mulr_suml /=. by apply: eq_bigr => j _; rewrite xcfunZr -!mulrA mulr_natl. rewrite !mulrA 2![_ / _]mulrAC (defK _ _ Kg1) (defK _ _ Kg2); congr (_ * _). rewrite gring_irr_modeM ?gring_class_sum_central // mulnC natrM. rewrite (gring_mode_class_sum_eq i Kg2) !mulrA divfK ?irr1_neq0 //. by congr (_ * _); rewrite [_ * _]mulrC (gring_mode_class_sum_eq i Kg1) !mulrA. Qed. (* This is Isaacs, Problem (2.16). *) Lemma index_support_dvd_degree gT (G H : {group gT}) chi : H \subset G -> chi \is a character -> chi \in 'CF(G, H) -> (H :==: 1%g) || abelian G -> (#|G : H| %| chi 1%g)%C. Proof. move=> sHG Nchi Hchi ZHG. suffices: (#|G : H| %| 'Res[H] chi 1%g)%C by rewrite cfResE ?group1. rewrite ['Res _]cfun_sum_cfdot sum_cfunE rpred_sum // => i _. rewrite cfunE dvdC_mulr ?Cint_Cnat ?Cnat_irr1 //. have [j ->]: exists j, 'chi_i = 'Res 'chi[G]_j. case/predU1P: ZHG => [-> | cGG] in i *. suffices ->: i = 0 by exists 0; rewrite !irr0 cfRes_cfun1 ?sub1G. apply/val_inj; case: i => [[|i] //=]; rewrite ltnNge NirrE. by rewrite (@leq_trans 1) // leqNgt classes_gt1 eqxx. have linG := char_abelianP G cGG; have linG1 j := eqP (proj2 (andP (linG j))). have /fin_all_exists[rH DrH] j: exists k, 'Res[H, G] 'chi_j = 'chi_k. apply/irrP/lin_char_irr/andP. by rewrite cfRes_char ?irr_char // cfRes1 ?linG1. suffices{i} all_rH: codom rH =i Iirr H. by exists (iinv (all_rH i)); rewrite DrH f_iinv. apply/subset_cardP; last exact/subsetP; apply/esym/eqP. rewrite card_Iirr_abelian ?(abelianS sHG) //. rewrite -(eqn_pmul2r (indexg_gt0 G H)) Lagrange //; apply/eqP. rewrite -sum_nat_const -card_Iirr_abelian // -sum1_card. rewrite (partition_big rH (mem (codom rH))) /=; last exact: image_f. have nsHG: H <| G by rewrite -sub_abelian_normal. apply: eq_bigr => _ /codomP[i ->]; rewrite -card_quotient ?normal_norm //. rewrite -card_Iirr_abelian ?quotient_abelian //. have Mlin j1 j2: exists k, 'chi_j1 * 'chi_j2 = 'chi[G]_k. exact/irrP/lin_char_irr/rpredM. have /fin_all_exists[rQ DrQ] (j : Iirr (G / H)) := Mlin i (mod_Iirr j). have mulJi: ('chi[G]_i)^*%CF * 'chi_i = 1. apply/cfun_inP=> x Gx; rewrite !cfunE -lin_charV_conj ?linG // cfun1E Gx. by rewrite lin_charV ?mulVf ?lin_char_neq0 ?linG. have inj_rQ: injective rQ. move=> j1 j2 /(congr1 (fun k => (('chi_i)^*%CF * 'chi_k) / H)%CF). by rewrite -!DrQ !mulrA mulJi !mul1r !mod_IirrE ?cfModK // => /irr_inj. rewrite -(card_imset _ inj_rQ) -sum1_card; apply: eq_bigl => j. rewrite -(inj_eq irr_inj) -!DrH; apply/eqP/imsetP=> [eq_ij | [k _ ->]]. have [k Dk] := Mlin (conjC_Iirr i) j; exists (quo_Iirr H k) => //. apply/irr_inj; rewrite -DrQ quo_IirrK //. by rewrite -Dk conjC_IirrE mulrCA mulrA mulJi mul1r. apply/subsetP=> x Hx; have Gx := subsetP sHG x Hx. rewrite cfkerEirr inE linG1 -Dk conjC_IirrE; apply/eqP. transitivity ((1 : 'CF(G)) x); last by rewrite cfun1E Gx. by rewrite -mulJi !cfunE -!(cfResE _ sHG Hx) eq_ij. rewrite -DrQ; apply/cfun_inP=> x Hx; rewrite !cfResE // cfunE mulrC. by rewrite cfker1 ?linG1 ?mul1r ?(subsetP _ x Hx) // mod_IirrE ?cfker_mod. have: (#|G : H| %| #|G : H|%:R * '[chi, 'chi_j])%C. by rewrite dvdC_mulr ?Cint_Cnat ?Cnat_cfdot_char_irr. congr (_ %| _)%C; rewrite (cfdotEl _ Hchi) -(Lagrange sHG) mulnC natrM. rewrite invfM -mulrA mulVKf ?neq0CiG //; congr (_ * _). by apply: eq_bigr => x Hx; rewrite !cfResE. Qed. (* This is Isaacs, Theorem (3.13). *) Theorem faithful_degree_p_part gT (p : nat) (G P : {group gT}) i : cfaithful 'chi[G]_i -> p.-nat (truncC ('chi_i 1%g)) -> p.-Sylow(G) P -> abelian P -> 'chi_i 1%g = (#|G : 'Z(G)|`_p)%:R. Proof. have [p_pr | pr'p] := boolP (prime p); last first. have p'n n: (n > 0)%N -> p^'.-nat n. by move/p'natEpi->; rewrite mem_primes (negPf pr'p). rewrite irr1_degree natCK => _ /pnat_1-> => [_ _|]. by rewrite part_p'nat ?p'n. by rewrite p'n ?irr_degree_gt0. move=> fful_i /p_natP[a Dchi1] sylP cPP. have Dchi1C: 'chi_i 1%g = (p ^ a)%:R by rewrite -Dchi1 irr1_degree natCK. have pa_dv_ZiG: (p ^ a %| #|G : 'Z(G)|)%N. rewrite -dvdC_nat -[pa in (pa %| _)%C]Dchi1C -(cfcenter_fful_irr fful_i). exact: dvd_irr1_index_center. have [sPG pP p'PiG] := and3P sylP. have ZchiP: 'Res[P] 'chi_i \in 'CF(P, P :&: 'Z(G)). apply/cfun_onP=> x; rewrite inE; have [Px | /cfun0->//] := boolP (x \in P). rewrite /= -(cfcenter_fful_irr fful_i) cfResE //. apply: coprime_degree_support_cfcenter. rewrite Dchi1 coprimeXl // prime_coprime // -p'natE //. apply: pnat_dvd p'PiG; rewrite -index_cent1 indexgS // subsetI sPG. by rewrite sub_cent1 (subsetP cPP). have /andP[_ nZG] := center_normal G; have nZP := subset_trans sPG nZG. apply/eqP; rewrite Dchi1C eqr_nat eqn_dvd -{1}(pfactorK a p_pr) -p_part. rewrite partn_dvd //= -dvdC_nat -[pa in (_ %| pa)%C]Dchi1C -card_quotient //=. rewrite -(card_Hall (quotient_pHall nZP sylP)) card_quotient // -indexgI. rewrite -(cfResE _ sPG) // index_support_dvd_degree ?subsetIl ?cPP ?orbT //. by rewrite cfRes_char ?irr_char. Qed. (* This is Isaacs, Lemma (3.14). *) (* Note that the assumption that G be cyclic is unnecessary, as S will be *) (* empty if this is not the case. *) Lemma sum_norm2_char_generators gT (G : {group gT}) (chi : 'CF(G)) : let S := [pred s | generator G s] in chi \is a character -> {in S, forall s, chi s != 0} -> \sum_(s in S) `|chi s| ^+ 2 >= #|S|%:R. Proof. move=> S Nchi nz_chi_S; pose n := #|G|. have [g Sg | S_0] := pickP (generator G); last first. by rewrite eq_card0 // big_pred0 ?lerr. have defG: <[g]> = G by apply/esym/eqP. have [cycG Gg]: cyclic G /\ g \in G by rewrite -defG cycle_cyclic cycle_id. pose I := {k : 'I_n | coprime n k}; pose ItoS (k : I) := (g ^+ sval k)%g. have imItoS: codom ItoS =i S. move=> s; rewrite inE /= /ItoS /I /n /S -defG -orderE. apply/codomP/idP=> [[[i cogi] ->] | Ss]; first by rewrite generator_coprime. have [m ltmg Ds] := cyclePmin (cycle_generator Ss). by rewrite Ds generator_coprime in Ss; apply: ex_intro (Sub (Sub m _) _) _. have /injectiveP injItoS: injective ItoS. move=> k1 k2 /eqP; apply: contraTeq. by rewrite eq_expg_mod_order orderE defG -/n !modn_small. have [Qn galQn [QnC gQnC [eps [pr_eps defQn] QnG]]] := group_num_field_exists G. have{QnG} QnGg := QnG _ G _ _ g (order_dvdG Gg). pose calG := 'Gal({:Qn} / 1). have /fin_all_exists2[ItoQ inItoQ defItoQ] (k : I): exists2 nu, nu \in calG & nu eps = eps ^+ val k. - case: k => [[m _] /=]; rewrite coprime_sym => /Qn_aut_exists[nuC DnuC]. have [nuQ DnuQ] := restrict_aut_to_normal_num_field QnC nuC. have hom_nu: kHom 1 {:Qn} (linfun nuQ). rewrite k1HomE; apply/ahom_inP. by split=> [u v | ]; rewrite !lfunE ?rmorphM ?rmorph1. have [|nu cGnu Dnu] := kHom_to_gal _ (normalFieldf 1) hom_nu. by rewrite !subvf. exists nu => //; apply: (fmorph_inj QnC). rewrite -Dnu ?memvf // lfunE DnuQ rmorphX DnuC //. by rewrite prim_expr_order // fmorph_primitive_root. have{defQn} imItoQ: calG = ItoQ @: {:I}. apply/setP=> nu; apply/idP/imsetP=> [cGnu | [k _ ->] //]. have pr_nu_e: n.-primitive_root (nu eps) by rewrite fmorph_primitive_root. have [i Dnue] := prim_rootP pr_eps (prim_expr_order pr_nu_e). rewrite Dnue prim_root_exp_coprime // coprime_sym in pr_nu_e. apply: ex_intro2 (Sub i _) _ _ => //; apply/eqP. rewrite /calG /= -defQn in ItoQ inItoQ defItoQ nu cGnu Dnue *. by rewrite gal_adjoin_eq // defItoQ -Dnue. have injItoQ: {in {:I} &, injective ItoQ}. move=> k1 k2 _ _ /(congr1 (fun nu : gal_of _ => nu eps))/eqP. by apply: contraTeq; rewrite !defItoQ (eq_prim_root_expr pr_eps) !modn_small. pose pi1 := \prod_(s in S) chi s; pose pi2 := \prod_(s in S) `|chi s| ^+ 2. have Qpi1: pi1 \in Crat. have [a Da] := QnGg _ Nchi; suffices ->: pi1 = QnC (galNorm 1 {:Qn} a). have /vlineP[q ->] := mem_galNorm galQn (memvf a). by rewrite rmorphZ_num rmorph1 mulr1 Crat_rat. rewrite /galNorm rmorph_prod -/calG imItoQ big_imset //=. rewrite /pi1 -(eq_bigl _ _ imItoS) -big_uniq // big_image /=. apply: eq_bigr => k _; have [nuC DnuC] := gQnC (ItoQ k); rewrite DnuC Da. have [r ->] := char_sum_irr Nchi; rewrite !sum_cfunE rmorph_sum. apply: eq_bigr => i _; have /QnGg[b Db] := irr_char i. have Lchi_i: 'chi_i \is a linear_char by rewrite irr_cyclic_lin. have /(prim_rootP pr_eps)[m Dem]: b ^+ n = 1. apply/eqP; rewrite -(fmorph_eq1 QnC) rmorphX Db -lin_charX //. by rewrite -expg_mod_order orderE defG modnn lin_char1. rewrite -Db -DnuC Dem rmorphX /= defItoQ exprAC -{m}Dem rmorphX {b}Db. by rewrite lin_charX. clear I ItoS imItoS injItoS ItoQ inItoQ defItoQ imItoQ injItoQ. clear Qn galQn QnC gQnC eps pr_eps QnGg calG. have{Qpi1} Zpi1: pi1 \in Cint. by rewrite Cint_rat_Aint // rpred_prod // => s _; apply: Aint_char. have{pi1 Zpi1} pi2_ge1: 1 <= pi2. have ->: pi2 = `|pi1| ^+ 2. by rewrite (big_morph Num.norm (@normrM _) (@normr1 _)) -prodrXl. 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. rewrite -(expr_ge1 Sgt0); last by rewrite divr_ge0 ?ler0n ?sumr_ge0. 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 (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. rewrite -sumr_const !(partition_big_imset (fun s => <[s]>)) /=. apply: ler_sum => _ /imsetP[g /setD1P[ntg Gg] ->]. have sgG: <[g]> \subset G by rewrite cycle_subG. pose S := [pred s | generator <[g]> s]; pose chi := 'Res[<[g]>] 'chi_i. have defS: [pred s in G^# | <[s]> == <[g]>] =i S. move=> s; rewrite inE /= eq_sym andb_idl // !inE -cycle_eq1 -cycle_subG. by move/eqP <-; rewrite cycle_eq1 ntg. have resS: {in S, 'chi_i =1 chi}. by move=> s /cycle_generator=> g_s; rewrite cfResE ?cycle_subG. rewrite !(eq_bigl _ _ defS) sumr_const. rewrite (eq_bigr (fun s => `|chi s| ^+ 2)) => [|s /resS-> //]. apply: sum_norm2_char_generators => [|s Ss]. by rewrite cfRes_char ?irr_char. by rewrite -resS // nz_chi ?(subsetP sgG) ?cycle_generator. Qed. End MoreIntegralChar. math-comp-mathcomp-1.12.0/mathcomp/character/mxabelem.v000066400000000000000000001260401375767750300230420ustar00rootroot00000000000000(* (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 ssralg poly finset fingroup morphism perm. From mathcomp Require Import automorphism quotient gproduct action finalg. From mathcomp Require Import zmodp commutator cyclic center pgroup gseries. From mathcomp Require Import nilpotent sylow maximal abelian matrix. From mathcomp Require Import mxalgebra mxrepresentation. (******************************************************************************) (* This file completes the theory developed in mxrepresentation.v with the *) (* construction and properties of linear representations over finite fields, *) (* and in particular the correspondence between internal action on a (normal) *) (* elementary abelian p-subgroup and a linear representation on an Fp-module. *) (* We provide the following next constructions for a finite field F: *) (* 'Zm%act == the action of {unit F} on 'M[F]_(m, n). *) (* rowg A == the additive group of 'rV[F]_n spanned by the row space *) (* of the matrix A. *) (* rowg_mx L == the partial inverse to rowg; for any 'Zm-stable group L *) (* of 'rV[F]_n we have rowg (rowg_mx L) = L. *) (* GLrepr F n == the natural, faithful representation of 'GL_n[F]. *) (* reprGLm rG == the morphism G >-> 'GL_n[F] equivalent to the *) (* representation r of G (with rG : mx_repr r G). *) (* ('MR rG)%act == the action of G on 'rV[F]_n equivalent to the *) (* representation r of G (with rG : mx_repr r G). *) (* The second set of constructions defines the interpretation of a normal *) (* non-trivial elementary abelian p-subgroup as an 'F_p module. We assume *) (* abelE : p.-abelem E and ntE : E != 1, throughout, as these are needed to *) (* build the isomorphism between E and a nontrivial 'rV['F_p]_n. *) (* 'rV(E) == the type of row vectors of the 'F_p module equivalent *) (* to E when E is a non-trivial p.-abelem group. *) (* 'M(E) == the type of matrices corresponding to E. *) (* 'dim E == the width of vectors/matrices in 'rV(E) / 'M(E). *) (* abelem_rV abelE ntE == the one-to-one injection of E onto 'rV(E). *) (* rVabelem abelE ntE == the one-to-one projection of 'rV(E) onto E. *) (* abelem_repr abelE ntE nEG == the representation of G on 'rV(E) that is *) (* equivalent to conjugation by G in E; here abelE, ntE are *) (* as above, and G \subset 'N(E). *) (* This file end with basic results on p-modular representations of p-groups, *) (* and theorems giving the structure of the representation of extraspecial *) (* groups; these results use somewhat more advanced group theory than the *) (* rest of mxrepresentation, in particular, results of sylow.v and maximal.v. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope abelem_scope. Import GroupScope GRing.Theory FinRing.Theory. Local Open Scope ring_scope. (* Special results for representations on a finite field. In this case, the *) (* representation is equivalent to a morphism into the general linear group *) (* 'GL_n[F]. It is furthermore equivalent to a group action on the finite *) (* additive group of the corresponding row space 'rV_n. In addition, row *) (* spaces of matrices in 'M[F]_n correspond to subgroups of that vector group *) (* (this is only surjective when F is a prime field 'F_p), with moduleules *) (* corresponding to subgroups stabilized by the external action. *) Section FinRingRepr. Variable (R : finComUnitRingType) (gT : finGroupType). Variables (G : {group gT}) (n : nat) (rG : mx_representation R G n). Definition mx_repr_act (u : 'rV_n) x := u *m rG (val (subg G x)). Lemma mx_repr_actE u x : x \in G -> mx_repr_act u x = u *m rG x. Proof. by move=> Gx; rewrite /mx_repr_act /= subgK. Qed. Fact mx_repr_is_action : is_action G mx_repr_act. Proof. split=> [x | u x y Gx Gy]; first exact: can_inj (repr_mxK _ (subgP _)). by rewrite !mx_repr_actE ?groupM // -mulmxA repr_mxM. Qed. Canonical Structure mx_repr_action := Action mx_repr_is_action. Fact mx_repr_is_groupAction : is_groupAction [set: 'rV[R]_n] mx_repr_action. Proof. move=> x Gx /=; rewrite !inE. apply/andP; split; first by apply/subsetP=> u; rewrite !inE. by apply/morphicP=> /= u v _ _; rewrite !actpermE /= /mx_repr_act mulmxDl. Qed. Canonical Structure mx_repr_groupAction := GroupAction mx_repr_is_groupAction. End FinRingRepr. Notation "''MR' rG" := (mx_repr_action rG) (at level 10, rG at level 8) : action_scope. Notation "''MR' rG" := (mx_repr_groupAction rG) : groupAction_scope. Section FinFieldRepr. Variable F : finFieldType. (* The external group action (by scaling) of the multiplicative unit group *) (* of the finite field, and the correspondence between additive subgroups *) (* of row vectors that are stable by this action, and the matrix row spaces. *) Section ScaleAction. Variables m n : nat. Definition scale_act (A : 'M[F]_(m, n)) (a : {unit F}) := val a *: A. Lemma scale_actE A a : scale_act A a = val a *: A. Proof. by []. Qed. Fact scale_is_action : is_action setT scale_act. Proof. apply: is_total_action=> [A | A a b]; rewrite /scale_act ?scale1r //. by rewrite ?scalerA mulrC. Qed. Canonical scale_action := Action scale_is_action. Fact scale_is_groupAction : is_groupAction setT scale_action. Proof. move=> a _ /=; rewrite inE; apply/andP. split; first by apply/subsetP=> A; rewrite !inE. by apply/morphicP=> u A _ _ /=; rewrite !actpermE /= /scale_act scalerDr. Qed. Canonical scale_groupAction := GroupAction scale_is_groupAction. Lemma astab1_scale_act A : A != 0 -> 'C[A | scale_action] = 1%g. Proof. rewrite -mxrank_eq0=> nzA; apply/trivgP/subsetP=> a; apply: contraLR. rewrite !inE -val_eqE -subr_eq0 sub1set !inE => nz_a1. by rewrite -subr_eq0 -scaleN1r -scalerDl -mxrank_eq0 eqmx_scale. Qed. End ScaleAction. Local Notation "'Zm" := (scale_action _ _) (at level 8) : action_scope. Section RowGroup. Variable n : nat. Local Notation rVn := 'rV[F]_n. Definition rowg m (A : 'M[F]_(m, n)) : {set rVn} := [set u | u <= A]%MS. Lemma mem_rowg m A v : (v \in @rowg m A) = (v <= A)%MS. Proof. by rewrite inE. Qed. Fact rowg_group_set m A : group_set (@rowg m A). Proof. by apply/group_setP; split=> [|u v]; rewrite !inE ?sub0mx //; apply: addmx_sub. Qed. Canonical rowg_group m A := Group (@rowg_group_set m A). Lemma rowg_stable m (A : 'M_(m, n)) : [acts setT, on rowg A | 'Zm]. Proof. by apply/actsP=> a _ v; rewrite !inE eqmx_scale // -unitfE (valP a). Qed. Lemma rowgS m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (rowg A \subset rowg B) = (A <= B)%MS. Proof. apply/subsetP/idP=> sAB => [| u]. by apply/row_subP=> i; have:= sAB (row i A); rewrite !inE row_sub => ->. by rewrite !inE => suA; apply: submx_trans sAB. Qed. Lemma eq_rowg m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : (A :=: B)%MS -> rowg A = rowg B. Proof. by move=> eqAB; apply/eqP; rewrite eqEsubset !rowgS !eqAB andbb. Qed. Lemma rowg0 m : rowg (0 : 'M_(m, n)) = 1%g. Proof. by apply/trivgP/subsetP=> v; rewrite !inE eqmx0 submx0. Qed. Lemma rowg1 : rowg 1%:M = setT. Proof. by apply/setP=> x; rewrite !inE submx1. Qed. Lemma trivg_rowg m (A : 'M_(m, n)) : (rowg A == 1%g) = (A == 0). Proof. by rewrite -submx0 -rowgS rowg0 (sameP trivgP eqP). Qed. Definition rowg_mx (L : {set rVn}) := <<\matrix_(i < #|L|) enum_val i>>%MS. Lemma rowgK m (A : 'M_(m, n)) : (rowg_mx (rowg A) :=: A)%MS. Proof. apply/eqmxP; rewrite !genmxE; apply/andP; split. by apply/row_subP=> i; rewrite rowK; have:= enum_valP i; rewrite /= inE. apply/row_subP=> i; set v := row i A. have Av: v \in rowg A by rewrite inE row_sub. by rewrite (eq_row_sub (enum_rank_in Av v)) // rowK enum_rankK_in. Qed. Lemma rowg_mxS (L M : {set 'rV[F]_n}) : L \subset M -> (rowg_mx L <= rowg_mx M)%MS. Proof. move/subsetP=> sLM; rewrite !genmxE; apply/row_subP=> i. rewrite rowK; move: (enum_val i) (sLM _ (enum_valP i)) => v Mv. by rewrite (eq_row_sub (enum_rank_in Mv v)) // rowK enum_rankK_in. Qed. Lemma sub_rowg_mx (L : {set rVn}) : L \subset rowg (rowg_mx L). Proof. apply/subsetP=> v Lv; rewrite inE genmxE. by rewrite (eq_row_sub (enum_rank_in Lv v)) // rowK enum_rankK_in. Qed. Lemma stable_rowg_mxK (L : {group rVn}) : [acts setT, on L | 'Zm] -> rowg (rowg_mx L) = L. Proof. move=> linL; apply/eqP; rewrite eqEsubset sub_rowg_mx andbT. apply/subsetP=> v; rewrite inE genmxE => /submxP[u ->{v}]. rewrite mulmx_sum_row group_prod // => i _. rewrite rowK; move: (enum_val i) (enum_valP i) => v Lv. have [->|] := eqVneq (u 0 i) 0; first by rewrite scale0r group1. by rewrite -unitfE => aP; rewrite ((actsP linL) (FinRing.Unit _ aP)) ?inE. Qed. Lemma rowg_mx1 : rowg_mx 1%g = 0. Proof. by apply/eqP; rewrite -submx0 -(rowg0 0) rowgK sub0mx. Qed. Lemma rowg_mx_eq0 (L : {group rVn}) : (rowg_mx L == 0) = (L :==: 1%g). Proof. rewrite -trivg_rowg; apply/idP/eqP=> [|->]; last by rewrite rowg_mx1 rowg0. exact/contraTeq/subG1_contra/sub_rowg_mx. Qed. Lemma rowgI m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : rowg (A :&: B)%MS = rowg A :&: rowg B. Proof. by apply/setP=> u; rewrite !inE sub_capmx. Qed. Lemma card_rowg m (A : 'M_(m, n)) : #|rowg A| = (#|F| ^ \rank A)%N. Proof. rewrite -[\rank A]mul1n -card_matrix. have injA: injective (mulmxr (row_base A)). have /row_freeP[A' A'K] := row_base_free A. by move=> ?; apply: can_inj (mulmxr A') _ => u; rewrite /= -mulmxA A'K mulmx1. rewrite -(card_image (injA _)); apply: eq_card => v. by rewrite inE -(eq_row_base A) (sameP submxP codomP). Qed. Lemma rowgD m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : rowg (A + B)%MS = (rowg A * rowg B)%g. Proof. apply/eqP; rewrite eq_sym eqEcard mulG_subG /= !rowgS. rewrite addsmxSl addsmxSr -(@leq_pmul2r #|rowg A :&: rowg B|) ?cardG_gt0 //=. by rewrite -mul_cardG -rowgI !card_rowg -!expnD mxrank_sum_cap. Qed. Lemma cprod_rowg m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) : rowg A \* rowg B = rowg (A + B)%MS. Proof. by rewrite rowgD cprodE // (sub_abelian_cent2 (zmod_abelian setT)). Qed. Lemma dprod_rowg m1 m2 (A : 'M[F]_(m1, n)) (B : 'M[F]_(m2, n)) : mxdirect (A + B) -> rowg A \x rowg B = rowg (A + B)%MS. Proof. rewrite (sameP mxdirect_addsP eqP) -trivg_rowg rowgI => /eqP tiAB. by rewrite -cprod_rowg dprodEcp. Qed. Lemma bigcprod_rowg m I r (P : pred I) (A : I -> 'M[F]_n) (B : 'M[F]_(m, n)) : (\sum_(i <- r | P i) A i :=: B)%MS -> \big[cprod/1%g]_(i <- r | P i) rowg (A i) = rowg B. Proof. by move/eq_rowg <-; apply/esym/big_morph=> [? ?|]; rewrite (rowg0, cprod_rowg). Qed. Lemma bigdprod_rowg m (I : finType) (P : pred I) A (B : 'M[F]_(m, n)) : let S := (\sum_(i | P i) A i)%MS in (S :=: B)%MS -> mxdirect S -> \big[dprod/1%g]_(i | P i) rowg (A i) = rowg B. Proof. move=> S defS; rewrite mxdirectE defS /= => /eqP rankB. apply: bigcprod_card_dprod (bigcprod_rowg defS) (eq_leq _). by rewrite card_rowg rankB expn_sum; apply: eq_bigr => i _; rewrite card_rowg. Qed. End RowGroup. Variables (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variable (rG : mx_representation F G n). Fact GL_mx_repr : mx_repr 'GL_n[F] GLval. Proof. by []. Qed. Canonical GLrepr := MxRepresentation GL_mx_repr. Lemma GLmx_faithful : mx_faithful GLrepr. Proof. by apply/subsetP=> A; rewrite !inE mul1mx. Qed. Definition reprGLm x : {'GL_n[F]} := insubd (1%g : {'GL_n[F]}) (rG x). Lemma val_reprGLm x : x \in G -> val (reprGLm x) = rG x. Proof. by move=> Gx; rewrite val_insubd (repr_mx_unitr rG). Qed. Lemma comp_reprGLm : {in G, GLval \o reprGLm =1 rG}. Proof. exact: val_reprGLm. Qed. Lemma reprGLmM : {in G &, {morph reprGLm : x y / x * y}}%g. Proof. by move=> x y Gx Gy; apply: val_inj; rewrite /= !val_reprGLm ?groupM ?repr_mxM. Qed. Canonical reprGL_morphism := Morphism reprGLmM. Lemma ker_reprGLm : 'ker reprGLm = rker rG. Proof. apply/setP=> x; rewrite !inE mul1mx; apply: andb_id2l => Gx. by rewrite -val_eqE val_reprGLm. Qed. Lemma astab_rowg_repr m (A : 'M_(m, n)) : 'C(rowg A | 'MR rG) = rstab rG A. Proof. apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx. apply/subsetP/eqP=> cAx => [|u]; last first. by rewrite !inE mx_repr_actE // => /submxP[u' ->]; rewrite -mulmxA cAx. apply/row_matrixP=> i; apply/eqP; move/implyP: (cAx (row i A)). by rewrite !inE row_sub mx_repr_actE //= row_mul. Qed. Lemma astabs_rowg_repr m (A : 'M_(m, n)) : 'N(rowg A | 'MR rG) = rstabs rG A. Proof. apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx. apply/subsetP/idP=> nAx => [|u]; last first. by rewrite !inE mx_repr_actE // => Au; apply: (submx_trans (submxMr _ Au)). apply/row_subP=> i; move/implyP: (nAx (row i A)). by rewrite !inE row_sub mx_repr_actE //= row_mul. Qed. Lemma acts_rowg (A : 'M_n) : [acts G, on rowg A | 'MR rG] = mxmodule rG A. Proof. by rewrite astabs_rowg_repr. Qed. Lemma astab_setT_repr : 'C(setT | 'MR rG) = rker rG. Proof. by rewrite -rowg1 astab_rowg_repr. Qed. Lemma mx_repr_action_faithful : [faithful G, on setT | 'MR rG] = mx_faithful rG. Proof. by rewrite /faithful astab_setT_repr (setIidPr _) // [rker _]setIdE subsetIl. Qed. Lemma afix_repr (H : {set gT}) : H \subset G -> 'Fix_('MR rG)(H) = rowg (rfix_mx rG H). Proof. move/subsetP=> sHG; apply/setP=> /= u; rewrite !inE. apply/subsetP/rfix_mxP=> cHu x Hx; have:= cHu x Hx; by rewrite !inE /= => /eqP; rewrite mx_repr_actE ?sHG. Qed. Lemma gacent_repr (H : {set gT}) : H \subset G -> 'C_(| 'MR rG)(H) = rowg (rfix_mx rG H). Proof. by move=> sHG; rewrite gacentE // setTI afix_repr. Qed. End FinFieldRepr. Arguments rowg_mx {F n%N} L%g. Notation "''Zm'" := (scale_action _ _ _) (at level 8) : action_scope. Notation "''Zm'" := (scale_groupAction _ _ _) : groupAction_scope. Section MatrixGroups. Implicit Types m n p q : nat. Lemma exponent_mx_group m n q : m > 0 -> n > 0 -> q > 1 -> exponent [set: 'M['Z_q]_(m, n)] = q. Proof. move=> m_gt0 n_gt0 q_gt1; apply/eqP; rewrite eqn_dvd; apply/andP; split. apply/exponentP=> x _; apply/matrixP=> i j; rewrite mulmxnE !mxE. by rewrite -mulr_natr -Zp_nat_mod // modnn mulr0. pose cmx1 := const_mx 1%R : 'M['Z_q]_(m, n). apply: dvdn_trans (dvdn_exponent (in_setT cmx1)). have/matrixP/(_ (Ordinal m_gt0))/(_ (Ordinal n_gt0))/eqP := expg_order cmx1. by rewrite mulmxnE !mxE -order_dvdn order_Zp1 Zp_cast. Qed. Lemma rank_mx_group m n q : 'r([set: 'M['Z_q]_(m, n)]) = (m * n)%N. Proof. wlog q_gt1: q / q > 1 by case: q => [|[|q -> //]] /(_ 2)->. set G := setT; have cGG: abelian G := zmod_abelian _. have [mn0 | ] := posnP (m * n). by rewrite [G](card1_trivg _) ?rank1 // cardsT card_matrix mn0. rewrite muln_gt0 => /andP[m_gt0 n_gt0]. have expG: exponent G = q := exponent_mx_group m_gt0 n_gt0 q_gt1. apply/eqP; rewrite eqn_leq andbC -(leq_exp2l _ _ q_gt1) -{2}expG. have ->: (q ^ (m * n))%N = #|G| by rewrite cardsT card_matrix card_ord Zp_cast. rewrite max_card_abelian //= -grank_abelian //= -/G. pose B : {set 'M['Z_q]_(m, n)} := [set delta_mx ij.1 ij.2 | ij : 'I_m * 'I_n]. suffices ->: G = <>. have ->: (m * n)%N = #|{: 'I_m * 'I_n}| by rewrite card_prod !card_ord. exact: leq_trans (grank_min _) (leq_imset_card _ _). apply/setP=> v; rewrite inE (matrix_sum_delta v). rewrite group_prod // => i _; rewrite group_prod // => j _. rewrite -[v i j]natr_Zp scaler_nat groupX // mem_gen //. by apply/imsetP; exists (i, j). Qed. Lemma mx_group_homocyclic m n q : homocyclic [set: 'M['Z_q]_(m, n)]. Proof. wlog q_gt1: q / q > 1 by case: q => [|[|q -> //]] /(_ 2)->. set G := setT; have cGG: abelian G := zmod_abelian _. rewrite -max_card_abelian //= rank_mx_group cardsT card_matrix card_ord -/G. rewrite {1}Zp_cast //; have [-> // | ] := posnP (m * n). by rewrite muln_gt0 => /andP[m_gt0 n_gt0]; rewrite exponent_mx_group. Qed. Lemma abelian_type_mx_group m n q : q > 1 -> abelian_type [set: 'M['Z_q]_(m, n)] = nseq (m * n) q. Proof. rewrite (abelian_type_homocyclic (mx_group_homocyclic m n q)) rank_mx_group. have [-> // | ] := posnP (m * n); rewrite muln_gt0 => /andP[m_gt0 n_gt0] q_gt1. by rewrite exponent_mx_group. Qed. End MatrixGroups. Delimit Scope abelem_scope with Mg. Open Scope abelem_scope. Definition abelem_dim' (gT : finGroupType) (E : {set gT}) := (logn (pdiv #|E|) #|E|).-1. Arguments abelem_dim' {gT} E%g. Notation "''dim' E" := (abelem_dim' E).+1 (at level 10, E at level 8, format "''dim' E") : abelem_scope. Notation "''rV' ( E )" := 'rV_('dim E) (at level 8, format "''rV' ( E )") : abelem_scope. Notation "''M' ( E )" := 'M_('dim E) (at level 8, format "''M' ( E )") : abelem_scope. Notation "''rV[' F ] ( E )" := 'rV[F]_('dim E) (at level 8, only parsing) : abelem_scope. Notation "''M[' F ] ( E )" := 'M[F]_('dim E) (at level 8, only parsing) : abelem_scope. Section AbelemRepr. Section FpMatrix. Variables p m n : nat. Local Notation Mmn := 'M['F_p]_(m, n). Lemma mx_Fp_abelem : prime p -> p.-abelem [set: Mmn]. Proof. exact: fin_Fp_lmod_abelem. Qed. Lemma mx_Fp_stable (L : {group Mmn}) : [acts setT, on L | 'Zm]. Proof. apply/subsetP=> a _; rewrite !inE; apply/subsetP=> A L_A. by rewrite inE /= /scale_act -[val _]natr_Zp scaler_nat groupX. Qed. End FpMatrix. Section FpRow. Variables p n : nat. Local Notation rVn := 'rV['F_p]_n. Lemma rowg_mxK (L : {group rVn}) : rowg (rowg_mx L) = L. Proof. by apply: stable_rowg_mxK; apply: mx_Fp_stable. Qed. Lemma rowg_mxSK (L : {set rVn}) (M : {group rVn}) : (rowg_mx L <= rowg_mx M)%MS = (L \subset M). Proof. apply/idP/idP; last exact: rowg_mxS. by rewrite -rowgS rowg_mxK; apply/subset_trans/sub_rowg_mx. Qed. Lemma mxrank_rowg (L : {group rVn}) : prime p -> \rank (rowg_mx L) = logn p #|L|. Proof. by move=> p_pr; rewrite -{2}(rowg_mxK L) card_rowg card_Fp ?pfactorK. Qed. End FpRow. Variables (p : nat) (gT : finGroupType) (E : {group gT}). Hypotheses (abelE : p.-abelem E) (ntE : E :!=: 1%g). Let pE : p.-group E := abelem_pgroup abelE. Let p_pr : prime p. Proof. by have [] := pgroup_pdiv pE ntE. Qed. Local Notation n' := (abelem_dim' (gval E)). Local Notation n := n'.+1. Local Notation rVn := 'rV['F_p](gval E). Lemma dim_abelemE : n = logn p #|E|. Proof. rewrite /n'; have [_ _ [k ->]] := pgroup_pdiv pE ntE. by rewrite /pdiv primesX ?primes_prime // pfactorK. Qed. Lemma card_abelem_rV : #|rVn| = #|E|. Proof. by rewrite dim_abelemE card_matrix mul1n card_Fp // -p_part part_pnat_id. Qed. Lemma isog_abelem_rV : E \isog [set: rVn]. Proof. by rewrite (isog_abelem_card _ abelE) cardsT card_abelem_rV mx_Fp_abelem /=. Qed. Local Notation ab_rV_P := (existsP isog_abelem_rV). Definition abelem_rV : gT -> rVn := xchoose ab_rV_P. Local Notation ErV := abelem_rV. Lemma abelem_rV_M : {in E &, {morph ErV : x y / (x * y)%g >-> x + y}}. Proof. by case/misomP: (xchooseP ab_rV_P) => fM _; move/morphicP: fM. Qed. Canonical abelem_rV_morphism := Morphism abelem_rV_M. Lemma abelem_rV_isom : isom E setT ErV. Proof. by case/misomP: (xchooseP ab_rV_P). Qed. Lemma abelem_rV_injm : 'injm ErV. Proof. by case/isomP: abelem_rV_isom. Qed. Lemma abelem_rV_inj : {in E &, injective ErV}. Proof. by apply/injmP; apply: abelem_rV_injm. Qed. Lemma im_abelem_rV : ErV @* E = setT. Proof. by case/isomP: abelem_rV_isom. Qed. Lemma mem_im_abelem_rV u : u \in ErV @* E. Proof. by rewrite im_abelem_rV inE. Qed. Lemma sub_im_abelem_rV mA : subset mA (mem (ErV @* E)). Proof. by rewrite unlock; apply/pred0P=> v /=; rewrite mem_im_abelem_rV. Qed. Hint Resolve mem_im_abelem_rV sub_im_abelem_rV : core. Lemma abelem_rV_1 : ErV 1 = 0%R. Proof. by rewrite morph1. Qed. Lemma abelem_rV_X x i : x \in E -> ErV (x ^+ i) = i%:R *: ErV x. Proof. by move=> Ex; rewrite morphX // scaler_nat. Qed. Lemma abelem_rV_V x : x \in E -> ErV x^-1 = - ErV x. Proof. by move=> Ex; rewrite morphV. Qed. Definition rVabelem : rVn -> gT := invm abelem_rV_injm. Canonical rVabelem_morphism := [morphism of rVabelem]. Local Notation rV_E := rVabelem. Lemma rVabelem0 : rV_E 0 = 1%g. Proof. exact: morph1. Qed. Lemma rVabelemD : {morph rV_E : u v / u + v >-> (u * v)%g}. Proof. by move=> u v /=; rewrite -morphM. Qed. Lemma rVabelemN : {morph rV_E: u / - u >-> (u^-1)%g}. Proof. by move=> u /=; rewrite -morphV. Qed. Lemma rVabelemZ (m : 'F_p) : {morph rV_E : u / m *: u >-> (u ^+ m)%g}. Proof. by move=> u; rewrite /= -morphX -?[(u ^+ m)%g]scaler_nat ?natr_Zp. Qed. Lemma abelem_rV_K : {in E, cancel ErV rV_E}. Proof. exact: invmE. Qed. Lemma rVabelemK : cancel rV_E ErV. Proof. by move=> u; rewrite invmK. Qed. Lemma rVabelem_inj : injective rV_E. Proof. exact: can_inj rVabelemK. Qed. Lemma rVabelem_injm : 'injm rV_E. Proof. exact: injm_invm abelem_rV_injm. Qed. Lemma im_rVabelem : rV_E @* setT = E. Proof. by rewrite -im_abelem_rV im_invm. Qed. Lemma mem_rVabelem u : rV_E u \in E. Proof. by rewrite -im_rVabelem mem_morphim. Qed. Lemma sub_rVabelem L : rV_E @* L \subset E. Proof. by rewrite -[_ @* L]morphimIim im_invm subsetIl. Qed. Hint Resolve mem_rVabelem sub_rVabelem : core. Lemma card_rVabelem L : #|rV_E @* L| = #|L|. Proof. by rewrite card_injm ?rVabelem_injm. Qed. Lemma abelem_rV_mK (H : {set gT}) : H \subset E -> rV_E @* (ErV @* H) = H. Proof. exact: morphim_invm abelem_rV_injm H. Qed. Lemma rVabelem_mK L : ErV @* (rV_E @* L) = L. Proof. by rewrite morphim_invmE morphpreK. Qed. Lemma rVabelem_minj : injective (morphim (MorPhantom rV_E)). Proof. exact: can_inj rVabelem_mK. Qed. Lemma rVabelemS L M : (rV_E @* L \subset rV_E @* M) = (L \subset M). Proof. by rewrite injmSK ?rVabelem_injm. Qed. Lemma abelem_rV_S (H K : {set gT}) : H \subset E -> (ErV @* H \subset ErV @* K) = (H \subset K). Proof. by move=> sHE; rewrite injmSK ?abelem_rV_injm. Qed. Lemma sub_rVabelem_im L (H : {set gT}) : (rV_E @* L \subset H) = (L \subset ErV @* H). Proof. by rewrite sub_morphim_pre ?morphpre_invm. Qed. Lemma sub_abelem_rV_im (H : {set gT}) (L : {set 'rV['F_p]_n}) : H \subset E -> (ErV @* H \subset L) = (H \subset rV_E @* L). Proof. by move=> sHE; rewrite sub_morphim_pre ?morphim_invmE. Qed. Section OneGroup. Variable G : {group gT}. Definition abelem_mx_fun (g : subg_of G) v := ErV ((rV_E v) ^ val g). Definition abelem_mx of G \subset 'N(E) := fun x => lin1_mx (abelem_mx_fun (subg G x)). Hypothesis nEG : G \subset 'N(E). Local Notation r := (abelem_mx nEG). Fact abelem_mx_linear_proof g : linear (abelem_mx_fun g). Proof. rewrite /abelem_mx_fun; case: g => x /= /(subsetP nEG) Nx /= m u v. rewrite rVabelemD rVabelemZ conjMg conjXg. by rewrite abelem_rV_M ?abelem_rV_X ?groupX ?memJ_norm // natr_Zp. Qed. Canonical abelem_mx_linear g := Linear (abelem_mx_linear_proof g). Let rVabelemJmx v x : x \in G -> rV_E (v *m r x) = (rV_E v) ^ x. Proof. move=> Gx; rewrite /= mul_rV_lin1 /= /abelem_mx_fun subgK //. by rewrite abelem_rV_K // memJ_norm // (subsetP nEG). Qed. Fact abelem_mx_repr : mx_repr G r. Proof. split=> [|x y Gx Gy]; apply/row_matrixP=> i; apply: rVabelem_inj. by rewrite rowE -row1 rVabelemJmx // conjg1. by rewrite !rowE mulmxA !rVabelemJmx ?groupM // conjgM. Qed. Canonical abelem_repr := MxRepresentation abelem_mx_repr. Let rG := abelem_repr. Lemma rVabelemJ v x : x \in G -> rV_E (v *m rG x) = (rV_E v) ^ x. Proof. exact: rVabelemJmx. Qed. Lemma abelem_rV_J : {in E & G, forall x y, ErV (x ^ y) = ErV x *m rG y}. Proof. by move=> x y Ex Gy; rewrite -{1}(abelem_rV_K Ex) -rVabelemJ ?rVabelemK. Qed. Lemma abelem_rowgJ m (A : 'M_(m, n)) x : x \in G -> rV_E @* rowg (A *m rG x) = (rV_E @* rowg A) :^ x. Proof. move=> Gx; apply: (canRL (conjsgKV _)); apply/setP=> y. rewrite mem_conjgV !morphim_invmE !inE memJ_norm ?(subsetP nEG) //=. apply: andb_id2l => Ey; rewrite abelem_rV_J //. by rewrite submxMfree // row_free_unit (repr_mx_unit rG). Qed. Lemma rV_abelem_sJ (L : {group gT}) x : x \in G -> L \subset E -> ErV @* (L :^ x) = rowg (rowg_mx (ErV @* L) *m rG x). Proof. move=> Gx sLE; apply: rVabelem_minj; rewrite abelem_rowgJ //. by rewrite rowg_mxK !morphim_invm // -(normsP nEG x Gx) conjSg. Qed. Lemma rstab_abelem m (A : 'M_(m, n)) : rstab rG A = 'C_G(rV_E @* rowg A). Proof. apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx. apply/eqP/centP=> cAx => [_ /morphimP[u _ Au ->]|]. move: Au; rewrite inE => /submxP[u' ->] {u}. by apply/esym/commgP/conjg_fixP; rewrite -rVabelemJ -?mulmxA ?cAx. apply/row_matrixP=> i; apply: rVabelem_inj. by rewrite row_mul rVabelemJ // /conjg -cAx ?mulKg ?mem_morphim // inE row_sub. Qed. Lemma rstabs_abelem m (A : 'M_(m, n)) : rstabs rG A = 'N_G(rV_E @* rowg A). Proof. apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx. by rewrite -rowgS -rVabelemS abelem_rowgJ. Qed. Lemma rstabs_abelemG (L : {group gT}) : L \subset E -> rstabs rG (rowg_mx (ErV @* L)) = 'N_G(L). Proof. by move=> sLE; rewrite rstabs_abelem rowg_mxK morphim_invm. Qed. Lemma mxmodule_abelem m (U : 'M['F_p]_(m, n)) : mxmodule rG U = (G \subset 'N(rV_E @* rowg U)). Proof. by rewrite -subsetIidl -rstabs_abelem. Qed. Lemma mxmodule_abelemG (L : {group gT}) : L \subset E -> mxmodule rG (rowg_mx (ErV @* L)) = (G \subset 'N(L)). Proof. by move=> sLE; rewrite -subsetIidl -rstabs_abelemG. Qed. Lemma mxsimple_abelemP (U : 'M['F_p]_n) : reflect (mxsimple rG U) (minnormal (rV_E @* rowg U) G). Proof. apply: (iffP mingroupP) => [[/andP[ntU modU] minU] | [modU ntU minU]]. split=> [||V modV sVU ntV]; first by rewrite mxmodule_abelem. by apply: contraNneq ntU => ->; rewrite /= rowg0 morphim1. rewrite -rowgS -rVabelemS [_ @* rowg V]minU //. rewrite -subG1 sub_rVabelem_im morphim1 subG1 trivg_rowg ntV /=. by rewrite -mxmodule_abelem. by rewrite rVabelemS rowgS. split=> [|D /andP[ntD nDG sDU]]. rewrite -subG1 sub_rVabelem_im morphim1 subG1 trivg_rowg ntU /=. by rewrite -mxmodule_abelem. apply/eqP; rewrite eqEsubset sDU sub_rVabelem_im /= -rowg_mxSK rowgK. have sDE: D \subset E := subset_trans sDU (sub_rVabelem _). rewrite minU ?mxmodule_abelemG //. by rewrite -rowgS rowg_mxK sub_abelem_rV_im. by rewrite rowg_mx_eq0 (morphim_injm_eq1 abelem_rV_injm). Qed. Lemma mxsimple_abelemGP (L : {group gT}) : L \subset E -> reflect (mxsimple rG (rowg_mx (ErV @* L))) (minnormal L G). Proof. move/abelem_rV_mK=> {2}<-; rewrite -{2}[_ @* L]rowg_mxK. exact: mxsimple_abelemP. Qed. Lemma abelem_mx_irrP : reflect (mx_irreducible rG) (minnormal E G). Proof. by rewrite -[E in minnormal E G]im_rVabelem -rowg1; apply: mxsimple_abelemP. Qed. Lemma rfix_abelem (H : {set gT}) : H \subset G -> (rfix_mx rG H :=: rowg_mx (ErV @* 'C_E(H)%g))%MS. Proof. move/subsetP=> sHG; apply/eqmxP/andP; split. rewrite -rowgS rowg_mxK -sub_rVabelem_im // subsetI sub_rVabelem /=. apply/centsP=> y /morphimP[v _]; rewrite inE => cGv ->{y} x Gx. by apply/commgP/conjg_fixP; rewrite /= -rVabelemJ ?sHG ?(rfix_mxP H _). rewrite genmxE; apply/rfix_mxP=> x Hx; apply/row_matrixP=> i. rewrite row_mul rowK; case/morphimP: (enum_valP i) => z Ez /setIP[_ cHz] ->. by rewrite -abelem_rV_J ?sHG // conjgE (centP cHz) ?mulKg. Qed. Lemma rker_abelem : rker rG = 'C_G(E). Proof. by rewrite /rker rstab_abelem rowg1 im_rVabelem. Qed. Lemma abelem_mx_faithful : 'C_G(E) = 1%g -> mx_faithful rG. Proof. by rewrite /mx_faithful rker_abelem => ->. Qed. End OneGroup. Section SubGroup. Variables G H : {group gT}. Hypotheses (nEG : G \subset 'N(E)) (sHG : H \subset G). Let nEH := subset_trans sHG nEG. Local Notation rG := (abelem_repr nEG). Local Notation rHG := (subg_repr rG sHG). Local Notation rH := (abelem_repr nEH). Lemma eq_abelem_subg_repr : {in H, rHG =1 rH}. Proof. move=> x Hx; apply/row_matrixP=> i; rewrite !rowE !mul_rV_lin1 /=. by rewrite /abelem_mx_fun !subgK ?(subsetP sHG). Qed. Lemma rsim_abelem_subg : mx_rsim rHG rH. Proof. exists 1%:M => // [|x Hx]; first by rewrite row_free_unit unitmx1. by rewrite mul1mx mulmx1 eq_abelem_subg_repr. Qed. Lemma mxmodule_abelem_subg m (U : 'M_(m, n)) : mxmodule rHG U = mxmodule rH U. Proof. apply: eq_subset_r => x; rewrite !inE; apply: andb_id2l => Hx. by rewrite eq_abelem_subg_repr. Qed. Lemma mxsimple_abelem_subg U : mxsimple rHG U <-> mxsimple rH U. Proof. have eq_modH := mxmodule_abelem_subg; rewrite /mxsimple eq_modH. by split=> [] [-> -> minU]; split=> // V; have:= minU V; rewrite eq_modH. Qed. End SubGroup. End AbelemRepr. Arguments rVabelem_inj {p%N gT E%G} abelE ntE [v1%R v2%R] : rename. Section ModularRepresentation. Variables (F : fieldType) (p : nat) (gT : finGroupType). Hypothesis charFp : p \in [char F]. Implicit Types G H : {group gT}. (* This is Gorenstein, Lemma 2.6.3. *) Lemma rfix_pgroup_char G H n (rG : mx_representation F G n) : n > 0 -> p.-group H -> H \subset G -> rfix_mx rG H != 0. Proof. move=> n_gt0 pH sHG; rewrite -(rfix_subg rG sHG). move: {2}_.+1 (ltnSn (n + #|H|)) {rG G sHG}(subg_repr _ _) => m. elim: m gT H pH => // m IHm gT' G pG in n n_gt0 *; rewrite ltnS => le_nG_m rG. apply/eqP=> Gregular; have irrG: mx_irreducible rG. apply/mx_irrP; split=> // U modU; rewrite -mxrank_eq0 -lt0n => Unz. rewrite /row_full eqn_leq rank_leq_col leqNgt; apply/negP=> ltUn. have: rfix_mx (submod_repr modU) G != 0. by apply: IHm => //; apply: leq_trans le_nG_m; rewrite ltn_add2r. by rewrite -mxrank_eq0 (rfix_submod modU) // Gregular capmx0 linear0 mxrank0. have{m le_nG_m IHm} faithfulG: mx_faithful rG. apply/trivgP/eqP/idPn; set C := _ rG => ntC. suffices: rfix_mx (kquo_repr rG) (G / _)%g != 0. by rewrite -mxrank_eq0 rfix_quo // Gregular mxrank0. apply: (IHm _ _ (morphim_pgroup _ _)) => //. by apply: leq_trans le_nG_m; rewrite ltn_add2l ltn_quotient // rstab_sub. have{Gregular} ntG: G :!=: 1%g. apply: contraL n_gt0; move/eqP=> G1; rewrite -leqNgt -(mxrank1 F n). rewrite -(mxrank0 F n n) -Gregular mxrankS //; apply/rfix_mxP=> x. by rewrite {1}G1 mul1mx => /set1P->; rewrite repr_mx1. have p_pr: prime p by case/andP: charFp. have{ntG pG} [z]: {z | z \in 'Z(G) & #[z] = p}; last case/setIP=> Gz cGz ozp. apply: Cauchy => //; apply: contraR ntG; rewrite -p'natE // => p'Z. have pZ: p.-group 'Z(G) by rewrite (pgroupS (center_sub G)). by rewrite (trivg_center_pgroup pG (card1_trivg (pnat_1 pZ p'Z))). have{cGz} cGz1: centgmx rG (rG z - 1%:M). apply/centgmxP=> x Gx; rewrite mulmxBl mulmxBr mulmx1 mul1mx. by rewrite -!repr_mxM // (centP cGz). have{irrG faithfulG cGz1} Urz1: rG z - 1%:M \in unitmx. apply: (mx_Schur irrG) cGz1 _; rewrite subr_eq0. move/implyP: (subsetP faithfulG z). by rewrite !inE Gz mul1mx -order_eq1 ozp -implybNN neq_ltn orbC prime_gt1. do [case: n n_gt0 => // n' _; set n := n'.+1] in rG Urz1 *. have charMp: p \in [char 'M[F]_n]. exact: (rmorph_char (scalar_mx_rmorphism _ _)). have{Urz1}: Frobenius_aut charMp (rG z - 1) \in GRing.unit by rewrite unitrX. rewrite (Frobenius_autB_comm _ (commr1 _)) Frobenius_aut1. by rewrite -[_ (rG z)](repr_mxX rG) // -ozp expg_order repr_mx1 subrr unitr0. Qed. Variables (G : {group gT}) (n : nat) (rG : mx_representation F G n). Lemma pcore_sub_rstab_mxsimple M : mxsimple rG M -> 'O_p(G) \subset rstab rG M. Proof. case=> modM nzM simM; have sGpG := pcore_sub p G. rewrite rfix_mx_rstabC //; set U := rfix_mx _ _. have:= simM (M :&: U)%MS; rewrite sub_capmx submx_refl. apply; rewrite ?capmxSl //. by rewrite capmx_module // normal_rfix_mx_module ?pcore_normal. rewrite -(in_submodK (capmxSl _ _)) val_submod_eq0 -submx0. rewrite -(rfix_submod modM) // submx0 rfix_pgroup_char ?pcore_pgroup //. by rewrite lt0n mxrank_eq0. Qed. Lemma pcore_sub_rker_mx_irr : mx_irreducible rG -> 'O_p(G) \subset rker rG. Proof. exact: pcore_sub_rstab_mxsimple. Qed. (* This is Gorenstein, Lemma 3.1.3. *) Lemma pcore_faithful_mx_irr : mx_irreducible rG -> mx_faithful rG -> 'O_p(G) = 1%g. Proof. move=> irrG ffulG; apply/trivgP; apply: subset_trans ffulG. exact: pcore_sub_rstab_mxsimple. Qed. End ModularRepresentation. Section Extraspecial. Variables (F : fieldType) (gT : finGroupType) (S : {group gT}) (p n : nat). Hypotheses (pS : p.-group S) (esS : extraspecial S). Hypothesis oSpn : #|S| = (p ^ n.*2.+1)%N. Hypotheses (splitF : group_splitting_field F S) (F'S : [char F]^'.-group S). Let p_pr := extraspecial_prime pS esS. Let p_gt0 := prime_gt0 p_pr. Let p_gt1 := prime_gt1 p_pr. Let oZp := card_center_extraspecial pS esS. Let modIp' (i : 'I_p.-1) : (i.+1 %% p = i.+1)%N. Proof. by case: i => i; rewrite /= -ltnS prednK //; apply: modn_small. Qed. (* This is Aschbacher (34.9), parts (1)-(4). *) Theorem extraspecial_repr_structure (sS : irrType F S) : [/\ #|linear_irr sS| = (p ^ n.*2)%N, exists iphi : 'I_p.-1 -> sS, let phi i := irr_repr (iphi i) in [/\ injective iphi, codom iphi =i ~: linear_irr sS, forall i, mx_faithful (phi i), forall z, z \in 'Z(S)^# -> exists2 w, primitive_root_of_unity p w & forall i, phi i z = (w ^+ i.+1)%:M & forall i, irr_degree (iphi i) = (p ^ n)%N] & #|sS| = (p ^ n.*2 + p.-1)%N]. Proof. have [[defPhiS defS'] prZ] := esS; set linS := linear_irr sS. have nb_lin: #|linS| = (p ^ n.*2)%N. rewrite card_linear_irr // -divgS ?der_sub //=. by rewrite oSpn defS' oZp expnS mulKn. have nb_irr: #|sS| = (p ^ n.*2 + p.-1)%N. pose Zcl := classes S ::&: 'Z(S). have cardZcl: #|Zcl| = p. transitivity #|[set [set z] | z in 'Z(S)]|; last first. by rewrite card_imset //; apply: set1_inj. apply: eq_card => zS; apply/setIdP/imsetP=> [[] | [z]]. case/imsetP=> z Sz ->{zS} szSZ. have Zz: z \in 'Z(S) by rewrite (subsetP szSZ) ?class_refl. exists z => //; rewrite inE Sz in Zz. apply/eqP; rewrite eq_sym eqEcard sub1set class_refl cards1. by rewrite -index_cent1 (setIidPl _) ?indexgg // sub_cent1. case/setIP=> Sz cSz ->{zS}; rewrite sub1set inE Sz; split=> //. apply/imsetP; exists z; rewrite //. apply/eqP; rewrite eqEcard sub1set class_refl cards1. by rewrite -index_cent1 (setIidPl _) ?indexgg // sub_cent1. move/eqP: (class_formula S); rewrite (bigID (mem Zcl)) /=. rewrite (eq_bigr (fun _ => 1%N)) => [|zS]; last first. case/andP=> _ /setIdP[/imsetP[z Sz ->{zS}] /subsetIP[_ cSzS]]. rewrite (setIidPl _) ?indexgg // sub_cent1 (subsetP cSzS) //. exact: mem_repr (class_refl S z). rewrite sum1dep_card setIdE (setIidPr _) 1?cardsE ?cardZcl; last first. by apply/subsetP=> zS; rewrite 2!inE => /andP[]. have pn_gt0: p ^ n.*2 > 0 by rewrite expn_gt0 p_gt0. rewrite card_irr // oSpn expnS -(prednK pn_gt0) mulnS eqn_add2l. rewrite (eq_bigr (fun _ => p)) => [|xS]; last first. case/andP=> SxS; rewrite inE SxS; case/imsetP: SxS => x Sx ->{xS} notZxS. have [y Sy ->] := repr_class S x; apply: p_maximal_index => //. apply: cent1_extraspecial_maximal => //; first exact: groupJ. apply: contra notZxS => Zxy; rewrite -{1}(lcoset_id Sy) class_lcoset. rewrite ((_ ^: _ =P [set x ^ y])%g _) ?sub1set // eq_sym eqEcard. rewrite sub1set class_refl cards1 -index_cent1 (setIidPl _) ?indexgg //. by rewrite sub_cent1; apply: subsetP Zxy; apply: subsetIr. rewrite sum_nat_cond_const mulnC eqn_pmul2l //; move/eqP <-. rewrite addSnnS prednK // -cardZcl -[card _](cardsID Zcl) /= addnC. by congr (_ + _)%N; apply: eq_card => t; rewrite !inE andbC // andbAC andbb. have fful_nlin i: i \in ~: linS -> mx_faithful (irr_repr i). rewrite !inE => nlin_phi. apply/trivgP; apply: (TI_center_nil (pgroup_nil pS) (rker_normal _)). rewrite setIC; apply: (prime_TIg prZ); rewrite /= -defS' der1_sub_rker //. exact: socle_irr. have [i0 nlin_i0]: exists i0, i0 \in ~: linS. by apply/card_gt0P; rewrite cardsCs setCK nb_irr nb_lin addKn -subn1 subn_gt0. have [z defZ]: exists z, 'Z(S) = <[z]> by apply/cyclicP; rewrite prime_cyclic. have Zz: z \in 'Z(S) by [rewrite defZ cycle_id]; have [Sz cSz] := setIP Zz. have ozp: #[z] = p by rewrite -oZp defZ. have ntz: z != 1%g by rewrite -order_gt1 ozp. pose phi := irr_repr i0; have irr_phi: mx_irreducible phi := socle_irr i0. pose w := irr_mode i0 z. have phi_z: phi z = w%:M by rewrite /phi irr_center_scalar. have phi_ze e: phi (z ^+ e)%g = (w ^+ e)%:M. by rewrite /phi irr_center_scalar ?groupX ?irr_modeX. have wp1: w ^+ p = 1 by rewrite -irr_modeX // -ozp expg_order irr_mode1. have injw: {in 'Z(S) &, injective (irr_mode i0)}. move=> x y Zx Zy /= eq_xy; have [[Sx _] [Sy _]] := (setIP Zx, setIP Zy). apply: mx_faithful_inj (fful_nlin _ nlin_i0) _ _ Sx Sy _. by rewrite !{1}irr_center_scalar ?eq_xy; first by split. have prim_w e: 0 < e < p -> p.-primitive_root (w ^+ e). case/andP=> e_gt0 lt_e_p; apply/andP; split=> //. apply/eqfunP=> -[d ltdp] /=; rewrite unity_rootE -exprM. rewrite -(irr_mode1 i0) -irr_modeX // (inj_in_eq injw) ?groupX ?group1 //. rewrite -order_dvdn ozp Euclid_dvdM // gtnNdvd //=. move: ltdp; rewrite leq_eqVlt. by case: eqP => [-> _ | _ ltd1p]; rewrite (dvdnn, gtnNdvd). have /cyclicP[a defAutZ]: cyclic (Aut 'Z(S)) by rewrite Aut_prime_cyclic ?ozp. have phi_unitP (i : 'I_p.-1): (i.+1%:R : 'Z_#[z]) \in GRing.unit. by rewrite unitZpE ?order_gt1 // ozp prime_coprime // -lt0n !modIp'. pose ephi i := invm (injm_Zpm a) (Zp_unitm (FinRing.Unit _ (phi_unitP i))). pose j : 'Z_#[z] := val (invm (injm_Zp_unitm z) a). have co_j_p: coprime j p. rewrite coprime_sym /j; case: (invm _ a) => /=. by rewrite ozp /GRing.unit /= Zp_cast. have [alpha Aut_alpha alphaZ] := center_aut_extraspecial pS esS co_j_p. have alpha_i_z i: ((alpha ^+ ephi i) z = z ^+ i.+1)%g. transitivity ((a ^+ ephi i) z)%g. elim: (ephi i : nat) => // e IHe; rewrite !expgS !permM alphaZ //. have Aut_a: a \in Aut 'Z(S) by rewrite defAutZ cycle_id. rewrite -{2}[a](invmK (injm_Zp_unitm z)); last by rewrite im_Zp_unitm -defZ. rewrite /= autE ?cycle_id // -/j /= /cyclem. rewrite -(autmE (groupX _ Aut_a)) -(autmE (groupX _ Aut_alpha)). by rewrite !morphX //= !autmE IHe. rewrite [(a ^+ _)%g](invmK (injm_Zpm a)) /=; last first. by rewrite im_Zpm -defAutZ defZ Aut_aut. by rewrite autE ?cycle_id //= val_Zp_nat ozp ?modIp'. have rphiP i: S :==: autm (groupX (ephi i) Aut_alpha) @* S by rewrite im_autm. pose rphi i := morphim_repr (eqg_repr phi (rphiP i)) (subxx S). have rphi_irr i: mx_irreducible (rphi i) by apply/morphim_mx_irr/eqg_mx_irr. have rphi_fful i: mx_faithful (rphi i). rewrite /mx_faithful rker_morphim rker_eqg. by rewrite (trivgP (fful_nlin _ nlin_i0)) morphpreIdom; apply: injm_autm. have rphi_z i: rphi i z = (w ^+ i.+1)%:M. by rewrite /rphi [phi]lock /= /morphim_mx autmE alpha_i_z -lock phi_ze. pose iphi i := irr_comp sS (rphi i); pose phi_ i := irr_repr (iphi i). have{} phi_ze i e: phi_ i (z ^+ e)%g = (w ^+ (e * i.+1)%N)%:M. rewrite /phi_ !{1}irr_center_scalar ?groupX ?irr_modeX //. suffices ->: irr_mode (iphi i) z = w ^+ i.+1 by rewrite mulnC exprM. have:= mx_rsim_sym (rsim_irr_comp sS F'S (rphi_irr i)). case/mx_rsim_def=> B [B' _ homB]; rewrite /irr_mode homB // rphi_z. rewrite -{1}scalemx1 -scalemxAr -scalemxAl -{1}(repr_mx1 (rphi i)). by rewrite -homB // repr_mx1 scalemx1 mxE. have inj_iphi: injective iphi. move=> i1 i2 eqi12; apply/eqP. move/eqP: (congr1 (fun i => irr_mode i (z ^+ 1)) eqi12). rewrite /irr_mode !{1}[irr_repr _ _]phi_ze !{1}mxE !mul1n. by rewrite (eq_prim_root_expr (prim_w 1%N p_gt1)) !modIp'. have deg_phi i: irr_degree (iphi i) = irr_degree i0. by case: (rsim_irr_comp sS F'S (rphi_irr i)). have im_iphi: codom iphi =i ~: linS. apply/subset_cardP; last apply/subsetP=> _ /codomP[i ->]. by rewrite card_image // card_ord cardsCs setCK nb_irr nb_lin addKn. by rewrite !inE /= (deg_phi i) in nlin_i0 *. split=> //; exists iphi; rewrite -/phi_. split=> // [i | ze | i]. - have sim_i := rsim_irr_comp sS F'S (rphi_irr i). by rewrite -(mx_rsim_faithful sim_i) rphi_fful. - rewrite {1}defZ 2!inE andbC; case/andP. case/cyclePmin=> e; rewrite ozp => lt_e_p ->{ze}. case: (posnP e) => [-> | e_gt0 _]; first by rewrite eqxx. exists (w ^+ e) => [|i]; first by rewrite prim_w ?e_gt0. by rewrite phi_ze exprM. rewrite deg_phi {i}; set d := irr_degree i0. apply/eqP; move/eqP: (sum_irr_degree sS F'S splitF). rewrite (bigID (mem linS)) /= -/irr_degree. rewrite (eq_bigr (fun _ => 1%N)) => [|i]; last by rewrite !inE; move/eqP->. rewrite sum1_card nb_lin. rewrite (eq_bigl (mem (codom iphi))) // => [|i]; last first. by rewrite -in_setC -im_iphi. rewrite (eq_bigr (fun _ => d ^ 2))%N => [|_ /codomP[i ->]]; last first. by rewrite deg_phi. rewrite sum_nat_const card_image // card_ord oSpn (expnS p) -{3}[p]prednK //. rewrite mulSn eqn_add2l eqn_pmul2l; last by rewrite -ltnS prednK. by rewrite -muln2 expnM eqn_sqr. Qed. (* This is the corolloray of the above that is actually used in the proof of *) (* B & G, Theorem 2.5. It encapsulates the dependency on a socle of the *) (* regular representation. *) Variables (m : nat) (rS : mx_representation F S m) (U : 'M[F]_m). Hypotheses (simU : mxsimple rS U) (ffulU : rstab rS U == 1%g). Let sZS := center_sub S. Let rZ := subg_repr rS sZS. Lemma faithful_repr_extraspecial : \rank U = (p ^ n)%N /\ (forall V, mxsimple rS V -> mx_iso rZ U V -> mx_iso rS U V). Proof. suffices IH V: mxsimple rS V -> mx_iso rZ U V -> [&& \rank U == (p ^ n)%N & mxsimple_iso rS U V]. - split=> [|/= V simV isoUV]. by case/andP: (IH U simU (mx_iso_refl _ _)) => /eqP. by case/andP: (IH V simV isoUV) => _ /(mxsimple_isoP simU). move=> simV isoUV; wlog sS: / irrType F S by apply: socle_exists. have [[_ defS'] prZ] := esS. have{prZ} ntZ: 'Z(S) :!=: 1%g by case: eqP prZ => // ->; rewrite cards1. have [_ [iphi]] := extraspecial_repr_structure sS. set phi := fun i => _ => [] [inj_phi im_phi _ phiZ dim_phi] _. have [modU nzU _]:= simU; pose rU := submod_repr modU. have nlinU: \rank U != 1%N. apply/eqP=> /(rker_linear rU); apply/negP; rewrite /rker rstab_submod. by rewrite (eqmx_rstab _ (val_submod1 _)) (eqP ffulU) defS' subG1. have irrU: mx_irreducible rU by apply/submod_mx_irr. have rsimU := rsim_irr_comp sS F'S irrU. set iU := irr_comp sS rU in rsimU; have [_ degU _ _]:= rsimU. have phiUP: iU \in codom iphi by rewrite im_phi !inE -degU. rewrite degU -(f_iinv phiUP) dim_phi eqxx /=; apply/(mxsimple_isoP simU). have [modV _ _]:= simV; pose rV := submod_repr modV. have irrV: mx_irreducible rV by apply/submod_mx_irr. have rsimV := rsim_irr_comp sS F'S irrV. set iV := irr_comp sS rV in rsimV; have [_ degV _ _]:= rsimV. have phiVP: iV \in codom iphi by rewrite im_phi !inE -degV -(mxrank_iso isoUV). pose jU := iinv phiUP; pose jV := iinv phiVP. have [z Zz ntz]:= trivgPn _ ntZ. have [|w prim_w phi_z] := phiZ z; first by rewrite 2!inE ntz. suffices eqjUV: jU == jV. apply/(mx_rsim_iso modU modV); apply: mx_rsim_trans rsimU _. by rewrite -(f_iinv phiUP) -/jU (eqP eqjUV) f_iinv; apply: mx_rsim_sym. have rsimUV: mx_rsim (subg_repr (phi jU) sZS) (subg_repr (phi jV) sZS). have [bU _ bUfree bUhom] := mx_rsim_sym rsimU. have [bV _ bVfree bVhom] := rsimV. have modUZ := mxmodule_subg sZS modU; have modVZ := mxmodule_subg sZS modV. case/(mx_rsim_iso modUZ modVZ): isoUV => [bZ degZ bZfree bZhom]. rewrite /phi !f_iinv; exists (bU *m bZ *m bV)=> [||x Zx]. - by rewrite -degU degZ degV. - by rewrite /row_free !mxrankMfree. have Sx := subsetP sZS x Zx. by rewrite 2!mulmxA bUhom // -(mulmxA _ _ bZ) bZhom // -4!mulmxA bVhom. have{rsimUV} [B [B' _ homB]] := mx_rsim_def rsimUV. have:= eqxx (irr_mode (iphi jU) z); rewrite /irr_mode; set i0 := Ordinal _. rewrite {2}[_ z]homB // ![_ z]phi_z mxE mulr1n -scalemx1 -scalemxAr -scalemxAl. rewrite -(repr_mx1 (subg_repr (phi jV) sZS)) -{B B'}homB // repr_mx1 scalemx1. by rewrite mxE (eq_prim_root_expr prim_w) !modIp'. Qed. End Extraspecial. math-comp-mathcomp-1.12.0/mathcomp/character/mxrepresentation.v000066400000000000000000007371301375767750300246670ustar00rootroot00000000000000(* (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 ssralg poly polydiv finset fingroup morphism. From mathcomp Require Import perm automorphism quotient finalg action zmodp. From mathcomp Require Import commutator cyclic center pgroup matrix mxalgebra. From mathcomp Require Import mxpoly. (******************************************************************************) (* This file provides linkage between classic Group Theory and commutative *) (* algebra -- representation theory. Since general abstract linear algebra is *) (* still being sorted out, we develop the required theory here on the *) (* assumption that all vector spaces are matrix spaces, indeed that most are *) (* row matrix spaces; our representation theory is specialized to the latter *) (* case. We provide many definitions and results of representation theory: *) (* enveloping algebras, reducible, irreducible and absolutely irreducible *) (* representations, representation centralisers, submodules and kernels, *) (* simple and semisimple modules, the Schur lemmas, Maschke's theorem, *) (* components, socles, homomorphisms and isomorphisms, the Jacobson density *) (* theorem, similar representations, the Jordan-Holder theorem, Clifford's *) (* theorem and Wedderburn components, regular representations and the *) (* Wedderburn structure theorem for semisimple group rings, and the *) (* construction of a splitting field of an irreducible representation, and of *) (* reduced, tensored, and factored representations. *) (* mx_representation F G n == the Structure type for representations of G *) (* with n x n matrices with coefficients in F. Note that *) (* rG : mx_representation F G n coerces to a function from *) (* the element type of G to 'M_n, and conversely all such *) (* functions have a Canonical mx_representation. *) (* mx_repr G r <-> r : gT -> 'M_n defines a (matrix) group representation *) (* on G : {set gT} (Prop predicate). *) (* enveloping_algebra_mx rG == a #|G| x (n ^ 2) matrix whose rows are the *) (* mxvec encodings of the image of G under rG, and whose *) (* row space therefore encodes the enveloping algebra of *) (* the representation of G. *) (* rker rG == the kernel of the representation of r on G, i.e., the *) (* subgroup of elements of G mapped to the identity by rG. *) (* mx_faithful rG == the representation rG of G is faithful (its kernel is *) (* trivial). *) (* rfix_mx rG H == an n x n matrix whose row space is the set of vectors *) (* fixed (centralised) by the representation of H by rG. *) (* rcent rG A == the subgroup of G whose representation via rG commutes *) (* with the square matrix A. *) (* rcenter rG == the subgroup of G whose representation via rG consists of *) (* scalar matrices. *) (* centgmx rG f <=> f commutes with every matrix in the representation of G *) (* (i.e., f is a total rG-homomorphism). *) (* rstab rG U == the subgroup of G whose representation via r fixes all *) (* vectors in U, pointwise. *) (* rstabs rG U == the subgroup of G whose representation via r fixes the row *) (* space of U globally. *) (* mxmodule rG U <=> the row-space of the matrix U is a module (globally *) (* invariant) under the representation rG of G. *) (* max_submod rG U V <-> U < V is not a proper is a proper subset of any *) (* proper rG-submodule of V (if both U and V are modules, *) (* then U is a maximal proper submodule of V). *) (* mx_subseries rG Us <=> Us : seq 'M_n is a list of rG-modules *) (* mx_composition_series rG Us <-> Us is an increasing composition series *) (* for an rG-module (namely, last 0 Us). *) (* mxsimple rG M <-> M is a simple rG-module (i.e., minimal and nontrivial) *) (* This is a Prop predicate on square matrices. *) (* mxnonsimple rG U <-> U is constructively not a submodule, that is, U *) (* contains a proper nontrivial submodule. *) (* mxnonsimple_sat rG U == U is not a simple as an rG-module. *) (* This is a bool predicate, which requires a decField *) (* structure on the scalar field. *) (* mxsemisimple rG W <-> W is constructively a direct sum of simple modules. *) (* mxsplits rG V U <-> V splits over U in rG, i.e., U has an rG-invariant *) (* complement in V. *) (* mx_completely_reducible rG V <-> V splits over all its submodules; note *) (* that this is only classically equivalent to stating that *) (* V is semisimple. *) (* mx_irreducible rG <-> the representation rG is irreducible, i.e., the full *) (* module 1%:M of rG is simple. *) (* mx_absolutely_irreducible rG == the representation rG of G is absolutely *) (* irreducible: its enveloping algebra is the full matrix *) (* ring. This is only classically equivalent to the more *) (* standard ``rG does not reduce in any field extension''. *) (* group_splitting_field F G <-> F is a splitting field for the group G: *) (* every irreducible representation of G is absolutely *) (* irreducible. Any field can be embedded classically into a *) (* splitting field. *) (* group_closure_field F gT <-> F is a splitting field for every group *) (* G : {group gT}, and indeed for any section of such a *) (* group. This is a convenient constructive substitute for *) (* algebraic closures, that can be constructed classically. *) (* dom_hom_mx rG f == a square matrix encoding the set of vectors for which *) (* multiplication by the n x n matrix f commutes with the *) (* representation of G, i.e., the largest domain on which *) (* f is an rG homomorphism. *) (* mx_iso rG U V <-> U and V are (constructively) rG-isomorphic; this is *) (* a Prop predicate. *) (* mx_simple_iso rG U V == U and V are rG-isomorphic if one of them is *) (* simple; this is a bool predicate. *) (* cyclic_mx rG u == the cyclic rG-module generated by the row vector u *) (* annihilator_mx rG u == the annihilator of the row vector u in the *) (* enveloping algebra the representation rG. *) (* row_hom_mx rG u == the image of u by the set of all rG-homomorphisms on *) (* its cyclic module, or, equivalently, the null-space of the *) (* annihilator of u. *) (* component_mx rG M == when M is a simple rG-module, the component of M in *) (* the representation rG, i.e. the module generated by all *) (* the (simple) modules rG-isomorphic to M. *) (* socleType rG == a Structure that represents the type of all components *) (* of rG (more precisely, it coerces to such a type via *) (* socle_sort). For sG : socleType, values of type sG (to be *) (* exact, socle_sort sG) coerce to square matrices. For any *) (* representation rG we can construct sG : socleType rG *) (* classically; the socleType structure encapsulates this *) (* use of classical logic. *) (* DecSocleType rG == a socleType rG structure, for a representation over a *) (* decidable field type. DecSocleType rG is opaque. *) (* socle_base W == for W : (sG : socleType), a simple module whose *) (* component is W; socle_simple W and socle_module W are *) (* proofs that socle_base W is a simple module. *) (* socle_mult W == the multiplicity of socle_base W in W : sG. *) (* := \rank W %/ \rank (socle_base W) *) (* Socle sG == the Socle of rG, given sG : socleType rG, i.e., the *) (* (direct) sum of all the components of rG. *) (* mx_rsim rG rG' <-> rG and rG' are similar representations of the same *) (* group G. Note that rG and rG' must then have equal, but *) (* not necessarily convertible, degree. *) (* submod_repr modU == a representation of G on 'rV_(\rank U) equivalent to *) (* the restriction of rG to U (here modU : mxmodule rG U). *) (* socle_repr W := submod_repr (socle_module W) *) (* val/in_submod rG U == the projections resp. from/onto 'rV_(\rank U), *) (* that correspond to submod_repr r G U (these work both on *) (* vectors and row spaces). *) (* factmod_repr modV == a representation of G on 'rV_(\rank (cokermx V)) that *) (* is equivalent to the factor module 'rV_n / V induced by V *) (* and rG (here modV : mxmodule rG V). *) (* val/in_factmod rG U == the projections for factmod_repr r G U. *) (* section_repr modU modV == the restriction to in_factmod V U of the factor *) (* representation factmod_repr modV (for modU : mxmodule rG U *) (* and modV : mxmodule rG V); section_repr modU modV is *) (* irreducible iff max_submod rG U V. *) (* subseries_repr modUs i == the representation for the section module *) (* in_factmod (0 :: Us)`_i Us`_i, where *) (* modUs : mx_subseries rG Us. *) (* series_repr compUs i == the representation for the section module *) (* in_factmod (0 :: Us)`_i Us`_i, where *) (* compUs : mx_composition_series rG Us. The Jordan-Holder *) (* theorem asserts the uniqueness of the set of such *) (* representations, up to similarity and permutation. *) (* regular_repr F G == the regular F-representation of the group G. *) (* group_ring F G == a #|G| x #|G|^2 matrix that encodes the free group *) (* ring of G -- that is, the enveloping algebra of the *) (* regular F-representation of G. *) (* gring_index x == the index corresponding to x \in G in the matrix *) (* encoding of regular_repr and group_ring. *) (* gring_row A == the row vector corresponding to A \in group_ring F G in *) (* the regular FG-module. *) (* gring_proj x A == the 1 x 1 matrix holding the coefficient of x \in G in *) (* (A \in group_ring F G)%MS. *) (* gring_mx rG u == the image of a row vector u of the regular FG-module, *) (* in the enveloping algebra of another representation rG. *) (* gring_op rG A == the image of a matrix of the free group ring of G, *) (* in the enveloping algebra of rG. *) (* gset_mx F G C == the group sum of C in the free group ring of G -- the *) (* sum of the images of all the x \in C in group_ring F G. *) (* classg_base F G == a #|classes G| x #|G|^2 matrix whose rows encode the *) (* group sums of the conjugacy classes of G -- this is a *) (* basis of 'Z(group_ring F G)%MS. *) (* irrType F G == a type indexing irreducible representations of G over a *) (* field F, provided its characteristic does not divide the *) (* order of G; it also indexes Wedderburn subrings. *) (* := socleType (regular_repr F G) *) (* irr_repr i == the irreducible representation corresponding to the *) (* index i : irrType sG *) (* := socle_repr i as i coerces to a component matrix. *) (* 'n_i, irr_degree i == the degree of irr_repr i; the notation is only *) (* active after Open Scope group_ring_scope. *) (* linear_irr sG == the set of sG-indices of linear irreducible *) (* representations of G. *) (* irr_comp sG rG == the sG-index of the unique irreducible representation *) (* similar to rG, at least when rG is irreducible and the *) (* characteristic is coprime. *) (* irr_mode i z == the unique eigenvalue of irr_repr i z, at least when *) (* irr_repr i z is scalar (e.g., when z \in 'Z(G)). *) (* [1 sG]%irr == the index of the principal representation of G, in *) (* sG : irrType F G. The i argument of irr_repr, irr_degree *) (* and irr_mode is in the %irr scope. This notation may be *) (* replaced locally by an interpretation of 1%irr as [1 sG] *) (* for some specific irrType sG. *) (* 'R_i, Wedderburn_subring i == the subring (indeed, the component) of the *) (* free group ring of G corresponding to the component i : sG *) (* of the regular FG-module, where sG : irrType F g. In *) (* coprime characteristic the Wedderburn structure theorem *) (* asserts that the free group ring is the direct sum of *) (* these subrings; as with 'n_i above, the notation is only *) (* active in group_ring_scope. *) (* 'e_i, Wedderburn_id i == the projection of the identity matrix 1%:M on the *) (* Wedderburn subring of i : sG (with sG a socleType). In *) (* coprime characteristic this is the identity element of *) (* the subring, and the basis of its center if the field F is *) (* a splitting field. As 'R_i, 'e_i is in group_ring_scope. *) (* subg_repr rG sHG == the restriction to H of the representation rG of G; *) (* here sHG : H \subset G. *) (* eqg_repr rG eqHG == the representation rG of G viewed a a representation *) (* of H; here eqHG : G == H. *) (* morphpre_repr f rG == the representation of f @*^-1 G obtained by *) (* composing the group morphism f with rG. *) (* morphim_repr rGf sGD == the representation of G induced by a *) (* representation rGf of f @* G; here sGD : G \subset D where *) (* D is the domain of the group morphism f. *) (* rconj_repr rG uB == the conjugate representation x |-> B * rG x * B^-1; *) (* here uB : B \in unitmx. *) (* quo_repr sHK nHG == the representation of G / H induced by rG, given *) (* sHK : H \subset rker rG, and nHG : G \subset 'N(H). *) (* kquo_repr rG == the representation induced on G / rker rG by rG. *) (* map_repr f rG == the representation f \o rG, whose module is the tensor *) (* product of the module of rG with the extension field into *) (* which f : {rmorphism F -> Fstar} embeds F. *) (* 'Cl%act == the transitive action of G on the Wedderburn components of *) (* H, with nsGH : H <| G, given by Clifford's theorem. More *) (* precisely this is a total action of G on socle_sort sH, *) (* where sH : socleType (subg_repr rG (normal_sub sGH)). *) (* We build on the MatrixFormula toolkit to define decision procedures for *) (* the reducibility property: *) (* mxmodule_form rG U == a formula asserting that the interpretation of U is *) (* a module of the representation rG. *) (* mxnonsimple_form rG U == a formula asserting that the interpretation of U *) (* contains a proper nontrivial rG-module. *) (* mxnonsimple_sat rG U <=> mxnonsimple_form rG U is satisfied. *) (* More involved constructions are encapsulated in two Coq submodules: *) (* MatrixGenField == a module that encapsulates the lengthy details of the *) (* construction of appropriate extension fields. We assume we *) (* have an irreducible representation rG of a group G, and a *) (* non-scalar matrix A that centralises rG(G), as this data *) (* is readily extracted from the Jacobson density theorem. It *) (* then follows from Schur's lemma that the ring generated by *) (* A is a field on which the extension of the representation *) (* rG of G is reducible. Note that this is equivalent to the *) (* more traditional quotient of the polynomial ring by an *) (* irreducible polynomial (the minimal polynomial of A), but *) (* much better suited to our needs. *) (* Here are the main definitions of MatrixGenField; they all have three *) (* proofs as arguments: (implicit) rG : mx_repr n G, irrG : mx_irreducible rG *) (* and cGA : centgmx rG A. These ensure the validity of the construction and *) (* allow us to define Canonical instances; we assume degree_mxminpoly A > 1 *) (* (which is equivalent to ~~ is_scalar_mx A) only to prove reducibility. *) (* + gen_of irrG cGA == the carrier type of the field generated by A. It is *) (* at least equipped with a fieldType structure; we also *) (* propagate any decFieldType/finFieldType structures on the *) (* original field. *) (* + gen irrG cGA == the morphism injecting into gen_of irrG cGA. *) (* + groot irrG cGA == the root of mxminpoly A in the gen_of irrG cGA field. *) (* + pval x, rVval x, mxval x == the interpretation of x : gen_of irrG cGA *) (* as a polynomial, a row vector, and a matrix, respectively. *) (* Both irrG and cGA are implicit arguments here. *) (* + gen_repr irrG cGA == an alternative to the field extension *) (* representation, which consists in reconsidering the *) (* original module as a module over the new gen_of field, *) (* thereby DIVIDING the original dimension n by the degree of *) (* the minimal polynomial of A. This can be simpler than the *) (* extension method, is actually required by the proof that *) (* odd groups are p-stable (B & G 6.1-2, and Appendix A), but *) (* is only applicable if G is the LARGEST group represented *) (* by rG (e.g., NOT for B & G 2.6). *) (* + gen_dim A == the dimension of gen_repr irrG cGA (only depends on A). *) (* + in_gen irrG cGA W == the ROWWISE image of a matrix W : 'M[F]_(m, n), *) (* i.e., interpreting W as a sequence of m tow vectors, *) (* under the bijection from rG to gen_repr irrG cGA. *) (* The sequence length m is a maximal implicit argument *) (* passed between the explicit argument cGA and W. *) (* + val_gen W == the ROWWISE image of an 'M[gen_of irrG cGA]_(m, gen_dim A) *) (* matrix W under the bijection from gen_repr irrG cGA to rG. *) (* + rowval_gen W == the ROWSPACE image of W under the bijection from *) (* gen_repr irrG cGA to rG, i.e., a 'M[F]_n matrix whose row *) (* space is the image of the row space of W. *) (* This is the A-ideal generated by val_gen W. *) (* + gen_sat e f <=> f : GRing.formula (gen_of irrG cGA) is satisfied in *) (* environment e : seq (gen_of irrG cGA), provided F has a *) (* decFieldType structure. *) (* + gen_env e, gen_term t, gen_form f == interpretations of environments, *) (* terms, and RING formulas over gen_of irrG cGA as row *) (* vector formulae, used to construct gen_sat. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope irrType_scope. Declare Scope group_ring_scope. Import GroupScope GRing.Theory. Local Open Scope ring_scope. Reserved Notation "''n_' i" (at level 8, i at level 2, format "''n_' i"). Reserved Notation "''R_' i" (at level 8, i at level 2, format "''R_' i"). Reserved Notation "''e_' i" (at level 8, i at level 2, format "''e_' i"). Delimit Scope irrType_scope with irr. Section RingRepr. Variable R : comUnitRingType. Section OneRepresentation. Variable gT : finGroupType. Definition mx_repr (G : {set gT}) n (r : gT -> 'M[R]_n) := r 1%g = 1%:M /\ {in G &, {morph r : x y / (x * y)%g >-> x *m y}}. Structure mx_representation G n := MxRepresentation { repr_mx :> gT -> 'M_n; _ : mx_repr G repr_mx }. Variables (G : {group gT}) (n : nat) (rG : mx_representation G n). Arguments rG _%group_scope : extra scopes. Lemma repr_mx1 : rG 1 = 1%:M. Proof. by case: rG => r []. Qed. Lemma repr_mxM : {in G &, {morph rG : x y / (x * y)%g >-> x *m y}}. Proof. by case: rG => r []. Qed. Lemma repr_mxK m x : x \in G -> cancel ((@mulmx R m n n)^~ (rG x)) (mulmx^~ (rG x^-1)). Proof. by move=> Gx U; rewrite -mulmxA -repr_mxM ?groupV // mulgV repr_mx1 mulmx1. Qed. Lemma repr_mxKV m x : x \in G -> cancel ((@mulmx R m n n)^~ (rG x^-1)) (mulmx^~ (rG x)). Proof. by rewrite -groupV -{3}[x]invgK; apply: repr_mxK. Qed. Lemma repr_mx_unit x : x \in G -> rG x \in unitmx. Proof. by move=> Gx; case/mulmx1_unit: (repr_mxKV Gx 1%:M). Qed. Lemma repr_mxV : {in G, {morph rG : x / x^-1%g >-> invmx x}}. Proof. by move=> x Gx /=; rewrite -[rG x^-1](mulKmx (repr_mx_unit Gx)) mulmxA repr_mxK. Qed. (* This is only used in the group ring construction below, as we only have *) (* developped the theory of matrix subalgebras for F-algebras. *) Definition enveloping_algebra_mx := \matrix_(i < #|G|) mxvec (rG (enum_val i)). Section Stabiliser. Variables (m : nat) (U : 'M[R]_(m, n)). Definition rstab := [set x in G | U *m rG x == U]. Lemma rstab_sub : rstab \subset G. Proof. by apply/subsetP=> x; case/setIdP. Qed. Lemma rstab_group_set : group_set rstab. Proof. apply/group_setP; rewrite inE group1 repr_mx1 mulmx1; split=> //= x y. case/setIdP=> Gx cUx; case/setIdP=> Gy cUy; rewrite inE repr_mxM ?groupM //. by rewrite mulmxA (eqP cUx). Qed. Canonical rstab_group := Group rstab_group_set. End Stabiliser. (* Centralizer subgroup and central homomorphisms. *) Section CentHom. Variable f : 'M[R]_n. Definition rcent := [set x in G | f *m rG x == rG x *m f]. Lemma rcent_sub : rcent \subset G. Proof. by apply/subsetP=> x; case/setIdP. Qed. Lemma rcent_group_set : group_set rcent. Proof. apply/group_setP; rewrite inE group1 repr_mx1 mulmx1 mul1mx; split=> //= x y. case/setIdP=> Gx; move/eqP=> cfx; case/setIdP=> Gy; move/eqP=> cfy. by rewrite inE repr_mxM ?groupM //= -mulmxA -cfy !mulmxA cfx. Qed. Canonical rcent_group := Group rcent_group_set. Definition centgmx := G \subset rcent. Lemma centgmxP : reflect (forall x, x \in G -> f *m rG x = rG x *m f) centgmx. Proof. apply: (iffP subsetP) => cGf x Gx; by have:= cGf x Gx; rewrite !inE Gx /=; move/eqP. Qed. End CentHom. (* Representation kernel, and faithful representations. *) Definition rker := rstab 1%:M. Canonical rker_group := Eval hnf in [group of rker]. Lemma rkerP x : reflect (x \in G /\ rG x = 1%:M) (x \in rker). Proof. by apply: (iffP setIdP) => [] [->]; move/eqP; rewrite mul1mx. Qed. Lemma rker_norm : G \subset 'N(rker). Proof. apply/subsetP=> x Gx; rewrite inE sub_conjg; apply/subsetP=> y. case/rkerP=> Gy ry1; rewrite mem_conjgV !inE groupJ //=. by rewrite !repr_mxM ?groupM ?groupV // ry1 !mulmxA mulmx1 repr_mxKV. Qed. Lemma rker_normal : rker <| G. Proof. by rewrite /normal rstab_sub rker_norm. Qed. Definition mx_faithful := rker \subset [1]. Lemma mx_faithful_inj : mx_faithful -> {in G &, injective rG}. Proof. move=> ffulG x y Gx Gy eq_rGxy; apply/eqP; rewrite eq_mulgV1 -in_set1. rewrite (subsetP ffulG) // inE groupM ?repr_mxM ?groupV //= eq_rGxy. by rewrite mulmxA repr_mxK. Qed. Lemma rker_linear : n = 1%N -> G^`(1)%g \subset rker. Proof. move=> n1; rewrite gen_subG; apply/subsetP=> xy; case/imset2P=> x y Gx Gy ->. rewrite !inE groupR //= /commg mulgA -invMg repr_mxM ?groupV ?groupM //. rewrite mulmxA (can2_eq (repr_mxK _) (repr_mxKV _)) ?groupM //. rewrite !repr_mxV ?repr_mxM ?groupM //; move: (rG x) (rG y). by rewrite n1 => rx ry; rewrite (mx11_scalar rx) scalar_mxC. Qed. (* Representation center. *) Definition rcenter := [set g in G | is_scalar_mx (rG g)]. Fact rcenter_group_set : group_set rcenter. Proof. apply/group_setP; split=> [|x y]. by rewrite inE group1 repr_mx1 scalar_mx_is_scalar. move=> /setIdP[Gx /is_scalar_mxP[a defx]] /setIdP[Gy /is_scalar_mxP[b defy]]. by rewrite !inE groupM ?repr_mxM // defx defy -scalar_mxM ?scalar_mx_is_scalar. Qed. Canonical rcenter_group := Group rcenter_group_set. Lemma rcenter_normal : rcenter <| G. Proof. rewrite /normal /rcenter {1}setIdE subsetIl; apply/subsetP=> x Gx; rewrite inE. apply/subsetP=> _ /imsetP[y /setIdP[Gy /is_scalar_mxP[c rGy]] ->]. rewrite inE !repr_mxM ?groupM ?groupV //= mulmxA rGy scalar_mxC repr_mxKV //. exact: scalar_mx_is_scalar. Qed. End OneRepresentation. Arguments rkerP {gT G n rG x}. Section Proper. Variables (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variable rG : mx_representation G n. Lemma repr_mxMr : {in G &, {morph rG : x y / (x * y)%g >-> x * y}}. Proof. exact: repr_mxM. Qed. Lemma repr_mxVr : {in G, {morph rG : x / (x^-1)%g >-> x^-1}}. Proof. exact: repr_mxV. Qed. Lemma repr_mx_unitr x : x \in G -> rG x \is a GRing.unit. Proof. exact: repr_mx_unit. Qed. Lemma repr_mxX m : {in G, {morph rG : x / (x ^+ m)%g >-> x ^+ m}}. Proof. elim: m => [|m IHm] x Gx; rewrite /= ?repr_mx1 // expgS exprS -IHm //. by rewrite repr_mxM ?groupX. Qed. End Proper. Section ChangeGroup. Variables (gT : finGroupType) (G H : {group gT}) (n : nat). Variables (rG : mx_representation G n). Section SubGroup. Hypothesis sHG : H \subset G. Lemma subg_mx_repr : mx_repr H rG. Proof. by split=> [|x y Hx Hy]; rewrite (repr_mx1, repr_mxM) ?(subsetP sHG). Qed. Definition subg_repr := MxRepresentation subg_mx_repr. Local Notation rH := subg_repr. Lemma rcent_subg U : rcent rH U = H :&: rcent rG U. Proof. by apply/setP=> x; rewrite !inE andbA -in_setI (setIidPl sHG). Qed. Section Stabiliser. Variables (m : nat) (U : 'M[R]_(m, n)). Lemma rstab_subg : rstab rH U = H :&: rstab rG U. Proof. by apply/setP=> x; rewrite !inE andbA -in_setI (setIidPl sHG). Qed. End Stabiliser. Lemma rker_subg : rker rH = H :&: rker rG. Proof. exact: rstab_subg. Qed. Lemma subg_mx_faithful : mx_faithful rG -> mx_faithful rH. Proof. by apply: subset_trans; rewrite rker_subg subsetIr. Qed. End SubGroup. Section SameGroup. Hypothesis eqGH : G :==: H. Lemma eqg_repr_proof : H \subset G. Proof. by rewrite (eqP eqGH). Qed. Definition eqg_repr := subg_repr eqg_repr_proof. Local Notation rH := eqg_repr. Lemma rcent_eqg U : rcent rH U = rcent rG U. Proof. by rewrite rcent_subg -(eqP eqGH) (setIidPr _) ?rcent_sub. Qed. Section Stabiliser. Variables (m : nat) (U : 'M[R]_(m, n)). Lemma rstab_eqg : rstab rH U = rstab rG U. Proof. by rewrite rstab_subg -(eqP eqGH) (setIidPr _) ?rstab_sub. Qed. End Stabiliser. Lemma rker_eqg : rker rH = rker rG. Proof. exact: rstab_eqg. Qed. Lemma eqg_mx_faithful : mx_faithful rH = mx_faithful rG. Proof. by rewrite /mx_faithful rker_eqg. Qed. End SameGroup. End ChangeGroup. Section Morphpre. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Variables (G : {group rT}) (n : nat) (rG : mx_representation G n). Lemma morphpre_mx_repr : mx_repr (f @*^-1 G) (rG \o f). Proof. split=> [|x y]; first by rewrite /= morph1 repr_mx1. case/morphpreP=> Dx Gfx; case/morphpreP=> Dy Gfy. by rewrite /= morphM ?repr_mxM. Qed. Canonical morphpre_repr := MxRepresentation morphpre_mx_repr. Local Notation rGf := morphpre_repr. Section Stabiliser. Variables (m : nat) (U : 'M[R]_(m, n)). Lemma rstab_morphpre : rstab rGf U = f @*^-1 (rstab rG U). Proof. by apply/setP=> x; rewrite !inE andbA. Qed. End Stabiliser. Lemma rker_morphpre : rker rGf = f @*^-1 (rker rG). Proof. exact: rstab_morphpre. Qed. End Morphpre. Section Morphim. Variables (aT rT : finGroupType) (G D : {group aT}) (f : {morphism D >-> rT}). Variables (n : nat) (rGf : mx_representation (f @* G) n). Definition morphim_mx of G \subset D := fun x => rGf (f x). Hypothesis sGD : G \subset D. Lemma morphim_mxE x : morphim_mx sGD x = rGf (f x). Proof. by []. Qed. Let sG_f'fG : G \subset f @*^-1 (f @* G). Proof. by rewrite -sub_morphim_pre. Qed. Lemma morphim_mx_repr : mx_repr G (morphim_mx sGD). Proof. exact: subg_mx_repr (morphpre_repr f rGf) sG_f'fG. Qed. Canonical morphim_repr := MxRepresentation morphim_mx_repr. Local Notation rG := morphim_repr. Section Stabiliser. Variables (m : nat) (U : 'M[R]_(m, n)). Lemma rstab_morphim : rstab rG U = G :&: f @*^-1 rstab rGf U. Proof. by rewrite -rstab_morphpre -(rstab_subg _ sG_f'fG). Qed. End Stabiliser. Lemma rker_morphim : rker rG = G :&: f @*^-1 (rker rGf). Proof. exact: rstab_morphim. Qed. End Morphim. Section Conjugate. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variables (rG : mx_representation G n) (B : 'M[R]_n). Definition rconj_mx of B \in unitmx := fun x => B *m rG x *m invmx B. Hypothesis uB : B \in unitmx. Lemma rconj_mx_repr : mx_repr G (rconj_mx uB). Proof. split=> [|x y Gx Gy]; rewrite /rconj_mx ?repr_mx1 ?mulmx1 ?mulmxV ?repr_mxM //. by rewrite !mulmxA mulmxKV. Qed. Canonical rconj_repr := MxRepresentation rconj_mx_repr. Local Notation rGB := rconj_repr. Lemma rconj_mxE x : rGB x = B *m rG x *m invmx B. Proof. by []. Qed. Lemma rconj_mxJ m (W : 'M_(m, n)) x : W *m rGB x *m B = W *m B *m rG x. Proof. by rewrite !mulmxA mulmxKV. Qed. Lemma rcent_conj A : rcent rGB A = rcent rG (invmx B *m A *m B). Proof. apply/setP=> x; rewrite !inE /= rconj_mxE !mulmxA. rewrite (can2_eq (mulmxKV uB) (mulmxK uB)) -!mulmxA. by rewrite -(can2_eq (mulKVmx uB) (mulKmx uB)). Qed. Lemma rstab_conj m (U : 'M_(m, n)) : rstab rGB U = rstab rG (U *m B). Proof. apply/setP=> x; rewrite !inE /= rconj_mxE !mulmxA. by rewrite (can2_eq (mulmxKV uB) (mulmxK uB)). Qed. Lemma rker_conj : rker rGB = rker rG. Proof. apply/setP=> x; rewrite !inE /= mulmxA (can2_eq (mulmxKV uB) (mulmxK uB)). by rewrite mul1mx -scalar_mxC (inj_eq (can_inj (mulKmx uB))) mul1mx. Qed. Lemma conj_mx_faithful : mx_faithful rGB = mx_faithful rG. Proof. by rewrite /mx_faithful rker_conj. Qed. End Conjugate. Section Quotient. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variable rG : mx_representation G n. Definition quo_mx (H : {set gT}) of H \subset rker rG & G \subset 'N(H) := fun Hx : coset_of H => rG (repr Hx). Section SubQuotient. Variable H : {group gT}. Hypotheses (krH : H \subset rker rG) (nHG : G \subset 'N(H)). Let nHGs := subsetP nHG. Lemma quo_mx_coset x : x \in G -> quo_mx krH nHG (coset H x) = rG x. Proof. move=> Gx; rewrite /quo_mx val_coset ?nHGs //; case: repr_rcosetP => z Hz. by case/rkerP: (subsetP krH z Hz) => Gz rz1; rewrite repr_mxM // rz1 mul1mx. Qed. Lemma quo_mx_repr : mx_repr (G / H)%g (quo_mx krH nHG). Proof. split=> [|Hx Hy]; first by rewrite /quo_mx repr_coset1 repr_mx1. case/morphimP=> x Nx Gx ->{Hx}; case/morphimP=> y Ny Gy ->{Hy}. by rewrite -morphM // !quo_mx_coset ?groupM ?repr_mxM. Qed. Canonical quo_repr := MxRepresentation quo_mx_repr. Local Notation rGH := quo_repr. Lemma quo_repr_coset x : x \in G -> rGH (coset H x) = rG x. Proof. exact: quo_mx_coset. Qed. Lemma rcent_quo A : rcent rGH A = (rcent rG A / H)%g. Proof. apply/setP=> Hx; rewrite !inE. apply/andP/idP=> [[]|]; case/morphimP=> x Nx Gx ->{Hx}. by rewrite quo_repr_coset // => cAx; rewrite mem_morphim // inE Gx. by case/setIdP: Gx => Gx cAx; rewrite quo_repr_coset ?mem_morphim. Qed. Lemma rstab_quo m (U : 'M_(m, n)) : rstab rGH U = (rstab rG U / H)%g. Proof. apply/setP=> Hx; rewrite !inE. apply/andP/idP=> [[]|]; case/morphimP=> x Nx Gx ->{Hx}. by rewrite quo_repr_coset // => nUx; rewrite mem_morphim // inE Gx. by case/setIdP: Gx => Gx nUx; rewrite quo_repr_coset ?mem_morphim. Qed. Lemma rker_quo : rker rGH = (rker rG / H)%g. Proof. exact: rstab_quo. Qed. End SubQuotient. Definition kquo_mx := quo_mx (subxx (rker rG)) (rker_norm rG). Lemma kquo_mxE : kquo_mx = quo_mx (subxx (rker rG)) (rker_norm rG). Proof. by []. Qed. Canonical kquo_repr := @MxRepresentation _ _ _ kquo_mx (quo_mx_repr _ _). Lemma kquo_repr_coset x : x \in G -> kquo_repr (coset (rker rG) x) = rG x. Proof. exact: quo_repr_coset. Qed. Lemma kquo_mx_faithful : mx_faithful kquo_repr. Proof. by rewrite /mx_faithful rker_quo trivg_quotient. Qed. End Quotient. Section Regular. Variables (gT : finGroupType) (G : {group gT}). Local Notation nG := #|pred_of_set (gval G)|. Definition gring_index (x : gT) := enum_rank_in (group1 G) x. Lemma gring_valK : cancel enum_val gring_index. Proof. exact: enum_valK_in. Qed. Lemma gring_indexK : {in G, cancel gring_index enum_val}. Proof. exact: enum_rankK_in. Qed. Definition regular_mx x : 'M[R]_nG := \matrix_i delta_mx 0 (gring_index (enum_val i * x)). Lemma regular_mx_repr : mx_repr G regular_mx. Proof. split=> [|x y Gx Gy]; apply/row_matrixP=> i; rewrite !rowK. by rewrite mulg1 row1 gring_valK. by rewrite row_mul rowK -rowE rowK mulgA gring_indexK // groupM ?enum_valP. Qed. Canonical regular_repr := MxRepresentation regular_mx_repr. Local Notation aG := regular_repr. Definition group_ring := enveloping_algebra_mx aG. Local Notation R_G := group_ring. Definition gring_row : 'M[R]_nG -> 'rV_nG := row (gring_index 1). Canonical gring_row_linear := [linear of gring_row]. Lemma gring_row_mul A B : gring_row (A *m B) = gring_row A *m B. Proof. exact: row_mul. Qed. Definition gring_proj x := row (gring_index x) \o trmx \o gring_row. Canonical gring_proj_linear x := [linear of gring_proj x]. Lemma gring_projE : {in G &, forall x y, gring_proj x (aG y) = (x == y)%:R}. Proof. move=> x y Gx Gy; rewrite /gring_proj /= /gring_row rowK gring_indexK //=. rewrite mul1g trmx_delta rowE mul_delta_mx_cond [delta_mx 0 0]mx11_scalar !mxE. by rewrite /= -(inj_eq (can_inj gring_valK)) !gring_indexK. Qed. Lemma regular_mx_faithful : mx_faithful aG. Proof. apply/subsetP=> x /setIdP[Gx]. rewrite mul1mx inE => /eqP/(congr1 (gring_proj 1%g)). rewrite -(repr_mx1 aG) !gring_projE ?group1 // eqxx eq_sym. by case: (x == _) => // /eqP; rewrite eq_sym oner_eq0. Qed. Section GringMx. Variables (n : nat) (rG : mx_representation G n). Definition gring_mx := vec_mx \o mulmxr (enveloping_algebra_mx rG). Canonical gring_mx_linear := [linear of gring_mx]. Lemma gring_mxJ a x : x \in G -> gring_mx (a *m aG x) = gring_mx a *m rG x. Proof. move=> Gx; rewrite /gring_mx /= ![a *m _]mulmx_sum_row. rewrite !(mulmx_suml, linear_sum); apply: eq_bigr => i _. rewrite linearZ -!scalemxAl linearZ /=; congr (_ *: _) => {a}. rewrite !rowK /= !mxvecK -rowE rowK mxvecK. by rewrite gring_indexK ?groupM ?repr_mxM ?enum_valP. Qed. End GringMx. Lemma gring_mxK : cancel (gring_mx aG) gring_row. Proof. move=> a; rewrite /gring_mx /= mulmx_sum_row !linear_sum. rewrite {2}[a]row_sum_delta; apply: eq_bigr => i _. rewrite !linearZ /= /gring_row !(rowK, mxvecK). by rewrite gring_indexK // mul1g gring_valK. Qed. Section GringOp. Variables (n : nat) (rG : mx_representation G n). Definition gring_op := gring_mx rG \o gring_row. Canonical gring_op_linear := [linear of gring_op]. Lemma gring_opE a : gring_op a = gring_mx rG (gring_row a). Proof. by []. Qed. Lemma gring_opG x : x \in G -> gring_op (aG x) = rG x. Proof. move=> Gx; rewrite gring_opE /gring_row rowK gring_indexK // mul1g. by rewrite /gring_mx /= -rowE rowK mxvecK gring_indexK. Qed. Lemma gring_op1 : gring_op 1%:M = 1%:M. Proof. by rewrite -(repr_mx1 aG) gring_opG ?repr_mx1. Qed. Lemma gring_opJ A b : gring_op (A *m gring_mx aG b) = gring_op A *m gring_mx rG b. Proof. rewrite /gring_mx /= ![b *m _]mulmx_sum_row !linear_sum. apply: eq_bigr => i _; rewrite !linearZ /= !rowK !mxvecK. by rewrite gring_opE gring_row_mul gring_mxJ ?enum_valP. Qed. Lemma gring_op_mx b : gring_op (gring_mx aG b) = gring_mx rG b. Proof. by rewrite -[_ b]mul1mx gring_opJ gring_op1 mul1mx. Qed. Lemma gring_mxA a b : gring_mx rG (a *m gring_mx aG b) = gring_mx rG a *m gring_mx rG b. Proof. by rewrite -(gring_op_mx a) -gring_opJ gring_opE gring_row_mul gring_mxK. Qed. End GringOp. End Regular. End RingRepr. Arguments mx_representation R {gT} G%g n%N. Arguments mx_repr {R gT} G%g {n%N} r. Arguments group_ring R {gT} G%g. Arguments regular_repr R {gT} G%g. Arguments centgmxP {R gT G n rG f}. Arguments rkerP {R gT G n rG x}. Arguments repr_mxK {R gT G%G n%N} rG {m%N} [x%g] Gx. Arguments repr_mxKV {R gT G%G n%N} rG {m%N} [x%g] Gx. Arguments gring_valK {gT G%G} i%R : rename. Arguments gring_indexK {gT G%G} x%g. Arguments gring_mxK {R gT G%G} v%R : rename. Section ChangeOfRing. Variables (aR rR : comUnitRingType) (f : {rmorphism aR -> rR}). Local Notation "A ^f" := (map_mx (GRing.RMorphism.apply f) A) : ring_scope. Variables (gT : finGroupType) (G : {group gT}). Lemma map_regular_mx x : (regular_mx aR G x)^f = regular_mx rR G x. Proof. by apply/matrixP=> i j; rewrite !mxE rmorph_nat. Qed. Lemma map_gring_row (A : 'M_#|G|) : (gring_row A)^f = gring_row A^f. Proof. by rewrite map_row. Qed. Lemma map_gring_proj x (A : 'M_#|G|) : (gring_proj x A)^f = gring_proj x A^f. Proof. by rewrite map_row -map_trmx map_gring_row. Qed. Section OneRepresentation. Variables (n : nat) (rG : mx_representation aR G n). Definition map_repr_mx (f0 : aR -> rR) rG0 (g : gT) : 'M_n := map_mx f0 (rG0 g). Lemma map_mx_repr : mx_repr G (map_repr_mx f rG). Proof. split=> [|x y Gx Gy]; first by rewrite /map_repr_mx repr_mx1 map_mx1. by rewrite -map_mxM -repr_mxM. Qed. Canonical map_repr := MxRepresentation map_mx_repr. Local Notation rGf := map_repr. Lemma map_reprE x : rGf x = (rG x)^f. Proof. by []. Qed. Lemma map_reprJ m (A : 'M_(m, n)) x : (A *m rG x)^f = A^f *m rGf x. Proof. exact: map_mxM. Qed. Lemma map_enveloping_algebra_mx : (enveloping_algebra_mx rG)^f = enveloping_algebra_mx rGf. Proof. by apply/row_matrixP=> i; rewrite -map_row !rowK map_mxvec. Qed. Lemma map_gring_mx a : (gring_mx rG a)^f = gring_mx rGf a^f. Proof. by rewrite map_vec_mx map_mxM map_enveloping_algebra_mx. Qed. Lemma map_gring_op A : (gring_op rG A)^f = gring_op rGf A^f. Proof. by rewrite map_gring_mx map_gring_row. Qed. End OneRepresentation. Lemma map_regular_repr : map_repr (regular_repr aR G) =1 regular_repr rR G. Proof. exact: map_regular_mx. Qed. Lemma map_group_ring : (group_ring aR G)^f = group_ring rR G. Proof. rewrite map_enveloping_algebra_mx; apply/row_matrixP=> i. by rewrite !rowK map_regular_repr. Qed. (* Stabilisers, etc, are only mapped properly for fields. *) End ChangeOfRing. Section FieldRepr. Variable F : fieldType. Section OneRepresentation. Variable gT : finGroupType. Variables (G : {group gT}) (n : nat) (rG : mx_representation F G n). Arguments rG _%group_scope : extra scopes. Local Notation E_G := (enveloping_algebra_mx rG). Lemma repr_mx_free x : x \in G -> row_free (rG x). Proof. by move=> Gx; rewrite row_free_unit repr_mx_unit. Qed. Section Stabilisers. Variables (m : nat) (U : 'M[F]_(m, n)). Definition rstabs := [set x in G | U *m rG x <= U]%MS. Lemma rstabs_sub : rstabs \subset G. Proof. by apply/subsetP=> x /setIdP[]. Qed. Lemma rstabs_group_set : group_set rstabs. Proof. apply/group_setP; rewrite inE group1 repr_mx1 mulmx1. split=> //= x y /setIdP[Gx nUx] /setIdP[Gy]; rewrite inE repr_mxM ?groupM //. by apply: submx_trans; rewrite mulmxA submxMr. Qed. Canonical rstabs_group := Group rstabs_group_set. Lemma rstab_act x m1 (W : 'M_(m1, n)) : x \in rstab rG U -> (W <= U)%MS -> W *m rG x = W. Proof. by case/setIdP=> _ /eqP cUx /submxP[w ->]; rewrite -mulmxA cUx. Qed. Lemma rstabs_act x m1 (W : 'M_(m1, n)) : x \in rstabs -> (W <= U)%MS -> (W *m rG x <= U)%MS. Proof. by case/setIdP=> [_ nUx] sWU; apply: submx_trans nUx; apply: submxMr. Qed. Definition mxmodule := G \subset rstabs. Lemma mxmoduleP : reflect {in G, forall x, U *m rG x <= U}%MS mxmodule. Proof. by apply: (iffP subsetP) => modU x Gx; have:= modU x Gx; rewrite !inE ?Gx. Qed. End Stabilisers. Arguments mxmoduleP {m U}. Lemma rstabS m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (U <= V)%MS -> rstab rG V \subset rstab rG U. Proof. case/submxP=> u ->; apply/subsetP=> x. by rewrite !inE => /andP[-> /= /eqP cVx]; rewrite -mulmxA cVx. Qed. Lemma eqmx_rstab m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (U :=: V)%MS -> rstab rG U = rstab rG V. Proof. by move=> eqUV; apply/eqP; rewrite eqEsubset !rstabS ?eqUV. Qed. Lemma eqmx_rstabs m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (U :=: V)%MS -> rstabs U = rstabs V. Proof. by move=> eqUV; apply/setP=> x; rewrite !inE eqUV (eqmxMr _ eqUV). Qed. Lemma eqmx_module m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (U :=: V)%MS -> mxmodule U = mxmodule V. Proof. by move=> eqUV; rewrite /mxmodule (eqmx_rstabs eqUV). Qed. Lemma mxmodule0 m : mxmodule (0 : 'M_(m, n)). Proof. by apply/mxmoduleP=> x _; rewrite mul0mx. Qed. Lemma mxmodule1 : mxmodule 1%:M. Proof. by apply/mxmoduleP=> x _; rewrite submx1. Qed. Lemma mxmodule_trans m1 m2 (U : 'M_(m1, n)) (W : 'M_(m2, n)) x : mxmodule U -> x \in G -> (W <= U -> W *m rG x <= U)%MS. Proof. by move=> modU Gx sWU; apply: submx_trans (mxmoduleP modU x Gx); apply: submxMr. Qed. Lemma mxmodule_eigenvector m (U : 'M_(m, n)) : mxmodule U -> \rank U = 1%N -> {u : 'rV_n & {a | (U :=: u)%MS & {in G, forall x, u *m rG x = a x *: u}}}. Proof. move=> modU linU; set u := nz_row U; exists u. have defU: (U :=: u)%MS. apply/eqmxP; rewrite andbC -(geq_leqif (mxrank_leqif_eq _)) ?nz_row_sub //. by rewrite linU lt0n mxrank_eq0 nz_row_eq0 -mxrank_eq0 linU. pose a x := (u *m rG x *m pinvmx u) 0 0; exists a => // x Gx. by rewrite -mul_scalar_mx -mx11_scalar mulmxKpV // -defU mxmodule_trans ?defU. Qed. Lemma addsmx_module m1 m2 U V : @mxmodule m1 U -> @mxmodule m2 V -> mxmodule (U + V)%MS. Proof. move=> modU modV; apply/mxmoduleP=> x Gx. by rewrite addsmxMr addsmxS ?(mxmoduleP _ x Gx). Qed. Lemma sumsmx_module I r (P : pred I) U : (forall i, P i -> mxmodule (U i)) -> mxmodule (\sum_(i <- r | P i) U i)%MS. Proof. by move=> modU; elim/big_ind: _; [apply: mxmodule0 | apply: addsmx_module | ]. Qed. Lemma capmx_module m1 m2 U V : @mxmodule m1 U -> @mxmodule m2 V -> mxmodule (U :&: V)%MS. Proof. move=> modU modV; apply/mxmoduleP=> x Gx. by rewrite sub_capmx !mxmodule_trans ?capmxSl ?capmxSr. Qed. Lemma bigcapmx_module I r (P : pred I) U : (forall i, P i -> mxmodule (U i)) -> mxmodule (\bigcap_(i <- r | P i) U i)%MS. Proof. by move=> modU; elim/big_ind: _; [apply: mxmodule1 | apply: capmx_module | ]. Qed. (* Sub- and factor representations induced by a (sub)module. *) Section Submodule. Variable U : 'M[F]_n. Definition val_submod m : 'M_(m, \rank U) -> 'M_(m, n) := mulmxr (row_base U). Definition in_submod m : 'M_(m, n) -> 'M_(m, \rank U) := mulmxr (invmx (row_ebase U) *m pid_mx (\rank U)). Canonical val_submod_linear m := [linear of @val_submod m]. Canonical in_submod_linear m := [linear of @in_submod m]. Lemma val_submodE m W : @val_submod m W = W *m val_submod 1%:M. Proof. by rewrite mulmxA mulmx1. Qed. Lemma in_submodE m W : @in_submod m W = W *m in_submod 1%:M. Proof. by rewrite mulmxA mulmx1. Qed. Lemma val_submod1 : (val_submod 1%:M :=: U)%MS. Proof. by rewrite /val_submod /= mul1mx; apply: eq_row_base. Qed. Lemma val_submodP m W : (@val_submod m W <= U)%MS. Proof. by rewrite mulmx_sub ?eq_row_base. Qed. Lemma val_submodK m : cancel (@val_submod m) (@in_submod m). Proof. move=> W; rewrite /in_submod /= -!mulmxA mulKVmx ?row_ebase_unit //. by rewrite pid_mx_id ?rank_leq_row // pid_mx_1 mulmx1. Qed. Lemma val_submod_inj m : injective (@val_submod m). Proof. exact: can_inj (@val_submodK m). Qed. Lemma val_submodS m1 m2 (V : 'M_(m1, \rank U)) (W : 'M_(m2, \rank U)) : (val_submod V <= val_submod W)%MS = (V <= W)%MS. Proof. apply/idP/idP=> sVW; last exact: submxMr. by rewrite -[V]val_submodK -[W]val_submodK submxMr. Qed. Lemma in_submodK m W : (W <= U)%MS -> val_submod (@in_submod m W) = W. Proof. case/submxP=> w ->; rewrite /val_submod /= -!mulmxA. congr (_ *m _); rewrite -{1}[U]mulmx_ebase !mulmxA mulmxK ?row_ebase_unit //. by rewrite -2!(mulmxA (col_ebase U)) !pid_mx_id ?rank_leq_row // mulmx_ebase. Qed. Lemma val_submod_eq0 m W : (@val_submod m W == 0) = (W == 0). Proof. by rewrite -!submx0 -val_submodS linear0 !(submx0, eqmx0). Qed. Lemma in_submod_eq0 m W : (@in_submod m W == 0) = (W <= U^C)%MS. Proof. apply/eqP/submxP=> [W_U0 | [w ->{W}]]. exists (W *m invmx (row_ebase U)). rewrite mulmxA mulmxBr mulmx1 -(pid_mx_id _ _ _ (leqnn _)). rewrite mulmxA -(mulmxA W) [W *m (_ *m _)]W_U0 mul0mx subr0. by rewrite mulmxKV ?row_ebase_unit. rewrite /in_submod /= -!mulmxA mulKVmx ?row_ebase_unit //. by rewrite mul_copid_mx_pid ?rank_leq_row ?mulmx0. Qed. Lemma mxrank_in_submod m (W : 'M_(m, n)) : (W <= U)%MS -> \rank (in_submod W) = \rank W. Proof. by move=> sWU; apply/eqP; rewrite eqn_leq -{3}(in_submodK sWU) !mxrankM_maxl. Qed. Definition val_factmod m : _ -> 'M_(m, n) := mulmxr (row_base (cokermx U) *m row_ebase U). Definition in_factmod m : 'M_(m, n) -> _ := mulmxr (col_base (cokermx U)). Canonical val_factmod_linear m := [linear of @val_factmod m]. Canonical in_factmod_linear m := [linear of @in_factmod m]. Lemma val_factmodE m W : @val_factmod m W = W *m val_factmod 1%:M. Proof. by rewrite mulmxA mulmx1. Qed. Lemma in_factmodE m W : @in_factmod m W = W *m in_factmod 1%:M. Proof. by rewrite mulmxA mulmx1. Qed. Lemma val_factmodP m W : (@val_factmod m W <= U^C)%MS. Proof. by rewrite mulmx_sub {m W}// (eqmxMr _ (eq_row_base _)) -mulmxA submxMl. Qed. Lemma val_factmodK m : cancel (@val_factmod m) (@in_factmod m). Proof. move=> W /=; rewrite /in_factmod /=; set Uc := cokermx U. apply: (row_free_inj (row_base_free Uc)); rewrite -mulmxA mulmx_base. rewrite /val_factmod /= 2!mulmxA -/Uc mulmxK ?row_ebase_unit //. have /submxP[u ->]: (row_base Uc <= Uc)%MS by rewrite eq_row_base. by rewrite -!mulmxA copid_mx_id ?rank_leq_row. Qed. Lemma val_factmod_inj m : injective (@val_factmod m). Proof. exact: can_inj (@val_factmodK m). Qed. Lemma val_factmodS m1 m2 (V : 'M_(m1, _)) (W : 'M_(m2, _)) : (val_factmod V <= val_factmod W)%MS = (V <= W)%MS. Proof. apply/idP/idP=> sVW; last exact: submxMr. by rewrite -[V]val_factmodK -[W]val_factmodK submxMr. Qed. Lemma val_factmod_eq0 m W : (@val_factmod m W == 0) = (W == 0). Proof. by rewrite -!submx0 -val_factmodS linear0 !(submx0, eqmx0). Qed. Lemma in_factmod_eq0 m (W : 'M_(m, n)) : (in_factmod W == 0) = (W <= U)%MS. Proof. rewrite submxE -!mxrank_eq0 -{2}[_ U]mulmx_base mulmxA. by rewrite (mxrankMfree _ (row_base_free _)). Qed. Lemma in_factmodK m (W : 'M_(m, n)) : (W <= U^C)%MS -> val_factmod (in_factmod W) = W. Proof. case/submxP=> w ->{W}; rewrite /val_factmod /= -2!mulmxA. congr (_ *m _); rewrite (mulmxA (col_base _)) mulmx_base -2!mulmxA. by rewrite mulKVmx ?row_ebase_unit // mulmxA copid_mx_id ?rank_leq_row. Qed. Lemma in_factmod_addsK m (W : 'M_(m, n)) : (in_factmod (U + W)%MS :=: in_factmod W)%MS. Proof. apply: eqmx_trans (addsmxMr _ _ _) _. by rewrite ((_ *m _ =P 0) _) ?in_factmod_eq0 //; apply: adds0mx. Qed. Lemma add_sub_fact_mod m (W : 'M_(m, n)) : val_submod (in_submod W) + val_factmod (in_factmod W) = W. Proof. rewrite /val_submod /val_factmod /= -!mulmxA -mulmxDr. rewrite addrC (mulmxA (pid_mx _)) pid_mx_id // (mulmxA (col_ebase _)). rewrite (mulmxA _ _ (row_ebase _)) mulmx_ebase. rewrite (mulmxA (pid_mx _)) pid_mx_id // mulmxA -mulmxDl -mulmxDr. by rewrite subrK mulmx1 mulmxA mulmxKV ?row_ebase_unit. Qed. Lemma proj_factmodS m (W : 'M_(m, n)) : (val_factmod (in_factmod W) <= U + W)%MS. Proof. by rewrite -{2}[W]add_sub_fact_mod addsmx_addKl ?val_submodP ?addsmxSr. Qed. Lemma in_factmodsK m (W : 'M_(m, n)) : (U <= W)%MS -> (U + val_factmod (in_factmod W) :=: W)%MS. Proof. move/addsmx_idPr; apply: eqmx_trans (eqmx_sym _). by rewrite -{1}[W]add_sub_fact_mod; apply: addsmx_addKl; apply: val_submodP. Qed. Lemma mxrank_in_factmod m (W : 'M_(m, n)) : (\rank (in_factmod W) + \rank U)%N = \rank (U + W). Proof. rewrite -in_factmod_addsK in_factmodE; set fU := in_factmod 1%:M. suffices <-: ((U + W) :&: kermx fU :=: U)%MS by rewrite mxrank_mul_ker. apply: eqmx_trans (capmx_idPr (addsmxSl U W)). apply: cap_eqmx => //; apply/eqmxP/rV_eqP => u. by rewrite (sameP sub_kermxP eqP) -in_factmodE in_factmod_eq0. Qed. Definition submod_mx of mxmodule U := fun x => in_submod (val_submod 1%:M *m rG x). Definition factmod_mx of mxmodule U := fun x => in_factmod (val_factmod 1%:M *m rG x). Hypothesis Umod : mxmodule U. Lemma in_submodJ m (W : 'M_(m, n)) x : (W <= U)%MS -> in_submod (W *m rG x) = in_submod W *m submod_mx Umod x. Proof. move=> sWU; rewrite mulmxA; congr (in_submod _). by rewrite mulmxA -val_submodE in_submodK. Qed. Lemma val_submodJ m (W : 'M_(m, \rank U)) x : x \in G -> val_submod (W *m submod_mx Umod x) = val_submod W *m rG x. Proof. move=> Gx; rewrite 2!(mulmxA W) -val_submodE in_submodK //. by rewrite mxmodule_trans ?val_submodP. Qed. Lemma submod_mx_repr : mx_repr G (submod_mx Umod). Proof. rewrite /submod_mx; split=> [|x y Gx Gy /=]. by rewrite repr_mx1 mulmx1 val_submodK. rewrite -in_submodJ; first by rewrite repr_mxM ?mulmxA. by rewrite mxmodule_trans ?val_submodP. Qed. Canonical submod_repr := MxRepresentation submod_mx_repr. Lemma in_factmodJ m (W : 'M_(m, n)) x : x \in G -> in_factmod (W *m rG x) = in_factmod W *m factmod_mx Umod x. Proof. move=> Gx; rewrite -{1}[W]add_sub_fact_mod mulmxDl linearD /=. apply: (canLR (subrK _)); apply: etrans (_ : 0 = _). apply/eqP; rewrite in_factmod_eq0 (submx_trans _ (mxmoduleP Umod x Gx)) //. by rewrite submxMr ?val_submodP. by rewrite /in_factmod /val_factmod /= !mulmxA mulmx1 ?subrr. Qed. Lemma val_factmodJ m (W : 'M_(m, \rank (cokermx U))) x : x \in G -> val_factmod (W *m factmod_mx Umod x) = val_factmod (in_factmod (val_factmod W *m rG x)). Proof. by move=> Gx; rewrite -{1}[W]val_factmodK -in_factmodJ. Qed. Lemma factmod_mx_repr : mx_repr G (factmod_mx Umod). Proof. split=> [|x y Gx Gy /=]. by rewrite /factmod_mx repr_mx1 mulmx1 val_factmodK. by rewrite -in_factmodJ // -mulmxA -repr_mxM. Qed. Canonical factmod_repr := MxRepresentation factmod_mx_repr. (* For character theory. *) Lemma mxtrace_sub_fact_mod x : \tr (submod_repr x) + \tr (factmod_repr x) = \tr (rG x). Proof. rewrite -[submod_repr x]mulmxA mxtrace_mulC -val_submodE addrC. rewrite -[factmod_repr x]mulmxA mxtrace_mulC -val_factmodE addrC. by rewrite -mxtraceD add_sub_fact_mod. Qed. End Submodule. (* Properties of enveloping algebra as a subspace of 'rV_(n ^ 2). *) Lemma envelop_mx_id x : x \in G -> (rG x \in E_G)%MS. Proof. by move=> Gx; rewrite (eq_row_sub (enum_rank_in Gx x)) // rowK enum_rankK_in. Qed. Lemma envelop_mx1 : (1%:M \in E_G)%MS. Proof. by rewrite -(repr_mx1 rG) envelop_mx_id. Qed. Lemma envelop_mxP A : reflect (exists a, A = \sum_(x in G) a x *: rG x) (A \in E_G)%MS. Proof. have G_1 := group1 G; have bijG := enum_val_bij_in G_1. set h := enum_val in bijG; have Gh: h _ \in G by apply: enum_valP. apply: (iffP submxP) => [[u defA] | [a ->]]. exists (fun x => u 0 (enum_rank_in G_1 x)); apply: (can_inj mxvecK). rewrite defA mulmx_sum_row linear_sum (reindex h) //=. by apply: eq_big => [i | i _]; rewrite ?Gh // rowK linearZ enum_valK_in. exists (\row_i a (h i)); rewrite mulmx_sum_row linear_sum (reindex h) //=. by apply: eq_big => [i | i _]; rewrite ?Gh // mxE rowK linearZ. Qed. Lemma envelop_mxM A B : (A \in E_G -> B \in E_G -> A *m B \in E_G)%MS. Proof. case/envelop_mxP=> a ->{A}; case/envelop_mxP=> b ->{B}. rewrite mulmx_suml !linear_sum summx_sub //= => x Gx. rewrite !linear_sum summx_sub //= => y Gy. rewrite -scalemxAl !(linearZ, scalemx_sub) //= -repr_mxM //. by rewrite envelop_mx_id ?groupM. Qed. Lemma mxmodule_envelop m1 m2 (U : 'M_(m1, n)) (W : 'M_(m2, n)) A : (mxmodule U -> mxvec A <= E_G -> W <= U -> W *m A <= U)%MS. Proof. move=> modU /envelop_mxP[a ->] sWU; rewrite linear_sum summx_sub // => x Gx. by rewrite linearZ scalemx_sub ?mxmodule_trans. Qed. (* Module homomorphisms; any square matrix f defines a module homomorphism *) (* over some domain, namely, dom_hom_mx f. *) Definition dom_hom_mx f : 'M_n := kermx (lin1_mx (mxvec \o mulmx (cent_mx_fun E_G f) \o lin_mul_row)). Lemma hom_mxP m f (W : 'M_(m, n)) : reflect (forall x, x \in G -> W *m rG x *m f = W *m f *m rG x) (W <= dom_hom_mx f)%MS. Proof. apply: (iffP row_subP) => [cGf x Gx | cGf i]. apply/row_matrixP=> i; apply/eqP; rewrite -subr_eq0 -!mulmxA -!linearB /=. have:= sub_kermxP (cGf i); rewrite mul_rV_lin1 /=. move/(canRL mxvecK)/row_matrixP/(_ (enum_rank_in Gx x))/eqP; rewrite !linear0. by rewrite !row_mul rowK mul_vec_lin /= mul_vec_lin_row enum_rankK_in. apply/sub_kermxP; rewrite mul_rV_lin1 /=; apply: (canLR vec_mxK). apply/row_matrixP=> j; rewrite !row_mul rowK mul_vec_lin /= mul_vec_lin_row. by rewrite -!row_mul mulmxBr !mulmxA cGf ?enum_valP // subrr !linear0. Qed. Arguments hom_mxP {m f W}. Lemma hom_envelop_mxC m f (W : 'M_(m, n)) A : (W <= dom_hom_mx f -> A \in E_G -> W *m A *m f = W *m f *m A)%MS. Proof. move/hom_mxP=> cWfG /envelop_mxP[a ->]; rewrite !linear_sum mulmx_suml. by apply: eq_bigr => x Gx; rewrite !linearZ -scalemxAl /= cWfG. Qed. Lemma dom_hom_invmx f : f \in unitmx -> (dom_hom_mx (invmx f) :=: dom_hom_mx f *m f)%MS. Proof. move=> injf; set U := dom_hom_mx _; apply/eqmxP. rewrite -{1}[U](mulmxKV injf) submxMr; apply/hom_mxP=> x Gx. by rewrite -[_ *m rG x](hom_mxP _) ?mulmxK. by rewrite -[_ *m rG x](hom_mxP _) ?mulmxKV. Qed. Lemma dom_hom_mx_module f : mxmodule (dom_hom_mx f). Proof. apply/mxmoduleP=> x Gx; apply/hom_mxP=> y Gy. rewrite -[_ *m rG y]mulmxA -repr_mxM // 2?(hom_mxP _) ?groupM //. by rewrite repr_mxM ?mulmxA. Qed. Lemma hom_mxmodule m (U : 'M_(m, n)) f : (U <= dom_hom_mx f)%MS -> mxmodule U -> mxmodule (U *m f). Proof. move/hom_mxP=> cGfU modU; apply/mxmoduleP=> x Gx. by rewrite -cGfU // submxMr // (mxmoduleP modU). Qed. Lemma kermx_hom_module m (U : 'M_(m, n)) f : (U <= dom_hom_mx f)%MS -> mxmodule U -> mxmodule (U :&: kermx f)%MS. Proof. move=> homUf modU; apply/mxmoduleP=> x Gx. rewrite sub_capmx mxmodule_trans ?capmxSl //=. apply/sub_kermxP; rewrite (hom_mxP _) ?(submx_trans (capmxSl _ _)) //. by rewrite (sub_kermxP (capmxSr _ _)) mul0mx. Qed. Lemma scalar_mx_hom a m (U : 'M_(m, n)) : (U <= dom_hom_mx a%:M)%MS. Proof. by apply/hom_mxP=> x Gx; rewrite -!mulmxA scalar_mxC. Qed. Lemma proj_mx_hom (U V : 'M_n) : (U :&: V = 0)%MS -> mxmodule U -> mxmodule V -> (U + V <= dom_hom_mx (proj_mx U V))%MS. Proof. move=> dxUV modU modV; apply/hom_mxP=> x Gx. rewrite -{1}(add_proj_mx dxUV (submx_refl _)) !mulmxDl addrC. rewrite {1}[_ *m _]proj_mx_0 ?add0r //; last first. by rewrite mxmodule_trans ?proj_mx_sub. by rewrite [_ *m _](proj_mx_id dxUV) // mxmodule_trans ?proj_mx_sub. Qed. (* The subspace fixed by a subgroup H of G; it is a module if H <| G. *) (* The definition below is extensionally equivalent to the straightforward *) (* \bigcap_(x in H) kermx (rG x - 1%:M) *) (* but it avoids the dependency on the choice function; this allows it to *) (* commute with ring morphisms. *) Definition rfix_mx (H : {set gT}) := let commrH := \matrix_(i < #|H|) mxvec (rG (enum_val i) - 1%:M) in kermx (lin1_mx (mxvec \o mulmx commrH \o lin_mul_row)). Lemma rfix_mxP m (W : 'M_(m, n)) (H : {set gT}) : reflect (forall x, x \in H -> W *m rG x = W) (W <= rfix_mx H)%MS. Proof. rewrite /rfix_mx; set C := \matrix_i _. apply: (iffP row_subP) => [cHW x Hx | cHW j]. apply/row_matrixP=> j; apply/eqP; rewrite -subr_eq0 row_mul. move/sub_kermxP: {cHW}(cHW j); rewrite mul_rV_lin1 /=; move/(canRL mxvecK). move/row_matrixP/(_ (enum_rank_in Hx x)); rewrite row_mul rowK !linear0. by rewrite enum_rankK_in // mul_vec_lin_row mulmxBr mulmx1 => ->. apply/sub_kermxP; rewrite mul_rV_lin1 /=; apply: (canLR vec_mxK). apply/row_matrixP=> i; rewrite row_mul rowK mul_vec_lin_row -row_mul. by rewrite mulmxBr mulmx1 cHW ?enum_valP // subrr !linear0. Qed. Arguments rfix_mxP {m W}. Lemma rfix_mx_id (H : {set gT}) x : x \in H -> rfix_mx H *m rG x = rfix_mx H. Proof. exact/rfix_mxP. Qed. Lemma rfix_mxS (H K : {set gT}) : H \subset K -> (rfix_mx K <= rfix_mx H)%MS. Proof. by move=> sHK; apply/rfix_mxP=> x Hx; apply: rfix_mxP (subsetP sHK x Hx). Qed. Lemma rfix_mx_conjsg (H : {set gT}) x : x \in G -> H \subset G -> (rfix_mx (H :^ x) :=: rfix_mx H *m rG x)%MS. Proof. move=> Gx sHG; pose rf y := rfix_mx (H :^ y). suffices{x Gx} IH: {in G &, forall y z, rf y *m rG z <= rf (y * z)%g}%MS. apply/eqmxP; rewrite -/(rf x) -[H]conjsg1 -/(rf 1%g). rewrite -{4}[x] mul1g -{1}[rf x](repr_mxKV rG Gx) -{1}(mulgV x). by rewrite submxMr IH ?groupV. move=> x y Gx Gy; apply/rfix_mxP=> zxy; rewrite actM => /imsetP[zx Hzx ->]. have Gzx: zx \in G by apply: subsetP Hzx; rewrite conj_subG. rewrite -mulmxA -repr_mxM ?groupM ?groupV // -conjgC repr_mxM // mulmxA. by rewrite rfix_mx_id. Qed. Lemma norm_sub_rstabs_rfix_mx (H : {set gT}) : H \subset G -> 'N_G(H) \subset rstabs (rfix_mx H). Proof. move=> sHG; apply/subsetP=> x /setIP[Gx nHx]; rewrite inE Gx. apply/rfix_mxP=> y Hy; have Gy := subsetP sHG y Hy. have Hyx: (y ^ x^-1)%g \in H by rewrite memJ_norm ?groupV. rewrite -mulmxA -repr_mxM // conjgCV repr_mxM ?(subsetP sHG _ Hyx) // mulmxA. by rewrite (rfix_mx_id Hyx). Qed. Lemma normal_rfix_mx_module H : H <| G -> mxmodule (rfix_mx H). Proof. case/andP=> sHG nHG. by rewrite /mxmodule -{1}(setIidPl nHG) norm_sub_rstabs_rfix_mx. Qed. Lemma rfix_mx_module : mxmodule (rfix_mx G). Proof. exact: normal_rfix_mx_module. Qed. Lemma rfix_mx_rstabC (H : {set gT}) m (U : 'M[F]_(m, n)) : H \subset G -> (H \subset rstab rG U) = (U <= rfix_mx H)%MS. Proof. move=> sHG; apply/subsetP/rfix_mxP=> cHU x Hx. by rewrite (rstab_act (cHU x Hx)). by rewrite !inE (subsetP sHG) //= cHU. Qed. (* The cyclic module generated by a single vector. *) Definition cyclic_mx u := <>%MS. Lemma cyclic_mxP u v : reflect (exists2 A, A \in E_G & v = u *m A)%MS (v <= cyclic_mx u)%MS. Proof. rewrite genmxE; apply: (iffP submxP) => [[a] | [A /submxP[a defA]]] -> {v}. exists (vec_mx (a *m E_G)); last by rewrite mulmxA mul_rV_lin1. by rewrite vec_mxK submxMl. by exists a; rewrite mulmxA mul_rV_lin1 /= -defA mxvecK. Qed. Arguments cyclic_mxP {u v}. Lemma cyclic_mx_id u : (u <= cyclic_mx u)%MS. Proof. by apply/cyclic_mxP; exists 1%:M; rewrite ?mulmx1 ?envelop_mx1. Qed. Lemma cyclic_mx_eq0 u : (cyclic_mx u == 0) = (u == 0). Proof. rewrite -!submx0; apply/idP/idP. by apply: submx_trans; apply: cyclic_mx_id. move/submx0null->; rewrite genmxE; apply/row_subP=> i. by rewrite row_mul mul_rV_lin1 /= mul0mx ?sub0mx. Qed. Lemma cyclic_mx_module u : mxmodule (cyclic_mx u). Proof. apply/mxmoduleP=> x Gx; apply/row_subP=> i; rewrite row_mul. have [A E_A ->{i}] := @cyclic_mxP u _ (row_sub i _); rewrite -mulmxA. by apply/cyclic_mxP; exists (A *m rG x); rewrite ?envelop_mxM ?envelop_mx_id. Qed. Lemma cyclic_mx_sub m u (W : 'M_(m, n)) : mxmodule W -> (u <= W)%MS -> (cyclic_mx u <= W)%MS. Proof. move=> modU Wu; rewrite genmxE; apply/row_subP=> i. by rewrite row_mul mul_rV_lin1 /= mxmodule_envelop // vec_mxK row_sub. Qed. Lemma hom_cyclic_mx u f : (u <= dom_hom_mx f)%MS -> (cyclic_mx u *m f :=: cyclic_mx (u *m f))%MS. Proof. move=> domf_u; apply/eqmxP; rewrite !(eqmxMr _ (genmxE _)). apply/genmxP; rewrite genmx_id; congr <<_>>%MS; apply/row_matrixP=> i. by rewrite !row_mul !mul_rV_lin1 /= hom_envelop_mxC // vec_mxK row_sub. Qed. (* The annihilator of a single vector. *) Definition annihilator_mx u := (E_G :&: kermx (lin_mul_row u))%MS. Lemma annihilator_mxP u A : reflect (A \in E_G /\ u *m A = 0)%MS (A \in annihilator_mx u)%MS. Proof. rewrite sub_capmx; apply: (iffP andP) => [[-> /sub_kermxP]|[-> uA0]]. by rewrite mul_rV_lin1 /= mxvecK. by split=> //; apply/sub_kermxP; rewrite mul_rV_lin1 /= mxvecK. Qed. (* The subspace of homomorphic images of a row vector. *) Definition row_hom_mx u := (\bigcap_j kermx (vec_mx (row j (annihilator_mx u))))%MS. Lemma row_hom_mxP u v : reflect (exists2 f, u <= dom_hom_mx f & u *m f = v)%MS (v <= row_hom_mx u)%MS. Proof. apply: (iffP sub_bigcapmxP) => [iso_uv | [f hom_uf <-] i _]. have{iso_uv} uv0 A: (A \in E_G)%MS /\ u *m A = 0 -> v *m A = 0. move/annihilator_mxP=> /submxP[a defA]. rewrite -[A]mxvecK {A}defA [a *m _]mulmx_sum_row !linear_sum big1 // => i _. by rewrite !linearZ /= (sub_kermxP _) ?scaler0 ?iso_uv. pose U := E_G *m lin_mul_row u; pose V := E_G *m lin_mul_row v. pose f := pinvmx U *m V. have hom_uv_f x: x \in G -> u *m rG x *m f = v *m rG x. move=> Gx; apply/eqP; rewrite 2!mulmxA mul_rV_lin1 -subr_eq0 -mulmxBr. rewrite uv0 // 2!linearB /= vec_mxK; split. by rewrite addmx_sub ?submxMl // eqmx_opp envelop_mx_id. have Uux: (u *m rG x <= U)%MS. by rewrite -(genmxE U) mxmodule_trans ?cyclic_mx_id ?cyclic_mx_module. by rewrite -{2}(mulmxKpV Uux) [_ *m U]mulmxA mul_rV_lin1 subrr. have def_uf: u *m f = v. by rewrite -[u]mulmx1 -[v]mulmx1 -(repr_mx1 rG) hom_uv_f. by exists f => //; apply/hom_mxP=> x Gx; rewrite def_uf hom_uv_f. apply/sub_kermxP; set A := vec_mx _. have: (A \in annihilator_mx u)%MS by rewrite vec_mxK row_sub. by case/annihilator_mxP => E_A uA0; rewrite -hom_envelop_mxC // uA0 mul0mx. Qed. (* Sub-, isomorphic, simple, semisimple and completely reducible modules. *) (* All these predicates are intuitionistic (since, e.g., testing simplicity *) (* requires a splitting algorithm fo r the mas field). They are all *) (* specialized to square matrices, to avoid spurrious height parameters. *) (* Module isomorphism is an intentional property in general, but it can be *) (* decided when one of the two modules is known to be simple. *) Variant mx_iso (U V : 'M_n) : Prop := MxIso f of f \in unitmx & (U <= dom_hom_mx f)%MS & (U *m f :=: V)%MS. Lemma eqmx_iso U V : (U :=: V)%MS -> mx_iso U V. Proof. by move=> eqUV; exists 1%:M; rewrite ?unitmx1 ?scalar_mx_hom ?mulmx1. Qed. Lemma mx_iso_refl U : mx_iso U U. Proof. exact: eqmx_iso. Qed. Lemma mx_iso_sym U V : mx_iso U V -> mx_iso V U. Proof. case=> f injf homUf defV; exists (invmx f); first by rewrite unitmx_inv. by rewrite dom_hom_invmx // -defV submxMr. by rewrite -[U](mulmxK injf); apply: eqmxMr (eqmx_sym _). Qed. Lemma mx_iso_trans U V W : mx_iso U V -> mx_iso V W -> mx_iso U W. Proof. case=> f injf homUf defV [g injg homVg defW]. exists (f *m g); first by rewrite unitmx_mul injf. by apply/hom_mxP=> x Gx; rewrite !mulmxA 2?(hom_mxP _) ?defV. by rewrite mulmxA; apply: eqmx_trans (eqmxMr g defV) defW. Qed. Lemma mxrank_iso U V : mx_iso U V -> \rank U = \rank V. Proof. by case=> f injf _ <-; rewrite mxrankMfree ?row_free_unit. Qed. Lemma mx_iso_module U V : mx_iso U V -> mxmodule U -> mxmodule V. Proof. by case=> f _ homUf defV; rewrite -(eqmx_module defV); apply: hom_mxmodule. Qed. (* Simple modules (we reserve the term "irreducible" for representations). *) Definition mxsimple (V : 'M_n) := [/\ mxmodule V, V != 0 & forall U : 'M_n, mxmodule U -> (U <= V)%MS -> U != 0 -> (V <= U)%MS]. Definition mxnonsimple (U : 'M_n) := exists V : 'M_n, [&& mxmodule V, (V <= U)%MS, V != 0 & \rank V < \rank U]. Lemma mxsimpleP U : [/\ mxmodule U, U != 0 & ~ mxnonsimple U] <-> mxsimple U. Proof. do [split => [] [modU nzU simU]; split] => // [V modV sVU nzV | [V]]. apply/idPn; rewrite -(ltn_leqif (mxrank_leqif_sup sVU)) => ltVU. by case: simU; exists V; apply/and4P. by case/and4P=> modV sVU nzV; apply/negP; rewrite -leqNgt mxrankS ?simU. Qed. Lemma mxsimple_module U : mxsimple U -> mxmodule U. Proof. by case. Qed. Lemma mxsimple_exists m (U : 'M_(m, n)) : mxmodule U -> U != 0 -> classically (exists2 V, mxsimple V & V <= U)%MS. Proof. move=> modU nzU [] // simU; move: {2}_.+1 (ltnSn (\rank U)) => r leUr. elim: r => // r IHr in m U leUr modU nzU simU. have genU := genmxE U; apply: (simU); exists <>%MS; last by rewrite genU. apply/mxsimpleP; split; rewrite ?(eqmx_eq0 genU) ?(eqmx_module genU) //. case=> V; rewrite !genU=> /and4P[modV sVU nzV ltVU]; case: notF. apply: IHr nzV _ => // [|[W simW sWV]]; first exact: leq_trans ltVU _. by apply: simU; exists W => //; apply: submx_trans sWV sVU. Qed. Lemma mx_iso_simple U V : mx_iso U V -> mxsimple U -> mxsimple V. Proof. move=> isoUV [modU nzU simU]; have [f injf homUf defV] := isoUV. split=> [||W modW sWV nzW]; first by rewrite (mx_iso_module isoUV). by rewrite -(eqmx_eq0 defV) -(mul0mx n f) (can_eq (mulmxK injf)). rewrite -defV -[W](mulmxKV injf) submxMr //; set W' := W *m _. have sW'U: (W' <= U)%MS by rewrite -[U](mulmxK injf) submxMr ?defV. rewrite (simU W') //; last by rewrite -(can_eq (mulmxK injf)) mul0mx mulmxKV. rewrite hom_mxmodule ?dom_hom_invmx // -[W](mulmxKV injf) submxMr //. exact: submx_trans sW'U homUf. Qed. Lemma mxsimple_cyclic u U : mxsimple U -> u != 0 -> (u <= U)%MS -> (U :=: cyclic_mx u)%MS. Proof. case=> [modU _ simU] nz_u Uu; apply/eqmxP; set uG := cyclic_mx u. have s_uG_U: (uG <= U)%MS by rewrite cyclic_mx_sub. by rewrite simU ?cyclic_mx_eq0 ?submx_refl // cyclic_mx_module. Qed. (* The surjective part of Schur's lemma. *) Lemma mx_Schur_onto m (U : 'M_(m, n)) V f : mxmodule U -> mxsimple V -> (U <= dom_hom_mx f)%MS -> (U *m f <= V)%MS -> U *m f != 0 -> (U *m f :=: V)%MS. Proof. move=> modU [modV _ simV] homUf sUfV nzUf. apply/eqmxP; rewrite sUfV -(genmxE (U *m f)). rewrite simV ?(eqmx_eq0 (genmxE _)) ?genmxE //. by rewrite (eqmx_module (genmxE _)) hom_mxmodule. Qed. (* The injective part of Schur's lemma. *) Lemma mx_Schur_inj U f : mxsimple U -> (U <= dom_hom_mx f)%MS -> U *m f != 0 -> (U :&: kermx f)%MS = 0. Proof. case=> [modU _ simU] homUf nzUf; apply/eqP; apply: contraR nzUf => nz_ker. rewrite (sameP eqP sub_kermxP) (sameP capmx_idPl eqmxP) simU ?capmxSl //. exact: kermx_hom_module. Qed. (* The injectve part of Schur's lemma, stated as isomorphism with the image. *) Lemma mx_Schur_inj_iso U f : mxsimple U -> (U <= dom_hom_mx f)%MS -> U *m f != 0 -> mx_iso U (U *m f). Proof. move=> simU homUf nzUf; have [modU _ _] := simU. have eqUfU: \rank (U *m f) = \rank U by apply/mxrank_injP; rewrite mx_Schur_inj. have{eqUfU} [g invg defUf] := complete_unitmx eqUfU. suffices homUg: (U <= dom_hom_mx g)%MS by exists g; rewrite ?defUf. apply/hom_mxP=> x Gx; have [ux defUx] := submxP (mxmoduleP modU x Gx). by rewrite -defUf -(hom_mxP homUf) // defUx -!(mulmxA ux) defUf. Qed. (* The isomorphism part of Schur's lemma. *) Lemma mx_Schur_iso U V f : mxsimple U -> mxsimple V -> (U <= dom_hom_mx f)%MS -> (U *m f <= V)%MS -> U *m f != 0 -> mx_iso U V. Proof. move=> simU simV homUf sUfV nzUf; have [modU _ _] := simU. have [g invg homUg defUg] := mx_Schur_inj_iso simU homUf nzUf. exists g => //; apply: mx_Schur_onto; rewrite ?defUg //. by rewrite -!submx0 defUg in nzUf *. Qed. (* A boolean test for module isomorphism that is only valid for simple *) (* modules; this is the only case that matters in practice. *) Lemma nz_row_mxsimple U : mxsimple U -> nz_row U != 0. Proof. by case=> _ nzU _; rewrite nz_row_eq0. Qed. Definition mxsimple_iso (U V : 'M_n) := [&& mxmodule V, (V :&: row_hom_mx (nz_row U))%MS != 0 & \rank V <= \rank U]. Lemma mxsimple_isoP U V : mxsimple U -> reflect (mx_iso U V) (mxsimple_iso U V). Proof. move=> simU; pose u := nz_row U. have [Uu nz_u]: (u <= U)%MS /\ u != 0 by rewrite nz_row_sub nz_row_mxsimple. apply: (iffP and3P) => [[modV] | isoUV]; last first. split; last by rewrite (mxrank_iso isoUV). by case: (mx_iso_simple isoUV simU). have [f injf homUf defV] := isoUV; apply/rowV0Pn; exists (u *m f). rewrite sub_capmx -defV submxMr //. by apply/row_hom_mxP; exists f; first apply: (submx_trans Uu). by rewrite -(mul0mx _ f) (can_eq (mulmxK injf)) nz_u. case/rowV0Pn=> v; rewrite sub_capmx => /andP[Vv]. case/row_hom_mxP => f homMf def_v nz_v eqrUV. pose uG := cyclic_mx u; pose vG := cyclic_mx v. have def_vG: (uG *m f :=: vG)%MS by rewrite /vG -def_v; apply: hom_cyclic_mx. have defU: (U :=: uG)%MS by apply: mxsimple_cyclic. have mod_uG: mxmodule uG by rewrite cyclic_mx_module. have homUf: (U <= dom_hom_mx f)%MS. by rewrite defU cyclic_mx_sub ?dom_hom_mx_module. have isoUf: mx_iso U (U *m f). apply: mx_Schur_inj_iso => //; apply: contra nz_v; rewrite -!submx0. by rewrite (eqmxMr f defU) def_vG; apply: submx_trans (cyclic_mx_id v). apply: mx_iso_trans (isoUf) (eqmx_iso _); apply/eqmxP. have sUfV: (U *m f <= V)%MS by rewrite (eqmxMr f defU) def_vG cyclic_mx_sub. by rewrite -mxrank_leqif_eq ?eqn_leq 1?mxrankS // -(mxrank_iso isoUf). Qed. Lemma mxsimple_iso_simple U V : mxsimple_iso U V -> mxsimple U -> mxsimple V. Proof. by move=> isoUV simU; apply: mx_iso_simple (simU); apply/mxsimple_isoP. Qed. (* For us, "semisimple" means "sum of simple modules"; this is classically, *) (* but not intuitionistically, equivalent to the "completely reducible" *) (* alternate characterization. *) Implicit Type I : finType. Variant mxsemisimple (V : 'M_n) := MxSemisimple I U (W := (\sum_(i : I) U i)%MS) of forall i, mxsimple (U i) & (W :=: V)%MS & mxdirect W. (* This is a slight generalization of Aschbacher 12.5 for finite sets. *) Lemma sum_mxsimple_direct_compl m I W (U : 'M_(m, n)) : let V := (\sum_(i : I) W i)%MS in (forall i : I, mxsimple (W i)) -> mxmodule U -> (U <= V)%MS -> {J : {set I} | let S := U + \sum_(i in J) W i in S :=: V /\ mxdirect S}%MS. Proof. move=> V simW modU sUV; pose V_ (J : {set I}) := (\sum_(i in J) W i)%MS. pose dxU (J : {set I}) := mxdirect (U + V_ J). have [J maxJ]: {J | maxset dxU J}; last case/maxsetP: maxJ => dxUVJ maxJ. apply: ex_maxset; exists set0. by rewrite /dxU mxdirectE /V_ /= !big_set0 addn0 addsmx0 /=. have modWJ: mxmodule (V_ J) by apply: sumsmx_module => i _; case: (simW i). exists J; split=> //; apply/eqmxP; rewrite addsmx_sub sUV; apply/andP; split. by apply/sumsmx_subP=> i Ji; rewrite (sumsmx_sup i). rewrite -/(V_ J); apply/sumsmx_subP=> i _. case Ji: (i \in J). by apply: submx_trans (addsmxSr _ _); apply: (sumsmx_sup i). have [modWi nzWi simWi] := simW i. rewrite (sameP capmx_idPl eqmxP) simWi ?capmxSl ?capmx_module ?addsmx_module //. apply: contraFT (Ji); rewrite negbK => dxWiUVJ. rewrite -(maxJ (i |: J)) ?setU11 ?subsetUr // /dxU. rewrite mxdirectE /= !big_setU1 ?Ji //=. rewrite addnCA addsmxA (addsmxC U) -addsmxA -mxdirectE /=. by rewrite mxdirect_addsE /= mxdirect_trivial -/(dxU _) dxUVJ. Qed. Lemma sum_mxsimple_direct_sub I W (V : 'M_n) : (forall i : I, mxsimple (W i)) -> (\sum_i W i :=: V)%MS -> {J : {set I} | let S := \sum_(i in J) W i in S :=: V /\ mxdirect S}%MS. Proof. move=> simW defV. have [|J [defS dxS]] := sum_mxsimple_direct_compl simW (mxmodule0 n). exact: sub0mx. exists J; split; last by rewrite mxdirectE /= adds0mx mxrank0 in dxS. by apply: eqmx_trans defV; rewrite adds0mx_id in defS. Qed. Lemma mxsemisimple0 : mxsemisimple 0. Proof. exists [finType of 'I_0] (fun _ => 0); [by case | by rewrite big_ord0 | ]. by rewrite mxdirectE /= !big_ord0 mxrank0. Qed. Lemma intro_mxsemisimple (I : Type) r (P : pred I) W V : (\sum_(i <- r | P i) W i :=: V)%MS -> (forall i, P i -> W i != 0 -> mxsimple (W i)) -> mxsemisimple V. Proof. move=> defV simW; pose W_0 := [pred i | W i == 0]. have [-> | nzV] := eqVneq V 0; first exact: mxsemisimple0. case def_r: r => [| i0 r'] => [|{r' def_r}]. by rewrite -mxrank_eq0 -defV def_r big_nil mxrank0 in nzV. move: defV; rewrite (bigID W_0) /= addsmxC -big_filter !(big_nth i0) !big_mkord. rewrite addsmxC big1 ?adds0mx_id => [|i /andP[_ /eqP] //]. set tI := 'I_(_); set r_ := nth _ _ => defV. have{simW} simWr (i : tI) : mxsimple (W (r_ i)). case: i => m /=; set Pr := fun i => _ => lt_m_r /=. suffices: (Pr (r_ m)) by case/andP; apply: simW. apply: all_nthP m lt_m_r; apply/all_filterP. by rewrite -filter_predI; apply: eq_filter => i; rewrite /= andbb. have [J []] := sum_mxsimple_direct_sub simWr defV. case: (set_0Vmem J) => [-> V0 | [j0 Jj0]]. by rewrite -mxrank_eq0 -V0 big_set0 mxrank0 in nzV. pose K := {j | j \in J}; pose k0 : K := Sub j0 Jj0. have bij_KJ: {on J, bijective (sval : K -> _)}. by exists (insubd k0) => [k _ | j Jj]; rewrite ?valKd ?insubdK. have J_K (k : K) : sval k \in J by apply: valP k. rewrite mxdirectE /= !(reindex _ bij_KJ) !(eq_bigl _ _ J_K) -mxdirectE /= -/tI. exact: MxSemisimple. Qed. Lemma mxsimple_semisimple U : mxsimple U -> mxsemisimple U. Proof. move=> simU; apply: (intro_mxsemisimple (_ : \sum_(i < 1) U :=: U))%MS => //. by rewrite big_ord1. Qed. Lemma addsmx_semisimple U V : mxsemisimple U -> mxsemisimple V -> mxsemisimple (U + V)%MS. Proof. case=> [I W /= simW defU _] [J T /= simT defV _]. have defUV: (\sum_ij sum_rect (fun _ => 'M_n) W T ij :=: U + V)%MS. by rewrite big_sumType /=; apply: adds_eqmx. by apply: intro_mxsemisimple defUV _; case=> /=. Qed. Lemma sumsmx_semisimple (I : finType) (P : pred I) V : (forall i, P i -> mxsemisimple (V i)) -> mxsemisimple (\sum_(i | P i) V i)%MS. Proof. move=> ssimV; elim/big_ind: _ => //; first exact: mxsemisimple0. exact: addsmx_semisimple. Qed. Lemma eqmx_semisimple U V : (U :=: V)%MS -> mxsemisimple U -> mxsemisimple V. Proof. by move=> eqUV [I W S simW defU dxS]; exists I W => //; apply: eqmx_trans eqUV. Qed. Lemma hom_mxsemisimple (V f : 'M_n) : mxsemisimple V -> (V <= dom_hom_mx f)%MS -> mxsemisimple (V *m f). Proof. case=> I W /= simW defV _; rewrite -defV => /sumsmx_subP homWf. have{defV} defVf: (\sum_i W i *m f :=: V *m f)%MS. by apply: eqmx_trans (eqmx_sym _) (eqmxMr f defV); apply: sumsmxMr. apply: (intro_mxsemisimple defVf) => i _ nzWf. by apply: mx_iso_simple (simW i); apply: mx_Schur_inj_iso; rewrite ?homWf. Qed. Lemma mxsemisimple_module U : mxsemisimple U -> mxmodule U. Proof. case=> I W /= simW defU _. by rewrite -(eqmx_module defU) sumsmx_module // => i _; case: (simW i). Qed. (* Completely reducible modules, and Maeschke's Theorem. *) Variant mxsplits (V U : 'M_n) := MxSplits (W : 'M_n) of mxmodule W & (U + W :=: V)%MS & mxdirect (U + W). Definition mx_completely_reducible V := forall U, mxmodule U -> (U <= V)%MS -> mxsplits V U. Lemma mx_reducibleS U V : mxmodule U -> (U <= V)%MS -> mx_completely_reducible V -> mx_completely_reducible U. Proof. move=> modU sUV redV U1 modU1 sU1U. have [W modW defV dxU1W] := redV U1 modU1 (submx_trans sU1U sUV). exists (W :&: U)%MS; first exact: capmx_module. by apply/eqmxP; rewrite !matrix_modl // capmxSr sub_capmx defV sUV /=. by apply/mxdirect_addsP; rewrite capmxA (mxdirect_addsP dxU1W) cap0mx. Qed. Lemma mx_Maschke : [char F]^'.-group G -> mx_completely_reducible 1%:M. Proof. rewrite /pgroup charf'_nat; set nG := _%:R => nzG U => /mxmoduleP Umod _. pose phi := nG^-1 *: (\sum_(x in G) rG x^-1 *m pinvmx U *m U *m rG x). have phiG x: x \in G -> phi *m rG x = rG x *m phi. move=> Gx; rewrite -scalemxAl -scalemxAr; congr (_ *: _). rewrite {2}(reindex_acts 'R _ Gx) ?astabsR //= mulmx_suml mulmx_sumr. apply: eq_bigr => y Gy; rewrite !mulmxA -repr_mxM ?groupV ?groupM //. by rewrite invMg mulKVg repr_mxM ?mulmxA. have Uphi: U *m phi = U. rewrite -scalemxAr mulmx_sumr (eq_bigr (fun _ => U)) => [|x Gx]. by rewrite sumr_const -scaler_nat !scalerA mulVf ?scale1r. by rewrite 3!mulmxA mulmxKpV ?repr_mxKV ?Umod ?groupV. have tiUker: (U :&: kermx phi = 0)%MS. apply/eqP/rowV0P=> v; rewrite sub_capmx => /andP[/submxP[u ->] /sub_kermxP]. by rewrite -mulmxA Uphi. exists (kermx phi); last exact/mxdirect_addsP. apply/mxmoduleP=> x Gx; apply/sub_kermxP. by rewrite -mulmxA -phiG // mulmxA mulmx_ker mul0mx. apply/eqmxP; rewrite submx1 sub1mx. rewrite /row_full mxrank_disjoint_sum //= mxrank_ker. suffices ->: (U :=: phi)%MS by rewrite subnKC ?rank_leq_row. apply/eqmxP; rewrite -{1}Uphi submxMl scalemx_sub //. by rewrite summx_sub // => x Gx; rewrite -mulmxA mulmx_sub ?Umod. Qed. Lemma mxsemisimple_reducible V : mxsemisimple V -> mx_completely_reducible V. Proof. case=> [I W /= simW defV _] U modU sUV; rewrite -defV in sUV. have [J [defV' dxV]] := sum_mxsimple_direct_compl simW modU sUV. exists (\sum_(i in J) W i)%MS. - by apply: sumsmx_module => i _; case: (simW i). - exact: eqmx_trans defV' defV. by rewrite mxdirect_addsE (sameP eqP mxdirect_addsP) /= in dxV; case/and3P: dxV. Qed. Lemma mx_reducible_semisimple V : mxmodule V -> mx_completely_reducible V -> classically (mxsemisimple V). Proof. move=> modV redV [] // nssimV; have [r leVr] := ubnP (\rank V). elim: r => // r IHr in V leVr modV redV nssimV. have [V0 | nzV] := eqVneq V 0. by rewrite nssimV ?V0 //; apply: mxsemisimple0. apply: (mxsimple_exists modV nzV) => [[U simU sUV]]; have [modU nzU _] := simU. have [W modW defUW dxUW] := redV U modU sUV. have sWV: (W <= V)%MS by rewrite -defUW addsmxSr. apply: IHr (mx_reducibleS modW sWV redV) _ => // [|ssimW]. rewrite ltnS -defUW (mxdirectP dxUW) /= in leVr; apply: leq_trans leVr. by rewrite -add1n leq_add2r lt0n mxrank_eq0. apply: nssimV (eqmx_semisimple defUW (addsmx_semisimple _ ssimW)). exact: mxsimple_semisimple. Qed. Lemma mxsemisimpleS U V : mxmodule U -> (U <= V)%MS -> mxsemisimple V -> mxsemisimple U. Proof. move=> modU sUV ssimV. have [W modW defUW dxUW]:= mxsemisimple_reducible ssimV modU sUV. move/mxdirect_addsP: dxUW => dxUW. have defU : (V *m proj_mx U W :=: U)%MS. by apply/eqmxP; rewrite proj_mx_sub -{1}[U](proj_mx_id dxUW) ?submxMr. apply: eqmx_semisimple defU _; apply: hom_mxsemisimple ssimV _. by rewrite -defUW proj_mx_hom. Qed. Lemma hom_mxsemisimple_iso I P U W f : let V := (\sum_(i : I | P i) W i)%MS in mxsimple U -> (forall i, P i -> W i != 0 -> mxsimple (W i)) -> (V <= dom_hom_mx f)%MS -> (U <= V *m f)%MS -> {i | P i & mx_iso (W i) U}. Proof. move=> V simU simW homVf sUVf; have [modU nzU _] := simU. have ssimVf: mxsemisimple (V *m f). exact: hom_mxsemisimple (intro_mxsemisimple (eqmx_refl V) simW) homVf. have [U' modU' defVf] := mxsemisimple_reducible ssimVf modU sUVf. move/mxdirect_addsP=> dxUU'; pose p := f *m proj_mx U U'. case: (pickP (fun i => P i && (W i *m p != 0))) => [i /andP[Pi nzWip] | no_i]. have sWiV: (W i <= V)%MS by rewrite (sumsmx_sup i). have sWipU: (W i *m p <= U)%MS by rewrite mulmxA proj_mx_sub. exists i => //; apply: (mx_Schur_iso (simW i Pi _) simU _ sWipU nzWip). by apply: contraNneq nzWip => ->; rewrite mul0mx. apply: (submx_trans sWiV); apply/hom_mxP=> x Gx. by rewrite mulmxA [_ *m p]mulmxA 2?(hom_mxP _) -?defVf ?proj_mx_hom. case/negP: nzU; rewrite -submx0 -[U](proj_mx_id dxUU') //. rewrite (submx_trans (submxMr _ sUVf)) // -mulmxA -/p sumsmxMr. by apply/sumsmx_subP=> i Pi; move/negbT: (no_i i); rewrite Pi negbK submx0. Qed. (* The component associated to a given irreducible module. *) Section Components. Fact component_mx_key : unit. Proof. by []. Qed. Definition component_mx_expr (U : 'M[F]_n) := (\sum_i cyclic_mx (row i (row_hom_mx (nz_row U))))%MS. Definition component_mx := locked_with component_mx_key component_mx_expr. Canonical component_mx_unfoldable := [unlockable fun component_mx]. Variable U : 'M[F]_n. Hypothesis simU : mxsimple U. Let u := nz_row U. Let iso_u := row_hom_mx u. Let nz_u : u != 0 := nz_row_mxsimple simU. Let Uu : (u <= U)%MS := nz_row_sub U. Let defU : (U :=: cyclic_mx u)%MS := mxsimple_cyclic simU nz_u Uu. Local Notation compU := (component_mx U). Lemma component_mx_module : mxmodule compU. Proof. by rewrite unlock sumsmx_module // => i; rewrite cyclic_mx_module. Qed. Lemma genmx_component : <>%MS = compU. Proof. by rewrite [in compU]unlock genmx_sums; apply: eq_bigr => i; rewrite genmx_id. Qed. Lemma component_mx_def : {I : finType & {W : I -> 'M_n | forall i, mx_iso U (W i) & compU = \sum_i W i}}%MS. Proof. pose r i := row i iso_u; pose r_nz i := r i != 0; pose I := {i | r_nz i}. exists [finType of I]; exists (fun i => cyclic_mx (r (sval i))) => [i|]. apply/mxsimple_isoP=> //; apply/and3P. split; first by rewrite cyclic_mx_module. apply/rowV0Pn; exists (r (sval i)); last exact: (svalP i). by rewrite sub_capmx cyclic_mx_id row_sub. have [f hom_u_f <-] := @row_hom_mxP u (r (sval i)) (row_sub _ _). by rewrite defU -hom_cyclic_mx ?mxrankM_maxl. rewrite -(eq_bigr _ (fun _ _ => genmx_id _)) -genmx_sums -genmx_component. rewrite [in compU]unlock; apply/genmxP/andP; split; last first. by apply/sumsmx_subP => i _; rewrite (sumsmx_sup (sval i)). apply/sumsmx_subP => i _. case i0: (r_nz i); first by rewrite (sumsmx_sup (Sub i i0)). by move/negbFE: i0; rewrite -cyclic_mx_eq0 => /eqP->; apply: sub0mx. Qed. Lemma component_mx_semisimple : mxsemisimple compU. Proof. have [I [W isoUW ->]] := component_mx_def. apply: intro_mxsemisimple (eqmx_refl _) _ => i _ _. exact: mx_iso_simple (isoUW i) simU. Qed. Lemma mx_iso_component V : mx_iso U V -> (V <= compU)%MS. Proof. move=> isoUV; have [f injf homUf defV] := isoUV. have simV := mx_iso_simple isoUV simU. have hom_u_f := submx_trans Uu homUf. have ->: (V :=: cyclic_mx (u *m f))%MS. apply: eqmx_trans (hom_cyclic_mx hom_u_f). exact: eqmx_trans (eqmx_sym defV) (eqmxMr _ defU). have iso_uf: (u *m f <= iso_u)%MS by apply/row_hom_mxP; exists f. rewrite genmxE; apply/row_subP=> j; rewrite row_mul mul_rV_lin1 /=. set a := vec_mx _; apply: submx_trans (submxMr _ iso_uf) _. apply/row_subP=> i; rewrite row_mul [in compU]unlock (sumsmx_sup i) //. by apply/cyclic_mxP; exists a; rewrite // vec_mxK row_sub. Qed. Lemma component_mx_id : (U <= compU)%MS. Proof. exact: mx_iso_component (mx_iso_refl U). Qed. Lemma hom_component_mx_iso f V : mxsimple V -> (compU <= dom_hom_mx f)%MS -> (V <= compU *m f)%MS -> mx_iso U V. Proof. have [I [W isoUW ->]] := component_mx_def => simV homWf sVWf. have [i _ _|i _ ] := hom_mxsemisimple_iso simV _ homWf sVWf. exact: mx_iso_simple (simU). exact: mx_iso_trans. Qed. Lemma component_mx_iso V : mxsimple V -> (V <= compU)%MS -> mx_iso U V. Proof. move=> simV; rewrite -[compU]mulmx1. exact: hom_component_mx_iso (scalar_mx_hom _ _). Qed. Lemma hom_component_mx f : (compU <= dom_hom_mx f)%MS -> (compU *m f <= compU)%MS. Proof. move=> hom_f. have [I W /= simW defW _] := hom_mxsemisimple component_mx_semisimple hom_f. rewrite -defW; apply/sumsmx_subP=> i _; apply: mx_iso_component. by apply: hom_component_mx_iso hom_f _ => //; rewrite -defW (sumsmx_sup i). Qed. End Components. Lemma component_mx_isoP U V : mxsimple U -> mxsimple V -> reflect (mx_iso U V) (component_mx U == component_mx V). Proof. move=> simU simV; apply: (iffP eqP) => isoUV. by apply: component_mx_iso; rewrite ?isoUV ?component_mx_id. rewrite -(genmx_component U) -(genmx_component V); apply/genmxP. wlog suffices: U V simU simV isoUV / (component_mx U <= component_mx V)%MS. by move=> IH; rewrite !IH //; apply: mx_iso_sym. have [I [W isoWU ->]] := component_mx_def simU. apply/sumsmx_subP => i _; apply: mx_iso_component => //. exact: mx_iso_trans (mx_iso_sym isoUV) (isoWU i). Qed. Lemma component_mx_disjoint U V : mxsimple U -> mxsimple V -> component_mx U != component_mx V -> (component_mx U :&: component_mx V = 0)%MS. Proof. move=> simU simV neUV; apply: contraNeq neUV => ntUV. apply: (mxsimple_exists _ ntUV) => [|[W simW]]. by rewrite capmx_module ?component_mx_module. rewrite sub_capmx => /andP[sWU sWV]; apply/component_mx_isoP=> //. by apply: mx_iso_trans (_ : mx_iso U W) (mx_iso_sym _); apply: component_mx_iso. Qed. Section Socle. Record socleType := EnumSocle { socle_base_enum : seq 'M[F]_n; _ : forall M, M \in socle_base_enum -> mxsimple M; _ : forall M, mxsimple M -> has (mxsimple_iso M) socle_base_enum }. Lemma socle_exists : classically socleType. Proof. pose V : 'M[F]_n := 0; have: mxsemisimple V by apply: mxsemisimple0. have: n - \rank V < n.+1 by rewrite mxrank0 subn0. elim: _.+1 V => // n' IHn' V; rewrite ltnS => le_nV_n' ssimV. case=> // maxV; apply: (maxV); have [I /= U simU defV _] := ssimV. exists (codom U) => [M | M simM]; first by case/mapP=> i _ ->. suffices sMV: (M <= V)%MS. rewrite -defV -(mulmx1 (\sum_i _)%MS) in sMV. have [//| i _] := hom_mxsemisimple_iso simM _ (scalar_mx_hom _ _) sMV. move/mx_iso_sym=> isoM; apply/hasP. by exists (U i); [apply: codom_f | apply/mxsimple_isoP]. have ssimMV := addsmx_semisimple (mxsimple_semisimple simM) ssimV. apply: contraLR isT => nsMV; apply: IHn' ssimMV _ maxV. apply: leq_trans le_nV_n'; rewrite ltn_sub2l //. rewrite ltn_neqAle rank_leq_row andbT -[_ == _]sub1mx. by apply: contra nsMV; apply: submx_trans; apply: submx1. rewrite (ltn_leqif (mxrank_leqif_sup _)) ?addsmxSr //. by rewrite addsmx_sub submx_refl andbT. Qed. Section SocleDef. Variable sG0 : socleType. Definition socle_enum := map component_mx (socle_base_enum sG0). Lemma component_socle M : mxsimple M -> component_mx M \in socle_enum. Proof. rewrite /socle_enum; case: sG0 => e0 /= sim_e mem_e simM. have /hasP[M' e0M' isoMM'] := mem_e M simM; apply/mapP; exists M' => //. by apply/eqP/component_mx_isoP; [|apply: sim_e | apply/mxsimple_isoP]. Qed. Inductive socle_sort : predArgType := PackSocle W of W \in socle_enum. Local Notation sG := socle_sort. Local Notation e0 := (socle_base_enum sG0). Definition socle_base W := let: PackSocle W _ := W in e0`_(index W socle_enum). Coercion socle_val W : 'M[F]_n := component_mx (socle_base W). Definition socle_mult (W : sG) := (\rank W %/ \rank (socle_base W))%N. Lemma socle_simple W : mxsimple (socle_base W). Proof. case: W => M /=; rewrite /= /socle_enum /=; case: sG0 => e sim_e _ /= e_M. by apply: sim_e; rewrite mem_nth // -(size_map component_mx) index_mem. Qed. Definition socle_module (W : sG) := mxsimple_module (socle_simple W). Definition socle_repr W := submod_repr (socle_module W). Lemma nz_socle (W : sG) : W != 0 :> 'M_n. Proof. have simW := socle_simple W; have [_ nzW _] := simW; apply: contra nzW. by rewrite -!submx0; apply: submx_trans (component_mx_id simW). Qed. Lemma socle_mem (W : sG) : (W : 'M_n) \in socle_enum. Proof. exact: component_socle (socle_simple _). Qed. Lemma PackSocleK W e0W : @PackSocle W e0W = W :> 'M_n. Proof. rewrite /socle_val /= in e0W *; rewrite -(nth_map _ 0) ?nth_index //. by rewrite -(size_map component_mx) index_mem. Qed. Canonical socle_subType := SubType _ _ _ socle_sort_rect PackSocleK. Definition socle_eqMixin := Eval hnf in [eqMixin of sG by <:]. Canonical socle_eqType := Eval hnf in EqType sG socle_eqMixin. Definition socle_choiceMixin := Eval hnf in [choiceMixin of sG by <:]. Canonical socle_choiceType := ChoiceType sG socle_choiceMixin. Lemma socleP (W W' : sG) : reflect (W = W') (W == W')%MS. Proof. by rewrite (sameP genmxP eqP) !{1}genmx_component; apply: (W =P _). Qed. Fact socle_finType_subproof : cancel (fun W => SeqSub (socle_mem W)) (fun s => PackSocle (valP s)). Proof. by move=> W /=; apply: val_inj; rewrite /= PackSocleK. Qed. Definition socle_countMixin := CanCountMixin socle_finType_subproof. Canonical socle_countType := CountType sG socle_countMixin. Canonical socle_subCountType := [subCountType of sG]. Definition socle_finMixin := CanFinMixin socle_finType_subproof. Canonical socle_finType := FinType sG socle_finMixin. Canonical socle_subFinType := [subFinType of sG]. End SocleDef. Coercion socle_sort : socleType >-> predArgType. Variable sG : socleType. Section SubSocle. Variable P : pred sG. Notation S := (\sum_(W : sG | P W) socle_val W)%MS. Lemma subSocle_module : mxmodule S. Proof. by rewrite sumsmx_module // => W _; apply: component_mx_module. Qed. Lemma subSocle_semisimple : mxsemisimple S. Proof. apply: sumsmx_semisimple => W _; apply: component_mx_semisimple. exact: socle_simple. Qed. Local Notation ssimS := subSocle_semisimple. Lemma subSocle_iso M : mxsimple M -> (M <= S)%MS -> {W : sG | P W & mx_iso (socle_base W) M}. Proof. move=> simM sMS; have [modM nzM _] := simM. have [V /= modV defMV] := mxsemisimple_reducible ssimS modM sMS. move/mxdirect_addsP=> dxMV; pose p := proj_mx M V; pose Sp (W : sG) := W *m p. case: (pickP [pred i | P i & Sp i != 0]) => [/= W | Sp0]; last first. case/negP: nzM; rewrite -submx0 -[M](proj_mx_id dxMV) //. rewrite (submx_trans (submxMr _ sMS)) // sumsmxMr big1 // => W P_W. by apply/eqP; move/negbT: (Sp0 W); rewrite /= P_W negbK. rewrite {}/Sp /= => /andP[P_W nzSp]; exists W => //. have homWp: (W <= dom_hom_mx p)%MS. apply: submx_trans (proj_mx_hom dxMV modM modV). by rewrite defMV (sumsmx_sup W). have simWP := socle_simple W; apply: hom_component_mx_iso (homWp) _ => //. by rewrite (mx_Schur_onto _ simM) ?proj_mx_sub ?component_mx_module. Qed. Lemma capmx_subSocle m (M : 'M_(m, n)) : mxmodule M -> (M :&: S :=: \sum_(W : sG | P W) (M :&: W))%MS. Proof. move=> modM; apply/eqmxP/andP; split; last first. by apply/sumsmx_subP=> W P_W; rewrite capmxS // (sumsmx_sup W). have modMS: mxmodule (M :&: S)%MS by rewrite capmx_module ?subSocle_module. have [J /= U simU defMS _] := mxsemisimpleS modMS (capmxSr M S) ssimS. rewrite -defMS; apply/sumsmx_subP=> j _. have [sUjV sUjS]: (U j <= M /\ U j <= S)%MS. by apply/andP; rewrite -sub_capmx -defMS (sumsmx_sup j). have [W P_W isoWU] := subSocle_iso (simU j) sUjS. rewrite (sumsmx_sup W) // sub_capmx sUjV mx_iso_component //. exact: socle_simple. Qed. End SubSocle. Lemma subSocle_direct P : mxdirect (\sum_(W : sG | P W) W). Proof. apply/mxdirect_sumsP=> W _; apply/eqP. rewrite -submx0 capmx_subSocle ?component_mx_module //. apply/sumsmx_subP=> W' /andP[_ neWW']. by rewrite capmxC component_mx_disjoint //; apply: socle_simple. Qed. Definition Socle := (\sum_(W : sG) W)%MS. Lemma simple_Socle M : mxsimple M -> (M <= Socle)%MS. Proof. move=> simM; have socM := component_socle sG simM. by rewrite (sumsmx_sup (PackSocle socM)) // PackSocleK component_mx_id. Qed. Lemma semisimple_Socle U : mxsemisimple U -> (U <= Socle)%MS. Proof. by case=> I M /= simM <- _; apply/sumsmx_subP=> i _; apply: simple_Socle. Qed. Lemma reducible_Socle U : mxmodule U -> mx_completely_reducible U -> (U <= Socle)%MS. Proof. move=> modU redU; apply: (mx_reducible_semisimple modU redU). exact: semisimple_Socle. Qed. Lemma genmx_Socle : <>%MS = Socle. Proof. by rewrite genmx_sums; apply: eq_bigr => W; rewrite genmx_component. Qed. Lemma reducible_Socle1 : mx_completely_reducible 1%:M -> Socle = 1%:M. Proof. move=> redG; rewrite -genmx1 -genmx_Socle; apply/genmxP. by rewrite submx1 reducible_Socle ?mxmodule1. Qed. Lemma Socle_module : mxmodule Socle. Proof. exact: subSocle_module. Qed. Lemma Socle_semisimple : mxsemisimple Socle. Proof. exact: subSocle_semisimple. Qed. Lemma Socle_direct : mxdirect Socle. Proof. exact: subSocle_direct. Qed. Lemma Socle_iso M : mxsimple M -> {W : sG | mx_iso (socle_base W) M}. Proof. by move=> simM; case/subSocle_iso: (simple_Socle simM) => // W _; exists W. Qed. End Socle. (* Centralizer subgroup and central homomorphisms. *) Section CentHom. Variable f : 'M[F]_n. Lemma row_full_dom_hom : row_full (dom_hom_mx f) = centgmx rG f. Proof. by rewrite -sub1mx; apply/hom_mxP/centgmxP=> cfG x /cfG; rewrite !mul1mx. Qed. Lemma memmx_cent_envelop : (f \in 'C(E_G))%MS = centgmx rG f. Proof. apply/cent_rowP/centgmxP=> [cfG x Gx | cfG i]. by have:= cfG (enum_rank_in Gx x); rewrite rowK mxvecK enum_rankK_in. by rewrite rowK mxvecK /= cfG ?enum_valP. Qed. Lemma kermx_centg_module : centgmx rG f -> mxmodule (kermx f). Proof. move/centgmxP=> cGf; apply/mxmoduleP=> x Gx; apply/sub_kermxP. by rewrite -mulmxA -cGf // mulmxA mulmx_ker mul0mx. Qed. Lemma centgmx_hom m (U : 'M_(m, n)) : centgmx rG f -> (U <= dom_hom_mx f)%MS. Proof. by rewrite -row_full_dom_hom -sub1mx; apply: submx_trans (submx1 _). Qed. End CentHom. (* (Globally) irreducible, and absolutely irreducible representations. Note *) (* that unlike "reducible", "absolutely irreducible" can easily be decided. *) Definition mx_irreducible := mxsimple 1%:M. Lemma mx_irrP : mx_irreducible <-> n > 0 /\ (forall U, @mxmodule n U -> U != 0 -> row_full U). Proof. rewrite /mx_irreducible /mxsimple mxmodule1 -mxrank_eq0 mxrank1 -lt0n. do [split=> [[_ -> irrG] | [-> irrG]]; split=> // U] => [modU | modU _] nzU. by rewrite -sub1mx (irrG U) ?submx1. by rewrite sub1mx irrG. Qed. (* Schur's lemma for endomorphisms. *) Lemma mx_Schur : mx_irreducible -> forall f, centgmx rG f -> f != 0 -> f \in unitmx. Proof. move/mx_Schur_onto=> irrG f. rewrite -row_full_dom_hom -!row_full_unit -!sub1mx => cGf nz. by rewrite -[f]mul1mx irrG ?submx1 ?mxmodule1 ?mul1mx. Qed. Definition mx_absolutely_irreducible := (n > 0) && row_full E_G. Lemma mx_abs_irrP : reflect (n > 0 /\ exists a_, forall A, A = \sum_(x in G) a_ x A *: rG x) mx_absolutely_irreducible. Proof. have G_1 := group1 G; have bijG := enum_val_bij_in G_1. set h := enum_val in bijG; have Gh : h _ \in G by apply: enum_valP. rewrite /mx_absolutely_irreducible; case: (n > 0); last by right; case. apply: (iffP row_fullP) => [[E' E'G] | [_ [a_ a_G]]]. split=> //; exists (fun x B => (mxvec B *m E') 0 (enum_rank_in G_1 x)) => B. apply: (can_inj mxvecK); rewrite -{1}[mxvec B]mulmx1 -{}E'G mulmxA. move: {B E'}(_ *m E') => u; apply/rowP=> j. rewrite linear_sum (reindex h) //= mxE summxE. by apply: eq_big => [k| k _]; rewrite ?Gh // enum_valK_in mxE linearZ !mxE. exists (\matrix_(j, i) a_ (h i) (vec_mx (row j 1%:M))). apply/row_matrixP=> i; rewrite -[row i 1%:M]vec_mxK {}[vec_mx _]a_G. apply/rowP=> j; rewrite linear_sum (reindex h) //= 2!mxE summxE. by apply: eq_big => [k| k _]; [rewrite Gh | rewrite linearZ !mxE]. Qed. Lemma mx_abs_irr_cent_scalar : mx_absolutely_irreducible -> forall A, centgmx rG A -> is_scalar_mx A. Proof. case/mx_abs_irrP=> n_gt0 [a_ a_G] A /centgmxP cGA. have{cGA a_G} cMA B: A *m B = B *m A. rewrite {}[B]a_G mulmx_suml mulmx_sumr. by apply: eq_bigr => x Gx; rewrite -scalemxAl -scalemxAr cGA. pose i0 := Ordinal n_gt0; apply/is_scalar_mxP; exists (A i0 i0). apply/matrixP=> i j; move/matrixP/(_ i0 j): (esym (cMA (delta_mx i0 i))). rewrite -[A *m _]trmxK trmx_mul trmx_delta -!(@mul_delta_mx _ n 1 n 0) -!mulmxA. by rewrite -!rowE !mxE !big_ord1 !mxE !eqxx !mulr_natl /= andbT eq_sym. Qed. Lemma mx_abs_irrW : mx_absolutely_irreducible -> mx_irreducible. Proof. case/mx_abs_irrP=> n_gt0 [a_ a_G]; apply/mx_irrP; split=> // U Umod. case/rowV0Pn=> u Uu; rewrite -mxrank_eq0 -lt0n row_leq_rank -sub1mx. case/submxP: Uu => v ->{u} /row_freeP[u' vK]; apply/row_subP=> i. rewrite rowE scalar_mxC -{}vK -2![_ *m _]mulmxA; move: {u' i}(u' *m _) => A. rewrite mulmx_sub {v}// [A]a_G linear_sum summx_sub //= => x Gx. by rewrite linearZ /= scalemx_sub // (mxmoduleP Umod). Qed. Lemma linear_mx_abs_irr : n = 1%N -> mx_absolutely_irreducible. Proof. move=> n1; rewrite /mx_absolutely_irreducible /row_full eqn_leq rank_leq_col. rewrite {1 2 3}n1 /= lt0n mxrank_eq0; apply: contraTneq envelop_mx1 => ->. by rewrite eqmx0 submx0 mxvec_eq0 -mxrank_eq0 mxrank1 n1. Qed. Lemma abelian_abs_irr : abelian G -> mx_absolutely_irreducible = (n == 1%N). Proof. move=> cGG; apply/idP/eqP=> [absG|]; last exact: linear_mx_abs_irr. have [n_gt0 _] := andP absG. pose M := <>%MS. have rM: \rank M = 1%N by rewrite genmxE mxrank_delta. suffices defM: (M == 1%:M)%MS by rewrite (eqmxP defM) mxrank1 in rM. case: (mx_abs_irrW absG) => _ _ ->; rewrite ?submx1 -?mxrank_eq0 ?rM //. apply/mxmoduleP=> x Gx; suffices: is_scalar_mx (rG x). by case/is_scalar_mxP=> a ->; rewrite mul_mx_scalar scalemx_sub. apply: (mx_abs_irr_cent_scalar absG). by apply/centgmxP=> y Gy; rewrite -!repr_mxM // (centsP cGG). Qed. End OneRepresentation. Arguments mxmoduleP {gT G n rG m U}. Arguments envelop_mxP {gT G n rG A}. Arguments hom_mxP {gT G n rG m f W}. Arguments rfix_mxP {gT G n rG m W}. Arguments cyclic_mxP {gT G n rG u v}. Arguments annihilator_mxP {gT G n rG u A}. Arguments row_hom_mxP {gT G n rG u v}. Arguments mxsimple_isoP {gT G n rG U V}. Arguments socleP {gT G n rG sG0 W W'}. Arguments mx_abs_irrP {gT G n rG}. Arguments val_submod {n U m} W. Arguments in_submod {n} U {m} W. Arguments val_submodK {n U m} W : rename. Arguments in_submodK {n U m} [W] sWU. Arguments val_submod_inj {n U m} [W1 W2] : rename. Arguments val_factmod {n U m} W. Arguments in_factmod {n} U {m} W. Arguments val_factmodK {n U m} W : rename. Arguments in_factmodK {n} U {m} [W] sWU. Arguments val_factmod_inj {n U m} [W1 W2] : rename. Section Proper. Variables (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variable rG : mx_representation F G n. Lemma envelop_mx_ring : mxring (enveloping_algebra_mx rG). Proof. apply/andP; split; first by apply/mulsmx_subP; apply: envelop_mxM. apply/mxring_idP; exists 1%:M; split=> *; rewrite ?mulmx1 ?mul1mx //. by rewrite -mxrank_eq0 mxrank1. exact: envelop_mx1. Qed. End Proper. Section JacobsonDensity. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variable rG : mx_representation F G n. Hypothesis irrG : mx_irreducible rG. Local Notation E_G := (enveloping_algebra_mx rG). Local Notation Hom_G := 'C(E_G)%MS. Lemma mx_Jacobson_density : ('C(Hom_G) <= E_G)%MS. Proof. apply/row_subP=> iB; rewrite -[row iB _]vec_mxK; move defB: (vec_mx _) => B. have{defB} cBcE: (B \in 'C(Hom_G))%MS by rewrite -defB vec_mxK row_sub. have rGnP: mx_repr G (fun x => lin_mx (mulmxr (rG x)) : 'A_n). split=> [|x y Gx Gy]; apply/row_matrixP=> i. by rewrite !rowE mul_rV_lin repr_mx1 /= !mulmx1 vec_mxK. by rewrite !rowE mulmxA !mul_rV_lin repr_mxM //= mxvecK mulmxA. move def_rGn: (MxRepresentation rGnP) => rGn. pose E_Gn := enveloping_algebra_mx rGn. pose e1 : 'rV[F]_(n ^ 2) := mxvec 1%:M; pose U := cyclic_mx rGn e1. have U_e1: (e1 <= U)%MS by rewrite cyclic_mx_id. have modU: mxmodule rGn U by rewrite cyclic_mx_module. pose Bn : 'M_(n ^ 2) := lin_mx (mulmxr B). suffices U_e1Bn: (e1 *m Bn <= U)%MS. rewrite mul_vec_lin /= mul1mx in U_e1Bn; apply: submx_trans U_e1Bn _. rewrite genmxE; apply/row_subP=> i; rewrite row_mul rowK mul_vec_lin_row. by rewrite -def_rGn mul_vec_lin /= mul1mx (eq_row_sub i) ?rowK. have{cBcE} cBncEn A: centgmx rGn A -> A *m Bn = Bn *m A. rewrite -def_rGn => cAG; apply/row_matrixP; case/mxvec_indexP=> j k /=. rewrite !rowE !mulmxA -mxvec_delta -(mul_delta_mx (0 : 'I_1)). rewrite mul_rV_lin mul_vec_lin /= -mulmxA; apply: (canLR vec_mxK). apply/row_matrixP=> i; set dj0 := delta_mx j 0. pose Aij := row i \o vec_mx \o mulmxr A \o mxvec \o mulmx dj0. have defAij := mul_rV_lin1 [linear of Aij]; rewrite /= {2}/Aij /= in defAij. rewrite -defAij row_mul -defAij -!mulmxA (cent_mxP cBcE) {k}//. rewrite memmx_cent_envelop; apply/centgmxP=> x Gx; apply/row_matrixP=> k. rewrite !row_mul !rowE !{}defAij /= -row_mul mulmxA mul_delta_mx. congr (row i _); rewrite -(mul_vec_lin (mulmxr_linear _ _)) -mulmxA. by rewrite -(centgmxP cAG) // mulmxA mx_rV_lin. suffices redGn: mx_completely_reducible rGn 1%:M. have [V modV defUV] := redGn _ modU (submx1 _); move/mxdirect_addsP=> dxUV. rewrite -(proj_mx_id dxUV U_e1) -mulmxA {}cBncEn 1?mulmxA ?proj_mx_sub //. by rewrite -row_full_dom_hom -sub1mx -defUV proj_mx_hom. pose W i : 'M[F]_(n ^ 2) := <>%MS. have defW: (\sum_i W i :=: 1%:M)%MS. apply/eqmxP; rewrite submx1; apply/row_subP; case/mxvec_indexP=> i j. rewrite row1 -mxvec_delta (sumsmx_sup i) // genmxE; apply/submxP. by exists (delta_mx 0 j); rewrite mul_rV_lin1 /= mul_delta_mx. apply: mxsemisimple_reducible; apply: (intro_mxsemisimple defW) => i _ nzWi. split=> // [|Vi modVi sViWi nzVi]. apply/mxmoduleP=> x Gx; rewrite genmxE (eqmxMr _ (genmxE _)) -def_rGn. apply/row_subP=> j; rewrite rowE mulmxA !mul_rV_lin1 /= mxvecK -mulmxA. by apply/submxP; move: (_ *m rG x) => v; exists v; rewrite mul_rV_lin1. do [rewrite !genmxE; set f := lin1_mx _] in sViWi *. have f_free: row_free f. apply/row_freeP; exists (lin1_mx (row i \o vec_mx)); apply/row_matrixP=> j. by rewrite row1 rowE mulmxA !mul_rV_lin1 /= mxvecK rowE !mul_delta_mx. pose V := <>%MS; have Vidf := mulmxKpV sViWi. suffices: (1%:M <= V)%MS by rewrite genmxE -(submxMfree _ _ f_free) mul1mx Vidf. case: irrG => _ _ ->; rewrite ?submx1 //; last first. by rewrite -mxrank_eq0 genmxE -(mxrankMfree _ f_free) Vidf mxrank_eq0. apply/mxmoduleP=> x Gx; rewrite genmxE (eqmxMr _ (genmxE _)). rewrite -(submxMfree _ _ f_free) Vidf. apply: submx_trans (mxmoduleP modVi x Gx); rewrite -{2}Vidf. apply/row_subP=> j; apply: (eq_row_sub j); rewrite row_mul -def_rGn. by rewrite !(row_mul _ _ f) !mul_rV_lin1 /= mxvecK !row_mul !mulmxA. Qed. Lemma cent_mx_scalar_abs_irr : \rank Hom_G <= 1 -> mx_absolutely_irreducible rG. Proof. rewrite leqNgt => /(has_non_scalar_mxP (scalar_mx_cent _ _)) scal_cE. apply/andP; split; first by case/mx_irrP: irrG. rewrite -sub1mx; apply: submx_trans mx_Jacobson_density. apply/memmx_subP=> B _; apply/cent_mxP=> A cGA. case scalA: (is_scalar_mx A); last by case: scal_cE; exists A; rewrite ?scalA. by case/is_scalar_mxP: scalA => a ->; rewrite scalar_mxC. Qed. End JacobsonDensity. Section ChangeGroup. Variables (gT : finGroupType) (G H : {group gT}) (n : nat). Variables (rG : mx_representation F G n). Section SubGroup. Hypothesis sHG : H \subset G. Local Notation rH := (subg_repr rG sHG). Lemma rfix_subg : rfix_mx rH = rfix_mx rG. Proof. by []. Qed. Section Stabilisers. Variables (m : nat) (U : 'M[F]_(m, n)). Lemma rstabs_subg : rstabs rH U = H :&: rstabs rG U. Proof. by apply/setP=> x; rewrite !inE andbA -in_setI (setIidPl sHG). Qed. Lemma mxmodule_subg : mxmodule rG U -> mxmodule rH U. Proof. by rewrite /mxmodule rstabs_subg subsetI subxx; apply: subset_trans. Qed. End Stabilisers. Lemma mxsimple_subg M : mxmodule rG M -> mxsimple rH M -> mxsimple rG M. Proof. by move=> modM [_ nzM minM]; split=> // U /mxmodule_subg; apply: minM. Qed. Lemma subg_mx_irr : mx_irreducible rH -> mx_irreducible rG. Proof. by apply: mxsimple_subg; apply: mxmodule1. Qed. Lemma subg_mx_abs_irr : mx_absolutely_irreducible rH -> mx_absolutely_irreducible rG. Proof. rewrite /mx_absolutely_irreducible -!sub1mx => /andP[-> /submx_trans-> //]. apply/row_subP=> i; rewrite rowK /= envelop_mx_id //. by rewrite (subsetP sHG) ?enum_valP. Qed. End SubGroup. Section SameGroup. Hypothesis eqGH : G :==: H. Local Notation rH := (eqg_repr rG eqGH). Lemma rfix_eqg : rfix_mx rH = rfix_mx rG. Proof. by []. Qed. Section Stabilisers. Variables (m : nat) (U : 'M[F]_(m, n)). Lemma rstabs_eqg : rstabs rH U = rstabs rG U. Proof. by rewrite rstabs_subg -(eqP eqGH) (setIidPr _) ?rstabs_sub. Qed. Lemma mxmodule_eqg : mxmodule rH U = mxmodule rG U. Proof. by rewrite /mxmodule rstabs_eqg -(eqP eqGH). Qed. End Stabilisers. Lemma mxsimple_eqg M : mxsimple rH M <-> mxsimple rG M. Proof. rewrite /mxsimple mxmodule_eqg. split=> [] [-> -> minM]; split=> // U modU; by apply: minM; rewrite mxmodule_eqg in modU *. Qed. Lemma eqg_mx_irr : mx_irreducible rH <-> mx_irreducible rG. Proof. exact: mxsimple_eqg. Qed. Lemma eqg_mx_abs_irr : mx_absolutely_irreducible rH = mx_absolutely_irreducible rG. Proof. by congr (_ && (_ == _)); rewrite /enveloping_algebra_mx /= -(eqP eqGH). Qed. End SameGroup. End ChangeGroup. Section Morphpre. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Variables (G : {group rT}) (n : nat) (rG : mx_representation F G n). Local Notation rGf := (morphpre_repr f rG). Section Stabilisers. Variables (m : nat) (U : 'M[F]_(m, n)). Lemma rstabs_morphpre : rstabs rGf U = f @*^-1 (rstabs rG U). Proof. by apply/setP=> x; rewrite !inE andbA. Qed. Lemma mxmodule_morphpre : G \subset f @* D -> mxmodule rGf U = mxmodule rG U. Proof. by move=> sGf; rewrite /mxmodule rstabs_morphpre morphpreSK. Qed. End Stabilisers. Lemma rfix_morphpre (H : {set aT}) : H \subset D -> (rfix_mx rGf H :=: rfix_mx rG (f @* H))%MS. Proof. move=> sHD; apply/eqmxP/andP; split. by apply/rfix_mxP=> _ /morphimP[x _ Hx ->]; rewrite rfix_mx_id. by apply/rfix_mxP=> x Hx; rewrite rfix_mx_id ?mem_morphim ?(subsetP sHD). Qed. Lemma morphpre_mx_irr : G \subset f @* D -> (mx_irreducible rGf <-> mx_irreducible rG). Proof. move/mxmodule_morphpre=> modG; split=> /mx_irrP[n_gt0 irrG]; by apply/mx_irrP; split=> // U modU; apply: irrG; rewrite modG in modU *. Qed. Lemma morphpre_mx_abs_irr : G \subset f @* D -> mx_absolutely_irreducible rGf = mx_absolutely_irreducible rG. Proof. move=> sGfD; congr (_ && (_ == _)); apply/eqP; rewrite mxrank_leqif_sup //. apply/row_subP=> i; rewrite rowK. case/morphimP: (subsetP sGfD _ (enum_valP i)) => x Dx _ def_i. by rewrite def_i (envelop_mx_id rGf) // !inE Dx -def_i enum_valP. apply/row_subP=> i; rewrite rowK (envelop_mx_id rG) //. by case/morphpreP: (enum_valP i). Qed. End Morphpre. Section Morphim. Variables (aT rT : finGroupType) (G D : {group aT}) (f : {morphism D >-> rT}). Variables (n : nat) (rGf : mx_representation F (f @* G) n). Hypothesis sGD : G \subset D. Let sG_f'fG : G \subset f @*^-1 (f @* G). Proof. by rewrite -sub_morphim_pre. Qed. Local Notation rG := (morphim_repr rGf sGD). Section Stabilisers. Variables (m : nat) (U : 'M[F]_(m, n)). Lemma rstabs_morphim : rstabs rG U = G :&: f @*^-1 rstabs rGf U. Proof. by rewrite -rstabs_morphpre -(rstabs_subg _ sG_f'fG). Qed. Lemma mxmodule_morphim : mxmodule rG U = mxmodule rGf U. Proof. by rewrite /mxmodule rstabs_morphim subsetI subxx -sub_morphim_pre. Qed. End Stabilisers. Lemma rfix_morphim (H : {set aT}) : H \subset D -> (rfix_mx rG H :=: rfix_mx rGf (f @* H))%MS. Proof. exact: rfix_morphpre. Qed. Lemma mxsimple_morphim M : mxsimple rG M <-> mxsimple rGf M. Proof. rewrite /mxsimple mxmodule_morphim. split=> [] [-> -> minM]; split=> // U modU; by apply: minM; rewrite mxmodule_morphim in modU *. Qed. Lemma morphim_mx_irr : (mx_irreducible rG <-> mx_irreducible rGf). Proof. exact: mxsimple_morphim. Qed. Lemma morphim_mx_abs_irr : mx_absolutely_irreducible rG = mx_absolutely_irreducible rGf. Proof. have fG_onto: f @* G \subset restrm sGD f @* G. by rewrite morphim_restrm setIid. rewrite -(morphpre_mx_abs_irr _ fG_onto); congr (_ && (_ == _)). by rewrite /enveloping_algebra_mx /= morphpre_restrm (setIidPl _). Qed. End Morphim. Section Submodule. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variables (rG : mx_representation F G n) (U : 'M[F]_n) (Umod : mxmodule rG U). Local Notation rU := (submod_repr Umod). Local Notation rU' := (factmod_repr Umod). Lemma rfix_submod (H : {set gT}) : H \subset G -> (rfix_mx rU H :=: in_submod U (U :&: rfix_mx rG H))%MS. Proof. move=> sHG; apply/eqmxP/andP; split; last first. apply/rfix_mxP=> x Hx; rewrite -in_submodJ ?capmxSl //. by rewrite (rfix_mxP H _) ?capmxSr. rewrite -val_submodS in_submodK ?capmxSl // sub_capmx val_submodP //=. apply/rfix_mxP=> x Hx. by rewrite -(val_submodJ Umod) ?(subsetP sHG) ?rfix_mx_id. Qed. Lemma rfix_factmod (H : {set gT}) : H \subset G -> (in_factmod U (rfix_mx rG H) <= rfix_mx rU' H)%MS. Proof. move=> sHG; apply/rfix_mxP=> x Hx. by rewrite -(in_factmodJ Umod) ?(subsetP sHG) ?rfix_mx_id. Qed. Lemma rstab_submod m (W : 'M_(m, \rank U)) : rstab rU W = rstab rG (val_submod W). Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. by rewrite -(inj_eq val_submod_inj) val_submodJ. Qed. Lemma rstabs_submod m (W : 'M_(m, \rank U)) : rstabs rU W = rstabs rG (val_submod W). Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. by rewrite -val_submodS val_submodJ. Qed. Lemma val_submod_module m (W : 'M_(m, \rank U)) : mxmodule rG (val_submod W) = mxmodule rU W. Proof. by rewrite /mxmodule rstabs_submod. Qed. Lemma in_submod_module m (V : 'M_(m, n)) : (V <= U)%MS -> mxmodule rU (in_submod U V) = mxmodule rG V. Proof. by move=> sVU; rewrite -val_submod_module in_submodK. Qed. Lemma rstab_factmod m (W : 'M_(m, n)) : rstab rG W \subset rstab rU' (in_factmod U W). Proof. by apply/subsetP=> x /setIdP[Gx /eqP cUW]; rewrite inE Gx -in_factmodJ //= cUW. Qed. Lemma rstabs_factmod m (W : 'M_(m, \rank (cokermx U))) : rstabs rU' W = rstabs rG (U + val_factmod W)%MS. Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. rewrite addsmxMr addsmx_sub (submx_trans (mxmoduleP Umod x Gx)) ?addsmxSl //. rewrite -val_factmodS val_factmodJ //= val_factmodS; apply/idP/idP=> nWx. rewrite (submx_trans (addsmxSr U _)) // -(in_factmodsK (addsmxSl U _)) //. by rewrite addsmxS // val_factmodS in_factmod_addsK. rewrite in_factmodE (submx_trans (submxMr _ nWx)) // -in_factmodE. by rewrite in_factmod_addsK val_factmodK. Qed. Lemma val_factmod_module m (W : 'M_(m, \rank (cokermx U))) : mxmodule rG (U + val_factmod W)%MS = mxmodule rU' W. Proof. by rewrite /mxmodule rstabs_factmod. Qed. Lemma in_factmod_module m (V : 'M_(m, n)) : mxmodule rU' (in_factmod U V) = mxmodule rG (U + V)%MS. Proof. rewrite -(eqmx_module _ (in_factmodsK (addsmxSl U V))). by rewrite val_factmod_module (eqmx_module _ (in_factmod_addsK _ _)). Qed. Lemma rker_submod : rker rU = rstab rG U. Proof. by rewrite /rker rstab_submod; apply: eqmx_rstab (val_submod1 U). Qed. Lemma rstab_norm : G \subset 'N(rstab rG U). Proof. by rewrite -rker_submod rker_norm. Qed. Lemma rstab_normal : rstab rG U <| G. Proof. by rewrite -rker_submod rker_normal. Qed. Lemma submod_mx_faithful : mx_faithful rU -> mx_faithful rG. Proof. by apply: subset_trans; rewrite rker_submod rstabS ?submx1. Qed. Lemma rker_factmod : rker rG \subset rker rU'. Proof. apply/subsetP=> x /rkerP[Gx cVx]. by rewrite inE Gx /= /factmod_mx cVx mul1mx mulmx1 val_factmodK. Qed. Lemma factmod_mx_faithful : mx_faithful rU' -> mx_faithful rG. Proof. exact: subset_trans rker_factmod. Qed. Lemma submod_mx_irr : mx_irreducible rU <-> mxsimple rG U. Proof. split=> [] [_ nzU simU]. rewrite -mxrank_eq0 mxrank1 mxrank_eq0 in nzU; split=> // V modV sVU nzV. rewrite -(in_submodK sVU) -val_submod1 val_submodS. rewrite -(genmxE (in_submod U V)) simU ?genmxE ?submx1 //=. by rewrite (eqmx_module _ (genmxE _)) in_submod_module. rewrite -submx0 genmxE -val_submodS in_submodK //. by rewrite linear0 eqmx0 submx0. apply/mx_irrP; rewrite lt0n mxrank_eq0; split=> // V modV. rewrite -(inj_eq val_submod_inj) linear0 -(eqmx_eq0 (genmxE _)) => nzV. rewrite -sub1mx -val_submodS val_submod1 -(genmxE (val_submod V)). rewrite simU ?genmxE ?val_submodP //=. by rewrite (eqmx_module _ (genmxE _)) val_submod_module. Qed. End Submodule. Section Conjugate. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variables (rG : mx_representation F G n) (B : 'M[F]_n). Hypothesis uB : B \in unitmx. Local Notation rGB := (rconj_repr rG uB). Lemma rfix_conj (H : {set gT}) : (rfix_mx rGB H :=: B *m rfix_mx rG H *m invmx B)%MS. Proof. apply/eqmxP/andP; split. rewrite -mulmxA (eqmxMfull (_ *m _)) ?row_full_unit //. rewrite -[rfix_mx rGB H](mulmxK uB) submxMr //; apply/rfix_mxP=> x Hx. apply: (canRL (mulmxKV uB)); rewrite -(rconj_mxJ _ uB) mulmxK //. by rewrite rfix_mx_id. apply/rfix_mxP=> x Gx; rewrite -3!mulmxA; congr (_ *m _). by rewrite !mulmxA mulmxKV // rfix_mx_id. Qed. Lemma rstabs_conj m (U : 'M_(m, n)) : rstabs rGB U = rstabs rG (U *m B). Proof. apply/setP=> x; rewrite !inE rconj_mxE !mulmxA. by rewrite -{2}[U](mulmxK uB) submxMfree // row_free_unit unitmx_inv. Qed. Lemma mxmodule_conj m (U : 'M_(m, n)) : mxmodule rGB U = mxmodule rG (U *m B). Proof. by rewrite /mxmodule rstabs_conj. Qed. Lemma conj_mx_irr : mx_irreducible rGB <-> mx_irreducible rG. Proof. have Bfree: row_free B by rewrite row_free_unit. split => /mx_irrP[n_gt0 irrG]; apply/mx_irrP; split=> // U. rewrite -[U](mulmxKV uB) -mxmodule_conj -mxrank_eq0 /row_full mxrankMfree //. by rewrite mxrank_eq0; apply: irrG. rewrite -mxrank_eq0 /row_full -(mxrankMfree _ Bfree) mxmodule_conj mxrank_eq0. exact: irrG. Qed. End Conjugate. Section Quotient. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Variables (rG : mx_representation F G n) (H : {group gT}). Hypotheses (krH : H \subset rker rG) (nHG : G \subset 'N(H)). Let nHGs := subsetP nHG. Local Notation rGH := (quo_repr krH nHG). Local Notation E_ r := (enveloping_algebra_mx r). Lemma quo_mx_quotient : (E_ rGH :=: E_ rG)%MS. Proof. apply/eqmxP/andP; split; apply/row_subP=> i. rewrite rowK; case/morphimP: (enum_valP i) => x _ Gx ->{i}. rewrite quo_repr_coset // (eq_row_sub (enum_rank_in Gx x)) // rowK. by rewrite enum_rankK_in. rewrite rowK -(quo_mx_coset krH nHG) ?enum_valP //; set Hx := coset H _. have GHx: Hx \in (G / H)%g by rewrite mem_quotient ?enum_valP. by rewrite (eq_row_sub (enum_rank_in GHx Hx)) // rowK enum_rankK_in. Qed. Lemma rfix_quo (K : {group gT}) : K \subset G -> (rfix_mx rGH (K / H)%g :=: rfix_mx rG K)%MS. Proof. move=> sKG; apply/eqmxP/andP; (split; apply/rfix_mxP) => [x Kx | Hx]. have Gx := subsetP sKG x Kx; rewrite -(quo_mx_coset krH nHG) // rfix_mx_id //. by rewrite mem_morphim ?(subsetP nHG). case/morphimP=> x _ Kx ->; have Gx := subsetP sKG x Kx. by rewrite quo_repr_coset ?rfix_mx_id. Qed. Lemma rstabs_quo m (U : 'M_(m, n)) : rstabs rGH U = (rstabs rG U / H)%g. Proof. apply/setP=> Hx; rewrite !inE; apply/andP/idP=> [[]|] /morphimP[x Nx Gx ->{Hx}]. by rewrite quo_repr_coset // => nUx; rewrite mem_morphim // inE Gx. by case/setIdP: Gx => Gx nUx; rewrite quo_repr_coset ?mem_morphim. Qed. Lemma mxmodule_quo m (U : 'M_(m, n)) : mxmodule rGH U = mxmodule rG U. Proof. rewrite /mxmodule rstabs_quo quotientSGK // ?(subset_trans krH) //. apply/subsetP=> x; rewrite !inE mul1mx => /andP[-> /eqP->]. by rewrite /= mulmx1. Qed. Lemma quo_mx_irr : mx_irreducible rGH <-> mx_irreducible rG. Proof. split; case/mx_irrP=> n_gt0 irrG; apply/mx_irrP; split=> // U modU; by apply: irrG; rewrite mxmodule_quo in modU *. Qed. End Quotient. Section SplittingField. Implicit Type gT : finGroupType. Definition group_splitting_field gT (G : {group gT}) := forall n (rG : mx_representation F G n), mx_irreducible rG -> mx_absolutely_irreducible rG. Definition group_closure_field gT := forall G : {group gT}, group_splitting_field G. Lemma quotient_splitting_field gT (G : {group gT}) (H : {set gT}) : G \subset 'N(H) -> group_splitting_field G -> group_splitting_field (G / H). Proof. move=> nHG splitG n rGH irrGH. by rewrite -(morphim_mx_abs_irr _ nHG) splitG //; apply/morphim_mx_irr. Qed. Lemma coset_splitting_field gT (H : {set gT}) : group_closure_field gT -> group_closure_field (coset_groupType H). Proof. move=> split_gT Gbar; have ->: Gbar = (coset H @*^-1 Gbar / H)%G. by apply: val_inj; rewrite /= /quotient morphpreK ?sub_im_coset. by apply: quotient_splitting_field; [apply: subsetIl | apply: split_gT]. Qed. End SplittingField. Section Abelian. Variables (gT : finGroupType) (G : {group gT}). Lemma mx_faithful_irr_center_cyclic n (rG : mx_representation F G n) : mx_faithful rG -> mx_irreducible rG -> cyclic 'Z(G). Proof. case: n rG => [|n] rG injG irrG; first by case/mx_irrP: irrG. move/trivgP: injG => KrG1; pose rZ := subg_repr rG (center_sub _). apply: (div_ring_mul_group_cyclic (repr_mx1 rZ)) (repr_mxM rZ) _ _; last first. exact: center_abelian. move=> x; rewrite -[[set _]]KrG1 !inE mul1mx -subr_eq0 andbC; set U := _ - _. do 2![case/andP]=> Gx cGx; rewrite Gx /=; apply: (mx_Schur irrG). apply/centgmxP=> y Gy; rewrite mulmxBl mulmxBr mulmx1 mul1mx. by rewrite -!repr_mxM // (centP cGx). Qed. Lemma mx_faithful_irr_abelian_cyclic n (rG : mx_representation F G n) : mx_faithful rG -> mx_irreducible rG -> abelian G -> cyclic G. Proof. move=> injG irrG cGG; rewrite -(setIidPl cGG). exact: mx_faithful_irr_center_cyclic injG irrG. Qed. Hypothesis splitG : group_splitting_field G. Lemma mx_irr_abelian_linear n (rG : mx_representation F G n) : mx_irreducible rG -> abelian G -> n = 1%N. Proof. by move=> irrG cGG; apply/eqP; rewrite -(abelian_abs_irr rG) ?splitG. Qed. Lemma mxsimple_abelian_linear n (rG : mx_representation F G n) M : abelian G -> mxsimple rG M -> \rank M = 1%N. Proof. move=> cGG simM; have [modM _ _] := simM. by move/(submod_mx_irr modM)/mx_irr_abelian_linear: simM => ->. Qed. Lemma linear_mxsimple n (rG : mx_representation F G n) (M : 'M_n) : mxmodule rG M -> \rank M = 1%N -> mxsimple rG M. Proof. move=> modM rM1; apply/(submod_mx_irr modM). by apply: mx_abs_irrW; rewrite linear_mx_abs_irr. Qed. End Abelian. Section AbelianQuotient. Variables (gT : finGroupType) (G : {group gT}). Variables (n : nat) (rG : mx_representation F G n). Lemma center_kquo_cyclic : mx_irreducible rG -> cyclic 'Z(G / rker rG)%g. Proof. move=> irrG; apply: mx_faithful_irr_center_cyclic (kquo_mx_faithful rG) _. exact/quo_mx_irr. Qed. Lemma der1_sub_rker : group_splitting_field G -> mx_irreducible rG -> (G^`(1) \subset rker rG)%g = (n == 1)%N. Proof. move=> splitG irrG; apply/idP/idP; last by move/eqP; apply: rker_linear. move/sub_der1_abelian; move/(abelian_abs_irr (kquo_repr rG))=> <-. by apply: (quotient_splitting_field (rker_norm _) splitG); apply/quo_mx_irr. Qed. End AbelianQuotient. Section Similarity. Variables (gT : finGroupType) (G : {group gT}). Local Notation reprG := (mx_representation F G). Variant mx_rsim n1 (rG1 : reprG n1) n2 (rG2 : reprG n2) : Prop := MxReprSim B of n1 = n2 & row_free B & forall x, x \in G -> rG1 x *m B = B *m rG2 x. Lemma mxrank_rsim n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> n1 = n2. Proof. by case. Qed. Lemma mx_rsim_refl n (rG : reprG n) : mx_rsim rG rG. Proof. exists 1%:M => // [|x _]; first by rewrite row_free_unit unitmx1. by rewrite mulmx1 mul1mx. Qed. Lemma mx_rsim_sym n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> mx_rsim rG2 rG1. Proof. case=> B def_n1; rewrite def_n1 in rG1 B *. rewrite row_free_unit => injB homB; exists (invmx B) => // [|x Gx]. by rewrite row_free_unit unitmx_inv. by apply: canRL (mulKmx injB) _; rewrite mulmxA -homB ?mulmxK. Qed. Lemma mx_rsim_trans n1 n2 n3 (rG1 : reprG n1) (rG2 : reprG n2) (rG3 : reprG n3) : mx_rsim rG1 rG2 -> mx_rsim rG2 rG3 -> mx_rsim rG1 rG3. Proof. case=> [B1 defn1 freeB1 homB1] [B2 defn2 freeB2 homB2]. exists (B1 *m B2); rewrite /row_free ?mxrankMfree 1?defn1 // => x Gx. by rewrite mulmxA homB1 // -!mulmxA homB2. Qed. Lemma mx_rsim_def n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> exists B, exists2 B', B' *m B = 1%:M & forall x, x \in G -> rG1 x = B *m rG2 x *m B'. Proof. case=> B def_n1; rewrite def_n1 in rG1 B *; rewrite row_free_unit => injB homB. by exists B, (invmx B) => [|x Gx]; rewrite ?mulVmx // -homB // mulmxK. Qed. Lemma mx_rsim_iso n (rG : reprG n) (U V : 'M_n) (modU : mxmodule rG U) (modV : mxmodule rG V) : mx_rsim (submod_repr modU) (submod_repr modV) <-> mx_iso rG U V. Proof. split=> [[B eqrUV injB homB] | [f injf homf defV]]. have: \rank (U *m val_submod (in_submod U 1%:M *m B)) = \rank U. do 2!rewrite mulmxA mxrankMfree ?row_base_free //. by rewrite -(eqmxMr _ (val_submod1 U)) -in_submodE val_submodK mxrank1. case/complete_unitmx => f injf defUf; exists f => //. apply/hom_mxP=> x Gx; rewrite -defUf -2!mulmxA -(val_submodJ modV) //. rewrite -(mulmxA _ B) -homB // val_submodE 3!(mulmxA U) (mulmxA _ _ B). rewrite -in_submodE -in_submodJ //. have [u ->] := submxP (mxmoduleP modU x Gx). by rewrite in_submodE -mulmxA -defUf !mulmxA mulmx1. apply/eqmxP; rewrite -mxrank_leqif_eq. by rewrite mxrankMfree ?eqrUV ?row_free_unit. by rewrite -defUf mulmxA val_submodP. have eqrUV: \rank U = \rank V by rewrite -defV mxrankMfree ?row_free_unit. exists (in_submod V (val_submod 1%:M *m f)) => // [|x Gx]. rewrite /row_free {6}eqrUV -[_ == _]sub1mx -val_submodS. rewrite in_submodK; last by rewrite -defV submxMr ?val_submodP. by rewrite val_submod1 -defV submxMr ?val_submod1. rewrite -in_submodJ; last by rewrite -defV submxMr ?val_submodP. rewrite -(hom_mxP (submx_trans (val_submodP _) homf)) //. by rewrite -(val_submodJ modU) // mul1mx 2!(mulmxA ((submod_repr _) x)) -val_submodE. Qed. Lemma mx_rsim_irr n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> mx_irreducible rG1 -> mx_irreducible rG2. Proof. case/mx_rsim_sym=> f def_n2; rewrite {n2}def_n2 in f rG2 * => injf homf. case/mx_irrP=> n1_gt0 minG; apply/mx_irrP; split=> // U modU nzU. rewrite /row_full -(mxrankMfree _ injf) -genmxE. apply: minG; last by rewrite -mxrank_eq0 genmxE mxrankMfree // mxrank_eq0. rewrite (eqmx_module _ (genmxE _)); apply/mxmoduleP=> x Gx. by rewrite -mulmxA -homf // mulmxA submxMr // (mxmoduleP modU). Qed. Lemma mx_rsim_abs_irr n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> mx_absolutely_irreducible rG1 = mx_absolutely_irreducible rG2. Proof. case=> f def_n2; rewrite -{n2}def_n2 in f rG2 *. rewrite row_free_unit => injf homf; congr (_ && (_ == _)). pose Eg (g : 'M[F]_n1) := lin_mx (mulmxr (invmx g) \o mulmx g). have free_Ef: row_free (Eg f). apply/row_freeP; exists (Eg (invmx f)); apply/row_matrixP=> i. rewrite rowE row1 mulmxA mul_rV_lin mx_rV_lin /=. by rewrite invmxK !{1}mulmxA mulmxKV // -mulmxA mulKmx // vec_mxK. symmetry; rewrite -(mxrankMfree _ free_Ef); congr (\rank _). apply/row_matrixP=> i; rewrite row_mul !rowK mul_vec_lin /=. by rewrite -homf ?enum_valP // mulmxK. Qed. Lemma rker_mx_rsim n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> rker rG1 = rker rG2. Proof. case=> f def_n2; rewrite -{n2}def_n2 in f rG2 *. rewrite row_free_unit => injf homf. apply/setP=> x; rewrite !inE !mul1mx; apply: andb_id2l => Gx. by rewrite -(can_eq (mulmxK injf)) homf // -scalar_mxC (can_eq (mulKmx injf)). Qed. Lemma mx_rsim_faithful n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> mx_faithful rG1 = mx_faithful rG2. Proof. by move=> simG12; rewrite /mx_faithful (rker_mx_rsim simG12). Qed. Lemma mx_rsim_factmod n (rG : reprG n) U V (modU : mxmodule rG U) (modV : mxmodule rG V) : (U + V :=: 1%:M)%MS -> mxdirect (U + V) -> mx_rsim (factmod_repr modV) (submod_repr modU). Proof. move=> addUV dxUV. have eqUV: \rank U = \rank (cokermx V). by rewrite mxrank_coker -{3}(mxrank1 F n) -addUV (mxdirectP dxUV) addnK. have{} dxUV: (U :&: V = 0)%MS by apply/mxdirect_addsP. exists (in_submod U (val_factmod 1%:M *m proj_mx U V)) => // [|x Gx]. rewrite /row_free -{6}eqUV -[_ == _]sub1mx -val_submodS val_submod1. rewrite in_submodK ?proj_mx_sub // -{1}[U](proj_mx_id dxUV) //. rewrite -{1}(add_sub_fact_mod V U) mulmxDl proj_mx_0 ?val_submodP // add0r. by rewrite submxMr // val_factmodS submx1. rewrite -in_submodJ ?proj_mx_sub // -(hom_mxP _) //; last first. by apply: submx_trans (submx1 _) _; rewrite -addUV proj_mx_hom. rewrite mulmxA; congr (_ *m _); rewrite mulmxA -val_factmodE; apply/eqP. rewrite eq_sym -subr_eq0 -mulmxBl proj_mx_0 //. by rewrite -[_ *m rG x](add_sub_fact_mod V) addrK val_submodP. Qed. Lemma mxtrace_rsim n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) : mx_rsim rG1 rG2 -> {in G, forall x, \tr (rG1 x) = \tr (rG2 x)}. Proof. case/mx_rsim_def=> B [B' B'B def_rG1] x Gx. by rewrite def_rG1 // mxtrace_mulC mulmxA B'B mul1mx. Qed. Lemma mx_rsim_scalar n1 n2 (rG1 : reprG n1) (rG2 : reprG n2) x c : x \in G -> mx_rsim rG1 rG2 -> rG1 x = c%:M -> rG2 x = c%:M. Proof. move=> Gx /mx_rsim_sym[B _ Bfree rG2_B] rG1x. by apply: (row_free_inj Bfree); rewrite rG2_B // rG1x scalar_mxC. Qed. End Similarity. Section Socle. Variables (gT : finGroupType) (G : {group gT}). Variables (n : nat) (rG : mx_representation F G n) (sG : socleType rG). Lemma socle_irr (W : sG) : mx_irreducible (socle_repr W). Proof. by apply/submod_mx_irr; apply: socle_simple. Qed. Lemma socle_rsimP (W1 W2 : sG) : reflect (mx_rsim (socle_repr W1) (socle_repr W2)) (W1 == W2). Proof. have [simW1 simW2] := (socle_simple W1, socle_simple W2). by apply: (iffP (component_mx_isoP simW1 simW2)); move/mx_rsim_iso; apply. Qed. Local Notation mG U := (mxmodule rG U). Local Notation sr modV := (submod_repr modV). Lemma mx_rsim_in_submod U V (modU : mG U) (modV : mG V) : let U' := <>%MS in (U <= V)%MS -> exists modU' : mxmodule (sr modV) U', mx_rsim (sr modU) (sr modU'). Proof. move=> U' sUV; have modU': mxmodule (sr modV) U'. by rewrite (eqmx_module _ (genmxE _)) in_submod_module. have rankU': \rank U = \rank U' by rewrite genmxE mxrank_in_submod. pose v1 := val_submod 1%:M; pose U1 := v1 _ U. have sU1V: (U1 <= V)%MS by rewrite val_submod1. have sU1U': (in_submod V U1 <= U')%MS by rewrite genmxE submxMr ?val_submod1. exists modU', (in_submod U' (in_submod V U1)) => // [|x Gx]. apply/row_freeP; exists (v1 _ _ *m v1 _ _ *m in_submod U 1%:M). by rewrite 2!mulmxA -in_submodE -!val_submodE !in_submodK ?val_submodK. rewrite -!in_submodJ // -(val_submodJ modU) // mul1mx. by rewrite 2!{1}in_submodE mulmxA (mulmxA _ U1) -val_submodE -!in_submodE. Qed. Lemma rsim_submod1 U (modU : mG U) : (U :=: 1%:M)%MS -> mx_rsim (sr modU) rG. Proof. move=> U1; exists (val_submod 1%:M) => [||x Gx]; first by rewrite U1 mxrank1. by rewrite /row_free val_submod1. by rewrite -(val_submodJ modU) // mul1mx -val_submodE. Qed. Lemma mxtrace_submod1 U (modU : mG U) : (U :=: 1%:M)%MS -> {in G, forall x, \tr (sr modU x) = \tr (rG x)}. Proof. by move=> defU; apply: mxtrace_rsim (rsim_submod1 modU defU). Qed. Lemma mxtrace_dadd_mod U V W (modU : mG U) (modV : mG V) (modW : mG W) : (U + V :=: W)%MS -> mxdirect (U + V) -> {in G, forall x, \tr (sr modU x) + \tr (sr modV x) = \tr (sr modW x)}. Proof. move=> defW dxW x Gx; have [sUW sVW]: (U <= W)%MS /\ (V <= W)%MS. by apply/andP; rewrite -addsmx_sub defW. pose U' := <>%MS; pose V' := <>%MS. have addUV': (U' + V' :=: 1%:M)%MS. apply/eqmxP; rewrite submx1 /= (adds_eqmx (genmxE _) (genmxE _)). by rewrite -addsmxMr -val_submodS val_submod1 in_submodK ?defW. have dxUV': mxdirect (U' + V'). apply/eqnP; rewrite /= addUV' mxrank1 !genmxE !mxrank_in_submod //. by rewrite -(mxdirectP dxW) /= defW. have [modU' simU] := mx_rsim_in_submod modU modW sUW. have [modV' simV] := mx_rsim_in_submod modV modW sVW. rewrite (mxtrace_rsim simU) // (mxtrace_rsim simV) //. rewrite -(mxtrace_sub_fact_mod modV') addrC; congr (_ + _). by rewrite (mxtrace_rsim (mx_rsim_factmod modU' modV' addUV' dxUV')). Qed. Lemma mxtrace_dsum_mod (I : finType) (P : pred I) U W (modU : forall i, mG (U i)) (modW : mG W) : let S := (\sum_(i | P i) U i)%MS in (S :=: W)%MS -> mxdirect S -> {in G, forall x, \sum_(i | P i) \tr (sr (modU i) x) = \tr (sr modW x)}. Proof. move=> /= sumS dxS x Gx; have [m lePm] := ubnP #|P|. elim: m => // m IHm in P lePm W modW sumS dxS *. have [j /= Pj | P0] := pickP P; last first. case: sumS (_ x); rewrite !big_pred0 // mxrank0 => <- _ rWx. by rewrite [rWx]flatmx0 linear0. rewrite ltnS (cardD1x Pj) in lePm. rewrite mxdirectE /= !(bigD1 j Pj) -mxdirectE mxdirect_addsE /= in dxS sumS *. have [_ dxW' dxW] := and3P dxS; rewrite (sameP eqP mxdirect_addsP) in dxW. rewrite (IHm _ _ _ (sumsmx_module _ (fun i _ => modU i)) (eqmx_refl _)) //. exact: mxtrace_dadd_mod. Qed. Lemma mxtrace_component U (simU : mxsimple rG U) : let V := component_mx rG U in let modV := component_mx_module rG U in let modU := mxsimple_module simU in {in G, forall x, \tr (sr modV x) = \tr (sr modU x) *+ (\rank V %/ \rank U)}. Proof. move=> V modV modU x Gx. have [I W S simW defV dxV] := component_mx_semisimple simU. rewrite -(mxtrace_dsum_mod (fun i => mxsimple_module (simW i)) modV defV) //. have rankU_gt0: \rank U > 0 by rewrite lt0n mxrank_eq0; case simU. have isoW i: mx_iso rG U (W i). by apply: component_mx_iso; rewrite ?simU // -defV (sumsmx_sup i). have ->: (\rank V %/ \rank U)%N = #|I|. symmetry; rewrite -(mulnK #|I| rankU_gt0); congr (_ %/ _)%N. rewrite -defV (mxdirectP dxV) /= -sum_nat_const. by apply: eq_bigr => i _; apply: mxrank_iso. rewrite -sumr_const; apply: eq_bigr => i _; symmetry. by apply: mxtrace_rsim Gx; apply/mx_rsim_iso; apply: isoW. Qed. Lemma mxtrace_Socle : let modS := Socle_module sG in {in G, forall x, \tr (sr modS x) = \sum_(W : sG) \tr (socle_repr W x) *+ socle_mult W}. Proof. move=> /= x Gx /=; pose modW (W : sG) := component_mx_module rG (socle_base W). rewrite -(mxtrace_dsum_mod modW _ (eqmx_refl _) (Socle_direct sG)) //. by apply: eq_bigr => W _; rewrite (mxtrace_component (socle_simple W)). Qed. End Socle. Section Clifford. Variables (gT : finGroupType) (G H : {group gT}). Hypothesis nsHG : H <| G. Variables (n : nat) (rG : mx_representation F G n). Let sHG := normal_sub nsHG. Let nHG := normal_norm nsHG. Let rH := subg_repr rG sHG. Lemma Clifford_simple M x : mxsimple rH M -> x \in G -> mxsimple rH (M *m rG x). Proof. have modmG m U y: y \in G -> (mxmodule rH) m U -> mxmodule rH (U *m rG y). move=> Gy modU; apply/mxmoduleP=> h Hh; have Gh := subsetP sHG h Hh. rewrite -mulmxA -repr_mxM // conjgCV repr_mxM ?groupJ ?groupV // mulmxA. by rewrite submxMr ?(mxmoduleP modU) // -mem_conjg (normsP nHG). have nzmG m y (U : 'M_(m, n)): y \in G -> (U *m rG y == 0) = (U == 0). by move=> Gy; rewrite -{1}(mul0mx m (rG y)) (can_eq (repr_mxK rG Gy)). case=> [modM nzM simM] Gx; have Gx' := groupVr Gx. split=> [||U modU sUMx nzU]; rewrite ?modmG ?nzmG //. rewrite -(repr_mxKV rG Gx U) submxMr //. by rewrite (simM (U *m _)) ?modmG ?nzmG // -(repr_mxK rG Gx M) submxMr. Qed. Lemma Clifford_hom x m (U : 'M_(m, n)) : x \in 'C_G(H) -> (U <= dom_hom_mx rH (rG x))%MS. Proof. case/setIP=> Gx cHx; apply/rV_subP=> v _{U}. apply/hom_mxP=> h Hh; have Gh := subsetP sHG h Hh. by rewrite -!mulmxA /= -!repr_mxM // (centP cHx). Qed. Lemma Clifford_iso x U : x \in 'C_G(H) -> mx_iso rH U (U *m rG x). Proof. move=> cHx; have [Gx _] := setIP cHx. by exists (rG x); rewrite ?repr_mx_unit ?Clifford_hom. Qed. Lemma Clifford_iso2 x U V : mx_iso rH U V -> x \in G -> mx_iso rH (U *m rG x) (V *m rG x). Proof. case=> [f injf homUf defV] Gx; have Gx' := groupVr Gx. pose fx := rG (x^-1)%g *m f *m rG x; exists fx; last 1 first. - by rewrite !mulmxA repr_mxK //; apply: eqmxMr. - by rewrite !unitmx_mul andbC !repr_mx_unit. apply/hom_mxP=> h Hh; have Gh := subsetP sHG h Hh. rewrite -(mulmxA U) -repr_mxM // conjgCV repr_mxM ?groupJ // !mulmxA. rewrite !repr_mxK // (hom_mxP homUf) -?mem_conjg ?(normsP nHG) //=. by rewrite !repr_mxM ?invgK ?groupM // !mulmxA repr_mxKV. Qed. Lemma Clifford_componentJ M x : mxsimple rH M -> x \in G -> (component_mx rH (M *m rG x) :=: component_mx rH M *m rG x)%MS. Proof. set simH := mxsimple rH; set cH := component_mx rH. have actG: {in G, forall y M, simH M -> cH M *m rG y <= cH (M *m rG y)}%MS. move=> {M} y Gy /= M simM; have [I [U isoU def_cHM]] := component_mx_def simM. rewrite /cH def_cHM sumsmxMr; apply/sumsmx_subP=> i _. by apply: mx_iso_component; [apply: Clifford_simple | apply: Clifford_iso2]. move=> simM Gx; apply/eqmxP; rewrite actG // -/cH. rewrite -{1}[cH _](repr_mxKV rG Gx) submxMr // -{2}[M](repr_mxK rG Gx). by rewrite actG ?groupV //; apply: Clifford_simple. Qed. Hypothesis irrG : mx_irreducible rG. Lemma Clifford_basis M : mxsimple rH M -> {X : {set gT} | X \subset G & let S := \sum_(x in X) M *m rG x in S :=: 1%:M /\ mxdirect S}%MS. Proof. move=> simM. have simMG (g : [subg G]) : mxsimple rH (M *m rG (val g)). by case: g => x Gx; apply: Clifford_simple. have [|XG [defX1 dxX1]] := sum_mxsimple_direct_sub simMG (_ : _ :=: 1%:M)%MS. apply/eqmxP; case irrG => _ _ ->; rewrite ?submx1 //; last first. rewrite -submx0; apply/sumsmx_subP; move/(_ 1%g (erefl _)); apply: negP. by rewrite submx0 repr_mx1 mulmx1; case simM. apply/mxmoduleP=> x Gx; rewrite sumsmxMr; apply/sumsmx_subP=> [[y Gy]] /= _. by rewrite (sumsmx_sup (subg G (y * x))) // subgK ?groupM // -mulmxA repr_mxM. exists (val @: XG); first by apply/subsetP=> ?; case/imsetP=> [[x Gx]] _ ->. have bij_val: {on val @: XG, bijective (@sgval _ G)}. exists (subg G) => [g _ | x]; first exact: sgvalK. by case/imsetP=> [[x' Gx]] _ ->; rewrite subgK. have defXG g: (val g \in val @: XG) = (g \in XG). by apply/imsetP/idP=> [[h XGh] | XGg]; [move/val_inj-> | exists g]. by rewrite /= mxdirectE /= !(reindex _ bij_val) !(eq_bigl _ _ defXG). Qed. Variable sH : socleType rH. Definition Clifford_act (W : sH) x := let Gx := subgP (subg G x) in PackSocle (component_socle sH (Clifford_simple (socle_simple W) Gx)). Let valWact W x : (Clifford_act W x :=: W *m rG (sgval (subg G x)))%MS. Proof. rewrite PackSocleK; apply: Clifford_componentJ (subgP _). exact: socle_simple. Qed. Fact Clifford_is_action : is_action G Clifford_act. Proof. split=> [x W W' eqWW' | W x y Gx Gy]. pose Gx := subgP (subg G x); apply/socleP; apply/eqmxP. rewrite -(repr_mxK rG Gx W) -(repr_mxK rG Gx W'); apply: eqmxMr. apply: eqmx_trans (eqmx_sym _) (valWact _ _). by rewrite -eqWW'; apply: valWact. apply/socleP; rewrite !{1}valWact 2!{1}(eqmxMr _ (valWact _ _)). by rewrite !subgK ?groupM ?repr_mxM ?mulmxA ?andbb. Qed. Definition Clifford_action := Action Clifford_is_action. Local Notation "'Cl" := Clifford_action (at level 8) : action_scope. Lemma val_Clifford_act W x : x \in G -> ('Cl%act W x :=: W *m rG x)%MS. Proof. by move=> Gx; apply: eqmx_trans (valWact _ _) _; rewrite subgK. Qed. Lemma Clifford_atrans : [transitive G, on [set: sH] | 'Cl]. Proof. have [_ nz1 _] := irrG. apply: mxsimple_exists (mxmodule1 rH) nz1 _ _ => [[M simM _]]. pose W1 := PackSocle (component_socle sH simM). have [X sXG [def1 _]] := Clifford_basis simM; move/subsetP: sXG => sXG. apply/imsetP; exists W1; first by rewrite inE. symmetry; apply/setP=> W; rewrite inE; have simW := socle_simple W. have:= submx1 (socle_base W); rewrite -def1 -[(\sum_(x in X) _)%MS]mulmx1. case/(hom_mxsemisimple_iso simW) => [x Xx _ | | x Xx isoMxW]. - by apply: Clifford_simple; rewrite ?sXG. - exact: scalar_mx_hom. have Gx := sXG x Xx; apply/imsetP; exists x => //; apply/socleP/eqmxP/eqmx_sym. apply: eqmx_trans (val_Clifford_act _ Gx) _; rewrite PackSocleK. apply: eqmx_trans (eqmx_sym (Clifford_componentJ simM Gx)) _. apply/eqmxP; rewrite (sameP genmxP eqP) !{1}genmx_component. by apply/component_mx_isoP=> //; apply: Clifford_simple. Qed. Lemma Clifford_Socle1 : Socle sH = 1%:M. Proof. case/imsetP: Clifford_atrans => W _ _; have simW := socle_simple W. have [X sXG [def1 _]] := Clifford_basis simW. rewrite reducible_Socle1 //; apply: mxsemisimple_reducible. apply: intro_mxsemisimple def1 _ => x /(subsetP sXG) Gx _. exact: Clifford_simple. Qed. Lemma Clifford_rank_components (W : sH) : (#|sH| * \rank W)%N = n. Proof. rewrite -{9}(mxrank1 F n) -Clifford_Socle1. rewrite (mxdirectP (Socle_direct sH)) /= -sum_nat_const. apply: eq_bigr => W1 _; have [W0 _ W0G] := imsetP Clifford_atrans. have{} W0G W': W' \in orbit 'Cl G W0 by rewrite -W0G inE. have [/orbitP[x Gx <-] /orbitP[y Gy <-]] := (W0G W, W0G W1). by rewrite !{1}val_Clifford_act // !mxrankMfree // !repr_mx_free. Qed. Theorem Clifford_component_basis M : mxsimple rH M -> {t : nat & {x_ : sH -> 'I_t -> gT | forall W, let sW := (\sum_j M *m rG (x_ W j))%MS in [/\ forall j, x_ W j \in G, (sW :=: W)%MS & mxdirect sW]}}. Proof. move=> simM; pose t := (n %/ #|sH| %/ \rank M)%N; exists t. have [X /subsetP sXG [defX1 dxX1]] := Clifford_basis simM. pose sMv (W : sH) x := (M *m rG x <= W)%MS; pose Xv := [pred x in X | sMv _ x]. have sXvG W: {subset Xv W <= G} by move=> x /andP[/sXG]. have defW W: (\sum_(x in Xv W) M *m rG x :=: W)%MS. apply/eqmxP; rewrite -(geq_leqif (mxrank_leqif_eq _)); last first. by apply/sumsmx_subP=> x /andP[]. rewrite -(leq_add2r (\sum_(W' | W' != W) \rank W')) -((bigD1 W) predT) //=. rewrite -(mxdirectP (Socle_direct sH)) /= -/(Socle _) Clifford_Socle1 -defX1. apply: leq_trans (mxrankS _) (mxrank_sum_leqif _).1 => /=. rewrite (bigID (sMv W))%MS addsmxS //=. apply/sumsmx_subP=> x /andP[Xx notW_Mx]; have Gx := sXG x Xx. have simMx := Clifford_simple simM Gx. pose Wx := PackSocle (component_socle sH simMx). have sMxWx: (M *m rG x <= Wx)%MS by rewrite PackSocleK component_mx_id. by rewrite (sumsmx_sup Wx) //; apply: contra notW_Mx => /eqP <-. have dxXv W: mxdirect (\sum_(x in Xv W) M *m rG x). move: dxX1; rewrite !mxdirectE /= !(bigID (sMv W) (mem X)) /=. by rewrite -mxdirectE mxdirect_addsE /= => /andP[]. have def_t W: #|Xv W| = t. rewrite /t -{1}(Clifford_rank_components W) mulKn 1?(cardD1 W) //. rewrite -defW (mxdirectP (dxXv W)) /= (eq_bigr (fun _ => \rank M)) => [|x]. rewrite sum_nat_const mulnK //; last by rewrite lt0n mxrank_eq0; case simM. by move/sXvG=> Gx; rewrite mxrankMfree // row_free_unit repr_mx_unit. exists (fun W i => enum_val (cast_ord (esym (def_t W)) i)) => W. case: {def_t}t / (def_t W) => sW. case: (pickP (Xv W)) => [x0 XvWx0 | XvW0]; last first. by case/negP: (nz_socle W); rewrite -submx0 -defW big_pred0. have{x0 XvWx0} reXv := reindex _ (enum_val_bij_in XvWx0). have def_sW: (sW :=: W)%MS. apply: eqmx_trans (defW W); apply/eqmxP; apply/genmxP; congr <<_>>%MS. rewrite reXv /=; apply: eq_big => [j | j _]; first by have:= enum_valP j. by rewrite cast_ord_id. split=> // [j|]; first by rewrite (sXvG W) ?enum_valP. apply/mxdirectP; rewrite def_sW -(defW W) /= (mxdirectP (dxXv W)) /= reXv /=. by apply: eq_big => [j | j _]; [move: (enum_valP j) | rewrite cast_ord_id]. Qed. Lemma Clifford_astab : H <*> 'C_G(H) \subset 'C([set: sH] | 'Cl). Proof. rewrite join_subG !subsetI sHG subsetIl /=; apply/andP; split. apply/subsetP=> h Hh; have Gh := subsetP sHG h Hh; rewrite inE. apply/subsetP=> W _; have simW := socle_simple W; have [modW _ _] := simW. have simWh: mxsimple rH (socle_base W *m rG h) by apply: Clifford_simple. rewrite inE -val_eqE /= PackSocleK eq_sym. apply/component_mx_isoP; rewrite ?subgK //; apply: component_mx_iso => //. by apply: submx_trans (component_mx_id simW); move/mxmoduleP: modW => ->. apply/subsetP=> z cHz; have [Gz _] := setIP cHz; rewrite inE. apply/subsetP=> W _; have simW := socle_simple W; have [modW _ _] := simW. have simWz: mxsimple rH (socle_base W *m rG z) by apply: Clifford_simple. rewrite inE -val_eqE /= PackSocleK eq_sym. by apply/component_mx_isoP; rewrite ?subgK //; apply: Clifford_iso. Qed. Lemma Clifford_astab1 (W : sH) : 'C[W | 'Cl] = rstabs rG W. Proof. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. rewrite sub1set inE (sameP eqP socleP) !val_Clifford_act //. rewrite andb_idr // => sWxW; rewrite -mxrank_leqif_sup //. by rewrite mxrankMfree ?repr_mx_free. Qed. Lemma Clifford_rstabs_simple (W : sH) : mxsimple (subg_repr rG (rstabs_sub rG W)) W. Proof. split => [||U modU sUW nzU]; last 2 [exact: nz_socle]. by rewrite /mxmodule rstabs_subg setIid. have modUH: mxmodule rH U. apply/mxmoduleP=> h Hh; rewrite (mxmoduleP modU) //. rewrite /= -Clifford_astab1 !(inE, sub1set) (subsetP sHG) //. rewrite (astab_act (subsetP Clifford_astab h _)) ?inE //=. by rewrite mem_gen // inE Hh. apply: (mxsimple_exists modUH nzU) => [[M simM sMU]]. have [t [x_ /(_ W)[Gx_ defW _]]] := Clifford_component_basis simM. rewrite -defW; apply/sumsmx_subP=> j _; set x := x_ W j. have{Gx_} Gx: x \in G by rewrite Gx_. apply: submx_trans (submxMr _ sMU) _; apply: (mxmoduleP modU). rewrite inE -val_Clifford_act Gx //; set Wx := 'Cl%act W x. case: (eqVneq Wx W) (simM) => [-> //=|] neWxW [_ /negP[]]; rewrite -submx0. rewrite (canF_eq (actKin 'Cl Gx)) in neWxW. rewrite -(component_mx_disjoint _ _ neWxW); try exact: socle_simple. rewrite sub_capmx {1}(submx_trans sMU sUW) val_Clifford_act ?groupV //. by rewrite -(eqmxMr _ defW) sumsmxMr (sumsmx_sup j) ?repr_mxK. Qed. End Clifford. Section JordanHolder. Variables (gT : finGroupType) (G : {group gT}). Variables (n : nat) (rG : mx_representation F G n). Local Notation modG := ((mxmodule rG) n). Lemma section_module (U V : 'M_n) (modU : modG U) (modV : modG V) : mxmodule (factmod_repr modU) <>%MS. Proof. by rewrite (eqmx_module _ (genmxE _)) in_factmod_module addsmx_module. Qed. Definition section_repr U V (modU : modG U) (modV : modG V) := submod_repr (section_module modU modV). Lemma mx_factmod_sub U modU : mx_rsim (@section_repr U _ modU (mxmodule1 rG)) (factmod_repr modU). Proof. exists (val_submod 1%:M) => [||x Gx]. - apply: (@addIn (\rank U)); rewrite genmxE mxrank_in_factmod mxrank_coker. by rewrite (addsmx_idPr (submx1 U)) mxrank1 subnK ?rank_leq_row. - by rewrite /row_free val_submod1. by rewrite -[_ x]mul1mx -val_submodE val_submodJ. Qed. Definition max_submod (U V : 'M_n) := (U < V)%MS /\ (forall W, ~ [/\ modG W, U < W & W < V])%MS. Lemma max_submodP U V (modU : modG U) (modV : modG V) : (U <= V)%MS -> (max_submod U V <-> mx_irreducible (section_repr modU modV)). Proof. move=> sUV; split=> [[ltUV maxU] | ]. apply/mx_irrP; split=> [|WU modWU nzWU]. by rewrite genmxE lt0n mxrank_eq0 in_factmod_eq0; case/andP: ltUV. rewrite -sub1mx -val_submodS val_submod1 genmxE. pose W := (U + val_factmod (val_submod WU))%MS. suffices sVW: (V <= W)%MS. rewrite {2}in_factmodE (submx_trans (submxMr _ sVW)) //. rewrite addsmxMr -!in_factmodE val_factmodK. by rewrite ((in_factmod U U =P 0) _) ?adds0mx ?in_factmod_eq0. move/and3P: {maxU}(maxU W); apply: contraR; rewrite /ltmx addsmxSl => -> /=. move: modWU; rewrite /mxmodule rstabs_submod rstabs_factmod => -> /=. rewrite addsmx_sub submx_refl -in_factmod_eq0 val_factmodK. move: nzWU; rewrite -[_ == 0](inj_eq val_submod_inj) linear0 => ->. rewrite -(in_factmodsK sUV) addsmxS // val_factmodS. by rewrite -(genmxE (in_factmod U V)) val_submodP. case/mx_irrP; rewrite lt0n {1}genmxE mxrank_eq0 in_factmod_eq0 => ltUV maxV. split=> // [|W [modW /andP[sUW ltUW] /andP[sWV /negP[]]]]; first exact/andP. rewrite -(in_factmodsK sUV) -(in_factmodsK sUW) addsmxS // val_factmodS. rewrite -genmxE -val_submod1; set VU := <<_>>%MS. have sW_VU: (in_factmod U W <= VU)%MS. by rewrite genmxE -val_factmodS !submxMr. rewrite -(in_submodK sW_VU) val_submodS -(genmxE (in_submod _ _)). rewrite sub1mx maxV //. rewrite (eqmx_module _ (genmxE _)) in_submod_module ?genmxE ?submxMr //. by rewrite in_factmod_module addsmx_module. rewrite -submx0 [(_ <= 0)%MS]genmxE -val_submodS linear0 in_submodK //. by rewrite eqmx0 submx0 in_factmod_eq0. Qed. Lemma max_submod_eqmx U1 U2 V1 V2 : (U1 :=: U2)%MS -> (V1 :=: V2)%MS -> max_submod U1 V1 -> max_submod U2 V2. Proof. move=> eqU12 eqV12 [ltUV1 maxU1]. by split=> [|W]; rewrite -(lt_eqmx eqU12) -(lt_eqmx eqV12). Qed. Definition mx_subseries := all modG. Definition mx_composition_series V := mx_subseries V /\ (forall i, i < size V -> max_submod (0 :: V)`_i V`_i). Local Notation mx_series := mx_composition_series. Fact mx_subseries_module V i : mx_subseries V -> mxmodule rG V`_i. Proof. move=> modV; have [|leVi] := ltnP i (size V); first exact: all_nthP. by rewrite nth_default ?mxmodule0. Qed. Fact mx_subseries_module' V i : mx_subseries V -> mxmodule rG (0 :: V)`_i. Proof. by move=> modV; rewrite mx_subseries_module //= mxmodule0. Qed. Definition subseries_repr V i (modV : all modG V) := section_repr (mx_subseries_module' i modV) (mx_subseries_module i modV). Definition series_repr V i (compV : mx_composition_series V) := subseries_repr i (proj1 compV). Lemma mx_series_lt V : mx_composition_series V -> path ltmx 0 V. Proof. by case=> _ compV; apply/(pathP 0)=> i /compV[]. Qed. Lemma max_size_mx_series (V : seq 'M[F]_n) : path ltmx 0 V -> size V <= \rank (last 0 V). Proof. rewrite -[size V]addn0 -(mxrank0 F n n); elim: V 0 => //= V1 V IHV V0. rewrite ltmxErank -andbA => /and3P[_ ltV01 ltV]. by apply: leq_trans (IHV _ ltV); rewrite addSnnS leq_add2l. Qed. Lemma mx_series_repr_irr V i (compV : mx_composition_series V) : i < size V -> mx_irreducible (series_repr i compV). Proof. case: compV => modV compV /compV maxVi; apply/max_submodP => //. by apply: ltmxW; case: maxVi. Qed. Lemma mx_series_rcons U V : mx_series (rcons U V) <-> [/\ mx_series U, modG V & max_submod (last 0 U) V]. Proof. rewrite /mx_series /mx_subseries all_rcons size_rcons -rcons_cons. split=> [ [/andP[modU modV] maxU] | [[modU maxU] modV maxV]]. split=> //; last first. by have:= maxU _ (leqnn _); rewrite !nth_rcons leqnn ltnn eqxx -last_nth. by split=> // i ltiU; have:= maxU i (ltnW ltiU); rewrite !nth_rcons leqW ltiU. rewrite modV; split=> // i; rewrite !nth_rcons ltnS leq_eqVlt. case: eqP => [-> _ | /= _ ltiU]; first by rewrite ltnn ?eqxx -last_nth. by rewrite ltiU; apply: maxU. Qed. Theorem mx_Schreier U : mx_subseries U -> path ltmx 0 U -> classically (exists V, [/\ mx_series V, last 0 V :=: 1%:M & subseq U V])%MS. Proof. move: U => U0; set U := {1 2}U0; have: subseq U0 U := subseq_refl U. pose n' := n.+1; have: n < size U + n' by rewrite leq_addl. elim: n' U => [|n' IH_U] U ltUn' sU0U modU incU [] // noV. rewrite addn0 ltnNge in ltUn'; case/negP: ltUn'. by rewrite (leq_trans (max_size_mx_series incU)) ?rank_leq_row. apply: (noV); exists U; split => //; first split=> // i lt_iU; last first. apply/eqmxP; apply: contraT => neU1. apply: {IH_U}(IH_U (rcons U 1%:M)) noV. - by rewrite size_rcons addSnnS. - by rewrite (subseq_trans sU0U) ?subseq_rcons. - by rewrite /mx_subseries all_rcons mxmodule1. by rewrite rcons_path ltmxEneq neU1 submx1 !andbT. set U'i := _`_i; set Ui := _`_i; have defU := cat_take_drop i U. have defU'i: U'i = last 0 (take i U). rewrite (last_nth 0) /U'i -{1}defU -cat_cons nth_cat /=. by rewrite size_take lt_iU leqnn. move: incU; rewrite -defU cat_path (drop_nth 0) //= -/Ui -defU'i. set U' := take i U; set U'' := drop _ U; case/and3P=> incU' ltUi incU''. split=> // W [modW ltUW ltWV]; case: notF. apply: {IH_U}(IH_U (U' ++ W :: Ui :: U'')) noV; last 2 first. - by rewrite /mx_subseries -drop_nth // all_cat /= modW -all_cat defU. - by rewrite cat_path /= -defU'i; apply/and4P. - by rewrite -drop_nth // size_cat /= addnS -size_cat defU addSnnS. by rewrite (subseq_trans sU0U) // -defU cat_subseq // -drop_nth ?subseq_cons. Qed. Lemma mx_second_rsim U V (modU : modG U) (modV : modG V) : let modI := capmx_module modU modV in let modA := addsmx_module modU modV in mx_rsim (section_repr modI modU) (section_repr modV modA). Proof. move=> modI modA; set nI := {1}(\rank _). have sIU := capmxSl U V; have sVA := addsmxSr U V. pose valI := val_factmod (val_submod (1%:M : 'M_nI)). have UvalI: (valI <= U)%MS. rewrite -(addsmx_idPr sIU) (submx_trans _ (proj_factmodS _ _)) //. by rewrite submxMr // val_submod1 genmxE. exists (valI *m in_factmod _ 1%:M *m in_submod _ 1%:M) => [||x Gx]. - apply: (@addIn (\rank (U :&: V) + \rank V)%N); rewrite genmxE addnA addnCA. rewrite /nI genmxE !{1}mxrank_in_factmod 2?(addsmx_idPr _) //. by rewrite -mxrank_sum_cap addnC. - rewrite -kermx_eq0; apply/rowV0P=> u; rewrite (sameP sub_kermxP eqP). rewrite mulmxA -in_submodE mulmxA -in_factmodE -(inj_eq val_submod_inj). rewrite linear0 in_submodK ?in_factmod_eq0 => [Vvu|]; last first. by rewrite genmxE addsmxC in_factmod_addsK submxMr // mulmx_sub. apply: val_submod_inj; apply/eqP; rewrite linear0 -[val_submod u]val_factmodK. rewrite val_submodE val_factmodE -mulmxA -val_factmodE -/valI. by rewrite in_factmod_eq0 sub_capmx mulmx_sub. symmetry; rewrite -{1}in_submodE -{1}in_submodJ; last first. by rewrite genmxE addsmxC in_factmod_addsK -in_factmodE submxMr. rewrite -{1}in_factmodE -{1}in_factmodJ // mulmxA in_submodE; congr (_ *m _). apply/eqP; rewrite mulmxA -in_factmodE -subr_eq0 -linearB in_factmod_eq0. apply: submx_trans (capmxSr U V); rewrite -in_factmod_eq0 linearB /=. rewrite subr_eq0 {1}(in_factmodJ modI) // val_factmodK eq_sym. rewrite /valI val_factmodE mulmxA -val_factmodE val_factmodK. by rewrite -[submod_mx _ _]mul1mx -val_submodE val_submodJ. Qed. Lemma section_eqmx_add U1 U2 V1 V2 modU1 modU2 modV1 modV2 : (U1 :=: U2)%MS -> (U1 + V1 :=: U2 + V2)%MS -> mx_rsim (@section_repr U1 V1 modU1 modV1) (@section_repr U2 V2 modU2 modV2). Proof. move=> eqU12 eqV12; set n1 := {1}(\rank _). pose v1 := val_factmod (val_submod (1%:M : 'M_n1)). have sv12: (v1 <= U2 + V2)%MS. rewrite -eqV12 (submx_trans _ (proj_factmodS _ _)) //. by rewrite submxMr // val_submod1 genmxE. exists (v1 *m in_factmod _ 1%:M *m in_submod _ 1%:M) => [||x Gx]. - apply: (@addIn (\rank U1)); rewrite {2}eqU12 /n1 !{1}genmxE. by rewrite !{1}mxrank_in_factmod eqV12. - rewrite -kermx_eq0; apply/rowV0P=> u; rewrite (sameP sub_kermxP eqP) mulmxA. rewrite -in_submodE mulmxA -in_factmodE -(inj_eq val_submod_inj) linear0. rewrite in_submodK ?in_factmod_eq0 -?eqU12 => [U1uv1|]; last first. by rewrite genmxE -(in_factmod_addsK U2 V2) submxMr // mulmx_sub. apply: val_submod_inj; apply/eqP; rewrite linear0 -[val_submod _]val_factmodK. by rewrite in_factmod_eq0 val_factmodE val_submodE -mulmxA -val_factmodE. symmetry; rewrite -{1}in_submodE -{1}in_factmodE -{1}in_submodJ; last first. by rewrite genmxE -(in_factmod_addsK U2 V2) submxMr. rewrite -{1}in_factmodJ // mulmxA in_submodE; congr (_ *m _); apply/eqP. rewrite mulmxA -in_factmodE -subr_eq0 -linearB in_factmod_eq0 -eqU12. rewrite -in_factmod_eq0 linearB /= subr_eq0 {1}(in_factmodJ modU1) //. rewrite val_factmodK /v1 val_factmodE eq_sym mulmxA -val_factmodE val_factmodK. by rewrite -[_ *m _]mul1mx mulmxA -val_submodE val_submodJ. Qed. Lemma section_eqmx U1 U2 V1 V2 modU1 modU2 modV1 modV2 (eqU : (U1 :=: U2)%MS) (eqV : (V1 :=: V2)%MS) : mx_rsim (@section_repr U1 V1 modU1 modV1) (@section_repr U2 V2 modU2 modV2). Proof. by apply: section_eqmx_add => //; apply: adds_eqmx. Qed. Lemma mx_butterfly U V W modU modV modW : ~~ (U == V)%MS -> max_submod U W -> max_submod V W -> let modUV := capmx_module modU modV in max_submod (U :&: V)%MS U /\ mx_rsim (@section_repr V W modV modW) (@section_repr _ U modUV modU). Proof. move=> neUV maxU maxV modUV; have{neUV maxU} defW: (U + V :=: W)%MS. wlog{neUV modUV} ltUV: U V modU modV maxU maxV / ~~ (V <= U)%MS. by case/nandP: neUV => ?; first rewrite addsmxC; apply. apply/eqmxP/idPn=> neUVW; case: maxU => ltUW; case/(_ (U + V)%MS). rewrite addsmx_module // ltmxE ltmxEneq neUVW addsmxSl !addsmx_sub. by have [ltVW _] := maxV; rewrite submx_refl andbT ltUV !ltmxW. have sUV_U := capmxSl U V; have sVW: (V <= W)%MS by rewrite -defW addsmxSr. set goal := mx_rsim _ _; suffices{maxV} simUV: goal. split=> //; apply/(max_submodP modUV modU sUV_U). by apply: mx_rsim_irr simUV _; apply/max_submodP. apply: {goal}mx_rsim_sym. by apply: mx_rsim_trans (mx_second_rsim modU modV) _; apply: section_eqmx. Qed. Lemma mx_JordanHolder_exists U V : mx_composition_series U -> modG V -> max_submod V (last 0 U) -> {W : seq 'M_n | mx_composition_series W & last 0 W = V}. Proof. elim/last_ind: U V => [|U Um IHU] V compU modV; first by case; rewrite ltmx0. rewrite last_rcons => maxV; case/mx_series_rcons: compU => compU modUm maxUm. case eqUV: (last 0 U == V)%MS. case/lastP: U eqUV compU {maxUm IHU} => [|U' Um']. by rewrite andbC; move/eqmx0P->; exists [::]. rewrite last_rcons; move/eqmxP=> eqU'V; case/mx_series_rcons=> compU _ maxUm'. exists (rcons U' V); last by rewrite last_rcons. by apply/mx_series_rcons; split => //; apply: max_submod_eqmx maxUm'. set Um' := last 0 U in maxUm eqUV; have [modU _] := compU. have modUm': modG Um' by rewrite /Um' (last_nth 0) mx_subseries_module'. have [|||W compW lastW] := IHU (V :&: Um')%MS; rewrite ?capmx_module //. by case: (mx_butterfly modUm' modV modUm); rewrite ?eqUV // {1}capmxC. exists (rcons W V); last by rewrite last_rcons. apply/mx_series_rcons; split; rewrite // lastW. by case: (mx_butterfly modV modUm' modUm); rewrite // andbC eqUV. Qed. Let rsim_rcons U V compU compUV i : i < size U -> mx_rsim (@series_repr U i compU) (@series_repr (rcons U V) i compUV). Proof. by move=> ltiU; apply: section_eqmx; rewrite -?rcons_cons nth_rcons ?leqW ?ltiU. Qed. Let last_mod U (compU : mx_series U) : modG (last 0 U). Proof. by case: compU => modU _; rewrite (last_nth 0) (mx_subseries_module' _ modU). Qed. Let rsim_last U V modUm modV compUV : mx_rsim (@section_repr (last 0 U) V modUm modV) (@series_repr (rcons U V) (size U) compUV). Proof. apply: section_eqmx; last by rewrite nth_rcons ltnn eqxx. by rewrite -rcons_cons nth_rcons leqnn -last_nth. Qed. Local Notation rsimT := mx_rsim_trans. Local Notation rsimC := mx_rsim_sym. Lemma mx_JordanHolder U V compU compV : let m := size U in (last 0 U :=: last 0 V)%MS -> m = size V /\ (exists p : 'S_m, forall i : 'I_m, mx_rsim (@series_repr U i compU) (@series_repr V (p i) compV)). Proof. move Dr: {-}(size U) => r; move/eqP in Dr. elim: r U V Dr compU compV => /= [|r IHr] U V. move/nilP->; case/lastP: V => [|V Vm] /= ? compVm; rewrite ?last_rcons => Vm0. by split=> //; exists 1%g; case. by case/mx_series_rcons: (compVm) => _ _ []; rewrite -(lt_eqmx Vm0) ltmx0. case/lastP: U => // [U Um]; rewrite size_rcons eqSS => szUr compUm. case/mx_series_rcons: (compUm); set Um' := last 0 U => compU modUm maxUm. case/lastP: V => [|V Vm] compVm; rewrite ?last_rcons ?size_rcons /= => eqUVm. by case/mx_series_rcons: (compUm) => _ _ []; rewrite (lt_eqmx eqUVm) ltmx0. case/mx_series_rcons: (compVm); set Vm' := last 0 V => compV modVm maxVm. have [modUm' modVm']: modG Um' * modG Vm' := (last_mod compU, last_mod compV). pose i_m := @ord_max (size U). have [eqUVm' | neqUVm'] := altP (@eqmxP _ _ _ _ Um' Vm'). have [szV [p sim_p]] := IHr U V szUr compU compV eqUVm'. split; first by rewrite szV. exists (lift_perm i_m i_m p) => i; case: (unliftP i_m i) => [j|] ->{i}. apply: rsimT (rsimC _) (rsimT (sim_p j) _). by rewrite lift_max; apply: rsim_rcons. by rewrite lift_perm_lift lift_max; apply: rsim_rcons; rewrite -szV. have simUVm := section_eqmx modUm' modVm' modUm modVm eqUVm' eqUVm. apply: rsimT (rsimC _) (rsimT simUVm _); first exact: rsim_last. by rewrite lift_perm_id /= szV; apply: rsim_last. have maxVUm: max_submod Vm' Um by apply: max_submod_eqmx (eqmx_sym _) maxVm. have:= mx_butterfly modUm' modVm' modUm neqUVm' maxUm maxVUm. move: (capmx_module _ _); set Wm := (Um' :&: Vm')%MS => modWm [maxWUm simWVm]. have:= mx_butterfly modVm' modUm' modUm _ maxVUm maxUm. move: (capmx_module _ _); rewrite andbC capmxC -/Wm => modWmV [// | maxWVm]. rewrite {modWmV}(bool_irrelevance modWmV modWm) => simWUm. have [W compW lastW] := mx_JordanHolder_exists compU modWm maxWUm. have compWU: mx_series (rcons W Um') by apply/mx_series_rcons; rewrite lastW. have compWV: mx_series (rcons W Vm') by apply/mx_series_rcons; rewrite lastW. have [|szW [pU pUW]] := IHr U _ szUr compU compWU; first by rewrite last_rcons. rewrite size_rcons in szW; have ltWU: size W < size U by rewrite -szW. have{IHr} := IHr _ V _ compWV compV; rewrite last_rcons size_rcons -szW. case=> {r szUr}// szV [pV pWV]; split; first by rewrite szV. pose j_m := Ordinal ltWU; pose i_m' := lift i_m j_m. exists (lift_perm i_m i_m pU * tperm i_m i_m' * lift_perm i_m i_m pV)%g => i. rewrite !permM; case: (unliftP i_m i) => [j {simWUm}|] ->{i}; last first. rewrite lift_perm_id tpermL lift_perm_lift lift_max {simWVm}. apply: rsimT (rsimT (pWV j_m) _); last by apply: rsim_rcons; rewrite -szV. apply: rsimT (rsimC _) {simWUm}(rsimT simWUm _); first exact: rsim_last. by rewrite -lastW in modWm *; apply: rsim_last. apply: rsimT (rsimC _) {pUW}(rsimT (pUW j) _). by rewrite lift_max; apply: rsim_rcons. rewrite lift_perm_lift; case: (unliftP j_m (pU j)) => [k|] ->{j pU}. rewrite tpermD ?(inj_eq lift_inj) ?neq_lift //. rewrite lift_perm_lift !lift_max; set j := lift j_m k. have ltjW: j < size W by have:= ltn_ord k; rewrite -(lift_max k) /= {1 3}szW. apply: rsimT (rsimT (pWV j) _); last by apply: rsim_rcons; rewrite -szV. by apply: rsimT (rsimC _) (rsim_rcons compW _ _); first apply: rsim_rcons. apply: rsimT {simWVm}(rsimC (rsimT simWVm _)) _. by rewrite -lastW in modWm *; apply: rsim_last. rewrite tpermR lift_perm_id /= szV. by apply: rsimT (rsim_last modVm' modVm _); apply: section_eqmx. Qed. Lemma mx_JordanHolder_max U (m := size U) V compU modV : (last 0 U :=: 1%:M)%MS -> mx_irreducible (@factmod_repr _ G n rG V modV) -> exists i : 'I_m, mx_rsim (factmod_repr modV) (@series_repr U i compU). Proof. rewrite {}/m; set Um := last 0 U => Um1 irrV. have modUm: modG Um := last_mod compU; have simV := rsimC (mx_factmod_sub modV). have maxV: max_submod V Um. move/max_submodP: (mx_rsim_irr simV irrV) => /(_ (submx1 _)). by apply: max_submod_eqmx; last apply: eqmx_sym. have [W compW lastW] := mx_JordanHolder_exists compU modV maxV. have compWU: mx_series (rcons W Um) by apply/mx_series_rcons; rewrite lastW. have:= mx_JordanHolder compU compWU; rewrite last_rcons size_rcons. case=> // szW [p pUW]; have ltWU: size W < size U by rewrite szW. pose i := Ordinal ltWU; exists ((p^-1)%g i). apply: rsimT simV (rsimT _ (rsimC (pUW _))); rewrite permKV. apply: rsimT (rsimC _) (rsim_last (last_mod compW) modUm _). by apply: section_eqmx; rewrite ?lastW. Qed. End JordanHolder. Bind Scope irrType_scope with socle_sort. Section Regular. Variables (gT : finGroupType) (G : {group gT}). Local Notation nG := #|pred_of_set (gval G)|. Local Notation rF := (GRing.Field.comUnitRingType F) (only parsing). Local Notation aG := (regular_repr rF G). Local Notation R_G := (group_ring rF G). Lemma gring_free : row_free R_G. Proof. apply/row_freeP; exists (lin1_mx (row (gring_index G 1) \o vec_mx)). apply/row_matrixP=> i; rewrite row_mul rowK mul_rV_lin1 /= mxvecK rowK row1. by rewrite gring_indexK // mul1g gring_valK. Qed. Lemma gring_op_id A : (A \in R_G)%MS -> gring_op aG A = A. Proof. case/envelop_mxP=> a ->{A}; rewrite linear_sum. by apply: eq_bigr => x Gx; rewrite linearZ /= gring_opG. Qed. Lemma gring_rowK A : (A \in R_G)%MS -> gring_mx aG (gring_row A) = A. Proof. exact: gring_op_id. Qed. Lemma mem_gring_mx m a (M : 'M_(m, nG)) : (gring_mx aG a \in M *m R_G)%MS = (a <= M)%MS. Proof. by rewrite vec_mxK submxMfree ?gring_free. Qed. Lemma mem_sub_gring m A (M : 'M_(m, nG)) : (A \in M *m R_G)%MS = (A \in R_G)%MS && (gring_row A <= M)%MS. Proof. rewrite -(andb_idl (memmx_subP (submxMl _ _) A)); apply: andb_id2l => R_A. by rewrite -mem_gring_mx gring_rowK. Qed. Section GringMx. Variables (n : nat) (rG : mx_representation F G n). Lemma gring_mxP a : (gring_mx rG a \in enveloping_algebra_mx rG)%MS. Proof. by rewrite vec_mxK submxMl. Qed. Lemma gring_opM A B : (B \in R_G)%MS -> gring_op rG (A *m B) = gring_op rG A *m gring_op rG B. Proof. by move=> R_B; rewrite -gring_opJ gring_rowK. Qed. Hypothesis irrG : mx_irreducible rG. Lemma rsim_regular_factmod : {U : 'M_nG & {modU : mxmodule aG U & mx_rsim rG (factmod_repr modU)}}. Proof. pose v : 'rV[F]_n := nz_row 1%:M. pose fU := lin1_mx (mulmx v \o gring_mx rG); pose U := kermx fU. have modU: mxmodule aG U. apply/mxmoduleP => x Gx; apply/sub_kermxP/row_matrixP=> i. rewrite 2!row_mul row0; move: (row i U) (sub_kermxP (row_sub i U)) => u. by rewrite !mul_rV_lin1 /= gring_mxJ // mulmxA => ->; rewrite mul0mx. have def_n: \rank (cokermx U) = n. apply/eqP; rewrite mxrank_coker mxrank_ker subKn ?rank_leq_row // -genmxE. rewrite -[_ == _]sub1mx; have [_ _ ->] := irrG; rewrite ?submx1 //. rewrite (eqmx_module _ (genmxE _)); apply/mxmoduleP=> x Gx. apply/row_subP=> i; apply: eq_row_sub (gring_index G (enum_val i * x)) _. rewrite !rowE mulmxA !mul_rV_lin1 /= -mulmxA -gring_mxJ //. by rewrite -rowE rowK. rewrite (eqmx_eq0 (genmxE _)); apply/rowV0Pn. exists v; last exact: (nz_row_mxsimple irrG). apply/submxP; exists (gring_row (aG 1%g)); rewrite mul_rV_lin1 /=. by rewrite -gring_opE gring_opG // repr_mx1 mulmx1. exists U; exists modU; apply: mx_rsim_sym. exists (val_factmod 1%:M *m fU) => // [|x Gx]. rewrite /row_free eqn_leq rank_leq_row /= -subn_eq0 -mxrank_ker mxrank_eq0. apply/rowV0P=> u /sub_kermxP; rewrite mulmxA => /sub_kermxP. by rewrite -/U -in_factmod_eq0 mulmxA mulmx1 val_factmodK => /eqP. rewrite mulmxA -val_factmodE (canRL (addKr _) (add_sub_fact_mod U _)). rewrite mulmxDl mulNmx (sub_kermxP (val_submodP _)) oppr0 add0r. apply/row_matrixP=> i; move: (val_factmod _) => zz. by rewrite !row_mul !mul_rV_lin1 /= gring_mxJ // mulmxA. Qed. Lemma rsim_regular_series U (compU : mx_composition_series aG U) : (last 0 U :=: 1%:M)%MS -> exists i : 'I_(size U), mx_rsim rG (series_repr i compU). Proof. move=> lastU; have [V [modV simGV]] := rsim_regular_factmod. have irrV := mx_rsim_irr simGV irrG. have [i simVU] := mx_JordanHolder_max compU lastU irrV. by exists i; apply: mx_rsim_trans simGV simVU. Qed. Hypothesis F'G : [char F]^'.-group G. Lemma rsim_regular_submod : {U : 'M_nG & {modU : mxmodule aG U & mx_rsim rG (submod_repr modU)}}. Proof. have [V [modV eqG'V]] := rsim_regular_factmod. have [U modU defVU dxVU] := mx_Maschke F'G modV (submx1 V). exists U; exists modU; apply: mx_rsim_trans eqG'V _. by apply: mx_rsim_factmod; rewrite ?mxdirectE /= addsmxC // addnC. Qed. End GringMx. Definition gset_mx (A : {set gT}) := \sum_(x in A) aG x. Local Notation tG := #|pred_of_set (classes (gval G))|. Definition classg_base := \matrix_(k < tG) mxvec (gset_mx (enum_val k)). Let groupCl : {in G, forall x, {subset x ^: G <= G}}. Proof. by move=> x Gx; apply: subsetP; apply: class_subG. Qed. Lemma classg_base_free : row_free classg_base. Proof. rewrite -kermx_eq0; apply/rowV0P=> v /sub_kermxP; rewrite mulmx_sum_row => v0. apply/rowP=> k; rewrite mxE. have [x Gx def_k] := imsetP (enum_valP k). transitivity (@gring_proj F _ G x (vec_mx 0) 0 0); last first. by rewrite !linear0 !mxE. rewrite -{}v0 !linear_sum (bigD1 k) //= !linearZ /= rowK mxvecK def_k. rewrite linear_sum (bigD1 x) ?class_refl //= gring_projE // eqxx. rewrite !big1 ?addr0 ?mxE ?mulr1 // => [k' | y /andP[xGy ne_yx]]; first 1 last. by rewrite gring_projE ?(groupCl Gx xGy) // eq_sym (negPf ne_yx). rewrite rowK !linearZ /= mxvecK -(inj_eq enum_val_inj) def_k eq_sym. have [z Gz ->] := imsetP (enum_valP k'). move/eqP=> not_Gxz; rewrite linear_sum big1 ?scaler0 //= => y zGy. rewrite gring_projE ?(groupCl Gz zGy) //. by case: eqP zGy => // <- /class_eqP. Qed. Lemma classg_base_center : (classg_base :=: 'Z(R_G))%MS. Proof. apply/eqmxP/andP; split. apply/row_subP=> k; rewrite rowK /gset_mx sub_capmx {1}linear_sum. have [x Gx ->{k}] := imsetP (enum_valP k); have sxGG := groupCl Gx. rewrite summx_sub => [|y xGy]; last by rewrite envelop_mx_id ?sxGG. rewrite memmx_cent_envelop; apply/centgmxP=> y Gy. rewrite {2}(reindex_acts 'J _ Gy) ?astabsJ ?class_norm //=. rewrite mulmx_suml mulmx_sumr; apply: eq_bigr => z; move/sxGG=> Gz. by rewrite -!repr_mxM ?groupJ -?conjgC. apply/memmx_subP=> A; rewrite sub_capmx memmx_cent_envelop. case/andP=> /envelop_mxP[a ->{A}] cGa. rewrite (partition_big_imset (class^~ G)) -/(classes G) /=. rewrite linear_sum summx_sub //= => xG GxG; have [x Gx def_xG] := imsetP GxG. apply: submx_trans (scalemx_sub (a x) (submx_refl _)). rewrite (eq_row_sub (enum_rank_in GxG xG)) // linearZ /= rowK enum_rankK_in //. rewrite !linear_sum {xG GxG}def_xG; apply: eq_big => [y | xy] /=. apply/idP/andP=> [| [_ xGy]]; last by rewrite -(eqP xGy) class_refl. by case/imsetP=> z Gz ->; rewrite groupJ // classGidl. case/imsetP=> y Gy ->{xy}; rewrite linearZ; congr (_ *: _). move/(canRL (repr_mxK aG Gy)): (centgmxP cGa y Gy); have Gy' := groupVr Gy. move/(congr1 (gring_proj x)); rewrite -mulmxA mulmx_suml !linear_sum. rewrite (bigD1 x Gx) big1 => [|z /andP[Gz]]; rewrite !linearZ /=; last first. by rewrite eq_sym gring_projE // => /negPf->; rewrite scaler0. rewrite gring_projE // eqxx scalemx1 (bigD1 (x ^ y)%g) ?groupJ //=. rewrite big1 => [|z /andP[Gz]]; rewrite -scalemxAl !linearZ /=. rewrite !addr0 -!repr_mxM ?groupM // mulgA mulKVg mulgK => /rowP/(_ 0). by rewrite gring_projE // eqxx scalemx1 !mxE. rewrite eq_sym -(can_eq (conjgKV y)) conjgK conjgE invgK. by rewrite -!repr_mxM ?gring_projE ?groupM // => /negPf->; rewrite scaler0. Qed. Lemma regular_module_ideal m (M : 'M_(m, nG)) : mxmodule aG M = right_mx_ideal R_G (M *m R_G). Proof. apply/idP/idP=> modM. apply/mulsmx_subP=> A B; rewrite !mem_sub_gring => /andP[R_A M_A] R_B. by rewrite envelop_mxM // gring_row_mul (mxmodule_envelop modM). apply/mxmoduleP=> x Gx; apply/row_subP=> i; rewrite row_mul -mem_gring_mx. rewrite gring_mxJ // (mulsmx_subP modM) ?envelop_mx_id //. by rewrite mem_gring_mx row_sub. Qed. Definition irrType := socleType aG. Identity Coercion type_of_irrType : irrType >-> socleType. Variable sG : irrType. Definition irr_degree (i : sG) := \rank (socle_base i). Local Notation "'n_ i" := (irr_degree i) : group_ring_scope. Local Open Scope group_ring_scope. Lemma irr_degreeE i : 'n_i = \rank (socle_base i). Proof. by []. Qed. Lemma irr_degree_gt0 i : 'n_i > 0. Proof. by rewrite lt0n mxrank_eq0; case: (socle_simple i). Qed. Definition irr_repr i : mx_representation F G 'n_i := socle_repr i. Lemma irr_reprE i x : irr_repr i x = submod_mx (socle_module i) x. Proof. by []. Qed. Lemma rfix_regular : (rfix_mx aG G :=: gring_row (gset_mx G))%MS. Proof. apply/eqmxP/andP; split; last first. apply/rfix_mxP => x Gx; rewrite -gring_row_mul; congr gring_row. rewrite {2}/gset_mx (reindex_astabs 'R x) ?astabsR //= mulmx_suml. by apply: eq_bigr => y Gy; rewrite repr_mxM. apply/rV_subP=> v /rfix_mxP cGv. have /envelop_mxP[a def_v]: (gring_mx aG v \in R_G)%MS. by rewrite vec_mxK submxMl. suffices ->: v = a 1%g *: gring_row (gset_mx G) by rewrite scalemx_sub. rewrite -linearZ scaler_sumr -[v]gring_mxK def_v; congr (gring_row _). apply: eq_bigr => x Gx; congr (_ *: _). move/rowP/(_ 0): (congr1 (gring_proj x \o gring_mx aG) (cGv x Gx)). rewrite /= gring_mxJ // def_v mulmx_suml !linear_sum (bigD1 1%g) //=. rewrite repr_mx1 -scalemxAl mul1mx linearZ /= gring_projE // eqxx scalemx1. rewrite big1 ?addr0 ?mxE /= => [ | y /andP[Gy nt_y]]; last first. rewrite -scalemxAl linearZ -repr_mxM //= gring_projE ?groupM //. by rewrite eq_sym eq_mulgV1 mulgK (negPf nt_y) scaler0. rewrite (bigD1 x) //= linearZ /= gring_projE // eqxx scalemx1. rewrite big1 ?addr0 ?mxE // => y /andP[Gy ne_yx]. by rewrite linearZ /= gring_projE // eq_sym (negPf ne_yx) scaler0. Qed. Lemma principal_comp_subproof : mxsimple aG (rfix_mx aG G). Proof. apply: linear_mxsimple; first exact: rfix_mx_module. apply/eqP; rewrite rfix_regular eqn_leq rank_leq_row lt0n mxrank_eq0. apply/eqP => /(congr1 (gring_proj 1 \o gring_mx aG)); apply/eqP. rewrite /= -[gring_mx _ _]/(gring_op _ _) !linear0 !linear_sum (bigD1 1%g) //=. rewrite gring_opG ?gring_projE // eqxx big1 ?addr0 ?oner_eq0 // => x. by case/andP=> Gx nt_x; rewrite gring_opG // gring_projE // eq_sym (negPf nt_x). Qed. Fact principal_comp_key : unit. Proof. by []. Qed. Definition principal_comp_def := PackSocle (component_socle sG principal_comp_subproof). Definition principal_comp := locked_with principal_comp_key principal_comp_def. Local Notation "1" := principal_comp : irrType_scope. Lemma irr1_rfix : (1%irr :=: rfix_mx aG G)%MS. Proof. rewrite [1%irr]unlock PackSocleK; apply/eqmxP. rewrite (component_mx_id principal_comp_subproof) andbT. have [I [W isoW ->]] := component_mx_def principal_comp_subproof. apply/sumsmx_subP=> i _; have [f _ hom_f <-]:= isoW i. by apply/rfix_mxP=> x Gx; rewrite -(hom_mxP hom_f) // (rfix_mxP G _). Qed. Lemma rank_irr1 : \rank 1%irr = 1%N. Proof. apply/eqP; rewrite eqn_leq lt0n mxrank_eq0 nz_socle andbT. by rewrite irr1_rfix rfix_regular rank_leq_row. Qed. Lemma degree_irr1 : 'n_1 = 1%N. Proof. apply/eqP; rewrite eqn_leq irr_degree_gt0 -rank_irr1. by rewrite mxrankS ?component_mx_id //; apply: socle_simple. Qed. Definition Wedderburn_subring (i : sG) := <>%MS. Local Notation "''R_' i" := (Wedderburn_subring i) : group_ring_scope. Let sums_R : (\sum_i 'R_i :=: Socle sG *m R_G)%MS. Proof. apply/eqmxP; set R_S := (_ <= _)%MS. have sRS: R_S by apply/sumsmx_subP=> i; rewrite genmxE submxMr ?(sumsmx_sup i). rewrite sRS -(mulmxKpV sRS) mulmxA submxMr //; apply/sumsmx_subP=> i _. rewrite -(submxMfree _ _ gring_free) -(mulmxA _ _ R_G) mulmxKpV //. by rewrite (sumsmx_sup i) ?genmxE. Qed. Lemma Wedderburn_ideal i : mx_ideal R_G 'R_i. Proof. apply/andP; split; last first. rewrite /right_mx_ideal genmxE (muls_eqmx (genmxE _) (eqmx_refl _)). by rewrite -[(_ <= _)%MS]regular_module_ideal component_mx_module. apply/mulsmx_subP=> A B R_A; rewrite !genmxE !mem_sub_gring => /andP[R_B SiB]. rewrite envelop_mxM {R_A}// gring_row_mul -{R_B}(gring_rowK R_B). pose f := mulmx (gring_row A) \o gring_mx aG. rewrite -[_ *m _](mul_rV_lin1 [linear of f]). suffices: (i *m lin1_mx f <= i)%MS by apply: submx_trans; rewrite submxMr. apply: hom_component_mx; first exact: socle_simple. apply/rV_subP=> v _; apply/hom_mxP=> x Gx. by rewrite !mul_rV_lin1 /f /= gring_mxJ ?mulmxA. Qed. Lemma Wedderburn_direct : mxdirect (\sum_i 'R_i)%MS. Proof. apply/mxdirectP; rewrite /= sums_R mxrankMfree ?gring_free //. rewrite (mxdirectP (Socle_direct sG)); apply: eq_bigr=> i _ /=. by rewrite genmxE mxrankMfree ?gring_free. Qed. Lemma Wedderburn_disjoint i j : i != j -> ('R_i :&: 'R_j)%MS = 0. Proof. move=> ne_ij; apply/eqP; rewrite -submx0 capmxC. by rewrite -(mxdirect_sumsP Wedderburn_direct j) // capmxS // (sumsmx_sup i). Qed. Lemma Wedderburn_annihilate i j : i != j -> ('R_i * 'R_j)%MS = 0. Proof. move=> ne_ij; apply/eqP; rewrite -submx0 -(Wedderburn_disjoint ne_ij). rewrite sub_capmx; apply/andP; split. case/andP: (Wedderburn_ideal i) => _; apply: submx_trans. by rewrite mulsmxS // genmxE submxMl. case/andP: (Wedderburn_ideal j) => idlRj _; apply: submx_trans idlRj. by rewrite mulsmxS // genmxE submxMl. Qed. Lemma Wedderburn_mulmx0 i j A B : i != j -> (A \in 'R_i)%MS -> (B \in 'R_j)%MS -> A *m B = 0. Proof. move=> ne_ij RiA RjB; apply: memmx0. by rewrite -(Wedderburn_annihilate ne_ij) mem_mulsmx. Qed. Hypothesis F'G : [char F]^'.-group G. Lemma irr_mx_sum : (\sum_(i : sG) i = 1%:M)%MS. Proof. by apply: reducible_Socle1; apply: mx_Maschke. Qed. Lemma Wedderburn_sum : (\sum_i 'R_i :=: R_G)%MS. Proof. by apply: eqmx_trans sums_R _; rewrite /Socle irr_mx_sum mul1mx. Qed. Definition Wedderburn_id i := vec_mx (mxvec 1%:M *m proj_mx 'R_i (\sum_(j | j != i) 'R_j)%MS). Local Notation "''e_' i" := (Wedderburn_id i) : group_ring_scope. Lemma Wedderburn_sum_id : \sum_i 'e_i = 1%:M. Proof. rewrite -linear_sum; apply: canLR mxvecK _. have: (1%:M \in R_G)%MS := envelop_mx1 aG. rewrite -Wedderburn_sum; case/(sub_dsumsmx Wedderburn_direct) => e Re -> _. apply: eq_bigr => i _; have dxR := mxdirect_sumsP Wedderburn_direct i (erefl _). rewrite (bigD1 i) // mulmxDl proj_mx_id ?Re // proj_mx_0 ?addr0 //=. by rewrite summx_sub // => j ne_ji; rewrite (sumsmx_sup j) ?Re. Qed. Lemma Wedderburn_id_mem i : ('e_i \in 'R_i)%MS. Proof. by rewrite vec_mxK proj_mx_sub. Qed. Lemma Wedderburn_is_id i : mxring_id 'R_i 'e_i. Proof. have ideRi A: (A \in 'R_i)%MS -> 'e_i *m A = A. move=> RiA; rewrite -{2}[A]mul1mx -Wedderburn_sum_id mulmx_suml. rewrite (bigD1 i) //= big1 ?addr0 // => j ne_ji. by rewrite (Wedderburn_mulmx0 ne_ji) ?Wedderburn_id_mem. split=> // [||A RiA]; first 2 [exact: Wedderburn_id_mem]. apply: contraNneq (nz_socle i) => e0. apply/rowV0P=> v; rewrite -mem_gring_mx -(genmxE (i *m _)) => /ideRi. by rewrite e0 mul0mx => /(canLR gring_mxK); rewrite linear0. rewrite -{2}[A]mulmx1 -Wedderburn_sum_id mulmx_sumr (bigD1 i) //=. rewrite big1 ?addr0 // => j; rewrite eq_sym => ne_ij. by rewrite (Wedderburn_mulmx0 ne_ij) ?Wedderburn_id_mem. Qed. Lemma Wedderburn_closed i : ('R_i * 'R_i = 'R_i)%MS. Proof. rewrite -{3}['R_i]genmx_id -/'R_i -genmx_muls; apply/genmxP. have [idlRi idrRi] := andP (Wedderburn_ideal i). apply/andP; split. by apply: submx_trans idrRi; rewrite mulsmxS // genmxE submxMl. have [_ Ri_e ideRi _] := Wedderburn_is_id i. by apply/memmx_subP=> A RiA; rewrite -[A]ideRi ?mem_mulsmx. Qed. Lemma Wedderburn_is_ring i : mxring 'R_i. Proof. rewrite /mxring /left_mx_ideal Wedderburn_closed submx_refl. by apply/mxring_idP; exists 'e_i; apply: Wedderburn_is_id. Qed. Lemma Wedderburn_min_ideal m i (E : 'A_(m, nG)) : E != 0 -> (E <= 'R_i)%MS -> mx_ideal R_G E -> (E :=: 'R_i)%MS. Proof. move=> nzE sE_Ri /andP[idlE idrE]; apply/eqmxP; rewrite sE_Ri. pose M := E *m pinvmx R_G; have defE: E = M *m R_G. by rewrite mulmxKpV // (submx_trans sE_Ri) // genmxE submxMl. have modM: mxmodule aG M by rewrite regular_module_ideal -defE. have simSi := socle_simple i; set Si := socle_base i in simSi. have [I [W isoW defW]]:= component_mx_def simSi. rewrite /'R_i /socle_val /= defW genmxE defE submxMr //. apply/sumsmx_subP=> j _. have simW := mx_iso_simple (isoW j) simSi; have [modW _ minW] := simW. have [{minW}dxWE | nzWE] := eqVneq (W j :&: M)%MS 0; last first. by rewrite (sameP capmx_idPl eqmxP) minW ?capmxSl ?capmx_module. have [_ Rei ideRi _] := Wedderburn_is_id i. have:= nzE; rewrite -submx0 => /memmx_subP[A E_A]. rewrite -(ideRi _ (memmx_subP sE_Ri _ E_A)). have:= E_A; rewrite defE mem_sub_gring => /andP[R_A M_A]. have:= Rei; rewrite genmxE mem_sub_gring => /andP[Re]. rewrite -{2}(gring_rowK Re) /socle_val defW => /sub_sumsmxP[e ->]. rewrite !(linear_sum, mulmx_suml) summx_sub //= => k _. rewrite -(gring_rowK R_A) -gring_mxA -mulmxA gring_rowK //. rewrite ((W k *m _ =P 0) _) ?linear0 ?sub0mx //. have [f _ homWf defWk] := mx_iso_trans (mx_iso_sym (isoW j)) (isoW k). rewrite -submx0 -{k defWk}(eqmxMr _ defWk) -(hom_envelop_mxC homWf) //. rewrite -(mul0mx _ f) submxMr {f homWf}// -dxWE sub_capmx. rewrite (mxmodule_envelop modW) //=; apply/row_subP=> k. rewrite row_mul -mem_gring_mx -(gring_rowK R_A) gring_mxA gring_rowK //. by rewrite -defE (memmx_subP idlE) // mem_mulsmx ?gring_mxP. Qed. Section IrrComponent. (* The component of the socle of the regular module that is associated to an *) (* irreducible representation. *) Variables (n : nat) (rG : mx_representation F G n). Local Notation E_G := (enveloping_algebra_mx rG). Let not_rsim_op0 (iG j : sG) A : mx_rsim rG (socle_repr iG) -> iG != j -> (A \in 'R_j)%MS -> gring_op rG A = 0. Proof. case/mx_rsim_def=> f [f' _ hom_f] ne_iG_j RjA. transitivity (f *m in_submod _ (val_submod 1%:M *m A) *m f'). have{RjA}: (A \in R_G)%MS by rewrite -Wedderburn_sum (sumsmx_sup j). case/envelop_mxP=> a ->{A}; rewrite !(linear_sum, mulmx_suml). by apply: eq_bigr => x Gx; rewrite !linearZ /= -scalemxAl -hom_f ?gring_opG. rewrite (_ : _ *m A = 0) ?(linear0, mul0mx) //. apply/row_matrixP=> i; rewrite row_mul row0 -[row _ _]gring_mxK -gring_row_mul. rewrite (Wedderburn_mulmx0 ne_iG_j) ?linear0 // genmxE mem_gring_mx. by rewrite (row_subP _) // val_submod1 component_mx_id //; apply: socle_simple. Qed. Definition irr_comp := odflt 1%irr [pick i | gring_op rG 'e_i != 0]. Local Notation iG := irr_comp. Hypothesis irrG : mx_irreducible rG. Lemma rsim_irr_comp : mx_rsim rG (irr_repr iG). Proof. have [M [modM rsimM]] := rsim_regular_submod irrG F'G. have simM: mxsimple aG M. case/mx_irrP: irrG => n_gt0 minG. have [f def_n injf homf] := mx_rsim_sym rsimM. apply/(submod_mx_irr modM)/mx_irrP. split=> [|U modU nzU]; first by rewrite def_n. rewrite /row_full -(mxrankMfree _ injf) -genmxE {4}def_n. apply: minG; last by rewrite -mxrank_eq0 genmxE mxrankMfree // mxrank_eq0. rewrite (eqmx_module _ (genmxE _)); apply/mxmoduleP=> x Gx. by rewrite -mulmxA -homf // mulmxA submxMr // (mxmoduleP modU). pose i := PackSocle (component_socle sG simM). have{modM} rsimM: mx_rsim rG (socle_repr i). apply: mx_rsim_trans rsimM (mx_rsim_sym _); apply/mx_rsim_iso. apply: (component_mx_iso (socle_simple _)) => //. by rewrite [component_mx _ _]PackSocleK component_mx_id. have [<- // | ne_i_iG] := eqVneq i iG. suffices {i M simM ne_i_iG rsimM}: gring_op rG 'e_iG != 0. by rewrite (not_rsim_op0 rsimM ne_i_iG) ?Wedderburn_id_mem ?eqxx. rewrite /iG; case: pickP => //= G0. suffices: rG 1%g == 0. by case/idPn; rewrite -mxrank_eq0 repr_mx1 mxrank1 -lt0n; case/mx_irrP: irrG. rewrite -gring_opG // repr_mx1 -Wedderburn_sum_id linear_sum big1 // => j _. by move/eqP: (G0 j). Qed. Lemma irr_comp'_op0 j A : j != iG -> (A \in 'R_j)%MS -> gring_op rG A = 0. Proof. by rewrite eq_sym; apply: not_rsim_op0 rsim_irr_comp. Qed. Lemma irr_comp_envelop : ('R_iG *m lin_mx (gring_op rG) :=: E_G)%MS. Proof. apply/eqmxP/andP; split; apply/row_subP=> i. by rewrite row_mul mul_rV_lin gring_mxP. rewrite rowK /= -gring_opG ?enum_valP // -mul_vec_lin -gring_opG ?enum_valP //. rewrite vec_mxK /= -mulmxA mulmx_sub {i}//= -(eqmxMr _ Wedderburn_sum). rewrite (bigD1 iG) //= addsmxMr addsmxC [_ *m _](sub_kermxP _) ?adds0mx //=. apply/sumsmx_subP => j ne_j_iG; apply/memmx_subP=> A RjA; apply/sub_kermxP. by rewrite mul_vec_lin /= (irr_comp'_op0 ne_j_iG RjA) linear0. Qed. Lemma ker_irr_comp_op : ('R_iG :&: kermx (lin_mx (gring_op rG)))%MS = 0. Proof. apply/eqP; rewrite -submx0; apply/memmx_subP=> A. rewrite sub_capmx /= submx0 mxvec_eq0 => /andP[R_A]. rewrite (sameP sub_kermxP eqP) mul_vec_lin mxvec_eq0 /= => opA0. have [_ Re ideR _] := Wedderburn_is_id iG; rewrite -[A]ideR {ideR}//. move: Re; rewrite genmxE mem_sub_gring /socle_val => /andP[Re]. rewrite -{2}(gring_rowK Re) -submx0. pose simMi := socle_simple iG; have [J [M isoM ->]] := component_mx_def simMi. case/sub_sumsmxP=> e ->; rewrite linear_sum mulmx_suml summx_sub // => j _. rewrite -(in_submodK (submxMl _ (M j))); move: (in_submod _ _) => v. have modMj: mxmodule aG (M j) by apply: mx_iso_module (isoM j) _; case: simMi. have rsimMj: mx_rsim rG (submod_repr modMj). by apply: mx_rsim_trans rsim_irr_comp _; apply/mx_rsim_iso. have [f [f' _ hom_f]] := mx_rsim_def (mx_rsim_sym rsimMj); rewrite submx0. have <-: (gring_mx aG (val_submod (v *m (f *m gring_op rG A *m f')))) = 0. by rewrite (eqP opA0) !(mul0mx, linear0). have: (A \in R_G)%MS by rewrite -Wedderburn_sum (sumsmx_sup iG). case/envelop_mxP=> a ->; rewrite !(linear_sum, mulmx_suml) /=; apply/eqP. apply: eq_bigr=> x Gx; rewrite !linearZ -scalemxAl !linearZ /=. by rewrite gring_opG // -hom_f // val_submodJ // gring_mxJ. Qed. Lemma regular_op_inj : {in [pred A | (A \in 'R_iG)%MS] &, injective (gring_op rG)}. Proof. move=> A B RnA RnB /= eqAB; apply/eqP; rewrite -subr_eq0 -mxvec_eq0 -submx0. rewrite -ker_irr_comp_op sub_capmx (sameP sub_kermxP eqP) mul_vec_lin. by rewrite 2!linearB /= eqAB subrr linear0 addmx_sub ?eqmx_opp /=. Qed. Lemma rank_irr_comp : \rank 'R_iG = \rank E_G. Proof. symmetry; rewrite -{1}irr_comp_envelop; apply/mxrank_injP. by rewrite ker_irr_comp_op. Qed. End IrrComponent. Lemma irr_comp_rsim n1 n2 rG1 rG2 : @mx_rsim _ G n1 rG1 n2 rG2 -> irr_comp rG1 = irr_comp rG2. Proof. case=> f eq_n12; rewrite -eq_n12 in rG2 f * => inj_f hom_f. congr (odflt _ _); apply: eq_pick => i; rewrite -!mxrank_eq0. rewrite -(mxrankMfree _ inj_f); symmetry; rewrite -(eqmxMfull _ inj_f). have /envelop_mxP[e ->{i}]: ('e_i \in R_G)%MS. by rewrite -Wedderburn_sum (sumsmx_sup i) ?Wedderburn_id_mem. congr (\rank _ != _); rewrite !(mulmx_suml, linear_sum); apply: eq_bigr => x Gx. by rewrite !linearZ -scalemxAl /= !gring_opG ?hom_f. Qed. Lemma irr_reprK i : irr_comp (irr_repr i) = i. Proof. apply/eqP; apply/component_mx_isoP; try exact: socle_simple. by move/mx_rsim_iso: (rsim_irr_comp (socle_irr i)); apply: mx_iso_sym. Qed. Lemma irr_repr'_op0 i j A : j != i -> (A \in 'R_j)%MS -> gring_op (irr_repr i) A = 0. Proof. by move=> neq_ij /irr_comp'_op0-> //; [apply: socle_irr | rewrite irr_reprK]. Qed. Lemma op_Wedderburn_id i : gring_op (irr_repr i) 'e_i = 1%:M. Proof. rewrite -(gring_op1 (irr_repr i)) -Wedderburn_sum_id. rewrite linear_sum (bigD1 i) //= addrC big1 ?add0r // => j neq_ji. exact: irr_repr'_op0 (Wedderburn_id_mem j). Qed. Lemma irr_comp_id (M : 'M_nG) (modM : mxmodule aG M) (iM : sG) : mxsimple aG M -> (M <= iM)%MS -> irr_comp (submod_repr modM) = iM. Proof. move=> simM sMiM; rewrite -[iM]irr_reprK. apply/esym/irr_comp_rsim/mx_rsim_iso/component_mx_iso => //. exact: socle_simple. Qed. Lemma irr1_repr x : x \in G -> irr_repr 1 x = 1%:M. Proof. move=> Gx; suffices: x \in rker (irr_repr 1) by case/rkerP. apply: subsetP x Gx; rewrite rker_submod rfix_mx_rstabC // -irr1_rfix. by apply: component_mx_id; apply: socle_simple. Qed. Hypothesis splitG : group_splitting_field G. Lemma rank_Wedderburn_subring i : \rank 'R_i = ('n_i ^ 2)%N. Proof. apply/eqP; rewrite -{1}[i]irr_reprK; have irrSi := socle_irr i. by case/andP: (splitG irrSi) => _; rewrite rank_irr_comp. Qed. Lemma sum_irr_degree : (\sum_i 'n_i ^ 2 = nG)%N. Proof. apply: etrans (eqnP gring_free). rewrite -Wedderburn_sum (mxdirectP Wedderburn_direct) /=. by apply: eq_bigr => i _; rewrite rank_Wedderburn_subring. Qed. Lemma irr_mx_mult i : socle_mult i = 'n_i. Proof. rewrite /socle_mult -(mxrankMfree _ gring_free) -genmxE. by rewrite rank_Wedderburn_subring mulKn ?irr_degree_gt0. Qed. Lemma mxtrace_regular : {in G, forall x, \tr (aG x) = \sum_i \tr (socle_repr i x) *+ 'n_i}. Proof. move=> x Gx; have soc1: (Socle sG :=: 1%:M)%MS by rewrite -irr_mx_sum. rewrite -(mxtrace_submod1 (Socle_module sG) soc1) // mxtrace_Socle //. by apply: eq_bigr => i _; rewrite irr_mx_mult. Qed. Definition linear_irr := [set i | 'n_i == 1%N]. Lemma irr_degree_abelian : abelian G -> forall i, 'n_i = 1%N. Proof. by move=> cGG i; apply: mxsimple_abelian_linear (socle_simple i). Qed. Lemma linear_irr_comp i : 'n_i = 1%N -> (i :=: socle_base i)%MS. Proof. move=> ni1; apply/eqmxP; rewrite andbC -mxrank_leqif_eq -/'n_i. by rewrite -(mxrankMfree _ gring_free) -genmxE rank_Wedderburn_subring ni1. exact: component_mx_id (socle_simple i). Qed. Lemma Wedderburn_subring_center i : ('Z('R_i) :=: mxvec 'e_i)%MS. Proof. have [nz_e Re ideR idRe] := Wedderburn_is_id i. have Ze: (mxvec 'e_i <= 'Z('R_i))%MS. rewrite sub_capmx [(_ <= _)%MS]Re. by apply/cent_mxP=> A R_A; rewrite ideR // idRe. pose irrG := socle_irr i; set rG := socle_repr i in irrG. pose E_G := enveloping_algebra_mx rG; have absG := splitG irrG. apply/eqmxP; rewrite andbC -(geq_leqif (mxrank_leqif_eq Ze)). have ->: \rank (mxvec 'e_i) = (0 + 1)%N. by apply/eqP; rewrite eqn_leq rank_leq_row lt0n mxrank_eq0 mxvec_eq0. rewrite -(mxrank_mul_ker _ (lin_mx (gring_op rG))) addnC leq_add //. rewrite leqn0 mxrank_eq0 -submx0 -(ker_irr_comp_op irrG) capmxS //. by rewrite irr_reprK capmxSl. apply: leq_trans (mxrankS _) (rank_leq_row (mxvec 1%:M)). apply/memmx_subP=> Ar; case/submxP=> a ->{Ar}. rewrite mulmxA mul_rV_lin /=; set A := vec_mx _. rewrite memmx1 (mx_abs_irr_cent_scalar absG) // -memmx_cent_envelop. apply/cent_mxP=> Br; rewrite -(irr_comp_envelop irrG) irr_reprK. case/submxP=> b /(canRL mxvecK) ->{Br}; rewrite mulmxA mx_rV_lin /=. set B := vec_mx _; have RiB: (B \in 'R_i)%MS by rewrite vec_mxK submxMl. have sRiR: ('R_i <= R_G)%MS by rewrite -Wedderburn_sum (sumsmx_sup i). have: (A \in 'Z('R_i))%MS by rewrite vec_mxK submxMl. rewrite sub_capmx => /andP[RiA /cent_mxP cRiA]. by rewrite -!gring_opM ?(memmx_subP sRiR) 1?cRiA. Qed. Lemma Wedderburn_center : ('Z(R_G) :=: \matrix_(i < #|sG|) mxvec 'e_(enum_val i))%MS. Proof. have:= mxdirect_sums_center Wedderburn_sum Wedderburn_direct Wedderburn_ideal. move/eqmx_trans; apply; apply/eqmxP/andP; split. apply/sumsmx_subP=> i _; rewrite Wedderburn_subring_center. by apply: (eq_row_sub (enum_rank i)); rewrite rowK enum_rankK. apply/row_subP=> i; rewrite rowK -Wedderburn_subring_center. by rewrite (sumsmx_sup (enum_val i)). Qed. Lemma card_irr : #|sG| = tG. Proof. rewrite -(eqnP classg_base_free) classg_base_center. have:= mxdirect_sums_center Wedderburn_sum Wedderburn_direct Wedderburn_ideal. move->; rewrite (mxdirectP _) /=; last first. apply/mxdirect_sumsP=> i _; apply/eqP; rewrite -submx0. rewrite -{2}(mxdirect_sumsP Wedderburn_direct i) // capmxS ?capmxSl //=. by apply/sumsmx_subP=> j neji; rewrite (sumsmx_sup j) ?capmxSl. rewrite -sum1_card; apply: eq_bigr => i _; apply/eqP. rewrite Wedderburn_subring_center eqn_leq rank_leq_row lt0n mxrank_eq0. by rewrite andbT mxvec_eq0; case: (Wedderburn_is_id i). Qed. Section CenterMode. Variable i : sG. Let i0 := Ordinal (irr_degree_gt0 i). Definition irr_mode x := irr_repr i x i0 i0. Lemma irr_mode1 : irr_mode 1 = 1. Proof. by rewrite /irr_mode repr_mx1 mxE eqxx. Qed. Lemma irr_center_scalar : {in 'Z(G), forall x, irr_repr i x = (irr_mode x)%:M}. Proof. rewrite /irr_mode => x /setIP[Gx cGx]. suffices [a ->]: exists a, irr_repr i x = a%:M by rewrite mxE eqxx. apply/is_scalar_mxP; apply: (mx_abs_irr_cent_scalar (splitG (socle_irr i))). by apply/centgmxP=> y Gy; rewrite -!{1}repr_mxM 1?(centP cGx). Qed. Lemma irr_modeM : {in 'Z(G) &, {morph irr_mode : x y / (x * y)%g >-> x * y}}. Proof. move=> x y Zx Zy; rewrite {1}/irr_mode repr_mxM ?(subsetP (center_sub G)) //. by rewrite !irr_center_scalar // -scalar_mxM mxE eqxx. Qed. Lemma irr_modeX n : {in 'Z(G), {morph irr_mode : x / (x ^+ n)%g >-> x ^+ n}}. Proof. elim: n => [|n IHn] x Zx; first exact: irr_mode1. by rewrite expgS irr_modeM ?groupX // exprS IHn. Qed. Lemma irr_mode_unit : {in 'Z(G), forall x, irr_mode x \is a GRing.unit}. Proof. move=> x Zx /=; have:= unitr1 F. by rewrite -irr_mode1 -(mulVg x) irr_modeM ?groupV // unitrM; case/andP=> _. Qed. Lemma irr_mode_neq0 : {in 'Z(G), forall x, irr_mode x != 0}. Proof. by move=> x /irr_mode_unit; rewrite unitfE. Qed. Lemma irr_modeV : {in 'Z(G), {morph irr_mode : x / (x^-1)%g >-> x^-1}}. Proof. move=> x Zx /=; rewrite -[_^-1]mul1r; apply: canRL (mulrK (irr_mode_unit Zx)) _. by rewrite -irr_modeM ?groupV // mulVg irr_mode1. Qed. End CenterMode. Lemma irr1_mode x : x \in G -> irr_mode 1 x = 1. Proof. by move=> Gx; rewrite /irr_mode irr1_repr ?mxE. Qed. End Regular. Local Notation "[ 1 sG ]" := (principal_comp sG) : irrType_scope. Section LinearIrr. Variables (gT : finGroupType) (G : {group gT}). Lemma card_linear_irr (sG : irrType G) : [char F]^'.-group G -> group_splitting_field G -> #|linear_irr sG| = #|G : G^`(1)|%g. Proof. move=> F'G splitG; apply/eqP. wlog sGq: / irrType (G / G^`(1))%G by apply: socle_exists. have [_ nG'G] := andP (der_normal 1 G); apply/eqP; rewrite -card_quotient //. have cGqGq: abelian (G / G^`(1))%g by apply: sub_der1_abelian. have F'Gq: [char F]^'.-group (G / G^`(1))%g by apply: morphim_pgroup. have splitGq: group_splitting_field (G / G^`(1))%G. exact: quotient_splitting_field. rewrite -(sum_irr_degree sGq) // -sum1_card. pose rG (j : sGq) := morphim_repr (socle_repr j) nG'G. have irrG j: mx_irreducible (rG j) by apply/morphim_mx_irr; apply: socle_irr. rewrite (reindex (fun j => irr_comp sG (rG j))) /=. apply: eq_big => [j | j _]; last by rewrite irr_degree_abelian. have [_ lin_j _ _] := rsim_irr_comp sG F'G (irrG j). by rewrite inE -lin_j -irr_degreeE irr_degree_abelian. pose sGlin := {i | i \in linear_irr sG}. have sG'k (i : sGlin) : G^`(1)%g \subset rker (irr_repr (val i)). by case: i => i /=; rewrite !inE => lin; rewrite rker_linear //=; apply/eqP. pose h' u := irr_comp sGq (quo_repr (sG'k u) nG'G). have irrGq u: mx_irreducible (quo_repr (sG'k u) nG'G). by apply/quo_mx_irr; apply: socle_irr. exists (fun i => oapp h' [1 sGq]%irr (insub i)) => [j | i] lin_i. rewrite (insubT (mem _) lin_i) /=; apply/esym/eqP/socle_rsimP. apply: mx_rsim_trans (rsim_irr_comp sGq F'Gq (irrGq _)). have [g lin_g inj_g hom_g] := rsim_irr_comp sG F'G (irrG j). exists g => [||G'x]; last 1 [case/morphimP=> x _ Gx ->] || by []. by rewrite quo_repr_coset ?hom_g. rewrite (insubT (mem _) lin_i) /=; apply/esym/eqP/socle_rsimP. set u := exist _ _ _; apply: mx_rsim_trans (rsim_irr_comp sG F'G (irrG _)). have [g lin_g inj_g hom_g] := rsim_irr_comp sGq F'Gq (irrGq u). exists g => [||x Gx]; last 1 [have:= hom_g (coset _ x)] || by []. by rewrite quo_repr_coset; first by apply; rewrite mem_quotient. Qed. Lemma primitive_root_splitting_abelian (z : F) : #|G|.-primitive_root z -> abelian G -> group_splitting_field G. Proof. move=> ozG cGG [|n] rG irrG; first by case/mx_irrP: irrG. case: (pickP [pred x in G | ~~ is_scalar_mx (rG x)]) => [x | scalG]. case/andP=> Gx nscal_rGx; have: horner_mx (rG x) ('X^#|G| - 1) == 0. rewrite rmorphB rmorphX /= horner_mx_C horner_mx_X. rewrite -repr_mxX ?inE // ((_ ^+ _ =P 1)%g _) ?repr_mx1 ?subrr //. by rewrite -order_dvdn order_dvdG. case/idPn; rewrite -mxrank_eq0 -(factor_Xn_sub_1 ozG). elim: #|G| => [|i IHi]; first by rewrite big_nil horner_mx_C mxrank1. rewrite big_nat_recr //= rmorphM mxrankMfree {IHi}//. rewrite row_free_unit rmorphB /= horner_mx_X horner_mx_C. rewrite (mx_Schur irrG) ?subr_eq0 //; last first. by apply: contraNneq nscal_rGx => ->; apply: scalar_mx_is_scalar. rewrite -memmx_cent_envelop linearB. rewrite addmx_sub ?eqmx_opp ?scalar_mx_cent //= memmx_cent_envelop. by apply/centgmxP=> j Zh_j; rewrite -!repr_mxM // (centsP cGG). pose M := <>%MS. have linM: \rank M = 1%N by rewrite genmxE mxrank_delta. have modM: mxmodule rG M. apply/mxmoduleP=> x Gx; move/idPn: (scalG x); rewrite /= Gx negbK. by case/is_scalar_mxP=> ? ->; rewrite scalar_mxC submxMl. apply: linear_mx_abs_irr; apply/eqP; rewrite eq_sym -linM. by case/mx_irrP: irrG => _; apply; rewrite // -mxrank_eq0 linM. Qed. Lemma cycle_repr_structure x (sG : irrType G) : G :=: <[x]> -> [char F]^'.-group G -> group_splitting_field G -> exists2 w : F, #|G|.-primitive_root w & exists iphi : 'I_#|G| -> sG, [/\ bijective iphi, #|sG| = #|G|, forall i, irr_mode (iphi i) x = w ^+ i & forall i, irr_repr (iphi i) x = (w ^+ i)%:M]. Proof. move=> defG; rewrite {defG}(group_inj defG) -/#[x] in sG * => F'X splitF. have Xx := cycle_id x; have cXX := cycle_abelian x. have card_sG: #|sG| = #[x]. by rewrite card_irr //; apply/eqP; rewrite -card_classes_abelian. have linX := irr_degree_abelian splitF cXX (_ : sG). pose r (W : sG) := irr_mode W x. have scalX W: irr_repr W x = (r W)%:M. by apply: irr_center_scalar; rewrite ?(center_idP _). have inj_r: injective r. move=> V W eqVW; rewrite -(irr_reprK F'X V) -(irr_reprK F'X W). move: (irr_repr V) (irr_repr W) (scalX V) (scalX W). rewrite !linX {}eqVW => rV rW <- rWx; apply: irr_comp_rsim => //. exists 1%:M; rewrite ?row_free_unit ?unitmx1 // => xk; case/cycleP=> k ->{xk}. by rewrite mulmx1 mul1mx !repr_mxX // rWx. have rx1 W: r W ^+ #[x] = 1. by rewrite -irr_modeX ?(center_idP _) // expg_order irr_mode1. have /hasP[w _ prim_w]: has #[x].-primitive_root (map r (enum sG)). rewrite has_prim_root 1?map_inj_uniq ?enum_uniq //; first 1 last. by rewrite size_map -cardE card_sG. by apply/allP=> _ /mapP[W _ ->]; rewrite unity_rootE rx1. have iphi'P := prim_rootP prim_w (rx1 _); pose iphi' := sval (iphi'P _). have def_r W: r W = w ^+ iphi' W by apply: svalP (iphi'P W). have inj_iphi': injective iphi'. by move=> i j eq_ij; apply: inj_r; rewrite !def_r eq_ij. have iphiP: codom iphi' =i 'I_#[x]. by apply/subset_cardP; rewrite ?subset_predT // card_ord card_image. pose iphi i := iinv (iphiP i); exists w => //; exists iphi. have iphiK: cancel iphi iphi' by move=> i; apply: f_iinv. have r_iphi i: r (iphi i) = w ^+ i by rewrite def_r iphiK. split=> // [|i]; last by rewrite scalX r_iphi. by exists iphi' => // W; rewrite /iphi iinv_f. Qed. Lemma splitting_cyclic_primitive_root : cyclic G -> [char F]^'.-group G -> group_splitting_field G -> classically {z : F | #|G|.-primitive_root z}. Proof. case/cyclicP=> x defG F'G splitF; case=> // IH. wlog sG: / irrType G by apply: socle_exists. have [w prim_w _] := cycle_repr_structure sG defG F'G splitF. by apply: IH; exists w. Qed. End LinearIrr. End FieldRepr. Arguments rfix_mx {F gT G%g n%N} rG H%g. Arguments gset_mx F {gT} G%g A%g. Arguments classg_base F {gT} G%g _%g : extra scopes. Arguments irrType F {gT} G%g. Arguments mxmoduleP {F gT G n rG m U}. Arguments envelop_mxP {F gT G n rG A}. Arguments hom_mxP {F gT G n rG m f W}. Arguments mx_Maschke [F gT G n] rG _ [U]. Arguments rfix_mxP {F gT G n rG m W}. Arguments cyclic_mxP {F gT G n rG u v}. Arguments annihilator_mxP {F gT G n rG u A}. Arguments row_hom_mxP {F gT G n rG u v}. Arguments mxsimple_isoP {F gT G n rG U V}. Arguments socle_exists [F gT G n]. Arguments socleP {F gT G n rG sG0 W W'}. Arguments mx_abs_irrP {F gT G n rG}. Arguments socle_rsimP {F gT G n rG sG W1 W2}. Arguments val_submod {F n U m} W. Arguments in_submod {F n} U {m} W. Arguments val_submodK {F n U m} W : rename. Arguments in_submodK {F n U m} [W] sWU. Arguments val_submod_inj {F n U m} [W1 W2] : rename. Arguments val_factmod {F n U m} W. Arguments in_factmod {F n} U {m} W. Arguments val_factmodK {F n U m} W : rename. Arguments in_factmodK {F n} U {m} [W] sWU. Arguments val_factmod_inj {F n U m} [W1 W2] : rename. Notation "'Cl" := (Clifford_action _) : action_scope. Arguments gring_row {R gT G} A. Arguments gring_rowK {F gT G} [A] RG_A. Bind Scope irrType_scope with socle_sort. Notation "[ 1 sG ]" := (principal_comp sG) : irrType_scope. Arguments irr_degree {F gT G%G sG} i%irr. Arguments irr_repr {F gT G%G sG} i%irr _%g : extra scopes. Arguments irr_mode {F gT G%G sG} i%irr z%g : rename. Notation "''n_' i" := (irr_degree i) : group_ring_scope. Notation "''R_' i" := (Wedderburn_subring i) : group_ring_scope. Notation "''e_' i" := (Wedderburn_id i) : group_ring_scope. Section DecideRed. Import MatrixFormula. Local Notation term := GRing.term. Local Notation True := GRing.True. Local Notation And := GRing.And (only parsing). Local Notation morphAnd f := ((big_morph f) true andb). Local Notation eval := GRing.eval. Local Notation holds := GRing.holds. Local Notation qf_form := GRing.qf_form. Local Notation qf_eval := GRing.qf_eval. Section Definitions. Variables (F : fieldType) (gT : finGroupType) (G : {group gT}) (n : nat). Variable rG : mx_representation F G n. Definition mxmodule_form (U : 'M[term F]_n) := \big[And/True]_(x in G) submx_form (mulmx_term U (mx_term (rG x))) U. Lemma mxmodule_form_qf U : qf_form (mxmodule_form U). Proof. by rewrite (morphAnd (@qf_form _)) ?big1 //= => x _; rewrite submx_form_qf. Qed. Lemma eval_mxmodule U e : qf_eval e (mxmodule_form U) = mxmodule rG (eval_mx e U). Proof. rewrite (morphAnd (qf_eval e)) //= big_andE /=. apply/forallP/mxmoduleP=> Umod x; move/implyP: (Umod x); by rewrite eval_submx eval_mulmx eval_mx_term. Qed. Definition mxnonsimple_form (U : 'M[term F]_n) := let V := vec_mx (row_var F (n * n) 0) in let nzV := (~ mxrank_form 0 V)%T in let properVU := (submx_form V U /\ ~ submx_form U V)%T in (Exists_row_form (n * n) 0 (mxmodule_form V /\ nzV /\ properVU))%T. End Definitions. Variables (F : decFieldType) (gT : finGroupType) (G : {group gT}) (n : nat). Variable rG : mx_representation F G n. Definition mxnonsimple_sat U := GRing.sat (@row_env _ (n * n) [::]) (mxnonsimple_form rG (mx_term U)). Lemma mxnonsimpleP U : U != 0 -> reflect (mxnonsimple rG U) (mxnonsimple_sat U). Proof. rewrite /mxnonsimple_sat {1}/mxnonsimple_form; set Vt := vec_mx _ => /= nzU. pose nsim V := [&& mxmodule rG V, (V <= U)%MS, V != 0 & \rank V < \rank U]. set nsimUt := (_ /\ _)%T; have: qf_form nsimUt. by rewrite /= mxmodule_form_qf !mxrank_form_qf !submx_form_qf. move/GRing.qf_evalP; set qev := @GRing.qf_eval _ => qevP. have qev_nsim u: qev (row_env [:: u]) nsimUt = nsim n (vec_mx u). rewrite /nsim -mxrank_eq0 /qev /= eval_mxmodule eval_mxrank. rewrite !eval_submx eval_mx_term eval_vec_mx eval_row_var /=. do 2!bool_congr; apply: andb_id2l => sUV. by rewrite ltn_neqAle andbC !mxrank_leqif_sup. have n2gt0: n ^ 2 > 0. by move: nzU; rewrite muln_gt0 -mxrank_eq0; case: posnP (U) => // ->. apply: (iffP satP) => [|[V nsimV]]. by case/Exists_rowP=> // v; move/qevP; rewrite qev_nsim; exists (vec_mx v). apply/Exists_rowP=> //; exists (mxvec V); apply/qevP. by rewrite qev_nsim mxvecK. Qed. Lemma dec_mxsimple_exists (U : 'M_n) : mxmodule rG U -> U != 0 -> {V | mxsimple rG V & V <= U}%MS. Proof. have [m] := ubnP (\rank U); elim: m U => // m IHm U leUm modU nzU. have [nsimU | simU] := mxnonsimpleP nzU; last first. by exists U; first apply/mxsimpleP. move: (xchooseP nsimU); move: (xchoose _) => W /and4P[modW sWU nzW ltWU]. case: (IHm W) => // [|V simV sVW]; first exact: leq_trans ltWU _. by exists V; last apply: submx_trans sVW sWU. Qed. Lemma dec_mx_reducible_semisimple U : mxmodule rG U -> mx_completely_reducible rG U -> mxsemisimple rG U. Proof. have [m] := ubnP (\rank U); elim: m U => // m IHm U leUm modU redU. have [U0 | nzU] := eqVneq U 0. have{} U0: (\sum_(i < 0) 0 :=: U)%MS by rewrite big_ord0 U0. by apply: (intro_mxsemisimple U0); case. have [V simV sVU] := dec_mxsimple_exists modU nzU; have [modV nzV _] := simV. have [W modW defVW dxVW] := redU V modV sVU. have [||I W_ /= simW defW _] := IHm W _ modW. - rewrite ltnS in leUm; apply: leq_trans leUm. by rewrite -defVW (mxdirectP dxVW) /= -add1n leq_add2r lt0n mxrank_eq0. - by apply: mx_reducibleS redU; rewrite // -defVW addsmxSr. suffices defU: (\sum_i oapp W_ V i :=: U)%MS. by apply: (intro_mxsemisimple defU) => [] [|i] //=. apply: eqmx_trans defVW; rewrite (bigD1 None) //=; apply/eqmxP. have [i0 _ | I0] := pickP I. by rewrite (reindex some) ?addsmxS ?defW //; exists (odflt i0) => //; case. rewrite big_pred0 //; last by case=> // /I0. by rewrite !addsmxS ?sub0mx // -defW big_pred0. Qed. Lemma DecSocleType : socleType rG. Proof. have [n0 | n_gt0] := posnP n. by exists [::] => // M [_]; rewrite -mxrank_eq0 -leqn0 -n0 rank_leq_row. have n2_gt0: n ^ 2 > 0 by rewrite muln_gt0 n_gt0. pose span Ms := (\sum_(M <- Ms) component_mx rG M)%MS. have: {in [::], forall M, mxsimple rG M} by []. have [m] := ubnP (n - \rank (span [::])). elim: m [::] => // m IHm Ms /ltnSE-Ms_ge_n simMs. pose V := span Ms; pose Vt := mx_term V. pose Ut i := vec_mx (row_var F (n * n) i); pose Zt := mx_term (0 : 'M[F]_n). pose exU i f := Exists_row_form (n * n) i (~ submx_form (Ut i) Zt /\ f (Ut i)). pose meetUVf U := exU 1%N (fun W => submx_form W Vt /\ submx_form W U)%T. pose mx_sat := GRing.sat (@row_env F (n * n) [::]). have ev_sub0 := GRing.qf_evalP _ (submx_form_qf _ Zt). have ev_mod := GRing.qf_evalP _ (mxmodule_form_qf rG _). pose ev := (eval_mxmodule, eval_submx, eval_vec_mx, eval_row_var, eval_mx_term). case haveU: (mx_sat (exU 0%N (fun U => mxmodule_form rG U /\ ~ meetUVf _ U)%T)). have [U modU]: {U : 'M_n | mxmodule rG U & (U != 0) && ((U :&: V)%MS == 0)}. apply: sig2W; case/Exists_rowP: (satP haveU) => //= u [nzU [modU tiUV]]. exists (vec_mx u); first by move/ev_mod: modU; rewrite !ev. set W := (_ :&: V)%MS; move/ev_sub0: nzU; rewrite !ev -!submx0 => -> /=. apply/idPn=> nzW; case: tiUV; apply/Exists_rowP=> //; exists (mxvec W). apply/GRing.qf_evalP; rewrite /= ?submx_form_qf // !ev mxvecK nzW /=. by rewrite andbC -sub_capmx. case/andP=> nzU tiUV; have [M simM sMU] := dec_mxsimple_exists modU nzU. apply: (IHm (M :: Ms)) => [|M']; last first. by case/predU1P=> [-> //|]; apply: simMs. have [_ nzM _] := simM. suffices ltVMV: \rank V < \rank (span (M :: Ms)). rewrite (leq_trans _ Ms_ge_n) // ltn_sub2l ?(leq_trans ltVMV) //. exact: rank_leq_row. rewrite /span big_cons (ltn_leqif (mxrank_leqif_sup (addsmxSr _ _))). apply: contra nzM; rewrite addsmx_sub -submx0 -(eqP tiUV) sub_capmx sMU. by case/andP=> sMV _; rewrite (submx_trans _ sMV) ?component_mx_id. exists Ms => // M simM; have [modM nzM minM] := simM. have sMV: (M <= V)%MS. apply: contraFT haveU => not_sMV; apply/satP/Exists_rowP=> //. exists (mxvec M); split; first by apply/ev_sub0; rewrite !ev mxvecK submx0. split; first by apply/ev_mod; rewrite !ev mxvecK. apply/Exists_rowP=> // [[w]]. apply/GRing.qf_evalP; rewrite /= ?submx_form_qf // !ev /= mxvecK submx0. rewrite -nz_row_eq0 -(cyclic_mx_eq0 rG); set W := cyclic_mx _ _. apply: contra not_sMV => /and3P[nzW Vw Mw]. have{Vw Mw} [sWV sWM]: (W <= V /\ W <= M)%MS. rewrite !cyclic_mx_sub ?(submx_trans (nz_row_sub _)) //. by rewrite sumsmx_module // => M' _; apply: component_mx_module. by rewrite (submx_trans _ sWV) // minM ?cyclic_mx_module. wlog sG: / socleType rG by apply: socle_exists. have sVS: (V <= \sum_(W : sG | has (fun Mi => Mi <= W) Ms) W)%MS. rewrite [V](big_nth 0) big_mkord; apply/sumsmx_subP=> i _. set Mi := Ms`_i; have MsMi: Mi \in Ms by apply: mem_nth. have simMi := simMs _ MsMi; have S_Mi := component_socle sG simMi. rewrite (sumsmx_sup (PackSocle S_Mi)) ?PackSocleK //. by apply/hasP; exists Mi; rewrite ?component_mx_id. have [W MsW isoWM] := subSocle_iso simM (submx_trans sMV sVS). have [Mi MsMi sMiW] := hasP MsW; apply/hasP; exists Mi => //. have [simMi simW] := (simMs _ MsMi, socle_simple W); apply/mxsimple_isoP=> //. exact: mx_iso_trans (mx_iso_sym isoWM) (component_mx_iso simW simMi sMiW). Qed. End DecideRed. Prenex Implicits mxmodule_form mxnonsimple_form mxnonsimple_sat. (* Change of representation field (by tensoring) *) Section ChangeOfField. Variables (aF rF : fieldType) (f : {rmorphism aF -> rF}). Local Notation "A ^f" := (map_mx (GRing.RMorphism.apply f) A) : ring_scope. Variables (gT : finGroupType) (G : {group gT}). Section OneRepresentation. Variables (n : nat) (rG : mx_representation aF G n). Local Notation rGf := (map_repr f rG). Lemma map_rfix_mx H : (rfix_mx rG H)^f = rfix_mx rGf H. Proof. rewrite map_kermx //; congr (kermx _); apply: map_lin1_mx => //= v. rewrite map_mxvec map_mxM; congr (mxvec (_ *m _)); last first. by apply: map_lin1_mx => //= u; rewrite map_mxM map_vec_mx. by apply/row_matrixP=> i; rewrite -map_row !rowK map_mxvec map_mxB map_mx1. Qed. Lemma rcent_map A : rcent rGf A^f = rcent rG A. Proof. by apply/setP=> x; rewrite !inE -!map_mxM inj_eq //; apply: map_mx_inj. Qed. Lemma rstab_map m (U : 'M_(m, n)) : rstab rGf U^f = rstab rG U. Proof. by apply/setP=> x; rewrite !inE -!map_mxM inj_eq //; apply: map_mx_inj. Qed. Lemma rstabs_map m (U : 'M_(m, n)) : rstabs rGf U^f = rstabs rG U. Proof. by apply/setP=> x; rewrite !inE -!map_mxM ?map_submx. Qed. Lemma centgmx_map A : centgmx rGf A^f = centgmx rG A. Proof. by rewrite /centgmx rcent_map. Qed. Lemma mxmodule_map m (U : 'M_(m, n)) : mxmodule rGf U^f = mxmodule rG U. Proof. by rewrite /mxmodule rstabs_map. Qed. Lemma mxsimple_map (U : 'M_n) : mxsimple rGf U^f -> mxsimple rG U. Proof. case; rewrite map_mx_eq0 // mxmodule_map // => modU nzU minU. split=> // V modV sVU nzV; rewrite -(map_submx f). by rewrite (minU V^f) //= ?mxmodule_map ?map_mx_eq0 // map_submx. Qed. Lemma mx_irr_map : mx_irreducible rGf -> mx_irreducible rG. Proof. by move=> irrGf; apply: mxsimple_map; rewrite map_mx1. Qed. Lemma rker_map : rker rGf = rker rG. Proof. by rewrite /rker -rstab_map map_mx1. Qed. Lemma map_mx_faithful : mx_faithful rGf = mx_faithful rG. Proof. by rewrite /mx_faithful rker_map. Qed. Lemma map_mx_abs_irr : mx_absolutely_irreducible rGf = mx_absolutely_irreducible rG. Proof. by rewrite /mx_absolutely_irreducible -map_enveloping_algebra_mx row_full_map. Qed. End OneRepresentation. Lemma mx_rsim_map n1 n2 rG1 rG2 : @mx_rsim _ _ G n1 rG1 n2 rG2 -> mx_rsim (map_repr f rG1) (map_repr f rG2). Proof. case=> g eqn12 inj_g hom_g. by exists g^f => // [|x Gx]; rewrite ?row_free_map // -!map_mxM ?hom_g. Qed. Lemma map_section_repr n (rG : mx_representation aF G n) rGf U V (modU : mxmodule rG U) (modV : mxmodule rG V) (modUf : mxmodule rGf U^f) (modVf : mxmodule rGf V^f) : map_repr f rG =1 rGf -> mx_rsim (map_repr f (section_repr modU modV)) (section_repr modUf modVf). Proof. move=> def_rGf; set VU := <<_>>%MS. pose valUV := val_factmod (val_submod (1%:M : 'M[aF]_(\rank VU))). have sUV_Uf: (valUV^f <= U^f + V^f)%MS. rewrite -map_addsmx map_submx; apply: submx_trans (proj_factmodS _ _). by rewrite val_factmodS val_submod1 genmxE. exists (in_submod _ (in_factmod U^f valUV^f)) => [||x Gx]. - rewrite !genmxE -(mxrank_map f) map_mxM map_col_base. by case: (\rank (cokermx U)) / (mxrank_map _ _); rewrite map_cokermx. - rewrite -kermx_eq0 -submx0; apply/rV_subP=> u. rewrite (sameP sub_kermxP eqP) submx0 -val_submod_eq0. rewrite val_submodE -mulmxA -val_submodE in_submodK; last first. by rewrite genmxE -(in_factmod_addsK _ V^f) submxMr. rewrite in_factmodE mulmxA -in_factmodE in_factmod_eq0. move/(submxMr (in_factmod U 1%:M *m in_submod VU 1%:M)^f). rewrite -mulmxA -!map_mxM //; do 2!rewrite mulmxA -in_factmodE -in_submodE. rewrite val_factmodK val_submodK map_mx1 mulmx1. have ->: in_factmod U U = 0 by apply/eqP; rewrite in_factmod_eq0. by rewrite linear0 map_mx0 eqmx0 submx0. rewrite {1}in_submodE mulmxA -in_submodE -in_submodJ; last first. by rewrite genmxE -(in_factmod_addsK _ V^f) submxMr. congr (in_submod _ _); rewrite -in_factmodJ // in_factmodE mulmxA -in_factmodE. apply/eqP; rewrite -subr_eq0 -def_rGf -!map_mxM -linearB in_factmod_eq0. rewrite -map_mxB map_submx -in_factmod_eq0 linearB. rewrite /= (in_factmodJ modU) // val_factmodK. rewrite [valUV]val_factmodE mulmxA -val_factmodE val_factmodK. rewrite -val_submodE in_submodK ?subrr //. by rewrite mxmodule_trans ?section_module // val_submod1. Qed. Lemma map_regular_subseries U i (modU : mx_subseries (regular_repr aF G) U) (modUf : mx_subseries (regular_repr rF G) [seq M^f | M <- U]) : mx_rsim (map_repr f (subseries_repr i modU)) (subseries_repr i modUf). Proof. set mf := map _ in modUf *; rewrite /subseries_repr. do 2!move: (mx_subseries_module' _ _) (mx_subseries_module _ _). have mf_i V: nth 0^f (mf V) i = (V`_i)^f. case: (ltnP i (size V)) => [ltiV | leVi]; first exact: nth_map. by rewrite !nth_default ?size_map. rewrite -(map_mx0 f) mf_i (mf_i (0 :: U)) => modUi'f modUif modUi' modUi. by apply: map_section_repr; apply: map_regular_repr. Qed. Lemma extend_group_splitting_field : group_splitting_field aF G -> group_splitting_field rF G. Proof. move=> splitG n rG irrG. have modU0: all ((mxmodule (regular_repr aF G)) #|G|) [::] by []. apply: (mx_Schreier modU0 _) => // [[U [compU lastU _]]]; have [modU _]:= compU. pose Uf := map (map_mx f) U. have{lastU} lastUf: (last 0 Uf :=: 1%:M)%MS. by rewrite -(map_mx0 f) -(map_mx1 f) last_map; apply/map_eqmx. have modUf: mx_subseries (regular_repr rF G) Uf. rewrite /mx_subseries all_map; apply: etrans modU; apply: eq_all => Ui /=. rewrite -mxmodule_map; apply: eq_subset_r => x. by rewrite !inE map_regular_repr. have absUf i: i < size U -> mx_absolutely_irreducible (subseries_repr i modUf). move=> lt_i_U; rewrite -(mx_rsim_abs_irr (map_regular_subseries i modU _)). rewrite map_mx_abs_irr; apply: splitG. by apply: mx_rsim_irr (mx_series_repr_irr compU lt_i_U); apply: section_eqmx. have compUf: mx_composition_series (regular_repr rF G) Uf. split=> // i; rewrite size_map => ltiU. move/max_submodP: (mx_abs_irrW (absUf i ltiU)); apply. rewrite -{2}(map_mx0 f) -map_cons !(nth_map 0) ?leqW //. by rewrite map_submx // ltmxW // (pathP _ (mx_series_lt compU)). have [[i ltiU] simUi] := rsim_regular_series irrG compUf lastUf. have{} simUi: mx_rsim rG (subseries_repr i modUf). by apply: mx_rsim_trans simUi _; apply: section_eqmx. by rewrite (mx_rsim_abs_irr simUi) absUf; rewrite size_map in ltiU. Qed. End ChangeOfField. (* Construction of a splitting field FA of an irreducible representation, for *) (* a matrix A in the centraliser of the representation. FA is the row-vector *) (* space of the matrix algebra generated by A with basis 1, A, ..., A ^+ d.-1 *) (* or, equivalently, the polynomials in {poly F} taken mod the (irreducible) *) (* minimal polynomial pA of A (of degree d). *) (* The details of the construction of FA are encapsulated in a submodule. *) Module Import MatrixGenField. (* The type definition must come before the main section so that the Bind *) (* Scope directive applies to all lemmas and definition discharged at the *) (* of the section. *) Record gen_of {F : fieldType} {gT : finGroupType} {G : {group gT}} {n' : nat} {rG : mx_representation F G n'.+1} {A : 'M[F]_n'.+1} (irrG : mx_irreducible rG) (cGA : centgmx rG A) := Gen {rVval : 'rV[F]_(degree_mxminpoly A)}. Local Arguments rVval {F gT G%G n'%N rG A%R irrG cGA} x%R : rename. Bind Scope ring_scope with gen_of. Section GenField. Variables (F : fieldType) (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variables (rG : mx_representation F G n) (A : 'M[F]_n). Local Notation d := (degree_mxminpoly A). Local Notation Ad := (powers_mx A d). Local Notation pA := (mxminpoly A). Let d_gt0 := mxminpoly_nonconstant A. Local Notation irr := mx_irreducible. Hypotheses (irrG : irr rG) (cGA : centgmx rG A). Notation FA := (gen_of irrG cGA). Let inFA := Gen irrG cGA. Canonical gen_subType := Eval hnf in [newType for rVval : FA -> 'rV_d]. Definition gen_eqMixin := Eval hnf in [eqMixin of FA by <:]. Canonical gen_eqType := Eval hnf in EqType FA gen_eqMixin. Definition gen_choiceMixin := [choiceMixin of FA by <:]. Canonical gen_choiceType := Eval hnf in ChoiceType FA gen_choiceMixin. Definition gen0 := inFA 0. Definition genN (x : FA) := inFA (- val x). Definition genD (x y : FA) := inFA (val x + val y). Lemma gen_addA : associative genD. Proof. by move=> x y z; apply: val_inj; rewrite /= addrA. Qed. Lemma gen_addC : commutative genD. Proof. by move=> x y; apply: val_inj; rewrite /= addrC. Qed. Lemma gen_add0r : left_id gen0 genD. Proof. by move=> x; apply: val_inj; rewrite /= add0r. Qed. Lemma gen_addNr : left_inverse gen0 genN genD. Proof. by move=> x; apply: val_inj; rewrite /= addNr. Qed. Definition gen_zmodMixin := ZmodMixin gen_addA gen_addC gen_add0r gen_addNr. Canonical gen_zmodType := Eval hnf in ZmodType FA gen_zmodMixin. Definition pval (x : FA) := rVpoly (val x). Definition mxval (x : FA) := horner_mx A (pval x). Definition gen (x : F) := inFA (poly_rV x%:P). Lemma genK x : mxval (gen x) = x%:M. Proof. by rewrite /mxval [pval _]poly_rV_K ?horner_mx_C // size_polyC; case: (x != 0). Qed. Lemma mxval_inj : injective mxval. Proof. exact: inj_comp horner_rVpoly_inj val_inj. Qed. Lemma mxval0 : mxval 0 = 0. Proof. by rewrite /mxval [pval _]raddf0 rmorph0. Qed. Lemma mxvalN : {morph mxval : x / - x}. Proof. by move=> x; rewrite /mxval [pval _]raddfN rmorphN. Qed. Lemma mxvalD : {morph mxval : x y / x + y}. Proof. by move=> x y; rewrite /mxval [pval _]raddfD rmorphD. Qed. Definition mxval_sum := big_morph mxval mxvalD mxval0. Definition gen1 := inFA (poly_rV 1). Definition genM x y := inFA (poly_rV (pval x * pval y %% pA)). Definition genV x := inFA (poly_rV (mx_inv_horner A (mxval x)^-1)). Lemma mxval_gen1 : mxval gen1 = 1%:M. Proof. by rewrite /mxval [pval _]poly_rV_K ?size_poly1 // horner_mx_C. Qed. Lemma mxval_genM : {morph mxval : x y / genM x y >-> x *m y}. Proof. move=> x y; rewrite /mxval [pval _]poly_rV_K ?size_mod_mxminpoly //. by rewrite -horner_mxK mx_inv_hornerK ?horner_mx_mem // rmorphM. Qed. Lemma mxval_genV : {morph mxval : x / genV x >-> invmx x}. Proof. move=> x; rewrite /mxval [pval _]poly_rV_K ?size_poly ?mx_inv_hornerK //. pose m B : 'M[F]_(n * n) := lin_mx (mulmxr B); set B := mxval x. case uB: (B \is a GRing.unit); last by rewrite invr_out ?uB ?horner_mx_mem. have defAd: Ad = Ad *m m B *m m B^-1. apply/row_matrixP=> i. by rewrite !row_mul mul_rV_lin /= mx_rV_lin /= mulmxK ?vec_mxK. rewrite -[B^-1]mul1mx -(mul_vec_lin (mulmxr_linear _ _)) defAd submxMr //. rewrite -mxval_gen1 (submx_trans (horner_mx_mem _ _)) // {1}defAd. rewrite -(geq_leqif (mxrank_leqif_sup _)) ?mxrankM_maxl // -{}defAd. apply/row_subP=> i; rewrite row_mul rowK mul_vec_lin /= -{2}[A]horner_mx_X. by rewrite -rmorphX mulmxE -rmorphM horner_mx_mem. Qed. Lemma gen_mulA : associative genM. Proof. by move=> x y z; apply: mxval_inj; rewrite !mxval_genM mulmxA. Qed. Lemma gen_mulC : commutative genM. Proof. by move=> x y; rewrite /genM mulrC. Qed. Lemma gen_mul1r : left_id gen1 genM. Proof. by move=> x; apply: mxval_inj; rewrite mxval_genM mxval_gen1 mul1mx. Qed. Lemma gen_mulDr : left_distributive genM +%R. Proof. by move=> x y z; apply: mxval_inj; rewrite !(mxvalD, mxval_genM) mulmxDl. Qed. Lemma gen_ntriv : gen1 != 0. Proof. by rewrite -(inj_eq mxval_inj) mxval_gen1 mxval0 oner_eq0. Qed. Definition gen_ringMixin := ComRingMixin gen_mulA gen_mulC gen_mul1r gen_mulDr gen_ntriv. Canonical gen_ringType := Eval hnf in RingType FA gen_ringMixin. Canonical gen_comRingType := Eval hnf in ComRingType FA gen_mulC. Lemma mxval1 : mxval 1 = 1%:M. Proof. exact: mxval_gen1. Qed. Lemma mxvalM : {morph mxval : x y / x * y >-> x *m y}. Proof. exact: mxval_genM. Qed. Lemma mxval_sub : additive mxval. Proof. by move=> x y; rewrite mxvalD mxvalN. Qed. Canonical mxval_additive := Additive mxval_sub. Lemma mxval_is_multiplicative : multiplicative mxval. Proof. by split; [apply: mxvalM | apply: mxval1]. Qed. Canonical mxval_rmorphism := AddRMorphism mxval_is_multiplicative. Lemma mxval_centg x : centgmx rG (mxval x). Proof. rewrite [mxval _]horner_rVpoly -memmx_cent_envelop vec_mxK {x}mulmx_sub //. apply/row_subP=> k; rewrite rowK memmx_cent_envelop; apply/centgmxP => g Gg /=. by rewrite !mulmxE commrX // /GRing.comm -mulmxE (centgmxP cGA). Qed. Lemma gen_mulVr : GRing.Field.axiom genV. Proof. move=> x; rewrite -(inj_eq mxval_inj) mxval0. move/(mx_Schur irrG (mxval_centg x)) => u_x. by apply: mxval_inj; rewrite mxvalM mxval_genV mxval1 mulVmx. Qed. Lemma gen_invr0 : genV 0 = 0. Proof. by apply: mxval_inj; rewrite mxval_genV !mxval0 -{2}invr0. Qed. Definition gen_unitRingMixin := FieldUnitMixin gen_mulVr gen_invr0. Canonical gen_unitRingType := Eval hnf in UnitRingType FA gen_unitRingMixin. Canonical gen_comUnitRingType := Eval hnf in [comUnitRingType of FA]. Definition gen_fieldMixin := @FieldMixin _ _ _ _ : GRing.Field.mixin_of gen_unitRingType. Definition gen_idomainMixin := FieldIdomainMixin gen_fieldMixin. Canonical gen_idomainType := Eval hnf in IdomainType FA gen_idomainMixin. Canonical gen_fieldType := Eval hnf in FieldType FA gen_fieldMixin. Lemma mxvalV : {morph mxval : x / x^-1 >-> invmx x}. Proof. exact: mxval_genV. Qed. Lemma gen_is_rmorphism : rmorphism gen. Proof. split=> [x y|]; first by apply: mxval_inj; rewrite genK !rmorphB /= !genK. by split=> // x y; apply: mxval_inj; rewrite genK !rmorphM /= !genK. Qed. Canonical gen_additive := Additive gen_is_rmorphism. Canonical gen_rmorphism := RMorphism gen_is_rmorphism. (* The generated field contains a root of the minimal polynomial (in some *) (* cases we want to use the construction solely for that purpose). *) Definition groot := inFA (poly_rV ('X %% pA)). Lemma mxval_groot : mxval groot = A. Proof. rewrite /mxval [pval _]poly_rV_K ?size_mod_mxminpoly // -horner_mxK. by rewrite mx_inv_hornerK ?horner_mx_mem // horner_mx_X. Qed. Lemma mxval_grootX k : mxval (groot ^+ k) = A ^+ k. Proof. by rewrite rmorphX /= mxval_groot. Qed. Lemma map_mxminpoly_groot : (map_poly gen pA).[groot] = 0. Proof. (* The [_ groot] prevents divergence of simpl. *) apply: mxval_inj; rewrite -horner_map [_ groot]/= mxval_groot mxval0. rewrite -(mx_root_minpoly A); congr ((_ : {poly _}).[A]). by apply/polyP=> i; rewrite 3!coef_map; apply: genK. Qed. (* Plugging the extension morphism gen into the ext_repr construction *) (* yields a (reducible) tensored representation. *) Lemma non_linear_gen_reducible : d > 1 -> mxnonsimple (map_repr gen_rmorphism rG) 1%:M. Proof. rewrite ltnNge mxminpoly_linear_is_scalar => Anscal. pose Af := map_mx gen A; exists (kermx (Af - groot%:M)). rewrite submx1 kermx_centg_module /=; last first. apply/centgmxP=> z Gz; rewrite mulmxBl mulmxBr scalar_mxC. by rewrite -!map_mxM 1?(centgmxP cGA). rewrite andbC mxrank_ker -subn_gt0 mxrank1 subKn ?rank_leq_row // lt0n. rewrite mxrank_eq0 subr_eq0; case: eqP => [defAf | _]. rewrite -(map_mx_is_scalar gen_rmorphism) -/Af in Anscal. by case/is_scalar_mxP: Anscal; exists groot. rewrite -mxrank_eq0 mxrank_ker subn_eq0 row_leq_rank. apply/row_freeP=> [[XA' XAK]]. have pAf0: (mxminpoly Af).[groot] == 0. by rewrite mxminpoly_map ?map_mxminpoly_groot. have{pAf0} [q def_pAf]:= factor_theorem _ _ pAf0. have q_nz: q != 0. case: eqP (congr1 (fun p : {poly _} => size p) def_pAf) => // ->. by rewrite size_mxminpoly mul0r size_poly0. have qAf0: horner_mx Af q = 0. rewrite -[_ q]mulr1 -[1]XAK mulrA -{2}(horner_mx_X Af) -(horner_mx_C Af). by rewrite -rmorphB -rmorphM -def_pAf /= mx_root_minpoly mul0r. have{qAf0} := dvdp_leq q_nz (mxminpoly_min qAf0); rewrite def_pAf. by rewrite size_Mmonic ?monicXsubC // polyseqXsubC addn2 ltnn. Qed. (* An alternative to the above, used in the proof of the p-stability of *) (* groups of odd order, is to reconsider the original vector space as a *) (* vector space of dimension n / e over FA. This is applicable only if G is *) (* the largest group represented on the original vector space (i.e., if we *) (* are not studying a representation of G induced by one of a larger group, *) (* as in B & G Theorem 2.6 for instance). We can't fully exploit one of the *) (* benefits of this approach -- that the type domain for the vector space can *) (* remain unchanged -- because we're restricting ourselves to row matrices; *) (* we have to use explicit bijections to convert between the two views. *) Definition subbase nA (B : 'rV_nA) : 'M_(nA * d, n) := \matrix_ik mxvec (\matrix_(i, k) (row (B 0 i) (A ^+ k))) 0 ik. Lemma gen_dim_ex_proof : exists nA, [exists B : 'rV_nA, row_free (subbase B)]. Proof. by exists 0%N; apply/existsP; exists 0. Qed. Lemma gen_dim_ub_proof nA : [exists B : 'rV_nA, row_free (subbase B)] -> (nA <= n)%N. Proof. case/existsP=> B /eqnP def_nAd. by rewrite (leq_trans _ (rank_leq_col (subbase B))) // def_nAd leq_pmulr. Qed. Definition gen_dim := ex_maxn gen_dim_ex_proof gen_dim_ub_proof. Notation nA := gen_dim. Definition gen_base : 'rV_nA := odflt 0 [pick B | row_free (subbase B)]. Definition base := subbase gen_base. Lemma base_free : row_free base. Proof. rewrite /base /gen_base /nA; case: pickP => //; case: ex_maxnP => nA_max. by case/existsP=> B Bfree _ no_free; rewrite no_free in Bfree. Qed. Lemma base_full : row_full base. Proof. rewrite /row_full (eqnP base_free) /nA; case: ex_maxnP => nA. case/existsP=> /= B /eqnP Bfree nA_max; rewrite -Bfree eqn_leq rank_leq_col. rewrite -{1}(mxrank1 F n) mxrankS //; apply/row_subP=> j; set u := row _ _. move/implyP: {nA_max}(nA_max nA.+1); rewrite ltnn implybF. apply: contraR => nBj; apply/existsP. exists (row_mx (const_mx j : 'M_1) B); rewrite -row_leq_rank. pose Bj := Ad *m lin1_mx (mulmx u \o vec_mx). have rBj: \rank Bj = d. apply/eqP; rewrite eqn_leq rank_leq_row -subn_eq0 -mxrank_ker mxrank_eq0 /=. apply/rowV0P=> v /sub_kermxP; rewrite mulmxA mul_rV_lin1 /=. rewrite -horner_rVpoly; pose x := inFA v; rewrite -/(mxval x). have [[] // | nzx /(congr1 (mulmx^~ (mxval x^-1)))] := eqVneq x 0. rewrite mul0mx /= -mulmxA -mxvalM divff // mxval1 mulmx1. by move/rowP/(_ j)/eqP; rewrite !mxE !eqxx oner_eq0. rewrite {1}mulSn -Bfree -{1}rBj {rBj} -mxrank_disjoint_sum. rewrite mxrankS // addsmx_sub -[nA.+1]/(1 + nA)%N; apply/andP; split. apply/row_subP=> k; rewrite row_mul mul_rV_lin1 /=. apply: eq_row_sub (mxvec_index (lshift _ 0) k) _. by rewrite !rowK mxvecK mxvecE mxE row_mxEl mxE -row_mul mul1mx. apply/row_subP; case/mxvec_indexP=> i k. apply: eq_row_sub (mxvec_index (rshift 1 i) k) _. by rewrite !rowK !mxvecE 2!mxE row_mxEr. apply/eqP/rowV0P=> v; rewrite sub_capmx => /andP[/submxP[w]]. set x := inFA w; rewrite {Bj}mulmxA mul_rV_lin1 /= -horner_rVpoly -/(mxval x). have [-> | nzx ->] := eqVneq x 0; first by rewrite mxval0 mulmx0. move/(submxMr (mxval x^-1)); rewrite -mulmxA -mxvalM divff {nzx}//. rewrite mxval1 mulmx1 => Bx'j; rewrite (submx_trans Bx'j) in nBj => {Bx'j} //. apply/row_subP; case/mxvec_indexP=> i k. rewrite row_mul rowK mxvecE mxE rowE -mulmxA. have ->: A ^+ k *m mxval x^-1 = mxval (groot ^+ k / x). by rewrite mxvalM rmorphX /= mxval_groot. rewrite [mxval _]horner_rVpoly; move: {k u x}(val _) => u. rewrite (mulmx_sum_row u) !linear_sum summx_sub //= => k _. rewrite !linearZ scalemx_sub //= rowK mxvecK -rowE. by apply: eq_row_sub (mxvec_index i k) _; rewrite rowK mxvecE mxE. Qed. Lemma gen_dim_factor : (nA * d)%N = n. Proof. by rewrite -(eqnP base_free) (eqnP base_full). Qed. Lemma gen_dim_gt0 : nA > 0. Proof. by case: posnP gen_dim_factor => // ->. Qed. Section Bijection. Variable m : nat. Definition in_gen (W : 'M[F]_(m, n)) : 'M[FA]_(m, nA) := \matrix_(i, j) inFA (row j (vec_mx (row i W *m pinvmx base))). Definition val_gen (W : 'M[FA]_(m, nA)) : 'M[F]_(m, n) := \matrix_i (mxvec (\matrix_j val (W i j)) *m base). Lemma in_genK : cancel in_gen val_gen. Proof. move=> W; apply/row_matrixP=> i; rewrite rowK; set w := row i W. have b_w: (w <= base)%MS by rewrite submx_full ?base_full. rewrite -{b_w}(mulmxKpV b_w); congr (_ *m _). by apply/rowP; case/mxvec_indexP=> j k; rewrite mxvecE !mxE. Qed. Lemma val_genK : cancel val_gen in_gen. Proof. move=> W; apply/matrixP=> i j; apply: val_inj; rewrite mxE /= rowK. case/row_freeP: base_free => B' BB'; rewrite -[_ *m _]mulmx1 -BB' mulmxA. by rewrite mulmxKpV ?submxMl // -mulmxA BB' mulmx1 mxvecK rowK. Qed. Lemma in_gen0 : in_gen 0 = 0. Proof. by apply/matrixP=> i j; rewrite !mxE !(mul0mx, linear0). Qed. Lemma val_gen0 : val_gen 0 = 0. Proof. by apply: (canLR in_genK); rewrite in_gen0. Qed. Lemma in_genN : {morph in_gen : W / - W}. Proof. move=> W; apply/matrixP=> i j; apply: val_inj. by rewrite !mxE !(mulNmx, linearN). Qed. Lemma val_genN : {morph val_gen : W / - W}. Proof. by move=> W; apply: (canLR in_genK); rewrite in_genN val_genK. Qed. Lemma in_genD : {morph in_gen : U V / U + V}. Proof. move=> U V; apply/matrixP=> i j; apply: val_inj. by rewrite !mxE !(mulmxDl, linearD). Qed. Lemma val_genD : {morph val_gen : U V / U + V}. Proof. by move=> U V; apply: (canLR in_genK); rewrite in_genD !val_genK. Qed. Definition in_gen_sum := big_morph in_gen in_genD in_gen0. Definition val_gen_sum := big_morph val_gen val_genD val_gen0. Lemma in_genZ a : {morph in_gen : W / a *: W >-> gen a *: W}. Proof. move=> W; apply/matrixP=> i j; apply: mxval_inj. rewrite !mxE mxvalM genK ![mxval _]horner_rVpoly /=. by rewrite mul_scalar_mx !(I, scalemxAl, linearZ). Qed. End Bijection. Prenex Implicits val_genK in_genK. Lemma val_gen_rV (w : 'rV_nA) : val_gen w = mxvec (\matrix_j val (w 0 j)) *m base. Proof. by apply/rowP=> j; rewrite mxE. Qed. Section Bijection2. Variable m : nat. Lemma val_gen_row W (i : 'I_m) : val_gen (row i W) = row i (val_gen W). Proof. rewrite val_gen_rV rowK; congr (mxvec _ *m _). by apply/matrixP=> j k; rewrite !mxE. Qed. Lemma in_gen_row W (i : 'I_m) : in_gen (row i W) = row i (in_gen W). Proof. by apply: (canLR val_genK); rewrite val_gen_row in_genK. Qed. Lemma row_gen_sum_mxval W (i : 'I_m) : row i (val_gen W) = \sum_j row (gen_base 0 j) (mxval (W i j)). Proof. rewrite -val_gen_row [row i W]row_sum_delta val_gen_sum. apply: eq_bigr => /= j _; rewrite mxE; move: {W i}(W i j) => x. have ->: x = \sum_k gen (val x 0 k) * inFA (delta_mx 0 k). case: x => u; apply: mxval_inj; rewrite {1}[u]row_sum_delta. rewrite mxval_sum [mxval _]horner_rVpoly mulmx_suml linear_sum /=. apply: eq_bigr => k _; rewrite mxvalM genK [mxval _]horner_rVpoly /=. by rewrite mul_scalar_mx -scalemxAl linearZ. rewrite scaler_suml val_gen_sum mxval_sum linear_sum; apply: eq_bigr => k _. rewrite mxvalM genK mul_scalar_mx linearZ [mxval _]horner_rVpoly /=. rewrite -scalerA; apply: (canLR in_genK); rewrite in_genZ; congr (_ *: _). apply: (canRL val_genK); transitivity (row (mxvec_index j k) base); last first. by rewrite -rowE rowK mxvecE mxE rowK mxvecK. rewrite rowE -mxvec_delta -[val_gen _](row_id 0) rowK /=; congr (mxvec _ *m _). apply/row_matrixP=> j'; rewrite rowK !mxE mulr_natr rowE mul_delta_mx_cond. by rewrite !mulrb (fun_if rVval). Qed. Lemma val_genZ x : {morph @val_gen m : W / x *: W >-> W *m mxval x}. Proof. move=> W; apply/row_matrixP=> i; rewrite row_mul !row_gen_sum_mxval. by rewrite mulmx_suml; apply: eq_bigr => j _; rewrite mxE mulrC mxvalM row_mul. Qed. End Bijection2. Lemma submx_in_gen m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (U <= V -> in_gen U <= in_gen V)%MS. Proof. move=> sUV; apply/row_subP=> i; rewrite -in_gen_row. case/submxP: (row_subP sUV i) => u ->{i}. rewrite mulmx_sum_row in_gen_sum summx_sub // => j _. by rewrite in_genZ in_gen_row scalemx_sub ?row_sub. Qed. Lemma submx_in_gen_eq m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, n)) : (V *m A <= V -> (in_gen U <= in_gen V) = (U <= V))%MS. Proof. move=> sVA_V; apply/idP/idP=> siUV; last exact: submx_in_gen. apply/row_subP=> i; rewrite -[row i U]in_genK in_gen_row. case/submxP: (row_subP siUV i) => u ->{i U siUV}. rewrite mulmx_sum_row val_gen_sum summx_sub // => j _. rewrite val_genZ val_gen_row in_genK rowE -mulmxA mulmx_sub //. rewrite [mxval _]horner_poly mulmx_sumr summx_sub // => [[k _]] _ /=. rewrite mulmxA mul_mx_scalar -scalemxAl scalemx_sub {u j}//. elim: k => [|k IHk]; first by rewrite mulmx1. by rewrite exprSr mulmxA (submx_trans (submxMr A IHk)). Qed. Definition gen_mx g := \matrix_i in_gen (row (gen_base 0 i) (rG g)). Let val_genJmx m : {in G, forall g, {morph @val_gen m : W / W *m gen_mx g >-> W *m rG g}}. Proof. move=> g Gg /= W; apply/row_matrixP=> i; rewrite -val_gen_row !row_mul. rewrite mulmx_sum_row val_gen_sum row_gen_sum_mxval mulmx_suml. apply: eq_bigr => /= j _; rewrite val_genZ rowK in_genK mxE -!row_mul. by rewrite (centgmxP (mxval_centg _)). Qed. Lemma gen_mx_repr : mx_repr G gen_mx. Proof. split=> [|g h Gg Gh]; apply: (can_inj val_genK). by rewrite -[gen_mx 1]mul1mx val_genJmx // repr_mx1 mulmx1. rewrite {1}[val_gen]lock -[gen_mx g]mul1mx !val_genJmx // -mulmxA -repr_mxM //. by rewrite -val_genJmx ?groupM ?mul1mx -?lock. Qed. Canonical gen_repr := MxRepresentation gen_mx_repr. Local Notation rGA := gen_repr. Lemma val_genJ m : {in G, forall g, {morph @val_gen m : W / W *m rGA g >-> W *m rG g}}. Proof. exact: val_genJmx. Qed. Lemma in_genJ m : {in G, forall g, {morph @in_gen m : v / v *m rG g >-> v *m rGA g}}. Proof. by move=> g Gg /= v; apply: (canLR val_genK); rewrite val_genJ ?in_genK. Qed. Lemma rfix_gen (H : {set gT}) : H \subset G -> (rfix_mx rGA H :=: in_gen (rfix_mx rG H))%MS. Proof. move/subsetP=> sHG; apply/eqmxP/andP; split; last first. by apply/rfix_mxP=> g Hg; rewrite -in_genJ ?sHG ?rfix_mx_id. rewrite -[rfix_mx rGA H]val_genK; apply: submx_in_gen. by apply/rfix_mxP=> g Hg; rewrite -val_genJ ?rfix_mx_id ?sHG. Qed. Definition rowval_gen m U := <<\matrix_ik mxvec (\matrix_(i < m, k < d) (row i (val_gen U) *m A ^+ k)) 0 ik>>%MS. Lemma submx_rowval_gen m1 m2 (U : 'M_(m1, n)) (V : 'M_(m2, nA)) : (U <= rowval_gen V)%MS = (in_gen U <= V)%MS. Proof. rewrite genmxE; apply/idP/idP=> sUV. apply: submx_trans (submx_in_gen sUV) _. apply/row_subP; case/mxvec_indexP=> i k; rewrite -in_gen_row rowK mxvecE mxE. rewrite -mxval_grootX -val_gen_row -val_genZ val_genK scalemx_sub //. exact: row_sub. rewrite -[U]in_genK; case/submxP: sUV => u ->{U}. apply/row_subP=> i0; rewrite -val_gen_row row_mul; move: {i0 u}(row _ u) => u. rewrite mulmx_sum_row val_gen_sum summx_sub // => i _. rewrite val_genZ [mxval _]horner_rVpoly [_ *m Ad]mulmx_sum_row. rewrite !linear_sum summx_sub // => k _. rewrite !linearZ scalemx_sub {u}//= rowK mxvecK val_gen_row. by apply: (eq_row_sub (mxvec_index i k)); rewrite rowK mxvecE mxE. Qed. Lemma rowval_genK m (U : 'M_(m, nA)) : (in_gen (rowval_gen U) :=: U)%MS. Proof. apply/eqmxP; rewrite -submx_rowval_gen submx_refl /=. by rewrite -{1}[U]val_genK submx_in_gen // submx_rowval_gen val_genK. Qed. Lemma rowval_gen_stable m (U : 'M_(m, nA)) : (rowval_gen U *m A <= rowval_gen U)%MS. Proof. rewrite -[A]mxval_groot -{1}[_ U]in_genK -val_genZ. by rewrite submx_rowval_gen val_genK scalemx_sub // rowval_genK. Qed. Lemma rstab_in_gen m (U : 'M_(m, n)) : rstab rGA (in_gen U) = rstab rG U. Proof. apply/setP=> x; rewrite !inE; case Gx: (x \in G) => //=. by rewrite -in_genJ // (inj_eq (can_inj in_genK)). Qed. Lemma rstabs_in_gen m (U : 'M_(m, n)) : rstabs rG U \subset rstabs rGA (in_gen U). Proof. apply/subsetP=> x; rewrite !inE => /andP[Gx nUx]. by rewrite -in_genJ Gx // submx_in_gen. Qed. Lemma rstabs_rowval_gen m (U : 'M_(m, nA)) : rstabs rG (rowval_gen U) = rstabs rGA U. Proof. apply/setP=> x; rewrite !inE; case Gx: (x \in G) => //=. by rewrite submx_rowval_gen in_genJ // (eqmxMr _ (rowval_genK U)). Qed. Lemma mxmodule_rowval_gen m (U : 'M_(m, nA)) : mxmodule rG (rowval_gen U) = mxmodule rGA U. Proof. by rewrite /mxmodule rstabs_rowval_gen. Qed. Lemma gen_mx_irr : mx_irreducible rGA. Proof. apply/mx_irrP; split=> [|U Umod nzU]; first exact: gen_dim_gt0. rewrite -sub1mx -rowval_genK -submx_rowval_gen submx_full //. case/mx_irrP: irrG => _; apply; first by rewrite mxmodule_rowval_gen. rewrite -(inj_eq (can_inj in_genK)) in_gen0. by rewrite -mxrank_eq0 rowval_genK mxrank_eq0. Qed. Lemma rker_gen : rker rGA = rker rG. Proof. apply/setP=> g; rewrite !inE !mul1mx; case Gg: (g \in G) => //=. apply/eqP/eqP=> g1; apply/row_matrixP=> i. by apply: (can_inj in_genK); rewrite rowE in_genJ //= g1 mulmx1 row1. by apply: (can_inj val_genK); rewrite rowE val_genJ //= g1 mulmx1 row1. Qed. Lemma gen_mx_faithful : mx_faithful rGA = mx_faithful rG. Proof. by rewrite /mx_faithful rker_gen. Qed. End GenField. Section DecideGenField. Import MatrixFormula. Variable F : decFieldType. Local Notation False := GRing.False. Local Notation True := GRing.True. Local Notation Bool b := (GRing.Bool b%bool). Local Notation term := (GRing.term F). Local Notation form := (GRing.formula F). Local Notation morphAnd f := ((big_morph f) true andb). Variables (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variables (rG : mx_representation F G n) (A : 'M[F]_n). Hypotheses (irrG : mx_irreducible rG) (cGA : centgmx rG A). Local Notation FA := (gen_of irrG cGA). Local Notation inFA := (Gen irrG cGA). Local Notation d := (degree_mxminpoly A). Let d_gt0 : d > 0 := mxminpoly_nonconstant A. Local Notation Ad := (powers_mx A d). Let mxT (u : 'rV_d) := vec_mx (mulmx_term u (mx_term Ad)). Let eval_mxT e u : eval_mx e (mxT u) = mxval (inFA (eval_mx e u)). Proof. by rewrite eval_vec_mx eval_mulmx eval_mx_term [mxval _]horner_rVpoly. Qed. Let Ad'T := mx_term (pinvmx Ad). Let mulT (u v : 'rV_d) := mulmx_term (mxvec (mulmx_term (mxT u) (mxT v))) Ad'T. Lemma eval_mulT e u v : eval_mx e (mulT u v) = val (inFA (eval_mx e u) * inFA (eval_mx e v)). Proof. rewrite !(eval_mulmx, eval_mxvec) !eval_mxT eval_mx_term. by apply: (can_inj rVpolyK); rewrite -mxvalM [rVpoly _]horner_rVpolyK. Qed. Fixpoint gen_term t := match t with | 'X_k => row_var _ d k | x%:T => mx_term (val (x : FA)) | n1%:R => mx_term (val (n1%:R : FA))%R | t1 + t2 => \row_i (gen_term t1 0%R i + gen_term t2 0%R i) | - t1 => \row_i (- gen_term t1 0%R i) | t1 *+ n1 => mulmx_term (mx_term n1%:R%:M)%R (gen_term t1) | t1 * t2 => mulT (gen_term t1) (gen_term t2) | t1^-1 => gen_term t1 | t1 ^+ n1 => iter n1 (mulT (gen_term t1)) (mx_term (val (1%R : FA))) end%T. Definition gen_env (e : seq FA) := row_env (map val e). Lemma nth_map_rVval (e : seq FA) j : (map val e)`_j = val e`_j. Proof. case: (ltnP j (size e)) => [| leej]; first exact: (nth_map 0 0). by rewrite !nth_default ?size_map. Qed. Lemma set_nth_map_rVval (e : seq FA) j v : set_nth 0 (map val e) j v = map val (set_nth 0 e j (inFA v)). Proof. apply: (@eq_from_nth _ 0) => [|k _]; first by rewrite !(size_set_nth, size_map). by rewrite !(nth_map_rVval, nth_set_nth) /= nth_map_rVval [rVval _]fun_if. Qed. Lemma eval_gen_term e t : GRing.rterm t -> eval_mx (gen_env e) (gen_term t) = val (GRing.eval e t). Proof. elim: t => //=. - by move=> k _; apply/rowP=> i; rewrite !mxE /= nth_row_env nth_map_rVval. - by move=> x _; rewrite eval_mx_term. - by move=> x _; rewrite eval_mx_term. - move=> t1 + t2 + /andP[rt1 rt2] => <-// <-//. by apply/rowP=> k; rewrite !mxE. - by move=> t1 + rt1 => <-//; apply/rowP=> k; rewrite !mxE. - move=> t1 IH1 n1 rt1; rewrite eval_mulmx eval_mx_term mul_scalar_mx. by rewrite scaler_nat {}IH1 //; elim: n1 => //= n1 IHn1; rewrite !mulrS IHn1. - by move=> t1 IH1 t2 IH2 /andP[rt1 rt2]; rewrite eval_mulT IH1 ?IH2. move=> t1 + n1 => /[apply] IH1. elim: n1 => [|n1 IHn1] /=; first by rewrite eval_mx_term. by rewrite eval_mulT exprS IH1 IHn1. Qed. Fixpoint gen_form f := match f with | Bool b => Bool b | t1 == t2 => mxrank_form 0 (gen_term (t1 - t2)) | GRing.Unit t1 => mxrank_form 1 (gen_term t1) | f1 /\ f2 => gen_form f1 /\ gen_form f2 | f1 \/ f2 => gen_form f1 \/ gen_form f2 | f1 ==> f2 => gen_form f1 ==> gen_form f2 | ~ f1 => ~ gen_form f1 | ('exists 'X_k, f1) => Exists_row_form d k (gen_form f1) | ('forall 'X_k, f1) => ~ Exists_row_form d k (~ (gen_form f1)) end%T. Lemma sat_gen_form e f : GRing.rformula f -> reflect (GRing.holds e f) (GRing.sat (gen_env e) (gen_form f)). Proof. have ExP := Exists_rowP; have set_val := set_nth_map_rVval. elim: f e => //. - by move=> b e _; apply: (iffP satP). - rewrite /gen_form => t1 t2 e rt_t; set t := (_ - _)%T. have:= GRing.qf_evalP (gen_env e) (mxrank_form_qf 0 (gen_term t)). rewrite eval_mxrank mxrank_eq0 eval_gen_term // => tP. by rewrite (sameP satP tP) /= subr_eq0 val_eqE; apply: eqP. - move=> f1 IH1 f2 IH2 s /= /andP[/(IH1 s)f1P /(IH2 s)f2P]. by apply: (iffP satP) => [[/satP/f1P ? /satP/f2P] | [/f1P/satP ? /f2P/satP]]. - move=> f1 IH1 f2 IH2 s /= /andP[/(IH1 s)f1P /(IH2 s)f2P]. by apply: (iffP satP) => /= [] []; try move/satP; do [move/f1P | move/f2P]; try move/satP; auto. - move=> f1 IH1 f2 IH2 s /= /andP[/(IH1 s)f1P /(IH2 s)f2P]. by apply: (iffP satP) => /= implP; try move/satP; move/f1P; try move/satP; move/implP; try move/satP; move/f2P; try move/satP. - move=> f1 IH1 s /= /(IH1 s) f1P. by apply: (iffP satP) => /= notP; try move/satP; move/f1P; try move/satP. - move=> k f1 IHf1 s /IHf1 f1P; apply: (iffP satP) => /= [|[[v f1v]]]. by case/ExP=> // x /satP; rewrite set_val => /f1P; exists (inFA x). by apply/ExP=> //; exists v; rewrite set_val; apply/satP/f1P. move=> i f1 IHf1 s /IHf1 f1P; apply: (iffP satP) => /= allf1 => [[v]|]. apply/f1P; case: satP => // notf1x; case: allf1; apply/ExP=> //. by exists v; rewrite set_val. by case/ExP=> //= v []; apply/satP; rewrite set_val; apply/f1P. Qed. Definition gen_sat e f := GRing.sat (gen_env e) (gen_form (GRing.to_rform f)). Lemma gen_satP : GRing.DecidableField.axiom gen_sat. Proof. move=> e f; have [tor rto] := GRing.to_rformP e f. exact: (iffP (sat_gen_form e (GRing.to_rform_rformula f))). Qed. Definition gen_decFieldMixin := DecFieldMixin gen_satP. Canonical gen_decFieldType := Eval hnf in DecFieldType FA gen_decFieldMixin. End DecideGenField. Section FiniteGenField. Variables (F : finFieldType) (gT : finGroupType) (G : {group gT}) (n' : nat). Local Notation n := n'.+1. Variables (rG : mx_representation F G n) (A : 'M[F]_n). Hypotheses (irrG : mx_irreducible rG) (cGA : centgmx rG A). Notation FA := (gen_of irrG cGA). (* This should be [countMixin of FA by <:]*) Definition gen_countMixin := (sub_countMixin (gen_subType irrG cGA)). Canonical gen_countType := Eval hnf in CountType FA gen_countMixin. Canonical gen_subCountType := Eval hnf in [subCountType of FA]. Definition gen_finMixin := [finMixin of FA by <:]. Canonical gen_finType := Eval hnf in FinType FA gen_finMixin. Canonical gen_subFinType := Eval hnf in [subFinType of FA]. Canonical gen_finZmodType := Eval hnf in [finZmodType of FA]. Canonical gen_baseFinGroupType := Eval hnf in [baseFinGroupType of FA for +%R]. Canonical gen_finGroupType := Eval hnf in [finGroupType of FA for +%R]. Canonical gen_finRingType := Eval hnf in [finRingType of FA]. Canonical gen_finComRingType := Eval hnf in [finComRingType of FA]. Canonical gen_finUnitRingType := Eval hnf in [finUnitRingType of FA]. Canonical gen_finComUnitRingType := Eval hnf in [finComUnitRingType of FA]. Canonical gen_finIdomainType := Eval hnf in [finIdomainType of FA]. Canonical gen_finFieldType := Eval hnf in [finFieldType of FA]. Lemma card_gen : #|{:FA}| = (#|F| ^ degree_mxminpoly A)%N. Proof. by rewrite card_sub card_matrix mul1n. Qed. End FiniteGenField. End MatrixGenField. Bind Scope ring_scope with gen_of. Arguments rVval {F gT G%G n'%N rG A%R irrG cGA} x%R : rename. Prenex Implicits gen_of Gen rVval pval mxval gen groot. Arguments subbase {F n'} A {nA}. Prenex Implicits gen_dim gen_base base val_gen gen_mx rowval_gen. Arguments in_gen {F gT G n' rG A} irrG cGA {m} W. Arguments in_genK {F gT G n' rG A} irrG cGA {m} W : rename. Arguments val_genK {F gT G n' rG A irrG cGA m} W : rename. Prenex Implicits gen_env gen_term gen_form gen_sat. Canonical gen_subType. Canonical gen_eqType. Canonical gen_choiceType. Canonical gen_countType. Canonical gen_subCountType. Canonical gen_finType. Canonical gen_subFinType. Canonical gen_zmodType. Canonical gen_finZmodType. Canonical gen_baseFinGroupType. Canonical gen_finGroupType. Canonical gen_ringType. Canonical gen_finRingType. Canonical gen_comRingType. Canonical gen_finComRingType. Canonical gen_unitRingType. Canonical gen_finUnitRingType. Canonical gen_comUnitRingType. Canonical gen_finComUnitRingType. Canonical gen_idomainType. Canonical gen_finIdomainType. Canonical gen_fieldType. Canonical gen_finFieldType. Canonical gen_decFieldType. (* Classical splitting and closure field constructions provide convenient *) (* packaging for the pointwise construction. *) Section BuildSplittingField. Implicit Type gT : finGroupType. Implicit Type F : fieldType. Lemma group_splitting_field_exists gT (G : {group gT}) F : classically {Fs : fieldType & {rmorphism F -> Fs} & group_splitting_field Fs G}. Proof. move: F => F0 [] // nosplit; pose nG := #|G|; pose aG F := regular_repr F G. pose m := nG.+1; pose F := F0; pose U : seq 'M[F]_nG := [::]. suffices: size U + m <= nG by rewrite ltnn. have: mx_subseries (aG F) U /\ path ltmx 0 U by []. pose f : {rmorphism F0 -> F} := [rmorphism of idfun]. elim: m F U f => [|m IHm] F U f [modU ltU]. by rewrite addn0 (leq_trans (max_size_mx_series ltU)) ?rank_leq_row. rewrite addnS ltnNge -implybF; apply/implyP=> le_nG_Um; apply: nosplit. exists F => //; case=> [|n] rG irrG; first by case/mx_irrP: irrG. apply/idPn=> nabsG; pose cG := ('C(enveloping_algebra_mx rG))%MS. have{nabsG} [A]: exists2 A, (A \in cG)%MS & ~~ is_scalar_mx A. apply/has_non_scalar_mxP; rewrite ?scalar_mx_cent // ltnNge. by apply: contra nabsG; apply: cent_mx_scalar_abs_irr. rewrite {cG}memmx_cent_envelop -mxminpoly_linear_is_scalar -ltnNge => cGA. move/(non_linear_gen_reducible irrG cGA). set F' := gen_fieldType _ _; set rG' := @map_repr _ F' _ _ _ _ rG. move: F' (gen_rmorphism _ _ : {rmorphism F -> F'}) => F' f' in rG' * => irrG'. pose U' := [seq map_mx f' Ui | Ui <- U]. have modU': mx_subseries (aG F') U'. apply: etrans modU; rewrite /mx_subseries all_map; apply: eq_all => Ui. rewrite -(mxmodule_map f'); apply: eq_subset_r => x. by rewrite !inE map_regular_repr. case: notF; apply: (mx_Schreier modU ltU) => [[V [compV lastV sUV]]]. have{lastV} [] := rsim_regular_series irrG compV lastV. have{sUV} defV: V = U. apply/eqP; rewrite eq_sym -(geq_leqif (size_subseq_leqif sUV)). rewrite -(leq_add2r m); apply: leq_trans le_nG_Um. by apply: IHm f _; rewrite (mx_series_lt compV); case: compV. rewrite {V}defV in compV * => i rsimVi. apply: (mx_Schreier modU') => [|[V' [compV' _ sUV']]]. rewrite {modU' compV modU i le_nG_Um rsimVi}/U' -(map_mx0 f'). by apply: etrans ltU; elim: U 0 => //= Ui U IHU Ui'; rewrite IHU map_ltmx. have{sUV'} defV': V' = U'; last rewrite {V'}defV' in compV'. apply/eqP; rewrite eq_sym -(geq_leqif (size_subseq_leqif sUV')) size_map. rewrite -(leq_add2r m); apply: leq_trans le_nG_Um. apply: IHm [rmorphism of f' \o f] _. by rewrite (mx_series_lt compV'); case: compV'. suffices{irrG'}: mx_irreducible rG' by case/mxsimpleP=> _ _ []. have ltiU': i < size U' by rewrite size_map. apply: mx_rsim_irr (mx_rsim_sym _ ) (mx_series_repr_irr compV' ltiU'). by apply: mx_rsim_trans (mx_rsim_map f' rsimVi) _; apply: map_regular_subseries. Qed. Lemma group_closure_field_exists gT F : classically {Fs : fieldType & {rmorphism F -> Fs} & group_closure_field Fs gT}. Proof. set n := #|{group gT}|. suffices: classically {Fs : fieldType & {rmorphism F -> Fs} & forall G : {group gT}, enum_rank G < n -> group_splitting_field Fs G}. - apply: classic_bind => [[Fs f splitFs]] _ -> //. by exists Fs => // G; apply: splitFs. elim: (n) => [|i IHi]; first by move=> _ -> //; exists F => //; exists id. apply: classic_bind IHi => [[F' f splitF']]. have [le_n_i _ -> // | lt_i_n] := leqP n i. by exists F' => // G _; apply: splitF'; apply: leq_trans le_n_i. have:= @group_splitting_field_exists _ (enum_val (Ordinal lt_i_n)) F'. apply: classic_bind => [[Fs f' splitFs]] _ -> //. exists Fs => [|G]; first exact: [rmorphism of (f' \o f)]. rewrite ltnS leq_eqVlt -{1}[i]/(val (Ordinal lt_i_n)) val_eqE. case/predU1P=> [defG | ltGi]; first by rewrite -[G]enum_rankK defG. by apply: (extend_group_splitting_field f'); apply: splitF'. Qed. Lemma group_closure_closed_field (F : closedFieldType) gT : group_closure_field F gT. Proof. move=> G [|n] rG irrG; first by case/mx_irrP: irrG. apply: cent_mx_scalar_abs_irr => //; rewrite leqNgt. apply/(has_non_scalar_mxP (scalar_mx_cent _ _)) => [[A cGA nscalA]]. have [a]: exists a, eigenvalue A a. pose P := mxminpoly A; pose d := degree_mxminpoly A. have Pd1: P`_d = 1. by rewrite -(eqP (mxminpoly_monic A)) /lead_coef size_mxminpoly. have d_gt0: d > 0 := mxminpoly_nonconstant A. have [a def_ad] := solve_monicpoly (nth 0 (- P)) d_gt0. exists a; rewrite eigenvalue_root_min -/P /root -oppr_eq0 -hornerN. rewrite horner_coef size_opp size_mxminpoly -/d big_ord_recr -def_ad. by rewrite coefN Pd1 mulN1r /= subrr. case/negP; rewrite kermx_eq0 row_free_unit (mx_Schur irrG) ?subr_eq0 //. by rewrite -memmx_cent_envelop -raddfN linearD addmx_sub ?scalar_mx_cent. by apply: contraNneq nscalA => ->; apply: scalar_mx_is_scalar. Qed. End BuildSplittingField. math-comp-mathcomp-1.12.0/mathcomp/character/vcharacter.v000066400000000000000000001136211375767750300233730ustar00rootroot00000000000000(* (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 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. From mathcomp Require Import frobenius vector ssrnum ssrint intdiv algC. From mathcomp Require Import algnum classfun character integral_char. (******************************************************************************) (* This file provides basic notions of virtual character theory: *) (* 'Z[S, A] == collective predicate for the phi that are Z-linear *) (* combinations of elements of S : seq 'CF(G) and have *) (* support in A : {set gT}. *) (* 'Z[S] == collective predicate for the Z-linear combinations of *) (* elements of S. *) (* 'Z[irr G] == the collective predicate for virtual characters. *) (* dirr G == the collective predicate for normal virtual characters, *) (* i.e., virtual characters of norm 1: *) (* mu \in dirr G <=> m \in 'Z[irr G] and '[mu] = 1 *) (* <=> mu or - mu \in irr G. *) (* --> othonormal subsets of 'Z[irr G] are contained in dirr G. *) (* dIirr G == an index type for normal virtual characters. *) (* dchi i == the normal virtual character of index i. *) (* of_irr i == the (unique) irreducible constituent of dchi i: *) (* dchi i = 'chi_(of_irr i) or - 'chi_(of_irr i). *) (* ndirr i == the index of - dchi i. *) (* dirr1 G == the normal virtual character index of 1 : 'CF(G), the *) (* principal character. *) (* dirr_dIirr j f == the index i (or dirr1 G if it does not exist) such that *) (* dchi i = f j. *) (* dirr_constt phi == the normal virtual character constituents of phi: *) (* i \in dirr_constt phi <=> [dchi i, phi] > 0. *) (* to_dirr phi i == the normal virtual character constituent of phi with an *) (* irreducible constituent i, when i \in irr_constt phi. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Section Basics. Variables (gT : finGroupType) (B : {set gT}) (S : seq 'CF(B)) (A : {set gT}). Definition Zchar : {pred 'CF(B)} := [pred phi in 'CF(B, A) | dec_Cint_span (in_tuple S) phi]. Fact Zchar_key : pred_key Zchar. Proof. by []. Qed. Canonical Zchar_keyed := KeyedPred Zchar_key. Lemma cfun0_zchar : 0 \in Zchar. Proof. rewrite inE mem0v; apply/sumboolP; exists 0. by rewrite big1 // => i _; rewrite ffunE. Qed. Fact Zchar_zmod : zmod_closed Zchar. Proof. split; first exact: cfun0_zchar. move=> phi xi /andP[Aphi /sumboolP[a Da]] /andP[Axi /sumboolP[b Db]]. rewrite inE rpredB // Da Db -sumrB; apply/sumboolP; exists (a - b). by apply: eq_bigr => i _; rewrite -mulrzBr !ffunE. Qed. Canonical Zchar_opprPred := OpprPred Zchar_zmod. Canonical Zchar_addrPred := AddrPred Zchar_zmod. Canonical Zchar_zmodPred := ZmodPred Zchar_zmod. Lemma scale_zchar a phi : a \in Cint -> phi \in Zchar -> a *: phi \in Zchar. Proof. by case/CintP=> m -> Zphi; rewrite scaler_int rpredMz. Qed. End Basics. Notation "''Z[' S , A ]" := (Zchar S A) (at level 8, format "''Z[' S , A ]") : group_scope. Notation "''Z[' S ]" := 'Z[S, setT] (at level 8, format "''Z[' S ]") : group_scope. Section Zchar. Variables (gT : finGroupType) (G : {group gT}). Implicit Types (A B : {set gT}) (S : seq 'CF(G)). Lemma zchar_split S A phi : phi \in 'Z[S, A] = (phi \in 'Z[S]) && (phi \in 'CF(G, A)). Proof. by rewrite !inE cfun_onT andbC. Qed. Lemma zcharD1E phi S : (phi \in 'Z[S, G^#]) = (phi \in 'Z[S]) && (phi 1%g == 0). Proof. by rewrite zchar_split cfunD1E. Qed. Lemma zcharD1 phi S A : (phi \in 'Z[S, A^#]) = (phi \in 'Z[S, A]) && (phi 1%g == 0). Proof. by rewrite zchar_split cfun_onD1 andbA -zchar_split. Qed. Lemma zcharW S A : {subset 'Z[S, A] <= 'Z[S]}. Proof. by move=> phi; rewrite zchar_split => /andP[]. Qed. Lemma zchar_on S A : {subset 'Z[S, A] <= 'CF(G, A)}. Proof. by move=> phi /andP[]. Qed. Lemma zchar_onS A B S : A \subset B -> {subset 'Z[S, A] <= 'Z[S, B]}. Proof. move=> sAB phi; rewrite zchar_split (zchar_split _ B) => /andP[->]. exact: cfun_onS. Qed. Lemma zchar_onG S : 'Z[S, G] =i 'Z[S]. Proof. by move=> phi; rewrite zchar_split cfun_onG andbT. Qed. Lemma irr_vchar_on A : {subset 'Z[irr G, A] <= 'CF(G, A)}. Proof. exact: zchar_on. Qed. Lemma support_zchar S A phi : phi \in 'Z[S, A] -> support phi \subset A. Proof. by move/zchar_on; rewrite cfun_onE. Qed. Lemma mem_zchar_on S A phi : phi \in 'CF(G, A) -> phi \in S -> phi \in 'Z[S, A]. Proof. move=> Aphi /(@tnthP _ _ (in_tuple S))[i Dphi]; rewrite inE /= {}Aphi {phi}Dphi. apply/sumboolP; exists [ffun j => (j == i)%:Z]. rewrite (bigD1 i) //= ffunE eqxx (tnth_nth 0) big1 ?addr0 // => j i'j. by rewrite ffunE (negPf i'j). Qed. (* A special lemma is needed because trivial fails to use the cfun_onT Hint. *) Lemma mem_zchar S phi : phi \in S -> phi \in 'Z[S]. Proof. by move=> Sphi; rewrite mem_zchar_on ?cfun_onT. Qed. Lemma zchar_nth_expansion S A phi : phi \in 'Z[S, A] -> {z | forall i, z i \in Cint & phi = \sum_(i < size S) z i *: S`_i}. Proof. case/andP=> _ /sumboolP/sig_eqW[/= z ->]. exists (intr \o z) => [i|]; first exact: Cint_int. by apply: eq_bigr => i _; rewrite scaler_int. Qed. Lemma zchar_tuple_expansion n (S : n.-tuple 'CF(G)) A phi : phi \in 'Z[S, A] -> {z | forall i, z i \in Cint & phi = \sum_(i < n) z i *: S`_i}. Proof. by move/zchar_nth_expansion; rewrite size_tuple. Qed. (* A pure seq version with the extra hypothesis of S's unicity. *) Lemma zchar_expansion S A phi : uniq S -> phi \in 'Z[S, A] -> {z | forall xi, z xi \in Cint & phi = \sum_(xi <- S) z xi *: xi}. Proof. move=> Suniq /zchar_nth_expansion[z Zz ->] /=. pose zS xi := oapp z 0 (insub (index xi S)). exists zS => [xi | ]; rewrite {}/zS; first by case: (insub _). rewrite (big_nth 0) big_mkord; apply: eq_bigr => i _; congr (_ *: _). by rewrite index_uniq // valK. Qed. Lemma zchar_span S A : {subset 'Z[S, A] <= <>%VS}. Proof. move=> _ /zchar_nth_expansion[z Zz ->] /=. by apply: rpred_sum => i _; rewrite rpredZ // memv_span ?mem_nth. Qed. Lemma zchar_trans S1 S2 A B : {subset S1 <= 'Z[S2, B]} -> {subset 'Z[S1, A] <= 'Z[S2, A]}. Proof. move=> sS12 phi; rewrite !(zchar_split _ A) andbC => /andP[->]; rewrite andbT. case/zchar_nth_expansion=> z Zz ->; apply: rpred_sum => i _. by rewrite scale_zchar // (@zcharW _ B) ?sS12 ?mem_nth. Qed. Lemma zchar_trans_on S1 S2 A : {subset S1 <= 'Z[S2, A]} -> {subset 'Z[S1] <= 'Z[S2, A]}. Proof. move=> sS12 _ /zchar_nth_expansion[z Zz ->]; apply: rpred_sum => i _. by rewrite scale_zchar // sS12 ?mem_nth. Qed. Lemma zchar_sub_irr S A : {subset S <= 'Z[irr G]} -> {subset 'Z[S, A] <= 'Z[irr G, A]}. Proof. exact: zchar_trans. Qed. Lemma zchar_subset S1 S2 A : {subset S1 <= S2} -> {subset 'Z[S1, A] <= 'Z[S2, A]}. Proof. move=> sS12; apply: zchar_trans setT _ => // f /sS12 S2f. by rewrite mem_zchar. Qed. Lemma zchar_subseq S1 S2 A : subseq S1 S2 -> {subset 'Z[S1, A] <= 'Z[S2, A]}. Proof. by move/mem_subseq; apply: zchar_subset. Qed. Lemma zchar_filter S A (p : pred 'CF(G)) : {subset 'Z[filter p S, A] <= 'Z[S, A]}. Proof. by apply: zchar_subset=> f; apply/mem_subseq/filter_subseq. Qed. End Zchar. Section VChar. Variables (gT : finGroupType) (G : {group gT}). Implicit Types (A B : {set gT}) (phi chi : 'CF(G)) (S : seq 'CF(G)). Lemma char_vchar chi : chi \is a character -> chi \in 'Z[irr G]. Proof. case/char_sum_irr=> r ->; apply: rpred_sum => i _. by rewrite mem_zchar ?mem_tnth. Qed. Lemma irr_vchar i : 'chi[G]_i \in 'Z[irr G]. Proof. exact/char_vchar/irr_char. Qed. Lemma cfun1_vchar : 1 \in 'Z[irr G]. Proof. by rewrite -irr0 irr_vchar. Qed. Lemma vcharP phi : reflect (exists2 chi1, chi1 \is a character & exists2 chi2, chi2 \is a character & phi = chi1 - chi2) (phi \in 'Z[irr G]). Proof. apply: (iffP idP) => [| [a Na [b Nb ->]]]; last by rewrite rpredB ?char_vchar. case/zchar_tuple_expansion=> z Zz ->; rewrite (bigID (fun i => 0 <= z i)) /=. set chi1 := \sum_(i | _) _; set nchi2 := \sum_(i | _) _. 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 ltW //. by rewrite real_ltNge ?Creal_Cint. Qed. Lemma Aint_vchar phi x : phi \in 'Z[irr G] -> phi x \in Aint. Proof. case/vcharP=> [chi1 Nchi1 [chi2 Nchi2 ->]]. by rewrite !cfunE rpredB ?Aint_char. Qed. Lemma Cint_vchar1 phi : phi \in 'Z[irr G] -> phi 1%g \in Cint. Proof. case/vcharP=> phi1 Nphi1 [phi2 Nphi2 ->]. by rewrite !cfunE rpredB // rpred_Cnat ?Cnat_char1. Qed. Lemma Cint_cfdot_vchar_irr i phi : phi \in 'Z[irr G] -> '[phi, 'chi_i] \in Cint. Proof. case/vcharP=> chi1 Nchi1 [chi2 Nchi2 ->]. by rewrite cfdotBl rpredB // rpred_Cnat ?Cnat_cfdot_char_irr. Qed. Lemma cfdot_vchar_r phi psi : psi \in 'Z[irr G] -> '[phi, psi] = \sum_i '[phi, 'chi_i] * '[psi, 'chi_i]. Proof. move=> Zpsi; rewrite cfdot_sum_irr; apply: eq_bigr => i _; congr (_ * _). by rewrite aut_Cint ?Cint_cfdot_vchar_irr. Qed. Lemma Cint_cfdot_vchar : {in 'Z[irr G] &, forall phi psi, '[phi, psi] \in Cint}. Proof. move=> phi psi Zphi Zpsi; rewrite /= cfdot_vchar_r // rpred_sum // => k _. by rewrite rpredM ?Cint_cfdot_vchar_irr. Qed. Lemma Cnat_cfnorm_vchar : {in 'Z[irr G], forall phi, '[phi] \in Cnat}. Proof. by move=> phi Zphi; rewrite /= CnatEint cfnorm_ge0 Cint_cfdot_vchar. Qed. Fact vchar_mulr_closed : mulr_closed 'Z[irr G]. Proof. split; first exact: cfun1_vchar. move=> _ _ /vcharP[xi1 Nxi1 [xi2 Nxi2 ->]] /vcharP[xi3 Nxi3 [xi4 Nxi4 ->]]. by rewrite mulrBl !mulrBr !(rpredB, rpredD) // char_vchar ?rpredM. Qed. Canonical vchar_mulrPred := MulrPred vchar_mulr_closed. Canonical vchar_smulrPred := SmulrPred vchar_mulr_closed. Canonical vchar_semiringPred := SemiringPred vchar_mulr_closed. Canonical vchar_subringPred := SubringPred vchar_mulr_closed. Lemma mul_vchar A : {in 'Z[irr G, A] &, forall phi psi, phi * psi \in 'Z[irr G, A]}. Proof. move=> phi psi; rewrite zchar_split => /andP[Zphi Aphi] /zcharW Zpsi. rewrite zchar_split rpredM //; apply/cfun_onP=> x A'x. by rewrite cfunE (cfun_onP Aphi) ?mul0r. Qed. Section CfdotPairwiseOrthogonal. Variables (M : {group gT}) (S : seq 'CF(G)) (nu : 'CF(G) -> 'CF(M)). Hypotheses (Inu : {in 'Z[S] &, isometry nu}) (oSS : pairwise_orthogonal S). Let freeS := orthogonal_free oSS. Let uniqS : uniq S := free_uniq freeS. Let Z_S : {subset S <= 'Z[S]}. Proof. by move=> phi; apply: mem_zchar. Qed. Let notS0 : 0 \notin S. Proof. by case/andP: oSS. Qed. Let dotSS := proj2 (pairwise_orthogonalP oSS). Lemma map_pairwise_orthogonal : pairwise_orthogonal (map nu S). Proof. have inj_nu: {in S &, injective nu}. move=> phi psi Sphi Spsi /= eq_nu; apply: contraNeq (memPn notS0 _ Sphi). by rewrite -cfnorm_eq0 -Inu ?Z_S // {2}eq_nu Inu ?Z_S // => /dotSS->. have notSnu0: 0 \notin map nu S. apply: contra notS0 => /mapP[phi Sphi /esym/eqP]. by rewrite -cfnorm_eq0 Inu ?Z_S // cfnorm_eq0 => /eqP <-. apply/pairwise_orthogonalP; split; first by rewrite /= notSnu0 map_inj_in_uniq. move=> _ _ /mapP[phi Sphi ->] /mapP[psi Spsi ->]. by rewrite (inj_in_eq inj_nu) // Inu ?Z_S //; apply: dotSS. Qed. Lemma cfproj_sum_orthogonal P z phi : phi \in S -> '[\sum_(xi <- S | P xi) z xi *: nu xi, nu phi] = if P phi then z phi * '[phi] else 0. Proof. move=> Sphi; have defS := perm_to_rem Sphi. rewrite cfdot_suml (perm_big _ defS) big_cons /= cfdotZl Inu ?Z_S //. rewrite big1_seq ?addr0 // => xi; rewrite mem_rem_uniq ?inE //. by case/and3P=> _ neq_xi Sxi; rewrite cfdotZl Inu ?Z_S // dotSS ?mulr0. Qed. Lemma cfdot_sum_orthogonal z1 z2 : '[\sum_(xi <- S) z1 xi *: nu xi, \sum_(xi <- S) z2 xi *: nu xi] = \sum_(xi <- S) z1 xi * (z2 xi)^* * '[xi]. Proof. rewrite cfdot_sumr; apply: eq_big_seq => phi Sphi. by rewrite cfdotZr cfproj_sum_orthogonal // mulrCA mulrA. Qed. Lemma cfnorm_sum_orthogonal z : '[\sum_(xi <- S) z xi *: nu xi] = \sum_(xi <- S) `|z xi| ^+ 2 * '[xi]. Proof. by rewrite cfdot_sum_orthogonal; apply: eq_bigr => xi _; rewrite normCK. Qed. Lemma cfnorm_orthogonal : '[\sum_(xi <- S) nu xi] = \sum_(xi <- S) '[xi]. Proof. rewrite -(eq_bigr _ (fun _ _ => scale1r _)) cfnorm_sum_orthogonal. by apply: eq_bigr => xi; rewrite normCK conjC1 !mul1r. Qed. End CfdotPairwiseOrthogonal. Lemma orthogonal_span S phi : pairwise_orthogonal S -> phi \in <>%VS -> {z | z = fun xi => '[phi, xi] / '[xi] & phi = \sum_(xi <- S) z xi *: xi}. Proof. move=> oSS /free_span[|c -> _]; first exact: orthogonal_free. set z := fun _ => _ : algC; exists z => //; apply: eq_big_seq => u Su. rewrite /z cfproj_sum_orthogonal // mulfK // cfnorm_eq0. by rewrite (memPn _ u Su); case/andP: oSS. Qed. Section CfDotOrthonormal. Variables (M : {group gT}) (S : seq 'CF(G)) (nu : 'CF(G) -> 'CF(M)). Hypotheses (Inu : {in 'Z[S] &, isometry nu}) (onS : orthonormal S). Let oSS := orthonormal_orthogonal onS. Let freeS := orthogonal_free oSS. Let nS1 : {in S, forall phi, '[phi] = 1}. Proof. by move=> phi Sphi; case/orthonormalP: onS => _ -> //; rewrite eqxx. Qed. Lemma map_orthonormal : orthonormal (map nu S). Proof. rewrite !orthonormalE map_pairwise_orthogonal // andbT. by apply/allP=> _ /mapP[xi Sxi ->]; rewrite /= Inu ?nS1 // mem_zchar. Qed. Lemma cfproj_sum_orthonormal z phi : phi \in S -> '[\sum_(xi <- S) z xi *: nu xi, nu phi] = z phi. Proof. by move=> Sphi; rewrite cfproj_sum_orthogonal // nS1 // mulr1. Qed. Lemma cfdot_sum_orthonormal z1 z2 : '[\sum_(xi <- S) z1 xi *: xi, \sum_(xi <- S) z2 xi *: xi] = \sum_(xi <- S) z1 xi * (z2 xi)^*. Proof. rewrite cfdot_sum_orthogonal //; apply: eq_big_seq => phi /nS1->. by rewrite mulr1. Qed. Lemma cfnorm_sum_orthonormal z : '[\sum_(xi <- S) z xi *: nu xi] = \sum_(xi <- S) `|z xi| ^+ 2. Proof. rewrite cfnorm_sum_orthogonal //. by apply: eq_big_seq => xi /nS1->; rewrite mulr1. Qed. Lemma cfnorm_map_orthonormal : '[\sum_(xi <- S) nu xi] = (size S)%:R. Proof. by rewrite cfnorm_orthogonal // (eq_big_seq _ nS1) big_tnth sumr_const card_ord. Qed. Lemma orthonormal_span phi : phi \in <>%VS -> {z | z = fun xi => '[phi, xi] & phi = \sum_(xi <- S) z xi *: xi}. Proof. case/orthogonal_span=> // _ -> {2}->; set z := fun _ => _ : algC. by exists z => //; apply: eq_big_seq => xi /nS1->; rewrite divr1. Qed. End CfDotOrthonormal. Lemma cfnorm_orthonormal S : orthonormal S -> '[\sum_(xi <- S) xi] = (size S)%:R. Proof. exact: cfnorm_map_orthonormal. Qed. Lemma vchar_orthonormalP S : {subset S <= 'Z[irr G]} -> reflect (exists I : {set Iirr G}, exists b : Iirr G -> bool, perm_eq S [seq (-1) ^+ b i *: 'chi_i | i in I]) (orthonormal S). Proof. move=> vcS; apply: (equivP orthonormalP). split=> [[uniqS oSS] | [I [b defS]]]; last first. split=> [|xi1 xi2]; rewrite ?(perm_mem defS). rewrite (perm_uniq defS) map_inj_uniq ?enum_uniq // => i j /eqP. by rewrite eq_signed_irr => /andP[_ /eqP]. case/mapP=> [i _ ->] /mapP[j _ ->]; rewrite eq_signed_irr. rewrite cfdotZl cfdotZr rmorph_sign mulrA cfdot_irr -signr_addb mulr_natr. by rewrite mulrb andbC; case: eqP => //= ->; rewrite addbb eqxx. pose I := [set i | ('chi_i \in S) || (- 'chi_i \in S)]. pose b i := - 'chi_i \in S; exists I, b. apply: uniq_perm => // [|xi]. rewrite map_inj_uniq ?enum_uniq // => i j /eqP. by rewrite eq_signed_irr => /andP[_ /eqP]. apply/idP/mapP=> [Sxi | [i Ii ->{xi}]]; last first. move: Ii; rewrite mem_enum inE orbC -/(b i). by case b_i: (b i); rewrite (scale1r, scaleN1r). have: '[xi] = 1 by rewrite oSS ?eqxx. have vc_xi := vcS _ Sxi; rewrite cfdot_sum_irr. case/Cnat_sum_eq1 => [i _ | i [_ /eqP norm_xi_i xi_i'_0]]. by rewrite -normCK rpredX // Cnat_norm_Cint ?Cint_cfdot_vchar_irr. suffices def_xi: xi = (-1) ^+ b i *: 'chi_i. exists i; rewrite // mem_enum inE -/(b i) orbC. by case: (b i) def_xi Sxi => // ->; rewrite scale1r. move: Sxi; rewrite [xi]cfun_sum_cfdot (bigD1 i) //. rewrite big1 //= ?addr0 => [|j ne_ji]; last first. apply/eqP; rewrite scaler_eq0 -normr_eq0 -[_ == 0](expf_eq0 _ 2) normCK. by rewrite xi_i'_0 ?eqxx. have:= norm_xi_i; rewrite (aut_Cint _ (Cint_cfdot_vchar_irr _ _)) //. rewrite -subr_eq0 subr_sqr_1 mulf_eq0 subr_eq0 addr_eq0 /b scaler_sign. case/pred2P=> ->; last by rewrite scaleN1r => ->. rewrite scale1r => Sxi; case: ifP => // SNxi. have:= oSS _ _ Sxi SNxi; rewrite cfdotNr cfdot_irr eqxx; case: eqP => // _. by move/eqP; rewrite oppr_eq0 oner_eq0. Qed. Lemma vchar_norm1P phi : phi \in 'Z[irr G] -> '[phi] = 1 -> exists b : bool, exists i : Iirr G, phi = (-1) ^+ b *: 'chi_i. Proof. move=> Zphi phiN1. have: orthonormal phi by rewrite /orthonormal/= phiN1 eqxx. case/vchar_orthonormalP=> [xi /predU1P[->|] // | I [b def_phi]]. have: phi \in (phi : seq _) := mem_head _ _. by rewrite (perm_mem def_phi) => /mapP[i _ ->]; exists (b i), i. Qed. Lemma zchar_small_norm phi n : phi \in 'Z[irr G] -> '[phi] = n%:R -> (n < 4)%N -> {S : n.-tuple 'CF(G) | [/\ orthonormal S, {subset S <= 'Z[irr G]} & phi = \sum_(xi <- S) xi]}. Proof. move=> Zphi def_n lt_n_4. pose S := [seq '[phi, 'chi_i] *: 'chi_i | i in irr_constt phi]. have def_phi: phi = \sum_(xi <- S) xi. rewrite big_image big_mkcond {1}[phi]cfun_sum_cfdot. by apply: eq_bigr => i _; rewrite if_neg; case: eqP => // ->; rewrite scale0r. have orthS: orthonormal S. apply/orthonormalP; split=> [|_ _ /mapP[i phi_i ->] /mapP[j _ ->]]. rewrite map_inj_in_uniq ?enum_uniq // => i j; rewrite mem_enum => phi_i _. by move/eqP; rewrite eq_scaled_irr (negbTE phi_i) => /andP[_ /= /eqP]. rewrite eq_scaled_irr cfdotZl cfdotZr cfdot_irr mulrA mulr_natr mulrb. rewrite mem_enum in phi_i; rewrite (negbTE phi_i) andbC; case: eqP => // <-. have /CnatP[m def_m] := Cnat_norm_Cint (Cint_cfdot_vchar_irr i Zphi). apply/eqP; rewrite eqxx /= -normCK def_m -natrX eqr_nat eqn_leq lt0n. rewrite expn_eq0 andbT -eqC_nat -def_m normr_eq0 [~~ _]phi_i andbT. rewrite (leq_exp2r _ 1) // -ltnS -(@ltn_exp2r _ _ 2) //. apply: leq_ltn_trans lt_n_4; rewrite -leC_nat -def_n natrX. rewrite cfdot_sum_irr (bigD1 i) //= -normCK def_m addrC -subr_ge0 addrK. by rewrite sumr_ge0 // => ? _; apply: mul_conjC_ge0. have <-: size S = n. by apply/eqP; rewrite -eqC_nat -def_n def_phi cfnorm_orthonormal. exists (in_tuple S); split=> // _ /mapP[i _ ->]. by rewrite scale_zchar ?irr_vchar // Cint_cfdot_vchar_irr. Qed. Lemma vchar_norm2 phi : phi \in 'Z[irr G, G^#] -> '[phi] = 2%:R -> exists i, exists2 j, j != i & phi = 'chi_i - 'chi_j. Proof. rewrite zchar_split cfunD1E => /andP[Zphi phi1_0]. case/zchar_small_norm => // [[[|chi [|xi [|?]]] //= S2]]. case=> /andP[/and3P[Nchi Nxi _] /= ochi] /allP/and3P[Zchi Zxi _]. rewrite big_cons big_seq1 => def_phi. have [b [i def_chi]] := vchar_norm1P Zchi (eqP Nchi). have [c [j def_xi]] := vchar_norm1P Zxi (eqP Nxi). have neq_ji: j != i. apply: contraTneq ochi; rewrite !andbT def_chi def_xi => ->. rewrite cfdotZl cfdotZr rmorph_sign cfnorm_irr mulr1 -signr_addb. 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 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. Qed. End VChar. Section Isometries. Variables (gT : finGroupType) (L G : {group gT}) (S : seq 'CF(L)). Implicit Type nu : {additive 'CF(L) -> 'CF(G)}. Lemma Zisometry_of_cfnorm (tauS : seq 'CF(G)) : pairwise_orthogonal S -> pairwise_orthogonal tauS -> map cfnorm tauS = map cfnorm S -> {subset tauS <= 'Z[irr G]} -> {tau : {linear 'CF(L) -> 'CF(G)} | map tau S = tauS & {in 'Z[S], isometry tau, to 'Z[irr G]}}. Proof. move=> oSS oTT /isometry_of_cfnorm[||tau defT Itau] // Z_T; exists tau => //. split=> [|_ /zchar_nth_expansion[u Zu ->]]. by apply: sub_in2 Itau; apply: zchar_span. rewrite big_seq linear_sum rpred_sum // => xi Sxi. by rewrite linearZ scale_zchar ?Z_T // -defT map_f ?mem_nth. Qed. Lemma Zisometry_of_iso f : free S -> {in S, isometry f, to 'Z[irr G]} -> {tau : {linear 'CF(L) -> 'CF(G)} | {in S, tau =1 f} & {in 'Z[S], isometry tau, to 'Z[irr G]}}. Proof. move=> freeS [If Zf]; have [tau Dtau Itau] := isometry_of_free freeS If. exists tau => //; split; first by apply: sub_in2 Itau; apply: zchar_span. move=> _ /zchar_nth_expansion[a Za ->]; rewrite linear_sum rpred_sum // => i _. by rewrite linearZ rpredZ_Cint ?Dtau ?Zf ?mem_nth. Qed. Lemma Zisometry_inj A nu : {in 'Z[S, A] &, isometry nu} -> {in 'Z[S, A] &, injective nu}. Proof. by move/isometry_raddf_inj; apply; apply: rpredB. Qed. Lemma isometry_in_zchar nu : {in S &, isometry nu} -> {in 'Z[S] &, isometry nu}. Proof. move=> Inu _ _ /zchar_nth_expansion[u Zu ->] /zchar_nth_expansion[v Zv ->]. rewrite !raddf_sum; apply: eq_bigr => j _ /=. rewrite !cfdot_suml; apply: eq_bigr => i _. by rewrite !raddfZ_Cint //= !cfdotZl !cfdotZr Inu ?mem_nth. Qed. End Isometries. Section AutVchar. Variables (u : {rmorphism algC -> algC}) (gT : finGroupType) (G : {group gT}). Local Notation "alpha ^u" := (cfAut u alpha). Implicit Type (S : seq 'CF(G)) (phi chi : 'CF(G)). Lemma cfAut_zchar S A psi : cfAut_closed u S -> psi \in 'Z[S, A] -> psi^u \in 'Z[S, A]. Proof. rewrite zchar_split => SuS /andP[/zchar_nth_expansion[z Zz Dpsi] Apsi]. rewrite zchar_split cfAut_on {}Apsi {psi}Dpsi rmorph_sum rpred_sum //= => i _. by rewrite cfAutZ_Cint // scale_zchar // mem_zchar ?SuS ?mem_nth. Qed. Lemma cfAut_vchar A psi : psi \in 'Z[irr G, A] -> psi^u \in 'Z[irr G, A]. Proof. by apply: cfAut_zchar; apply: irr_aut_closed. Qed. Lemma sub_aut_zchar S A psi : {subset S <= 'Z[irr G]} -> psi \in 'Z[S, A] -> psi^u \in 'Z[S, A] -> psi - psi^u \in 'Z[S, A^#]. Proof. move=> Z_S Spsi Spsi_u; rewrite zcharD1 !cfunE subr_eq0 rpredB //=. by rewrite aut_Cint // Cint_vchar1 // (zchar_trans Z_S) ?(zcharW Spsi). Qed. Lemma conjC_vcharAut chi x : chi \in 'Z[irr G] -> (u (chi x))^* = u (chi x)^*. Proof. case/vcharP=> chi1 Nchi1 [chi2 Nchi2 ->]. by rewrite !cfunE !rmorphB !conjC_charAut. Qed. Lemma cfdot_aut_vchar phi chi : chi \in 'Z[irr G] -> '[phi^u , chi^u] = u '[phi, chi]. Proof. case/vcharP=> chi1 Nchi1 [chi2 Nchi2 ->]. by rewrite !raddfB /= !cfdot_aut_char. Qed. Lemma vchar_aut A chi : (chi^u \in 'Z[irr G, A]) = (chi \in 'Z[irr G, A]). Proof. rewrite !(zchar_split _ A) cfAut_on; congr (_ && _). apply/idP/idP=> [Zuchi|]; last exact: cfAut_vchar. rewrite [chi]cfun_sum_cfdot rpred_sum // => i _. rewrite scale_zchar ?irr_vchar //. by rewrite -(Cint_aut u) -cfdot_aut_irr -aut_IirrE Cint_cfdot_vchar_irr. Qed. End AutVchar. Definition cfConjC_vchar := cfAut_vchar conjC. Section MoreVchar. Variables (gT : finGroupType) (G H : {group gT}). Lemma cfRes_vchar phi : phi \in 'Z[irr G] -> 'Res[H] phi \in 'Z[irr H]. Proof. case/vcharP=> xi1 Nx1 [xi2 Nxi2 ->]. by rewrite raddfB rpredB ?char_vchar ?cfRes_char. Qed. Lemma cfRes_vchar_on A phi : H \subset G -> phi \in 'Z[irr G, A] -> 'Res[H] phi \in 'Z[irr H, A]. Proof. rewrite zchar_split => sHG /andP[Zphi Aphi]; rewrite zchar_split cfRes_vchar //. apply/cfun_onP=> x /(cfun_onP Aphi); rewrite !cfunElock !genGid sHG => ->. exact: mul0rn. Qed. Lemma cfInd_vchar phi : phi \in 'Z[irr H] -> 'Ind[G] phi \in 'Z[irr G]. Proof. move=> /vcharP[xi1 Nx1 [xi2 Nxi2 ->]]. by rewrite raddfB rpredB ?char_vchar ?cfInd_char. Qed. Lemma sub_conjC_vchar A phi : phi \in 'Z[irr G, A] -> phi - (phi^*)%CF \in 'Z[irr G, A^#]. Proof. move=> Zphi; rewrite sub_aut_zchar ?cfAut_zchar // => _ /irrP[i ->]. exact: irr_vchar. exact: cfConjC_irr. Qed. Lemma Frobenius_kernel_exists : [Frobenius G with complement H] -> {K : {group gT} | [Frobenius G = K ><| H]}. Proof. move=> frobG; have [_ ntiHG] := andP frobG. have [[_ sHG regGH][_ tiHG /eqP defNH]] := (normedTI_memJ_P ntiHG, and3P ntiHG). suffices /sigW[K defG]: exists K, gval K ><| H == G by exists K; apply/andP. pose K1 := G :\: cover (H^# :^: G). have oK1: #|K1| = #|G : H|. rewrite cardsD (setIidPr _); last first. rewrite cover_imset; apply/bigcupsP=> x Gx. by rewrite sub_conjg conjGid ?groupV // (subset_trans (subsetDl _ _)). rewrite (cover_partition (partition_normedTI ntiHG)) -(Lagrange sHG). by rewrite (card_support_normedTI ntiHG) (cardsD1 1%g) group1 mulSn addnK. suffices extG i: {j | {in H, 'chi[G]_j =1 'chi[H]_i} & K1 \subset cfker 'chi_j}. pose K := [group of \bigcap_i cfker 'chi_(s2val (extG i))]. have nKH: H \subset 'N(K). by apply/norms_bigcap/bigcapsP=> i _; apply: subset_trans (cfker_norm _). have tiKH: K :&: H = 1%g. apply/trivgP; rewrite -(TI_cfker_irr H) /= setIC; apply/bigcapsP=> i _. apply/subsetP=> x /setIP[Hx /bigcapP/(_ i isT)/=]; rewrite !cfkerEirr !inE. by case: (extG i) => /= j def_j _; rewrite !def_j. exists K; rewrite sdprodE // eqEcard TI_cardMg // mul_subG //=; last first. by rewrite (bigcap_min (0 : Iirr H)) ?cfker_sub. rewrite -(Lagrange sHG) mulnC leq_pmul2r // -oK1 subset_leq_card //. by apply/bigcapsP=> i _; case: (extG i). case i0: (i == 0). exists 0 => [x Hx|]; last by rewrite irr0 cfker_cfun1 subsetDl. by rewrite (eqP i0) !irr0 !cfun1E // (subsetP sHG) ?Hx. have ochi1: '['chi_i, 1] = 0 by rewrite -irr0 cfdot_irr i0. pose a := 'chi_i 1%g; have Za: a \in Cint by rewrite CintE Cnat_irr1. pose theta := 'chi_i - a%:A; pose phi := 'Ind[G] theta + a%:A. have /cfun_onP theta0: theta \in 'CF(H, H^#). by rewrite cfunD1E !cfunE cfun11 mulr1 subrr. have RItheta: 'Res ('Ind[G] theta) = theta. apply/cfun_inP=> x Hx; rewrite cfResE ?cfIndE // (big_setID H) /= addrC. apply: canLR (mulKf (neq0CG H)) _; rewrite (setIidPr sHG) mulr_natl. rewrite big1 ?add0r => [|y /setDP[/regGH tiHy H'y]]; last first. have [-> | ntx] := eqVneq x 1%g; first by rewrite conj1g theta0 ?inE ?eqxx. by rewrite theta0 ?tiHy // !inE ntx. by rewrite -sumr_const; apply: eq_bigr => y Hy; rewrite cfunJ. have ophi1: '[phi, 1] = 0. rewrite cfdotDl -cfdot_Res_r cfRes_cfun1 // cfdotBl !cfdotZl !cfnorm1. by rewrite ochi1 add0r addNr. have{ochi1} n1phi: '[phi] = 1. have: '[phi - a%:A] = '[theta] by rewrite addrK -cfdot_Res_l RItheta. rewrite !cfnormBd ?cfnormZ ?cfdotZr ?ophi1 ?ochi1 ?mulr0 //. by rewrite !cfnorm1 cfnorm_irr => /addIr. have Zphi: phi \in 'Z[irr G]. by rewrite rpredD ?cfInd_vchar ?rpredB ?irr_vchar // scale_zchar ?rpred1. have def_phi: {in H, phi =1 'chi_i}. move=> x Hx /=; rewrite !cfunE -[_ x](cfResE _ sHG) ?RItheta //. by rewrite !cfunE !cfun1E ?(subsetP sHG) ?Hx ?subrK. 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 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. by rewrite -(conjgK y x) cover_imset -class_supportEr imset2_f ?groupV. Qed. End MoreVchar. Definition dirr (gT : finGroupType) (B : {set gT}) : {pred 'CF(B)} := [pred f | (f \in irr B) || (- f \in irr B)]. Arguments dirr {gT}. Section Norm1vchar. Variables (gT : finGroupType) (G : {group gT}). Fact dirr_key : pred_key (dirr G). Proof. by []. Qed. Canonical dirr_keyed := KeyedPred dirr_key. Fact dirr_oppr_closed : oppr_closed (dirr G). Proof. by move=> xi; rewrite !inE opprK orbC. Qed. Canonical dirr_opprPred := OpprPred dirr_oppr_closed. Lemma dirr_opp v : (- v \in dirr G) = (v \in dirr G). Proof. exact: rpredN. Qed. Lemma dirr_sign n v : ((-1)^+ n *: v \in dirr G) = (v \in dirr G). Proof. exact: rpredZsign. Qed. Lemma irr_dirr i : 'chi_i \in dirr G. Proof. by rewrite !inE mem_irr. Qed. Lemma dirrP f : reflect (exists b : bool, exists i, f = (-1) ^+ b *: 'chi_i) (f \in dirr G). Proof. apply: (iffP idP) => [| [b [i ->]]]; last by rewrite dirr_sign irr_dirr. case/orP=> /irrP[i Hf]; first by exists false, i; rewrite scale1r. by exists true, i; rewrite scaleN1r -Hf opprK. Qed. (* This should perhaps be the definition of dirr. *) Lemma dirrE phi : phi \in dirr G = (phi \in 'Z[irr G]) && ('[phi] == 1). Proof. apply/dirrP/andP=> [[b [i ->]] | [Zphi /eqP/vchar_norm1P]]; last exact. by rewrite rpredZsign irr_vchar cfnorm_sign cfnorm_irr. Qed. Lemma cfdot_dirr f g : f \in dirr G -> g \in dirr G -> '[f, g] = (if f == - g then -1 else (f == g)%:R). Proof. case/dirrP=> [b1 [i1 ->]] /dirrP[b2 [i2 ->]]. rewrite cfdotZl cfdotZr rmorph_sign mulrA -signr_addb cfdot_irr. rewrite -scaleNr -signrN !eq_scaled_irr signr_eq0 !(inj_eq signr_inj) /=. by rewrite -!negb_add addbN mulr_sign -mulNrn mulrb; case: ifP. Qed. Lemma dirr_norm1 phi : phi \in 'Z[irr G] -> '[phi] = 1 -> phi \in dirr G. Proof. by rewrite dirrE => -> -> /=. Qed. Lemma dirr_aut u phi : (cfAut u phi \in dirr G) = (phi \in dirr G). Proof. rewrite !dirrE vchar_aut; apply: andb_id2l => /cfdot_aut_vchar->. exact: fmorph_eq1. Qed. Definition dIirr (B : {set gT}) := (bool * (Iirr B))%type. Definition dirr1 (B : {set gT}) : dIirr B := (false, 0). Definition ndirr (B : {set gT}) (i : dIirr B) : dIirr B := (~~ i.1, i.2). Lemma ndirr_diff (i : dIirr G) : ndirr i != i. Proof. by case: i => [] [|] i. Qed. Lemma ndirrK : involutive (@ndirr G). Proof. by move=> [b i]; rewrite /ndirr /= negbK. Qed. Lemma ndirr_inj : injective (@ndirr G). Proof. exact: (inv_inj ndirrK). Qed. Definition dchi (B : {set gT}) (i : dIirr B) : 'CF(B) := (-1)^+ i.1 *: 'chi_i.2. Lemma dchi1 : dchi (dirr1 G) = 1. Proof. by rewrite /dchi scale1r irr0. Qed. Lemma dirr_dchi i : dchi i \in dirr G. Proof. by apply/dirrP; exists i.1; exists i.2. Qed. Lemma dIrrP phi : reflect (exists i, phi = dchi i) (phi \in dirr G). Proof. by apply: (iffP idP)=> [/dirrP[b]|] [i ->]; [exists (b, i) | apply: dirr_dchi]. Qed. Lemma dchi_ndirrE (i : dIirr G) : dchi (ndirr i) = - dchi i. Proof. by case: i => [b i]; rewrite /ndirr /dchi signrN scaleNr. Qed. Lemma cfdot_dchi (i j : dIirr G) : '[dchi i, dchi j] = (i == j)%:R - (i == ndirr j)%:R. Proof. case: i => bi i; case: j => bj j; rewrite cfdot_dirr ?dirr_dchi // !xpair_eqE. rewrite -dchi_ndirrE !eq_scaled_irr signr_eq0 !(inj_eq signr_inj) /=. by rewrite -!negb_add addbN negbK; case: andP => [[->]|]; rewrite ?subr0 ?add0r. Qed. Lemma dchi_vchar i : dchi i \in 'Z[irr G]. Proof. by case: i => b i; rewrite rpredZsign irr_vchar. Qed. Lemma cfnorm_dchi (i : dIirr G) : '[dchi i] = 1. Proof. by case: i => b i; rewrite cfnorm_sign cfnorm_irr. Qed. Lemma dirr_inj : injective (@dchi G). Proof. case=> b1 i1 [b2 i2] /eqP; rewrite eq_scaled_irr (inj_eq signr_inj) /=. by rewrite signr_eq0 -xpair_eqE => /eqP. Qed. Definition dirr_dIirr (B : {set gT}) J (f : J -> 'CF(B)) j : dIirr B := odflt (dirr1 B) [pick i | dchi i == f j]. Lemma dirr_dIirrPE J (f : J -> 'CF(G)) (P : pred J) : (forall j, P j -> f j \in dirr G) -> forall j, P j -> dchi (dirr_dIirr f j) = f j. Proof. rewrite /dirr_dIirr => dirrGf j Pj; case: pickP => [i /eqP //|]. by have /dIrrP[i-> /(_ i)/eqP] := dirrGf j Pj. Qed. Lemma dirr_dIirrE J (f : J -> 'CF(G)) : (forall j, f j \in dirr G) -> forall j, dchi (dirr_dIirr f j) = f j. Proof. by move=> dirrGf j; apply: (@dirr_dIirrPE _ _ xpredT). Qed. Definition dirr_constt (B : {set gT}) (phi: 'CF(B)) : {set (dIirr B)} := [set i | 0 < '[phi, dchi i]]. Lemma dirr_consttE (phi : 'CF(G)) (i : dIirr G) : (i \in dirr_constt phi) = (0 < '[phi, dchi i]). 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 => /ltW -> /=. by case: i => b i; rewrite cfdotZr rmorph_sign rpredMsign Cint_cfdot_vchar_irr. Qed. Lemma dirr_constt_oppr (i : dIirr G) (phi : 'CF(G)) : (i \in dirr_constt (-phi)) = (ndirr i \in dirr_constt phi). Proof. by rewrite !dirr_consttE dchi_ndirrE cfdotNl cfdotNr. Qed. 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 (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. Proof. 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 := ('[phi, 'chi_i] < 0, i). Definition of_irr (B : {set gT}) (i : dIirr B) : Iirr B := i.2. Lemma irr_constt_to_dirr (phi: 'CF(G)) i : phi \in 'Z[irr G] -> (i \in irr_constt phi) = (to_dirr phi i \in dirr_constt phi). Proof. move=> Zphi; rewrite irr_consttE dirr_consttE cfdotZr rmorph_sign /=. by rewrite -real_normrEsign ?normr_gt0 ?Creal_Cint // Cint_cfdot_vchar_irr. Qed. Lemma to_dirrK (phi: 'CF(G)) : cancel (to_dirr phi) (@of_irr G). Proof. by []. Qed. 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 => [|/ltW/le_gtF] ->. Qed. Lemma cfdot_todirrE (phi: 'CF(G)) i (phi_i := dchi (to_dirr phi i)) : '[phi, phi_i] *: phi_i = '[phi, 'chi_i] *: 'chi_i. Proof. by rewrite cfdotZr rmorph_sign mulrC -scalerA signrZK. Qed. Lemma cfun_sum_dconstt (phi : 'CF(G)) : phi \in 'Z[irr G] -> phi = \sum_(i in dirr_constt phi) '[phi, dchi i] *: dchi i. Proof. move=> PiZ; rewrite [LHS]cfun_sum_constt. rewrite (reindex (to_dirr phi))=> [/= |]; last first. by exists (@of_irr _)=> //; apply: of_irrK . by apply: eq_big => i; rewrite ?irr_constt_to_dirr // cfdot_todirrE. Qed. Lemma cnorm_dconstt (phi : 'CF(G)) : phi \in 'Z[irr G] -> '[phi] = \sum_(i in dirr_constt phi) '[phi, dchi i] ^+ 2. Proof. move=> PiZ; rewrite {1 2}(cfun_sum_dconstt PiZ). rewrite cfdot_suml; apply: eq_bigr=> i IiD. rewrite cfdot_sumr (bigD1 i) //= big1 ?addr0 => [|j /andP [JiD IdJ]]. rewrite cfdotZr cfdotZl cfdot_dchi eqxx eq_sym (negPf (ndirr_diff i)). by rewrite subr0 mulr1 aut_Cnat ?Cnat_dirr. rewrite cfdotZr cfdotZl cfdot_dchi eq_sym (negPf IdJ) -natrB ?mulr0 //. by rewrite (negPf (contraNneq _ (dirr_constt_oppl JiD))) => // <-. Qed. Lemma dirr_small_norm (phi : 'CF(G)) n : phi \in 'Z[irr G] -> '[phi] = n%:R -> (n < 4)%N -> [/\ #|dirr_constt phi| = n, dirr_constt phi :&: dirr_constt (- phi) = set0 & phi = \sum_(i in dirr_constt phi) dchi i]. 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 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 //. by apply: eq_bigr => i /Fd->; rewrite scale1r. move=> IiD; apply: contraNeq Nl4 => phi_i_neq1. rewrite -Pln cnorm_dconstt // (bigD1 i) ?ler_paddr ?sumr_ge0 //=. by move=> j /andP[JiD _]; rewrite exprn_ge0 ?Cnat_ge0 ?Cnat_dirr. have /CnatP[m Dm] := Cnat_dirr PiZ IiD; rewrite Dm -natrX ler_nat (leq_sqr 2). by rewrite ltn_neqAle eq_sym -eqC_nat -ltC_nat -Dm phi_i_neq1 -dirr_consttE. Qed. Lemma cfdot_sum_dchi (phi1 phi2 : 'CF(G)) : '[\sum_(i in dirr_constt phi1) dchi i, \sum_(i in dirr_constt phi2) dchi i] = #|dirr_constt phi1 :&: dirr_constt phi2|%:R - #|dirr_constt phi1 :&: dirr_constt (- phi2)|%:R. Proof. rewrite addrC (big_setID (dirr_constt (- phi2))) /= cfdotDl; congr (_ + _). rewrite cfdot_suml -sumr_const -sumrN; apply: eq_bigr => i /setIP[p1i p2i]. rewrite cfdot_sumr (bigD1 (ndirr i)) -?dirr_constt_oppr //= dchi_ndirrE. rewrite cfdotNr cfnorm_dchi big1 ?addr0 // => j /andP[p2j i'j]. rewrite cfdot_dchi -(inv_eq ndirrK) [in rhs in - rhs]eq_sym (negPf i'j) subr0. rewrite (negPf (contraTneq _ p2i)) // => ->. by rewrite dirr_constt_oppr dirr_constt_oppl. rewrite cfdot_sumr (big_setID (dirr_constt phi1)) setIC /= addrC. rewrite big1 ?add0r => [|j /setDP[p2j p1'j]]; last first. rewrite cfdot_suml big1 // => i /setDP[p1i p2'i]. rewrite cfdot_dchi (negPf (contraTneq _ p1i)) => [|-> //]. rewrite (negPf (contraNneq _ p2'i)) ?subrr // => ->. by rewrite dirr_constt_oppr ndirrK. rewrite -sumr_const; apply: eq_bigr => i /setIP[p1i p2i]; rewrite cfdot_suml. rewrite (bigD1 i) /=; last by rewrite inE dirr_constt_oppr dirr_constt_oppl. rewrite cfnorm_dchi big1 ?addr0 // => j /andP[/setDP[p1j _] i'j]. rewrite cfdot_dchi (negPf i'j) (negPf (contraTneq _ p1j)) ?subrr // => ->. exact: dirr_constt_oppl. Qed. Lemma cfdot_dirr_eq1 : {in dirr G &, forall phi psi, ('[phi, psi] == 1) = (phi == psi)}. Proof. move=> _ _ /dirrP[b1 [i1 ->]] /dirrP[b2 [i2 ->]]. rewrite eq_signed_irr cfdotZl cfdotZr rmorph_sign cfdot_irr mulrA -signr_addb. rewrite pmulrn -rmorphMsign (eqr_int _ _ 1) -negb_add. by case: (b1 (+) b2) (i1 == i2) => [] []. Qed. Lemma cfdot_add_dirr_eq1 : {in dirr G & &, forall phi1 phi2 psi, '[phi1 + phi2, psi] = 1 -> psi = phi1 \/ psi = phi2}. Proof. move=> _ _ _ /dirrP[b1 [i1 ->]] /dirrP[b2 [i2 ->]] /dirrP[c [j ->]] /eqP. rewrite cfdotDl !cfdotZl !cfdotZr !rmorph_sign !cfdot_irr !mulrA -!signr_addb. rewrite 2!{1}signrE !mulrBl !mul1r -!natrM addrCA -subr_eq0 -!addrA. rewrite -!opprD addrA subr_eq0 -mulrSr -!natrD eqr_nat => eq_phi_psi. apply/pred2P; rewrite /= !eq_signed_irr -!negb_add !(eq_sym j) !(addbC c). by case: (i1 == j) eq_phi_psi; case: (i2 == j); do 2!case: (_ (+) c). Qed. End Norm1vchar. Prenex Implicits ndirr ndirrK to_dirr to_dirrK of_irr. Arguments of_irrK {gT G phi} [i] phi_i : rename. math-comp-mathcomp-1.12.0/mathcomp/field/000077500000000000000000000000001375767750300202055ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/field/AUTHORS000077700000000000000000000000001375767750300227462../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/field/CeCILL-B000077700000000000000000000000001375767750300230202../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/field/INSTALL.md000077700000000000000000000000001375767750300237062../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/field/Make000066400000000000000000000005611375767750300210070ustar00rootroot00000000000000all_field.v algC.v algebraics_fundamentals.v algnum.v closed_field.v cyclotomic.v falgebra.v fieldext.v finfield.v galois.v separable.v -R . mathcomp.field -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scopemath-comp-mathcomp-1.12.0/mathcomp/field/Makefile000066400000000000000000000002531375767750300216450ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory # -------------------------------------------------------------------- include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/field/README.md000077700000000000000000000000001375767750300233642../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/field/algC.v000066400000000000000000001421011375767750300212410ustar00rootroot00000000000000(* (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 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. (******************************************************************************) (* This file provides an axiomatic construction of the algebraic numbers. *) (* The construction only assumes the existence of an algebraically closed *) (* filed with an automorphism of order 2; this amounts to the purely *) (* algebraic contents of the Fundamenta Theorem of Algebra. *) (* algC == the closed, countable field of algebraic numbers. *) (* algCeq, algCring, ..., algCnumField == structures for algC. *) (* The ssrnum interfaces are implemented for algC as follows: *) (* x <= y <=> (y - x) is a nonnegative real *) (* x < y <=> (y - x) is a (strictly) positive real *) (* `|z| == the complex norm of z, i.e., sqrtC (z * z^* ). *) (* Creal == the subset of real numbers (:= Num.real for algC). *) (* 'i == the imaginary number (:= sqrtC (-1)). *) (* 'Re z == the real component of z. *) (* 'Im z == the imaginary component of z. *) (* z^* == the complex conjugate of z (:= conjC z). *) (* sqrtC z == a nonnegative square root of z, i.e., 0 <= sqrt x if 0 <= x. *) (* n.-root z == more generally, for n > 0, an nth root of z, chosen with a *) (* minimal non-negative argument for n > 1 (i.e., with a *) (* maximal real part subject to a nonnegative imaginary part). *) (* Note that n.-root (-1) is a primitive 2nth root of unity, *) (* an thus not equal to -1 for n odd > 1 (this will be shown in *) (* file cyclotomic.v). *) (* In addition, we provide: *) (* Crat == the subset of rational numbers. *) (* Cint == the subset of integers. *) (* Cnat == the subset of natural integers. *) (* getCrat z == some a : rat such that ratr a = z, provided z \in Crat. *) (* floorC z == for z \in Creal, an m : int s.t. m%:~R <= z < (m + 1)%:~R. *) (* truncC z == for z >= 0, an n : nat s.t. n%:R <= z < n.+1%:R, else 0%N. *) (* minCpoly z == the minimal (monic) polynomial over Crat with root z. *) (* algC_invaut nu == an inverse of nu : {rmorphism algC -> algC}. *) (* (x %| y)%C <=> y is an integer (Cint) multiple of x; if x or y are *) (* (x %| y)%Cx of type nat or int they are coerced to algC here. *) (* The (x %| y)%Cx display form is a workaround for *) (* design limitations of the Coq Notation facilities. *) (* (x == y %[mod z])%C <=> x and y differ by an integer (Cint) multiple of z; *) (* as above, arguments of type nat or int are cast to algC. *) (* (x != y %[mod z])%C <=> x and y do not differ by an integer multiple of z. *) (* Note that in file algnum we give an alternative definition of divisibility *) (* based on algebraic integers, overloading the notation in the %A scope. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope C_scope. Declare Scope C_core_scope. Declare Scope C_expanded_scope. Import Order.TTheory 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 : numMixin L | forall x : NumDomainType L numL, `|x| ^+ 2 = x * conj x}. Proof. move=> conjK conj_nt. have nz2: 2%:R != 0 :> L. apply/eqP=> char2; apply: conj_nt => e; apply/eqP/idPn=> eJ. have opp_id x: - x = x :> L. by apply/esym/eqP; rewrite -addr_eq0 -mulr2n -mulr_natl char2 mul0r. have{} char2: 2 \in [char L] by apply/eqP. without loss{eJ} eJ: e / conj e = e + 1. move/(_ (e / (e + conj e))); apply. rewrite fmorph_div rmorphD conjK -{1}[conj e](addNKr e) mulrDl. by rewrite opp_id (addrC e) divff // addr_eq0 opp_id. pose a := e * conj e; have aJ: conj a = a by rewrite rmorphM conjK mulrC. have [w Dw] := @solve_monicpoly _ 2 (nth 0 [:: e * a; - 1]) isT. have{} Dw: w ^+ 2 + w = e * a. by rewrite Dw !big_ord_recl big_ord0 /= mulr1 mulN1r addr0 subrK. pose b := w + conj w; have bJ: conj b = b by rewrite rmorphD conjK addrC. have Db2: b ^+ 2 + b = a. rewrite -Frobenius_autE // rmorphD addrACA Dw /= Frobenius_autE -rmorphX. by rewrite -rmorphD Dw rmorphM aJ eJ -mulrDl -{1}[e]opp_id addKr mul1r. have /eqP[] := oner_eq0 L; apply: (addrI b); rewrite addr0 -{2}bJ. have: (b + e) * (b + conj e) == 0. rewrite mulrDl 2!mulrDr -/a addrA addr_eq0 opp_id (mulrC e) -addrA. by rewrite -mulrDr eJ addrAC -{2}[e]opp_id subrr add0r mulr1 Db2. rewrite mulf_eq0 !addr_eq0 !opp_id => /pred2P[] -> //. by rewrite {2}eJ rmorphD rmorph1. have mul2I: injective (fun z : L => z *+ 2). by move=> x y; rewrite /= -mulr_natl -(mulr_natl y) => /mulfI->. pose sqrt x : L := sval (sig_eqW (@solve_monicpoly _ 2 (nth 0 [:: x]) isT)). have sqrtK x: sqrt x ^+ 2 = x. rewrite /sqrt; case: sig_eqW => /= y ->. by rewrite !big_ord_recl big_ord0 /= mulr1 mul0r !addr0. have sqrtE x y: y ^+ 2 = x -> {b : bool | y = (-1) ^+ b * sqrt x}. move=> Dx; exists (y != sqrt x); apply/eqP; rewrite mulr_sign if_neg. by case: ifPn => //; apply/implyP; rewrite implyNb -eqf_sqr Dx sqrtK. pose i := sqrt (- 1). have sqrMi x: (i * x) ^+ 2 = - x ^+ 2 by rewrite exprMn sqrtK mulN1r. have iJ : conj i = - i. have /sqrtE[b]: conj i ^+ 2 = - 1 by rewrite -rmorphX sqrtK rmorphN1. rewrite mulr_sign -/i; case: b => // Ri. case: conj_nt => z; wlog zJ: z / conj z = - z. move/(_ (z - conj z)); rewrite !rmorphB conjK opprB => zJ. by apply/mul2I/(canRL (subrK _)); rewrite -addrA zJ // addrC subrK. have [-> | nz_z] := eqVneq z 0; first exact: rmorph0. have [u Ru [v Rv Dz]]: exists2 u, conj u = u & exists2 v, conj v = v & (u + z * v) ^+ 2 = z. - pose y := sqrt z; exists ((y + conj y) / 2%:R). by rewrite fmorph_div rmorphD conjK addrC rmorph_nat. exists ((y - conj y) / (z *+ 2)). rewrite fmorph_div rmorphMn zJ mulNrn invrN mulrN -mulNr rmorphB opprB. by rewrite conjK. rewrite -(mulr_natl z) invfM (mulrC z) !mulrA divfK // -mulrDl addrACA. by rewrite subrr addr0 -mulr2n -mulr_natr mulfK ?Neq0 ?sqrtK. suffices u0: u = 0 by rewrite -Dz u0 add0r rmorphX rmorphM Rv zJ mulNr sqrrN. suffices [b Du]: exists b : bool, u = (-1) ^+ b * i * z * v. apply: mul2I; rewrite mul0rn mulr2n -{2}Ru. by rewrite Du !rmorphM rmorph_sign Rv Ri zJ !mulrN mulNr subrr. have/eqP:= zJ; rewrite -addr_eq0 -{1 2}Dz rmorphX rmorphD rmorphM Ru Rv zJ. rewrite mulNr sqrrB sqrrD addrACA (addrACA (u ^+ 2)) addNr addr0 -!mulr2n. rewrite -mulrnDl -(mul0rn _ 2) (inj_eq mul2I) /= -[rhs in _ + rhs]opprK. rewrite -sqrMi subr_eq0 eqf_sqr -mulNr !mulrA. by case/pred2P=> ->; [exists false | exists true]; rewrite mulr_sign. pose norm x := sqrt x * conj (sqrt x). have normK x : norm x ^+ 2 = x * conj x by rewrite exprMn -rmorphX sqrtK. have normE x y : y ^+ 2 = x -> norm x = y * conj y. rewrite /norm => /sqrtE[b /(canLR (signrMK b)) <-]. by rewrite !rmorphM rmorph_sign mulrACA -mulrA signrMK. have norm_eq0 x : norm x = 0 -> x = 0. by move/eqP; rewrite mulf_eq0 fmorph_eq0 -mulf_eq0 -expr2 sqrtK => /eqP. have normM x y : norm (x * y) = norm x * norm y. by rewrite mulrACA -rmorphM; apply: normE; rewrite exprMn !sqrtK. have normN x : norm (- x) = norm x. by rewrite -mulN1r normM {1}/norm iJ mulrN -expr2 sqrtK opprK mul1r. pose le x y := norm (y - x) == y - x; pose lt x y := (y != x) && le x y. have posE x: le 0 x = (norm x == x) by rewrite /le subr0. have leB x y: le x y = le 0 (y - x) by rewrite posE. have posP x : reflect (exists y, x = y * conj y) (le 0 x). rewrite posE; apply: (iffP eqP) => [Dx | [y {x}->]]; first by exists (sqrt x). by rewrite (normE _ _ (normK y)) rmorphM conjK (mulrC (conj _)) -expr2 normK. have posJ x : le 0 x -> conj x = x. by case/posP=> {x}u ->; rewrite rmorphM conjK mulrC. have pos_linear x y : le 0 x -> le 0 y -> le x y || le y x. move=> pos_x pos_y; rewrite leB -opprB orbC leB !posE normN -eqf_sqr. by rewrite normK rmorphB !posJ ?subrr. have sposDl x y : lt 0 x -> le 0 y -> lt 0 (x + y). have sqrtJ z : le 0 z -> conj (sqrt z) = sqrt z. rewrite posE -{2}[z]sqrtK -subr_eq0 -mulrBr mulf_eq0 subr_eq0. by case/pred2P=> ->; rewrite ?rmorph0. case/andP=> nz_x /sqrtJ uJ /sqrtJ vJ. set u := sqrt x in uJ; set v := sqrt y in vJ; pose w := u + i * v. have ->: x + y = w * conj w. rewrite rmorphD rmorphM iJ uJ vJ mulNr mulrC -subr_sqr sqrMi opprK. by rewrite !sqrtK. apply/andP; split; last by apply/posP; exists w. rewrite -normK expf_eq0 //=; apply: contraNneq nz_x => /norm_eq0 w0. rewrite -[x]sqrtK expf_eq0 /= -/u -(inj_eq mul2I) !mulr2n -{2}(rmorph0 conj). by rewrite -w0 rmorphD rmorphM iJ uJ vJ mulNr addrACA subrr addr0. have sposD x y : lt 0 x -> lt 0 y -> lt 0 (x + y). by move=> x_gt0 /andP[_]; apply: sposDl. have normD x y : le (norm (x + y)) (norm x + norm y). have sposM u v: lt 0 u -> le 0 (u * v) -> le 0 v. by rewrite /lt !posE normM andbC => /andP[/eqP-> /mulfI/inj_eq->]. have posD u v: le 0 u -> le 0 v -> le 0 (u + v). have [-> | nz_u u_ge0 v_ge0] := eqVneq u 0; first by rewrite add0r. by have /andP[]: lt 0 (u + v) by rewrite sposDl // /lt nz_u. have le_sqr u v: conj u = u -> le 0 v -> le (u ^+ 2) (v ^+ 2) -> le u v. case: (eqVneq u 0) => [-> //|nz_u Ru v_ge0]. have [u_gt0 | u_le0 _] := boolP (lt 0 u). by rewrite leB (leB u) subr_sqr mulrC addrC; apply: sposM; apply: sposDl. rewrite leB posD // posE normN -addr_eq0; apply/eqP. rewrite /lt nz_u posE -subr_eq0 in u_le0; apply: (mulfI u_le0). by rewrite mulr0 -subr_sqr normK Ru subrr. have pos_norm z: le 0 (norm z) by apply/posP; exists (sqrt z). rewrite le_sqr ?posJ ?posD // sqrrD !normK -normM rmorphD mulrDl !mulrDr. rewrite addrA addrC !addrA -(addrC (y * conj y)) !addrA. move: (y * _ + _) => u; rewrite -!addrA leB opprD addrACA {u}subrr add0r -leB. rewrite {}le_sqr ?posD //. by rewrite rmorphD !rmorphM !conjK addrC mulrC (mulrC y). rewrite -mulr2n -mulr_natr exprMn normK -natrX mulr_natr sqrrD mulrACA. rewrite -rmorphM (mulrC y x) addrAC leB mulrnA mulr2n opprD addrACA. rewrite subrr addr0 {2}(mulrC x) rmorphM mulrACA -opprB addrAC -sqrrB -sqrMi. 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 (NumMixin normD sposD norm_eq0 pos_linear normM (rrefl _) (rrefl _)). Qed. Module Algebraics. Module Type Specification. Parameter type : Type. Parameter eqMixin : Equality.class_of type. Canonical eqType := EqType type eqMixin. Parameter choiceMixin : Choice.mixin_of type. Canonical choiceType := ChoiceType type choiceMixin. Parameter countMixin : Countable.mixin_of type. Canonical countType := CountType type countMixin. Parameter zmodMixin : GRing.Zmodule.mixin_of type. Canonical zmodType := ZmodType type zmodMixin. Canonical countZmodType := [countZmodType of type]. Parameter ringMixin : GRing.Ring.mixin_of zmodType. Canonical ringType := RingType type ringMixin. Canonical countRingType := [countRingType of type]. Parameter unitRingMixin : GRing.UnitRing.mixin_of ringType. Canonical unitRingType := UnitRingType type unitRingMixin. Axiom mulC : @commutative ringType ringType *%R. Canonical comRingType := ComRingType type mulC. Canonical comUnitRingType := [comUnitRingType of type]. Axiom idomainAxiom : GRing.IntegralDomain.axiom ringType. Canonical idomainType := IdomainType type idomainAxiom. Axiom fieldMixin : GRing.Field.mixin_of unitRingType. Canonical fieldType := FieldType type fieldMixin. Parameter decFieldMixin : GRing.DecidableField.mixin_of unitRingType. Canonical decFieldType := DecFieldType type decFieldMixin. Axiom closedFieldAxiom : GRing.ClosedField.axiom ringType. Canonical closedFieldType := ClosedFieldType type closedFieldAxiom. Parameter numMixin : numMixin idomainType. Canonical porderType := POrderType ring_display type numMixin. Canonical numDomainType := NumDomainType type numMixin. Canonical normedZmodType := NormedZmodType type type numMixin. Canonical numFieldType := [numFieldType of type]. Parameter conjMixin : Num.ClosedField.imaginary_mixin_of numDomainType. Canonical numClosedFieldType := NumClosedFieldType type conjMixin. Axiom algebraic : integralRange (@ratr unitRingType). End Specification. Module Implementation : Specification. Definition L := tag Fundamental_Theorem_of_Algebraics. Definition conjL : {rmorphism L -> L} := s2val (tagged Fundamental_Theorem_of_Algebraics). Fact conjL_K : involutive conjL. Proof. exact: s2valP (tagged Fundamental_Theorem_of_Algebraics). Qed. Fact conjL_nt : ~ conjL =1 id. Proof. exact: s2valP' (tagged Fundamental_Theorem_of_Algebraics). Qed. Definition LnumMixin := ComplexNumMixin conjL_K conjL_nt. Definition Lnum := NumDomainType L (sval LnumMixin). Definition QtoL := [rmorphism of @ratr [numFieldType of Lnum]]. Notation pQtoL := (map_poly QtoL). Definition rootQtoL p_j := if p_j.1 == 0 then 0 else (sval (closed_field_poly_normal (pQtoL p_j.1)))`_p_j.2. Definition eq_root p_j q_k := rootQtoL p_j == rootQtoL q_k. Fact eq_root_is_equiv : equiv_class_of eq_root. Proof. by rewrite /eq_root; split=> [ ? | ? ? | ? ? ? ] // /eqP->. Qed. Canonical eq_root_equiv := EquivRelPack eq_root_is_equiv. Definition type : Type := {eq_quot eq_root}%qT. Definition eqMixin : Equality.class_of type := EquivQuot.eqMixin _. Canonical eqType := EqType type eqMixin. Definition choiceMixin : Choice.mixin_of type := EquivQuot.choiceMixin _. Canonical choiceType := ChoiceType type choiceMixin. Definition countMixin : Countable.mixin_of type := CanCountMixin reprK. Canonical countType := CountType type countMixin. Definition CtoL (u : type) := rootQtoL (repr u). Fact CtoL_inj : injective CtoL. Proof. by move=> u v /eqP eq_uv; rewrite -[u]reprK -[v]reprK; apply/eqmodP. Qed. Fact CtoL_P u : integralOver QtoL (CtoL u). Proof. rewrite /CtoL /rootQtoL; case: (repr u) => p j /=. case: (closed_field_poly_normal _) => r Dp /=. case: ifPn => [_ | nz_p]; first exact: integral0. have [/(nth_default 0)-> | lt_j_r] := leqP (size r) j; first exact: integral0. apply/integral_algebraic; exists p; rewrite // Dp -mul_polyC rootM orbC. by rewrite root_prod_XsubC mem_nth. Qed. Fact LtoC_subproof z : integralOver QtoL z -> {u | CtoL u = z}. Proof. case/sig2_eqW=> p mon_p pz0; rewrite /CtoL. pose j := index z (sval (closed_field_poly_normal (pQtoL p))). pose u := \pi_type%qT (p, j); exists u; have /eqmodP/eqP-> := reprK u. rewrite /rootQtoL -if_neg monic_neq0 //; apply: nth_index => /=. case: (closed_field_poly_normal _) => r /= Dp. by rewrite Dp (monicP _) ?(monic_map QtoL) // scale1r root_prod_XsubC in pz0. Qed. Definition LtoC z Az := sval (@LtoC_subproof z Az). Fact LtoC_K z Az : CtoL (@LtoC z Az) = z. Proof. exact: (svalP (LtoC_subproof Az)). Qed. Fact CtoL_K u : LtoC (CtoL_P u) = u. Proof. by apply: CtoL_inj; rewrite LtoC_K. Qed. Definition zero := LtoC (integral0 _). Definition add u v := LtoC (integral_add (CtoL_P u) (CtoL_P v)). Definition opp u := LtoC (integral_opp (CtoL_P u)). Fact addA : associative add. Proof. by move=> u v w; apply: CtoL_inj; rewrite !LtoC_K addrA. Qed. Fact addC : commutative add. Proof. by move=> u v; apply: CtoL_inj; rewrite !LtoC_K addrC. Qed. Fact add0 : left_id zero add. Proof. by move=> u; apply: CtoL_inj; rewrite !LtoC_K add0r. Qed. Fact addN : left_inverse zero opp add. Proof. by move=> u; apply: CtoL_inj; rewrite !LtoC_K addNr. Qed. Definition zmodMixin := ZmodMixin addA addC add0 addN. Canonical zmodType := ZmodType type zmodMixin. Canonical countZmodType := [countZmodType of type]. Fact CtoL_is_additive : additive CtoL. Proof. by move=> u v; rewrite !LtoC_K. Qed. Canonical CtoL_additive := Additive CtoL_is_additive. Definition one := LtoC (integral1 _). Definition mul u v := LtoC (integral_mul (CtoL_P u) (CtoL_P v)). Definition inv u := LtoC (integral_inv (CtoL_P u)). Fact mulA : associative mul. Proof. by move=> u v w; apply: CtoL_inj; rewrite !LtoC_K mulrA. Qed. Fact mulC : commutative mul. Proof. by move=> u v; apply: CtoL_inj; rewrite !LtoC_K mulrC. Qed. Fact mul1 : left_id one mul. Proof. by move=> u; apply: CtoL_inj; rewrite !LtoC_K mul1r. Qed. Fact mulD : left_distributive mul +%R. Proof. by move=> u v w; apply: CtoL_inj; rewrite !LtoC_K mulrDl. Qed. Fact one_nz : one != 0 :> type. Proof. by rewrite -(inj_eq CtoL_inj) !LtoC_K oner_eq0. Qed. Definition ringMixin := ComRingMixin mulA mulC mul1 mulD one_nz. Canonical ringType := RingType type ringMixin. Canonical comRingType := ComRingType type mulC. Canonical countRingType := [countRingType of type]. Fact CtoL_is_multiplicative : multiplicative CtoL. Proof. by split=> [u v|]; rewrite !LtoC_K. Qed. Canonical CtoL_rmorphism := AddRMorphism CtoL_is_multiplicative. Fact mulVf : GRing.Field.axiom inv. Proof. move=> u; rewrite -(inj_eq CtoL_inj) rmorph0 => nz_u. by apply: CtoL_inj; rewrite !LtoC_K mulVf. Qed. Fact inv0 : inv 0 = 0. Proof. by apply: CtoL_inj; rewrite !LtoC_K invr0. Qed. Definition unitRingMixin := FieldUnitMixin mulVf inv0. Canonical unitRingType := UnitRingType type unitRingMixin. Canonical comUnitRingType := [comUnitRingType of type]. Definition fieldMixin := FieldMixin mulVf inv0. Definition idomainAxiom := FieldIdomainMixin fieldMixin. Canonical idomainType := IdomainType type idomainAxiom. Canonical fieldType := FieldType type fieldMixin. Fact closedFieldAxiom : GRing.ClosedField.axiom ringType. Proof. move=> n a n_gt0; pose p := 'X^n - \poly_(i < n) CtoL (a i). have Ap: {in p : seq L, integralRange QtoL}. move=> _ /(nthP 0)[j _ <-]; rewrite coefB coefXn coef_poly. apply: integral_sub; first exact: integral_nat. by case: ifP => _; [apply: CtoL_P | apply: integral0]. have sz_p: size p = n.+1. by rewrite size_addl size_polyXn // size_opp ltnS size_poly. have [z pz0]: exists z, root p z by apply/closed_rootP; rewrite sz_p eqSS -lt0n. have Az: integralOver ratr z. by apply: integral_root Ap; rewrite // -size_poly_gt0 sz_p. exists (LtoC Az); apply/CtoL_inj; rewrite -[CtoL _]subr0 -(rootP pz0). rewrite rmorphX /= LtoC_K hornerD hornerXn hornerN opprD addNKr opprK. rewrite horner_poly rmorph_sum; apply: eq_bigr => k _. by rewrite rmorphM rmorphX /= LtoC_K. Qed. Definition decFieldMixin := closed_field_QEMixin closedFieldAxiom. Canonical decFieldType := DecFieldType type decFieldMixin. Canonical closedFieldType := ClosedFieldType type closedFieldAxiom. Fact conj_subproof u : integralOver QtoL (conjL (CtoL u)). Proof. have [p mon_p pu0] := CtoL_P u; exists p => //. rewrite -(fmorph_root conjL) conjL_K map_poly_id // => _ /(nthP 0)[j _ <-]. by rewrite coef_map fmorph_rat. Qed. Fact conj_is_rmorphism : rmorphism (fun u => LtoC (conj_subproof u)). Proof. do 2?split=> [u v|]; apply: CtoL_inj; last by rewrite !LtoC_K rmorph1. - by rewrite LtoC_K 3!{1}rmorphB /= !LtoC_K. by rewrite LtoC_K 3!{1}rmorphM /= !LtoC_K. Qed. Definition conj : {rmorphism type -> type} := RMorphism conj_is_rmorphism. Lemma conjK : involutive conj. Proof. by move=> u; apply: CtoL_inj; rewrite !LtoC_K conjL_K. Qed. Fact conj_nt : ~ conj =1 id. Proof. 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/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 : numMixin closedFieldType := sval (ComplexNumMixin conjK conj_nt). Canonical porderType := POrderType ring_display type numMixin. Canonical numDomainType := NumDomainType type numMixin. Canonical normedZmodType := NormedZmodType type type numMixin. Canonical numFieldType := [numFieldType of type]. Lemma normK u : `|u| ^+ 2 = u * conj u. Proof. exact: svalP (ComplexNumMixin conjK conj_nt) u. Qed. Lemma algebraic : integralRange (@ratr unitRingType). Proof. move=> u; have [p mon_p pu0] := CtoL_P u; exists p => {mon_p}//. rewrite -(fmorph_root CtoL_rmorphism) -map_poly_comp; congr (root _ _): pu0. by apply/esym/eq_map_poly; apply: fmorph_eq_rat. Qed. Definition conjMixin := ImaginaryMixin (svalP (imaginary_exists closedFieldType)) (fun x => esym (normK x)). Canonical numClosedFieldType := NumClosedFieldType type conjMixin. End Implementation. Definition divisor := Implementation.type. Module Internals. Import Implementation. Local Notation algC := type. Local Notation "z ^*" := (conj z) (at level 2, format "z ^*") : ring_scope. Local Notation QtoC := (ratr : rat -> algC). Local Notation QtoCm := [rmorphism of QtoC]. Local Notation pQtoC := (map_poly QtoC). Local Notation ZtoQ := (intr : int -> rat). Local Notation ZtoC := (intr : int -> algC). Local Notation Creal := (Num.real : qualifier 0 algC). Fact algCi_subproof : {i : algC | i ^+ 2 = -1}. Proof. exact: GRing.imaginary_exists. Qed. Variant getCrat_spec : Type := GetCrat_spec CtoQ of cancel QtoC CtoQ. Fact getCrat_subproof : getCrat_spec. Proof. have isQ := rat_algebraic_decidable algebraic. exists (fun z => if isQ z is left Qz then sval (sig_eqW Qz) else 0) => a. case: (isQ _) => [Qa | []]; last by exists a. by case: (sig_eqW _) => b /= /fmorph_inj. Qed. 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 | /ltW x_le0] := real_ge0P Rx; first exact. case/(_ (- x)) => [||m /(_ isT)]; rewrite ?rpredN ?oppr_ge0 //. rewrite ler_oppr ltr_oppl -!rmorphN opprD /= lt_neqAle le_eqVlt. case: eqP => [-> _ | _ /and3P[lt_x_m _ le_m_x]]. 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) (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_leP _ n%:R x; rewrite ?rpred_nat //. by rewrite Dn => /min_n; rewrite Dn ltnn. Qed. Fact minCpoly_subproof (x : algC) : {p | p \is monic & forall q, root (pQtoC q) x = (p %| q)%R}. Proof. have isQ := rat_algebraic_decidable algebraic. have [p [mon_p px0 irr_p]] := minPoly_decidable_closure isQ (algebraic x). exists p => // q; apply/idP/idP=> [qx0 | /dvdpP[r ->]]; last first. by rewrite rmorphM rootM px0 orbT. suffices /eqp_dvdl <-: gcdp p q %= p by apply: dvdp_gcdr. rewrite irr_p ?dvdp_gcdl ?gtn_eqF // -(size_map_poly QtoCm) gcdp_map /=. rewrite (@root_size_gt1 _ x) ?root_gcd ?px0 //. by rewrite gcdp_eq0 negb_and map_poly_eq0 monic_neq0. Qed. Definition algC_divisor (x : algC) := x : divisor. Definition int_divisor m := m%:~R : divisor. Definition nat_divisor n := n%:R : divisor. End Internals. Module Import Exports. Import Implementation Internals. Notation algC := type. Delimit Scope C_scope with C. Delimit Scope C_core_scope with Cc. Delimit Scope C_expanded_scope with Cx. Open Scope C_core_scope. Canonical eqType. Canonical choiceType. Canonical countType. Canonical zmodType. Canonical countZmodType. Canonical ringType. Canonical countRingType. Canonical unitRingType. Canonical comRingType. Canonical comUnitRingType. Canonical idomainType. Canonical porderType. Canonical numDomainType. Canonical normedZmodType. Canonical fieldType. Canonical numFieldType. Canonical decFieldType. Canonical closedFieldType. Canonical numClosedFieldType. Notation algCeq := eqType. Notation algCzmod := zmodType. Notation algCring := ringType. Notation algCuring := unitRingType. Notation algCnum := numDomainType. Notation algCfield := fieldType. Notation algCnumField := numFieldType. Notation algCnumClosedField := numClosedFieldType. Notation Creal := (@Num.Def.Rreal numDomainType). Definition getCrat := let: GetCrat_spec CtoQ _ := getCrat_subproof in CtoQ. Definition Crat : {pred algC} := fun x => ratr (getCrat x) == x. Definition floorC x := sval (floorC_subproof x). Definition Cint : {pred algC} := fun x => (floorC x)%:~R == x. Definition truncC x := if x >= 0 then `|floorC x|%N else 0%N. Definition Cnat : {pred algC} := fun x => (truncC x)%:R == x. Definition minCpoly x : {poly algC} := let: exist2 p _ _ := minCpoly_subproof x in map_poly ratr p. Coercion nat_divisor : nat >-> divisor. Coercion int_divisor : int >-> divisor. Coercion algC_divisor : algC >-> divisor. Lemma nCdivE (p : nat) : p = p%:R :> divisor. Proof. by []. Qed. Lemma zCdivE (p : int) : p = p%:~R :> divisor. Proof. by []. Qed. Definition CdivE := (nCdivE, zCdivE). Definition dvdC (x : divisor) : {pred algC} := fun y => if x == 0 then y == 0 else y / x \in Cint. Notation "x %| y" := (y \in dvdC x) : C_expanded_scope. Notation "x %| y" := (@in_mem divisor y (mem (dvdC x))) : C_scope. Definition eqCmod (e x y : divisor) := (e %| x - y)%C. Notation "x == y %[mod e ]" := (eqCmod e x y) : C_scope. Notation "x != y %[mod e ]" := (~~ (x == y %[mod e])%C) : C_scope. End Exports. End Algebraics. Export Algebraics.Exports. Section AlgebraicsTheory. Implicit Types (x y z : algC) (n : nat) (m : int) (b : bool). Import Algebraics.Internals. Local Notation ZtoQ := (intr : int -> rat). Local Notation ZtoC := (intr : int -> algC). Local Notation QtoC := (ratr : rat -> algC). Local Notation QtoCm := [rmorphism of QtoC]. Local Notation CtoQ := getCrat. Local Notation intrp := (map_poly intr). Local Notation pZtoQ := (map_poly ZtoQ). Local Notation pZtoC := (map_poly ZtoC). Local Notation pQtoC := (map_poly ratr). Let intr_inj_ZtoC := (intr_inj : injective ZtoC). Local Hint Resolve intr_inj_ZtoC : core. (* Specialization of a few basic ssrnum order lemmas. *) Definition eqC_nat n p : (n%:R == p%:R :> algC) = (n == p) := eqr_nat _ n p. Definition leC_nat n p : (n%:R <= p%:R :> algC) = (n <= p)%N := ler_nat _ n p. Definition ltC_nat n p : (n%:R < p%:R :> algC) = (n < p)%N := ltr_nat _ n p. Definition Cchar : [char algC] =i pred0 := @char_num _. (* This can be used in the converse direction to evaluate assertions over *) (* manifest rationals, such as 3%:R^-1 + 7%:%^-1 < 2%:%^-1 :> algC. *) (* Missing norm and integer exponent, due to gaps in ssrint and rat. *) Definition CratrE := let CnF := Algebraics.Implementation.numFieldType in let QtoCm := ratr_rmorphism CnF in ((rmorph0 QtoCm, rmorph1 QtoCm, rmorphMn QtoCm, rmorphN QtoCm, rmorphD QtoCm), (rmorphM QtoCm, rmorphX QtoCm, fmorphV QtoCm), (rmorphMz QtoCm, rmorphXz QtoCm, @ratr_norm CnF, @ratr_sg CnF), =^~ (@ler_rat CnF, @ltr_rat CnF, (inj_eq (fmorph_inj QtoCm)))). Definition CintrE := let CnF := Algebraics.Implementation.numFieldType in let ZtoCm := intmul1_rmorphism CnF in ((rmorph0 ZtoCm, rmorph1 ZtoCm, rmorphMn ZtoCm, rmorphN ZtoCm, rmorphD ZtoCm), (rmorphM ZtoCm, rmorphX ZtoCm), (rmorphMz ZtoCm, @intr_norm CnF, @intr_sg CnF), =^~ (@ler_int CnF, @ltr_int CnF, (inj_eq (@intr_inj CnF)))). Let nz2 : 2%:R != 0 :> algC. Proof. by rewrite -!CintrE. Qed. (* Conjugation and norm. *) Definition algC_algebraic x := Algebraics.Implementation.algebraic x. (* Real number subset. *) Lemma Creal0 : 0 \is Creal. Proof. exact: rpred0. Qed. Lemma Creal1 : 1 \is Creal. Proof. exact: rpred1. Qed. (* Trivial cannot resolve a general real0 hint. *) Hint Resolve Creal0 Creal1 : core. Lemma algCrect x : x = 'Re x + 'i * 'Im x. Proof. by rewrite [LHS]Crect. Qed. Lemma algCreal_Re x : 'Re x \is Creal. Proof. by rewrite Creal_Re. Qed. Lemma algCreal_Im x : 'Im x \is Creal. Proof. by rewrite Creal_Im. Qed. Hint Resolve algCreal_Re algCreal_Im : core. (* Integer subset. *) (* Not relying on the undocumented interval library, for now. *) Lemma floorC_itv x : x \is Creal -> (floorC x)%:~R <= x < (floorC x + 1)%:~R. 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 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?(@le_lt_trans _ _ x). Qed. Lemma intCK : cancel intr floorC. Proof. 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. Lemma floorC0 : floorC 0 = 0. Proof. exact: (intCK 0). Qed. Lemma floorC1 : floorC 1 = 1. Proof. exact: (intCK 1). Qed. Hint Resolve floorC0 floorC1 : core. Lemma floorCpK (p : {poly algC}) : p \is a polyOver Cint -> map_poly intr (map_poly floorC p) = p. Proof. move/(all_nthP 0)=> Zp; apply/polyP=> i. rewrite coef_map coef_map_id0 //= -[p]coefK coef_poly. by case: ifP => [/Zp/floorCK // | _]; rewrite floorC0. Qed. Lemma floorCpP (p : {poly algC}) : p \is a polyOver Cint -> {q | p = map_poly intr q}. Proof. by exists (map_poly floorC p); rewrite floorCpK. Qed. Lemma Cint_int m : m%:~R \in Cint. Proof. by rewrite unfold_in intCK. Qed. Lemma CintP x : reflect (exists m, x = m%:~R) (x \in Cint). Proof. by apply: (iffP idP) => [/eqP<-|[m ->]]; [exists (floorC x) | apply: Cint_int]. Qed. Lemma floorCD : {in Cint & Creal, {morph floorC : x y / x + y}}. Proof. move=> _ y /CintP[m ->] Ry; apply: floorC_def. by rewrite -addrA 2!rmorphD /= intCK ler_add2l ltr_add2l floorC_itv. Qed. Lemma floorCN : {in Cint, {morph floorC : x / - x}}. Proof. by move=> _ /CintP[m ->]; rewrite -rmorphN !intCK. Qed. Lemma floorCM : {in Cint &, {morph floorC : x y / x * y}}. Proof. by move=> _ _ /CintP[m1 ->] /CintP[m2 ->]; rewrite -rmorphM !intCK. Qed. Lemma floorCX n : {in Cint, {morph floorC : x / x ^+ n}}. Proof. by move=> _ /CintP[m ->]; rewrite -rmorphX !intCK. Qed. Lemma rpred_Cint (S : {pred algC}) (ringS : subringPred S) (kS : keyed_pred ringS) x : x \in Cint -> x \in kS. Proof. by case/CintP=> m ->; apply: rpred_int. Qed. Lemma Cint0 : 0 \in Cint. Proof. exact: (Cint_int 0). Qed. Lemma Cint1 : 1 \in Cint. Proof. exact: (Cint_int 1). Qed. Hint Resolve Cint0 Cint1 : core. Fact Cint_key : pred_key Cint. Proof. by []. Qed. Fact Cint_subring : subring_closed Cint. Proof. by split=> // _ _ /CintP[m ->] /CintP[p ->]; rewrite -(rmorphB, rmorphM) Cint_int. Qed. Canonical Cint_keyed := KeyedPred Cint_key. Canonical Cint_opprPred := OpprPred Cint_subring. Canonical Cint_addrPred := AddrPred Cint_subring. Canonical Cint_mulrPred := MulrPred Cint_subring. Canonical Cint_zmodPred := ZmodPred Cint_subring. Canonical Cint_semiringPred := SemiringPred Cint_subring. Canonical Cint_smulrPred := SmulrPred Cint_subring. Canonical Cint_subringPred := SubringPred Cint_subring. Lemma Creal_Cint : {subset Cint <= Creal}. Proof. by move=> _ /CintP[m ->]; apply: realz. Qed. Lemma conj_Cint x : x \in Cint -> x^* = x. Proof. by move/Creal_Cint/conj_Creal. Qed. Lemma Cint_normK x : x \in Cint -> `|x| ^+ 2 = x ^+ 2. Proof. by move/Creal_Cint/real_normK. Qed. Lemma CintEsign x : x \in Cint -> x = (-1) ^+ (x < 0)%C * `|x|. Proof. by move/Creal_Cint/realEsign. Qed. (* Natural integer subset. *) 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]) (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 (le_trans (ler0n _ n)) // (@floorC_def _ n) // addrC -intS. Qed. Lemma natCK n : truncC n%:R = n. Proof. by apply: truncC_def; rewrite lexx ltr_nat /=. Qed. Lemma CnatP x : reflect (exists n, x = n%:R) (x \in Cnat). Proof. by apply: (iffP eqP) => [<- | [n ->]]; [exists (truncC x) | rewrite natCK]. Qed. Lemma truncCK : {in Cnat, cancel truncC (GRing.natmul 1)}. Proof. by move=> x /eqP. Qed. Lemma truncC_gt0 x : (0 < truncC x)%N = (1 <= x). 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: 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)). Proof. by rewrite -truncC_gt0 -eqn0Ngt; apply: eqP. Qed. Lemma truncC0 : truncC 0 = 0%N. Proof. exact: (natCK 0). Qed. Lemma truncC1 : truncC 1 = 1%N. Proof. exact: (natCK 1). Qed. Lemma truncCD : {in Cnat & Num.nneg, {morph truncC : x y / x + y >-> (x + y)%N}}. Proof. move=> _ y /CnatP[n ->] y_ge0; apply: truncC_def. by rewrite -addnS !natrD !natCK ler_add2l ltr_add2l truncC_itv. Qed. Lemma truncCM : {in Cnat &, {morph truncC : x y / x * y >-> (x * y)%N}}. Proof. by move=> _ _ /CnatP[n1 ->] /CnatP[n2 ->]; rewrite -natrM !natCK. Qed. Lemma truncCX n : {in Cnat, {morph truncC : x / x ^+ n >-> (x ^ n)%N}}. Proof. by move=> _ /CnatP[n1 ->]; rewrite -natrX !natCK. Qed. Lemma rpred_Cnat (S : {pred algC}) (ringS : semiringPred S) (kS : keyed_pred ringS) x : x \in Cnat -> x \in kS. Proof. by case/CnatP=> n ->; apply: rpred_nat. Qed. Lemma Cnat_nat n : n%:R \in Cnat. Proof. by apply/CnatP; exists n. Qed. Lemma Cnat0 : 0 \in Cnat. Proof. exact: (Cnat_nat 0). Qed. Lemma Cnat1 : 1 \in Cnat. Proof. exact: (Cnat_nat 1). Qed. Hint Resolve Cnat_nat Cnat0 Cnat1 : core. Fact Cnat_key : pred_key Cnat. Proof. by []. Qed. Fact Cnat_semiring : semiring_closed Cnat. Proof. by do 2![split] => //= _ _ /CnatP[n ->] /CnatP[m ->]; rewrite -(natrD, natrM). Qed. Canonical Cnat_keyed := KeyedPred Cnat_key. Canonical Cnat_addrPred := AddrPred Cnat_semiring. Canonical Cnat_mulrPred := MulrPred Cnat_semiring. Canonical Cnat_semiringPred := SemiringPred Cnat_semiring. Lemma Cnat_ge0 x : x \in Cnat -> 0 <= x. Proof. by case/CnatP=> n ->; apply: ler0n. Qed. Lemma Cnat_gt0 x : x \in Cnat -> (0 < x) = (x != 0). Proof. by case/CnatP=> n ->; rewrite pnatr_eq0 ltr0n lt0n. Qed. Lemma conj_Cnat x : x \in Cnat -> x^* = x. Proof. by case/CnatP=> n ->; apply: rmorph_nat. Qed. Lemma norm_Cnat x : x \in Cnat -> `|x| = x. Proof. by move/Cnat_ge0/ger0_norm. Qed. Lemma Creal_Cnat : {subset Cnat <= Creal}. Proof. by move=> z /conj_Cnat/CrealP. Qed. Lemma Cnat_sum_eq1 (I : finType) (P : pred I) (F : I -> algC) : (forall i, P i -> F i \in Cnat) -> \sum_(i | P i) F i = 1 -> {i : I | [/\ P i, F i = 1 & forall j, j != i -> P j -> F j = 0]}. Proof. move=> natF sumF1; pose nF i := truncC (F i). have{natF} defF i: P i -> F i = (nF i)%:R by move/natF/eqP. have{sumF1} /eqP sumF1: (\sum_(i | P i) nF i == 1)%N. by rewrite -eqC_nat natr_sum -(eq_bigr _ defF) sumF1. have [i Pi nZfi]: {i : I | P i & nF i != 0%N}. by apply/sig2W/exists_inP; rewrite -negb_forall_in -sum_nat_eq0 sumF1. have F'ge0 := (leq0n _, etrans (eq_sym _ _) (sum_nat_eq0 (predD1 P i) nF)). rewrite -lt0n in nZfi; have [_] := (leqif_add (leqif_eq nZfi) (F'ge0 _)). rewrite /= big_andbC -bigD1 // sumF1 => /esym/andP/=[/eqP Fi1 /forall_inP Fi'0]. exists i; split=> // [|j neq_ji Pj]; first by rewrite defF // -Fi1. by rewrite defF // (eqP (Fi'0 j _)) // neq_ji. Qed. Lemma Cnat_mul_eq1 x y : x \in Cnat -> y \in Cnat -> (x * y == 1) = (x == 1) && (y == 1). Proof. by do 2!move/truncCK <-; rewrite -natrM !pnatr_eq1 muln_eq1. Qed. Lemma Cnat_prod_eq1 (I : finType) (P : pred I) (F : I -> algC) : (forall i, P i -> F i \in Cnat) -> \prod_(i | P i) F i = 1 -> forall i, P i -> F i = 1. Proof. move=> natF prodF1; apply/eqfun_inP; rewrite -big_andE. move: prodF1; elim/(big_load (fun x => x \in Cnat)): _. elim/big_rec2: _ => // i all1x x /natF N_Fi [Nx x1all1]. by split=> [|/eqP]; rewrite ?rpredM ?Cnat_mul_eq1 // => /andP[-> /eqP]. Qed. (* Relating Cint and Cnat. *) Lemma Cint_Cnat : {subset Cnat <= Cint}. Proof. by move=> _ /CnatP[n ->]; rewrite pmulrn Cint_int. Qed. Lemma CintE x : (x \in Cint) = (x \in Cnat) || (- x \in Cnat). Proof. apply/idP/idP=> [/CintP[[n | n] ->] | ]; first by rewrite Cnat_nat. by rewrite NegzE opprK Cnat_nat orbT. by case/pred2P=> [<- | /(canLR opprK) <-]; rewrite ?rpredN rpred_nat. Qed. Lemma Cnat_norm_Cint x : x \in Cint -> `|x| \in Cnat. Proof. case/CintP=> [m ->]; rewrite [m]intEsign rmorphM rmorph_sign. by rewrite normrM normr_sign mul1r normr_nat rpred_nat. Qed. Lemma CnatEint x : (x \in Cnat) = (x \in Cint) && (0 <= x). Proof. apply/idP/andP=> [Nx | [Zx x_ge0]]; first by rewrite Cint_Cnat ?Cnat_ge0. by rewrite -(ger0_norm x_ge0) Cnat_norm_Cint. Qed. Lemma CintEge0 x : 0 <= x -> (x \in Cint) = (x \in Cnat). Proof. by rewrite CnatEint andbC => ->. Qed. Lemma Cnat_exp_even x n : ~~ odd n -> x \in Cint -> x ^+ n \in Cnat. Proof. rewrite -dvdn2 => /dvdnP[m ->] Zx; rewrite mulnC exprM -Cint_normK ?rpredX //. exact: Cnat_norm_Cint. Qed. Lemma norm_Cint_ge1 x : x \in Cint -> x != 0 -> 1 <= `|x|. Proof. rewrite -normr_eq0 => /Cnat_norm_Cint/CnatP[n ->]. 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 ?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: le_trans (_ : `|x| <= _); first by rewrite real_ler_norm ?Creal_Cint. by rewrite -Cint_normK // ler_eexpr // norm_Cint_ge1. Qed. (* Integer divisibility. *) Lemma dvdCP x y : reflect (exists2 z, z \in Cint & y = z * x) (x %| y)%C. Proof. rewrite unfold_in; have [-> | nz_x] := eqVneq. by apply: (iffP eqP) => [-> | [z _ ->]]; first exists 0; rewrite ?mulr0. apply: (iffP idP) => [Zyx | [z Zz ->]]; last by rewrite mulfK. by exists (y / x); rewrite ?divfK. Qed. 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 le_eqVlt => /predU1P[<- | ]; first by exists 22; rewrite !mulr0. by move=> /pmulr_lge0-> /CintEge0-> /CnatP[n ->]; exists n. Qed. Lemma dvdC0 x : (x %| 0)%C. Proof. by apply/dvdCP; exists 0; rewrite ?mul0r. Qed. Lemma dvd0C x : (0 %| x)%C = (x == 0). Proof. by rewrite unfold_in eqxx. Qed. Lemma dvdC_mull x y z : y \in Cint -> (x %| z)%C -> (x %| y * z)%C. Proof. move=> Zy /dvdCP[m Zm ->]; apply/dvdCP. by exists (y * m); rewrite ?mulrA ?rpredM. Qed. Lemma dvdC_mulr x y z : y \in Cint -> (x %| z)%C -> (x %| z * y)%C. Proof. by rewrite mulrC; apply: dvdC_mull. Qed. Lemma dvdC_mul2r x y z : y != 0 -> (x * y %| z * y)%C = (x %| z)%C. Proof. move=> nz_y; rewrite !unfold_in !(mulIr_eq0 _ (mulIf nz_y)). by rewrite mulrAC invfM mulrA divfK. Qed. Lemma dvdC_mul2l x y z : y != 0 -> (y * x %| y * z)%C = (x %| z)%C. Proof. by rewrite !(mulrC y); apply: dvdC_mul2r. Qed. Lemma dvdC_trans x y z : (x %| y)%C -> (y %| z)%C -> (x %| z)%C. Proof. by move=> x_dv_y /dvdCP[m Zm ->]; apply: dvdC_mull. Qed. Lemma dvdC_refl x : (x %| x)%C. Proof. by apply/dvdCP; exists 1; rewrite ?mul1r. Qed. Hint Resolve dvdC_refl : core. Fact dvdC_key x : pred_key (dvdC x). Proof. by []. Qed. Lemma dvdC_zmod x : zmod_closed (dvdC x). Proof. split=> [| _ _ /dvdCP[y Zy ->] /dvdCP[z Zz ->]]; first exact: dvdC0. by rewrite -mulrBl dvdC_mull ?rpredB. Qed. Canonical dvdC_keyed x := KeyedPred (dvdC_key x). Canonical dvdC_opprPred x := OpprPred (dvdC_zmod x). Canonical dvdC_addrPred x := AddrPred (dvdC_zmod x). Canonical dvdC_zmodPred x := ZmodPred (dvdC_zmod x). Lemma dvdC_nat (p n : nat) : (p %| n)%C = (p %| n)%N. Proof. rewrite unfold_in CintEge0 ?divr_ge0 ?invr_ge0 ?ler0n // !pnatr_eq0. have [-> | nz_p] := eqVneq; first by rewrite dvd0n. apply/CnatP/dvdnP=> [[q def_q] | [q ->]]; exists q. by apply/eqP; rewrite -eqC_nat natrM -def_q divfK ?pnatr_eq0. by rewrite [num in num / _]natrM mulfK ?pnatr_eq0. Qed. Lemma dvdC_int (p : nat) x : x \in Cint -> (p %| x)%C = (p %| `|floorC x|)%N. Proof. move=> Zx; rewrite -{1}(floorCK Zx) {1}[floorC x]intEsign. by rewrite rmorphMsign rpredMsign dvdC_nat. Qed. (* Elementary modular arithmetic. *) Lemma eqCmod_refl e x : (x == x %[mod e])%C. Proof. by rewrite /eqCmod subrr rpred0. Qed. Lemma eqCmodm0 e : (e == 0 %[mod e])%C. Proof. by rewrite /eqCmod subr0. Qed. Hint Resolve eqCmod_refl eqCmodm0 : core. Lemma eqCmod0 e x : (x == 0 %[mod e])%C = (e %| x)%C. Proof. by rewrite /eqCmod subr0. Qed. Lemma eqCmod_sym e x y : ((x == y %[mod e]) = (y == x %[mod e]))%C. Proof. by rewrite /eqCmod -opprB rpredN. Qed. Lemma eqCmod_trans e y x z : (x == y %[mod e] -> y == z %[mod e] -> x == z %[mod e])%C. Proof. by move=> Exy Eyz; rewrite /eqCmod -[x](subrK y) -addrA rpredD. Qed. Lemma eqCmod_transl e x y z : (x == y %[mod e])%C -> (x == z %[mod e])%C = (y == z %[mod e])%C. Proof. by move/(sym_left_transitive (eqCmod_sym e) (@eqCmod_trans e)). Qed. Lemma eqCmod_transr e x y z : (x == y %[mod e])%C -> (z == x %[mod e])%C = (z == y %[mod e])%C. Proof. by move/(sym_right_transitive (eqCmod_sym e) (@eqCmod_trans e)). Qed. Lemma eqCmodN e x y : (- x == y %[mod e])%C = (x == - y %[mod e])%C. Proof. by rewrite eqCmod_sym /eqCmod !opprK addrC. Qed. Lemma eqCmodDr e x y z : (y + x == z + x %[mod e])%C = (y == z %[mod e])%C. Proof. by rewrite /eqCmod addrAC opprD !addrA subrK. Qed. Lemma eqCmodDl e x y z : (x + y == x + z %[mod e])%C = (y == z %[mod e])%C. Proof. by rewrite !(addrC x) eqCmodDr. Qed. Lemma eqCmodD e x1 x2 y1 y2 : (x1 == x2 %[mod e] -> y1 == y2 %[mod e] -> x1 + y1 == x2 + y2 %[mod e])%C. Proof. by rewrite -(eqCmodDl e x2 y1) -(eqCmodDr e y1); apply: eqCmod_trans. Qed. Lemma eqCmod_nat (e m n : nat) : (m == n %[mod e])%C = (m == n %[mod e]). Proof. without loss lenm: m n / (n <= m)%N. by move=> IH; case/orP: (leq_total m n) => /IH //; rewrite eqCmod_sym eq_sym. by rewrite /eqCmod -natrB // dvdC_nat eqn_mod_dvd. Qed. Lemma eqCmod0_nat (e m : nat) : (m == 0 %[mod e])%C = (e %| m)%N. Proof. by rewrite eqCmod0 dvdC_nat. Qed. Lemma eqCmodMr e : {in Cint, forall z x y, x == y %[mod e] -> x * z == y * z %[mod e]}%C. Proof. by move=> z Zz x y; rewrite /eqCmod -mulrBl => /dvdC_mulr->. Qed. Lemma eqCmodMl e : {in Cint, forall z x y, x == y %[mod e] -> z * x == z * y %[mod e]}%C. Proof. by move=> z Zz x y Exy; rewrite !(mulrC z) eqCmodMr. Qed. Lemma eqCmodMl0 e : {in Cint, forall x, x * e == 0 %[mod e]}%C. Proof. by move=> x Zx; rewrite -(mulr0 x) eqCmodMl. Qed. Lemma eqCmodMr0 e : {in Cint, forall x, e * x == 0 %[mod e]}%C. Proof. by move=> x Zx; rewrite /= mulrC eqCmodMl0. Qed. Lemma eqCmod_addl_mul e : {in Cint, forall x y, x * e + y == y %[mod e]}%C. Proof. by move=> x Zx y; rewrite -{2}[y]add0r eqCmodDr eqCmodMl0. Qed. Lemma eqCmodM e : {in Cint & Cint, forall x1 y2 x2 y1, x1 == x2 %[mod e] -> y1 == y2 %[mod e] -> x1 * y1 == x2 * y2 %[mod e]}%C. Proof. move=> x1 y2 Zx1 Zy2 x2 y1 eq_x /(eqCmodMl Zx1)/eqCmod_trans-> //. exact: eqCmodMr. Qed. (* Rational number subset. *) Lemma ratCK : cancel QtoC CtoQ. Proof. by rewrite /getCrat; case: getCrat_subproof. Qed. Lemma getCratK : {in Crat, cancel CtoQ QtoC}. Proof. by move=> x /eqP. Qed. Lemma Crat_rat (a : rat) : QtoC a \in Crat. Proof. by rewrite unfold_in ratCK. Qed. Lemma CratP x : reflect (exists a, x = QtoC a) (x \in Crat). Proof. by apply: (iffP eqP) => [<- | [a ->]]; [exists (CtoQ x) | rewrite ratCK]. Qed. Lemma Crat0 : 0 \in Crat. Proof. by apply/CratP; exists 0; rewrite rmorph0. Qed. Lemma Crat1 : 1 \in Crat. Proof. by apply/CratP; exists 1; rewrite rmorph1. Qed. Hint Resolve Crat0 Crat1 : core. Fact Crat_key : pred_key Crat. Proof. by []. Qed. Fact Crat_divring_closed : divring_closed Crat. Proof. split=> // _ _ /CratP[x ->] /CratP[y ->]. by rewrite -rmorphB Crat_rat. by rewrite -fmorph_div Crat_rat. Qed. Canonical Crat_keyed := KeyedPred Crat_key. Canonical Crat_opprPred := OpprPred Crat_divring_closed. Canonical Crat_addrPred := AddrPred Crat_divring_closed. Canonical Crat_mulrPred := MulrPred Crat_divring_closed. Canonical Crat_zmodPred := ZmodPred Crat_divring_closed. Canonical Crat_semiringPred := SemiringPred Crat_divring_closed. Canonical Crat_smulrPred := SmulrPred Crat_divring_closed. Canonical Crat_divrPred := DivrPred Crat_divring_closed. Canonical Crat_subringPred := SubringPred Crat_divring_closed. Canonical Crat_sdivrPred := SdivrPred Crat_divring_closed. Canonical Crat_divringPred := DivringPred Crat_divring_closed. Lemma rpred_Crat (S : {pred algC}) (ringS : divringPred S) (kS : keyed_pred ringS) : {subset Crat <= kS}. Proof. by move=> _ /CratP[a ->]; apply: rpred_rat. Qed. Lemma conj_Crat z : z \in Crat -> z^* = z. Proof. by move/getCratK <-; rewrite fmorph_div !rmorph_int. Qed. Lemma Creal_Crat : {subset Crat <= Creal}. Proof. by move=> x /conj_Crat/CrealP. Qed. Lemma Cint_rat a : (QtoC a \in Cint) = (a \in Qint). Proof. apply/idP/idP=> [Za | /numqK <-]; last by rewrite rmorph_int Cint_int. apply/QintP; exists (floorC (QtoC a)); apply: (can_inj ratCK). by rewrite rmorph_int floorCK. Qed. Lemma minCpolyP x : {p | minCpoly x = pQtoC p /\ p \is monic & forall q, root (pQtoC q) x = (p %| q)%R}. Proof. by rewrite /minCpoly; case: (minCpoly_subproof x) => p; exists p. Qed. Lemma minCpoly_monic x : minCpoly x \is monic. Proof. by have [p [-> mon_p] _] := minCpolyP x; rewrite map_monic. Qed. Lemma minCpoly_eq0 x : (minCpoly x == 0) = false. Proof. exact/negbTE/monic_neq0/minCpoly_monic. Qed. Lemma root_minCpoly x : root (minCpoly x) x. Proof. by have [p [-> _] ->] := minCpolyP x. Qed. Lemma size_minCpoly x : (1 < size (minCpoly x))%N. Proof. by apply: root_size_gt1 (root_minCpoly x); rewrite ?minCpoly_eq0. Qed. (* Basic properties of automorphisms. *) Section AutC. Implicit Type nu : {rmorphism algC -> algC}. Lemma aut_Cnat nu : {in Cnat, nu =1 id}. Proof. by move=> _ /CnatP[n ->]; apply: rmorph_nat. Qed. Lemma aut_Cint nu : {in Cint, nu =1 id}. Proof. by move=> _ /CintP[m ->]; apply: rmorph_int. Qed. Lemma aut_Crat nu : {in Crat, nu =1 id}. Proof. by move=> _ /CratP[a ->]; apply: fmorph_rat. Qed. Lemma Cnat_aut nu x : (nu x \in Cnat) = (x \in Cnat). Proof. by do [apply/idP/idP=> Nx; have:= aut_Cnat nu Nx] => [/fmorph_inj <- | ->]. Qed. Lemma Cint_aut nu x : (nu x \in Cint) = (x \in Cint). Proof. by rewrite !CintE -rmorphN !Cnat_aut. Qed. Lemma Crat_aut nu x : (nu x \in Crat) = (x \in Crat). Proof. apply/idP/idP=> /CratP[a] => [|->]; last by rewrite fmorph_rat Crat_rat. by rewrite -(fmorph_rat nu) => /fmorph_inj->; apply: Crat_rat. Qed. Lemma algC_invaut_subproof nu x : {y | nu y = x}. Proof. have [r Dp] := closed_field_poly_normal (minCpoly x). suffices /mapP/sig2_eqW[y _ ->]: x \in map nu r by exists y. rewrite -root_prod_XsubC; congr (root _ x): (root_minCpoly x). have [q [Dq _] _] := minCpolyP x; rewrite Dq -(eq_map_poly (fmorph_rat nu)). rewrite (map_poly_comp nu) -{q}Dq Dp (monicP (minCpoly_monic x)) scale1r. rewrite rmorph_prod big_map; apply: eq_bigr => z _. by rewrite rmorphB /= map_polyX map_polyC. Qed. Definition algC_invaut nu x := sval (algC_invaut_subproof nu x). Lemma algC_invautK nu : cancel (algC_invaut nu) nu. Proof. by move=> x; rewrite /algC_invaut; case: algC_invaut_subproof. Qed. Lemma algC_autK nu : cancel nu (algC_invaut nu). Proof. exact: inj_can_sym (algC_invautK nu) (fmorph_inj nu). Qed. Fact algC_invaut_is_rmorphism nu : rmorphism (algC_invaut nu). Proof. exact: can2_rmorphism (algC_autK nu) (algC_invautK nu). Qed. Canonical algC_invaut_additive nu := Additive (algC_invaut_is_rmorphism nu). Canonical algC_invaut_rmorphism nu := RMorphism (algC_invaut_is_rmorphism nu). Lemma minCpoly_aut nu x : minCpoly (nu x) = minCpoly x. Proof. wlog suffices dvd_nu: nu x / (minCpoly x %| minCpoly (nu x))%R. apply/eqP; rewrite -eqp_monic ?minCpoly_monic //; apply/andP; split=> //. by rewrite -{2}(algC_autK nu x) dvd_nu. have [[q [Dq _] min_q] [q1 [Dq1 _] _]] := (minCpolyP x, minCpolyP (nu x)). rewrite Dq Dq1 dvdp_map -min_q -(fmorph_root nu) -map_poly_comp. by rewrite (eq_map_poly (fmorph_rat nu)) -Dq1 root_minCpoly. Qed. End AutC. Section AutLmodC. Variables (U V : lmodType algC) (f : {additive U -> V}). Lemma raddfZ_Cnat a u : a \in Cnat -> f (a *: u) = a *: f u. Proof. by case/CnatP=> n ->; apply: raddfZnat. Qed. Lemma raddfZ_Cint a u : a \in Cint -> f (a *: u) = a *: f u. Proof. by case/CintP=> m ->; rewrite !scaler_int raddfMz. Qed. End AutLmodC. Section PredCmod. Variable V : lmodType algC. Lemma rpredZ_Cnat S (addS : @addrPred V S) (kS : keyed_pred addS) : {in Cnat & kS, forall z u, z *: u \in kS}. Proof. by move=> _ u /CnatP[n ->]; apply: rpredZnat. Qed. Lemma rpredZ_Cint S (subS : @zmodPred V S) (kS : keyed_pred subS) : {in Cint & kS, forall z u, z *: u \in kS}. Proof. by move=> _ u /CintP[m ->]; apply: rpredZint. Qed. End PredCmod. End AlgebraicsTheory. Hint Resolve Creal0 Creal1 Cnat_nat Cnat0 Cnat1 Cint0 Cint1 floorC0 Crat0 Crat1 : core. Hint Resolve dvdC0 dvdC_refl eqCmod_refl eqCmodm0 : core. math-comp-mathcomp-1.12.0/mathcomp/field/algebraics_fundamentals.v000066400000000000000000001500651375767750300252400ustar00rootroot00000000000000(* (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 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 *) (* construction of the algebraic numbers in file algC.v. This theorem simply *) (* asserts the existence of an algebraically closed field with an *) (* automorphism of order 2, and dubbed the Fundamental_Theorem_of_Algebraics *) (* because it is essentially the Fundamental Theorem of Algebra for algebraic *) (* numbers (the more familiar version for complex numbers can be derived by *) (* continuity). *) (* Although our proof does indeed construct exactly the algebraics, we *) (* choose not to expose this in the statement of our Theorem. In algC.v we *) (* construct the norm and partial order of the "complex field" introduced by *) (* the Theorem; as these imply is has characteristic 0, we then get the *) (* algebraics as a subfield. To avoid some duplication a few basic properties *) (* of the algebraics, such as the existence of minimal polynomials, that are *) (* required by the proof of the Theorem, are also proved here. *) (* The main theorem of closed_field supplies us directly with an algebraic *) (* closure of the rationals (as the rationals are a countable field), so all *) (* we really need to construct is a conjugation automorphism that exchanges *) (* the two roots (i and -i) of X^2 + 1, and fixes a (real) subfield of *) (* index 2. This does not require actually constructing this field: the *) (* kHomExtend construction from galois.v supplies us with an automorphism *) (* conj_n of the number field Q[z_n] = Q[x_n, i] for any x_n such that Q[x_n] *) (* does not contain i (e.g., such that Q[x_n] is real). As conj_n will extend *) (* conj_m when Q[x_n] contains x_m, it therefore suffices to construct a *) (* sequence x_n such that *) (* (1) For each n, Q[x_n] is a REAL field containing Q[x_m] for all m <= n. *) (* (2) Each z in C belongs to Q[z_n] = Q[x_n, i] for large enough n. *) (* This, of course, amounts to proving the Fundamental Theorem of Algebra. *) (* Indeed, we use a constructive variant of Artin's algebraic proof of that *) (* Theorem to replace (2) by *) (* (3) Each monic polynomial over Q[x_m] whose constant term is -c^2 for some *) (* c in Q[x_m] has a root in Q[x_n] for large enough n. *) (* We then ensure (3) by setting Q[x_n+1] = Q[x_n, y] where y is the root of *) (* of such a polynomial p found by dichotomy in some interval [0, b] with b *) (* suitably large (such that p[b] >= 0), and p is obtained by decoding n into *) (* a triple (m, p, c) that satisfies the conditions of (3) (taking x_n+1=x_n *) (* if this is not the case), thereby ensuring that all such triples are *) (* ultimately considered. *) (* In more detail, the 600-line proof consists in six (uneven) parts: *) (* (A) - Construction of number fields (~ 100 lines): in order to make use of *) (* the theory developped in falgebra, fieldext, separable and galois we *) (* construct a separate fielExtType Q z for the number field Q[z], with *) (* z in C, the closure of rat supplied by countable_algebraic_closure. *) (* The morphism (ofQ z) maps Q z to C, and the Primitive Element Theorem *) (* lets us define a predicate sQ z characterizing the image of (ofQ z), *) (* as well as a partial inverse (inQ z) to (ofQ z). *) (* (B) - Construction of the real extension Q[x, y] (~ 230 lines): here y has *) (* to be a root of a polynomial p over Q[x] satisfying the conditions of *) (* (3), and Q[x] should be real and archimedean, which we represent by *) (* a morphism from Q x to some archimedean field R, as the ssrnum and *) (* fieldext structures are not compatible. The construction starts by *) (* weakening the condition p[0] = -c^2 to p[0] <= 0 (in R), then reducing *) (* to the case where p is the minimal polynomial over Q[x] of some y (in *) (* some Q[w] that contains x and all roots of p). Then we only need to *) (* construct a realFieldType structure for Q[t] = Q[x,y] (we don't even *) (* need to show it is consistent with that of R). This amounts to fixing *) (* the sign of all z != 0 in Q[t], consistently with arithmetic in Q[t]. *) (* Now any such z is equal to q[y] for some q in Q[x][X] coprime with p. *) (* Then up + vq = 1 for Bezout coefficients u and v. As p is monic, there *) (* is some b0 >= 0 in R such that p changes sign in ab0 = [0; b0]. As R *) (* is archimedean, some iteration of the binary search for a root of p in *) (* ab0 will yield an interval ab_n such that |up[d]| < 1/2 for d in ab_n. *) (* Then |q[d]| > 1/2M > 0 for any upper bound M on |v[X]| in ab0, so q *) (* cannot change sign in ab_n (as then root-finding in ab_n would yield a *) (* d with |Mq[d]| < 1/2), so we can fix the sign of z to that of q in *) (* ab_n. *) (* (C) - Construction of the x_n and z_n (~50 lines): x_ n is obtained by *) (* iterating (B), starting with x_0 = 0, and then (A) and the PET yield *) (* z_ n. We establish (1) and (3), and that the minimal polynomial of the *) (* preimage i_ n of i over the preimage R_ n of Q[x_n] is X^2 + 1. *) (* (D) - Establish (2), i.e., prove the FTA (~180 lines). We must depart from *) (* Artin's proof because deciding membership in the union of the Q[x_n] *) (* requires the FTA, i.e., we cannot (yet) construct a maximal real *) (* subfield of C. We work around this issue by first reducing to the case *) (* where Q[z] is Galois over Q and contains i, then using induction over *) (* the degree of z over Q[z_ n] (i.e., the degree of a monic polynomial *) (* over Q[z_n] that has z as a root). We can assume that z is not in *) (* Q[z_n]; then it suffices to find some y in Q[z_n, z] \ Q[z_n] that is *) (* also in Q[z_m] for some m > n, as then we can apply induction with the *) (* minimal polynomial of z over Q[z_n, y]. In any Galois extension Q[t] *) (* of Q that contains both z and z_n, Q[x_n, z] = Q[z_n, z] is Galois *) (* over both Q[x_n] and Q[z_n]. If Gal(Q[x_n,z] / Q[x_n]) isn't a 2-group *) (* take one of its Sylow 2-groups P; the minimal polynomial p of any *) (* generator of the fixed field F of P over Q[x_n] has odd degree, hence *) (* by (3) - p[X]p[-X] and thus p has a root y in some Q[x_m], hence in *) (* Q[z_m]. As F is normal, y is in F, with minimal polynomial p, and y *) (* is not in Q[z_n] = Q[x_n, i] since p has odd degree. Otherwise, *) (* Gal(Q[z_n,z] / Q[z_n]) is a proper 2-group, and has a maximal subgroup *) (* P of index 2. The fixed field F of P has a generator w over Q[z_n] *) (* with w^2 in Q[z_n] \ Q[x_n], i.e. w^2 = u + 2iv with v != 0. From (3) *) (* X^4 - uX^2 - v^2 has a root x in some Q[x_m]; then x != 0 as v != 0, *) (* hence w^2 = y^2 for y = x + iv/x in Q[z_m], and y generates F. *) (* (E) - Construct conj and conclude (~40 lines): conj z is defined as *) (* conj_ n z with the n provided by (2); since each conj_ m is a morphism *) (* of order 2 and conj z = conj_ m z for any m >= n, it follows that conj *) (* is also a morphism of order 2. *) (* Note that (C), (D) and (E) only depend on Q[x_n] not containing i; the *) (* order structure is not used (hence we need not prove that the ordering of *) (* Q[x_m] is consistent with that of Q[x_n] for m >= n). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GroupScope GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Local Notation "p ^@" := (p ^ in_alg _) (at level 2, format "p ^@"): ring_scope. Local Notation "<< E ; u >>" := <>%VS. Local Notation Qmorphism C := {rmorphism rat -> C}. 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. 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_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: lt_le_trans; rewrite mulrDl mul1r ltr_spaddr // -sumrN. rewrite natr_sum mulr_suml ler_sum // => j _. 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 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 (le_trans _ lb_x) // -natrD addn1 ler1n. Qed. Definition decidable_embedding sT T (f : sT -> T) := forall y, decidable (exists x, y = f x). Lemma rat_algebraic_decidable (C : fieldType) (QtoC : Qmorphism C) : integralRange QtoC -> decidable_embedding QtoC. Proof. have QtoCinj: injective QtoC by apply: fmorph_inj. pose ZtoQ : int -> rat := intr; pose ZtoC : int -> C := intr. have ZtoQinj: injective ZtoQ by apply: intr_inj. have defZtoC: ZtoC =1 QtoC \o ZtoQ by move=> m; rewrite /= rmorph_int. move=> algC x; have /sig2_eqW[q mon_q qx0] := algC x; pose d := (size q).-1. have [n ub_n]: {n | forall y, root q y -> `|y| < n}. have [n1 ub_n1] := monic_Cauchy_bound mon_q. 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_coefN lead_coefX (monicP mon_q) (mulrC 1) signrMK. exists (Num.max 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]. have [/sig2_eqW[y _ ->] | xa'x] := @mapP _ _ QtoC xa x; first by left; exists y. right=> [[y Dx]]; case: xa'x; exists y => //. have{x Dx qx0} qy0: root q y by rewrite Dx fmorph_root in qx0. have /dvdzP[b Da]: (denq y %| a)%Z. have /Gauss_dvdzl <-: coprimez (denq y) (numq y ^+ d). by rewrite coprimez_sym coprimezXl //; apply: coprime_num_den. pose p1 : {poly int} := a *: 'X^d - p. have Dp1: p1 ^ intr = a%:~R *: ('X^d - q). by rewrite rmorphB linearZ /= map_polyXn scalerBr Dq scalerKV ?intr_eq0. apply/dvdzP; exists (\sum_(i < d) p1`_i * numq y ^+ i * denq y ^+ (d - i.+1)). apply: ZtoQinj; rewrite /ZtoQ rmorphM mulr_suml rmorph_sum /=. transitivity ((p1 ^ intr).[y] * (denq y ^+ d)%:~R). rewrite Dp1 !hornerE hornerXn (rootP qy0) subr0. by rewrite !rmorphX /= numqE exprMn mulrA. have sz_p1: (size (p1 ^ ZtoQ)%R <= d)%N. rewrite Dp1 size_scale ?intr_eq0 //; apply/leq_sizeP=> i. rewrite leq_eqVlt eq_sym -polySpred ?monic_neq0 // coefB coefXn. case: eqP => [-> _ | _ /(nth_default 0)->//]. by rewrite -lead_coefE (monicP mon_q). rewrite (horner_coef_wide _ sz_p1) mulr_suml; apply: eq_bigr => i _. rewrite -!mulrA -exprSr coef_map !rmorphM !rmorphX /= numqE exprMn -mulrA. by rewrite -exprD -addSnnS subnKC. pose m := `|(numq y * b + N)%R|%N. 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: 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 (le_lt_trans (ler_norm_add _ _)) // normr_nat ltr_add2r. rewrite Dm ger0_norm ?addrK ?mulfK ?intr_eq0 // -ler_subl_addl sub0r. by rewrite (le_trans (ler_norm _)) ?normrN ?ltW. Qed. Lemma minPoly_decidable_closure (F : fieldType) (L : closedFieldType) (FtoL : {rmorphism F -> L}) x : decidable_embedding FtoL -> integralOver FtoL x -> {p | [/\ p \is monic, root (p ^ FtoL) x & irreducible_poly p]}. Proof. move=> isF /sig2W[p /monicP mon_p px0]. have [r Dp] := closed_field_poly_normal (p ^ FtoL); pose n := size r. rewrite lead_coef_map {}mon_p rmorph1 scale1r in Dp. pose Fpx q := (q \is a polyOver isF) && root q x. have FpxF q: Fpx (q ^ FtoL) = root (q ^ FtoL) x. by rewrite /Fpx polyOver_poly // => j _; apply/sumboolP; exists q`_j. pose p_ (I : {set 'I_n}) := \prod_(i <- enum I) ('X - (r`_i)%:P). have{px0 Dp} /ex_minset[I /minsetP[/andP[FpI pIx0] minI]]: exists I, Fpx (p_ I). exists setT; suffices ->: p_ setT = p ^ FtoL by rewrite FpxF. rewrite Dp (big_nth 0) big_mkord /p_ big_enum /=. by apply/eq_bigl=> i; rewrite inE. have{p} [p DpI]: {p | p_ I = p ^ FtoL}. exists (p_ I ^ (fun y => if isF y is left Fy then sval (sig_eqW Fy) else 0)). rewrite -map_poly_comp map_poly_id // => y /(allP FpI) /=. by rewrite unfold_in; case: (isF y) => // Fy _; case: (sig_eqW _). have mon_pI: p_ I \is monic by apply: monic_prod_XsubC. have mon_p: p \is monic by rewrite -(map_monic FtoL) -DpI. exists p; rewrite -DpI; split=> //; split=> [|q nCq q_dv_p]. by rewrite -(size_map_poly FtoL) -DpI (root_size_gt1 _ pIx0) ?monic_neq0. rewrite -dvdp_size_eqp //; apply/eqP. without loss mon_q: q nCq q_dv_p / q \is monic. move=> IHq; pose a := lead_coef q; pose q1 := a^-1 *: q. have nz_a: a != 0 by rewrite lead_coef_eq0 (dvdpN0 q_dv_p) ?monic_neq0. have /IHq IHq1: q1 \is monic by rewrite monicE lead_coefZ mulVf. by rewrite -IHq1 ?size_scale ?dvdpZl ?invr_eq0. without loss{nCq} qx0: q mon_q q_dv_p / root (q ^ FtoL) x. have /dvdpP[q1 Dp] := q_dv_p; rewrite DpI Dp rmorphM rootM -implyNb in pIx0. have mon_q1: q1 \is monic by rewrite Dp monicMr in mon_p. move=> IH; apply: (IH) (implyP pIx0 _) => //; apply: contra nCq => /IH IHq1. rewrite -(subnn (size q1)) {1}IHq1 ?Dp ?dvdp_mulr // polySpred ?monic_neq0 //. by rewrite eqSS size_monicM ?monic_neq0 // -!subn1 subnAC addKn. have /dvdp_prod_XsubC[m Dq]: q ^ FtoL %| p_ I by rewrite DpI dvdp_map. pose B := [set j in mask m (enum I)]; have{} Dq: q ^ FtoL = p_ B. apply/eqP; rewrite -eqp_monic ?monic_map ?monic_prod_XsubC //. congr (_ %= _): Dq; apply: perm_big => //. by rewrite uniq_perm ?mask_uniq ?enum_uniq // => j; rewrite mem_enum inE. rewrite -!(size_map_poly FtoL) Dq -DpI (minI B) // -?Dq ?FpxF //. by apply/subsetP=> j; rewrite inE => /mem_mask; rewrite mem_enum. Qed. Lemma alg_integral (F : fieldType) (L : fieldExtType F) : integralRange (in_alg L). Proof. move=> x; have [/polyOver1P[p Dp]] := (minPolyOver 1 x, monic_minPoly 1 x). by rewrite Dp map_monic; exists p; rewrite // -Dp root_minPoly. Qed. Prenex Implicits alg_integral. Import DefaultKeying GRing.DefaultPred. Arguments map_poly_inj {F R} f [p1 p2]. Theorem Fundamental_Theorem_of_Algebraics : {L : closedFieldType & {conj : {rmorphism L -> L} | involutive conj & ~ conj =1 id}}. Proof. have maxn3 n1 n2 n3: {m | [/\ n1 <= m, n2 <= m & n3 <= m]%N}. by exists (maxn n1 (maxn n2 n3)); apply/and3P; rewrite -!geq_max. have [C [/= QtoC algC]] := countable_algebraic_closure [countFieldType of rat]. exists C; have [i Di2] := GRing.imaginary_exists C. pose Qfield := fieldExtType rat; pose Cmorph (L : Qfield) := {rmorphism L -> C}. have charQ (L : Qfield): [char L] =i pred0 := ftrans (char_lalg L) (char_num _). have sepQ (L : Qfield) (K E : {subfield L}): separable K E. by apply/separableP=> u _; apply: charf0_separable. pose genQfield z L := {LtoC : Cmorph L & {u | LtoC u = z & <<1; u>> = fullv}}. have /all_tag[Q /all_tag[ofQ genQz]] z: {Qz : Qfield & genQfield z Qz}. have [|p [/monic_neq0 nzp pz0 irr_p]] := minPoly_decidable_closure _ (algC z). exact: rat_algebraic_decidable. pose Qz := SubFieldExtType pz0 irr_p. pose QzC := subfx_inj_rmorphism QtoC z p. exists Qz, QzC, (subfx_root QtoC z p); first exact: subfx_inj_root. apply/vspaceP=> u; rewrite memvf; apply/Fadjoin1_polyP. by have [q] := subfxEroot pz0 nzp u; exists q. have pQof z p: p^@ ^ ofQ z = p ^ QtoC. by rewrite -map_poly_comp; apply: eq_map_poly => x; rewrite !fmorph_eq_rat. have pQof2 z p u: ofQ z p^@.[u] = (p ^ QtoC).[ofQ z u]. by rewrite -horner_map pQof. have PET_Qz z (E : {subfield Q z}): {u | <<1; u>> = E}. exists (separable_generator 1 E). by rewrite -eq_adjoin_separable_generator ?sub1v. pose gen z x := exists q, x = (q ^ QtoC).[z]. have PET2 x y: {z | gen z x & gen z y}. pose Gxy := (x, y) = let: (p, q, z) := _ in ((p ^ QtoC).[z], (q ^ QtoC).[z]). suffices [[[p q] z] []]: {w | Gxy w} by exists z; [exists p | exists q]. apply/sig_eqW; have /integral_algebraic[px nz_px pxx0] := algC x. have /integral_algebraic[py nz_py pyy0] := algC y. have [n [[p Dx] [q Dy]]] := char0_PET nz_px pxx0 nz_py pyy0 (char_num _). by exists (p, q, y *+ n - x); congr (_, _). have gen_inQ z x: gen z x -> {u | ofQ z u = x}. have [u Dz _] := genQz z => /sig_eqW[q ->]. by exists q^@.[u]; rewrite pQof2 Dz. have gen_ofP z u v: reflect (gen (ofQ z u) (ofQ z v)) (v \in <<1; u>>). apply: (iffP Fadjoin1_polyP) => [[q ->]|]; first by rewrite pQof2; exists q. by case=> q; rewrite -pQof2 => /fmorph_inj->; exists q. have /all_tag[sQ genP] z: {s : pred C & forall x, reflect (gen z x) (x \in s)}. apply: all_tag (fun x => reflect (gen z x)) _ => x. have [w /gen_inQ[u <-] /gen_inQ[v <-]] := PET2 z x. by exists (v \in <<1; u>>)%VS; apply: gen_ofP. have sQtrans: transitive (fun x z => x \in sQ z). move=> x y z /genP[p ->] /genP[q ->]; apply/genP; exists (p \Po q). by rewrite map_comp_poly horner_comp. have sQid z: z \in sQ z by apply/genP; exists 'X; rewrite map_polyX hornerX. have{gen_ofP} sQof2 z u v: (ofQ z u \in sQ (ofQ z v)) = (u \in <<1; v>>%VS). exact/genP/(gen_ofP z). have sQof z v: ofQ z v \in sQ z. by have [u Dz defQz] := genQz z; rewrite -[in sQ z]Dz sQof2 defQz memvf. have{gen_inQ} sQ_inQ z x z_x := gen_inQ z x (genP z x z_x). have /all_sig[inQ inQ_K] z: {inQ | {in sQ z, cancel inQ (ofQ z)}}. by apply: all_sig_cond (fun x u => ofQ z u = x) 0 _ => x /sQ_inQ. have ofQ_K z: cancel (ofQ z) (inQ z). by move=> x; have /inQ_K/fmorph_inj := sQof z x. have sQring z: divring_closed (sQ z). have sQ_1: 1 \in sQ z by rewrite -(rmorph1 (ofQ z)) sQof. by split=> // x y /inQ_K<- /inQ_K<- /=; rewrite -(rmorphB, fmorph_div) sQof. have sQopp z : oppr_closed (sQ z) := sQring z. have sQadd z : addr_closed (sQ z) := sQring z. have sQmul z : mulr_closed (sQ z) := sQring z. have sQinv z : invr_closed (sQ z) := sQring z. pose morph_ofQ x z Qxz := forall u, ofQ z (Qxz u) = ofQ x u. have QtoQ z x: x \in sQ z -> {Qxz : 'AHom(Q x, Q z) | morph_ofQ x z Qxz}. move=> z_x; pose Qxz u := inQ z (ofQ x u). have QxzE u: ofQ z (Qxz u) = ofQ x u by apply/inQ_K/(sQtrans x). suffices /rat_lrmorphism QxzM: rmorphism Qxz. by exists (linfun_ahom (LRMorphism QxzM)) => u; rewrite lfunE QxzE. split=> [u v|]; first by apply: (canLR (ofQ_K z)); rewrite !rmorphB !QxzE. by split=> [u v|]; apply: (canLR (ofQ_K z)); rewrite ?rmorph1 ?rmorphM ?QxzE. pose sQs z s := all (mem (sQ z)) s. have inQsK z s: sQs z s -> map (ofQ z) (map (inQ z) s) = s. by rewrite -map_comp => /allP/(_ _ _)/inQ_K; apply: map_id_in. have inQpK z p: p \is a polyOver (sQ z) -> (p ^ inQ z) ^ ofQ z = p. by move=> /allP/(_ _ _)/inQ_K/=/map_poly_id; rewrite -map_poly_comp. have{gen PET2 genP} PET s: {z | sQs z s & <<1 & map (inQ z) s>>%VS = fullv}. have [y /inQsK Ds]: {y | sQs y s}. elim: s => [|x s /= [y IHs]]; first by exists 0. have [z /genP z_x /genP z_y] := PET2 x y. by exists z; rewrite /= {x}z_x; apply: sub_all IHs => x /sQtrans/= ->. have [w defQs] := PET_Qz _ <<1 & map (inQ y) s>>%AS; pose z := ofQ y w. have z_s: sQs z s. rewrite -Ds /sQs all_map; apply/allP=> u s_u /=. by rewrite sQof2 defQs seqv_sub_adjoin. have [[u Dz defQz] [Qzy QzyE]] := (genQz z, QtoQ y z (sQof y w)). exists z => //; apply/eqP; rewrite eqEsubv subvf /= -defQz. rewrite -(limg_ker0 _ _ (AHom_lker0 Qzy)) aimg_adjoin_seq aimg_adjoin aimg1. rewrite -[map _ _](mapK (ofQ_K y)) -(map_comp (ofQ y)) (eq_map QzyE) inQsK //. by rewrite -defQs -(canLR (ofQ_K y) Dz) -QzyE ofQ_K. pose rp s := \prod_(z <- s) ('X - z%:P). have map_rp (f : {rmorphism _}) s: rp _ s ^ f = rp _ (map f s). rewrite rmorph_prod /rp big_map; apply: eq_bigr => x _. by rewrite rmorphB /= map_polyX map_polyC. pose is_Gal z := SplittingField.axiom (Q z). have galQ x: {z | x \in sQ z & is_Gal z}. have /sig2W[p mon_p pz0] := algC x. have [s Dp] := closed_field_poly_normal (p ^ QtoC). rewrite (monicP _) ?monic_map // scale1r in Dp; have [z z_s defQz] := PET s. exists z; first by apply/(allP z_s); rewrite -root_prod_XsubC -Dp. exists p^@; first exact: alg_polyOver. exists (map (inQ z) s); last by apply/vspaceP=> u; rewrite defQz memvf. by rewrite -(eqp_map (ofQ z)) pQof Dp map_rp inQsK ?eqpxx. pose is_realC x := {R : archiFieldType & {rmorphism Q x -> R}}. pose realC := {x : C & is_realC x}. pose has_Rroot (xR : realC) p c (Rx := sQ (tag xR)) := [&& p \is a polyOver Rx, p \is monic, c \in Rx & p.[0] == - c ^+ 2]. pose root_in (xR : realC) p := exists2 w, w \in sQ (tag xR) & root p w. pose extendsR (xR yR : realC) := tag xR \in sQ (tag yR). have add_Rroot xR p c: {yR | extendsR xR yR & has_Rroot xR p c -> root_in yR p}. rewrite {}/extendsR; case: (has_Rroot xR p c) / and4P; last by exists xR. case: xR => x [R QxR] /= [/inQpK <-]; move: (p ^ _) => {}p mon_p /inQ_K<- Dc. have{c Dc} p0_le0: (p ^ QxR).[0] <= 0. rewrite horner_coef0 coef_map -[p`_0]ofQ_K -coef_map -horner_coef0 (eqP Dc). by rewrite -rmorphX -rmorphN ofQ_K /= rmorphN rmorphX oppr_le0 sqr_ge0. have [s Dp] := closed_field_poly_normal (p ^ ofQ x). have{Dp} /all_and2[s_p p_s] y: root (p ^ ofQ x) y <-> (y \in s). by rewrite Dp (monicP mon_p) scale1r root_prod_XsubC. rewrite map_monic in mon_p; have [z /andP[z_x /allP/=z_s] _] := PET (x :: s). have{z_x} [[Qxz QxzE] Dx] := (QtoQ z x z_x, inQ_K z x z_x). pose Qx := <<1; inQ z x>>%AS; pose QxzM := [rmorphism of Qxz]. have pQwx q1: q1 \is a polyOver Qx -> {q | q1 = q ^ Qxz}. move/polyOverP=> Qx_q1; exists ((q1 ^ ofQ z) ^ inQ x). apply: (map_poly_inj (ofQ z)); rewrite -map_poly_comp (eq_map_poly QxzE). by rewrite inQpK ?polyOver_poly // => j _; rewrite -Dx sQof2 Qx_q1. have /all_sig[t_ Dt] u: {t | <<1; t>> = <>} by apply: PET_Qz. suffices{p_s}[u Ry px0]: {u : Q z & is_realC (ofQ z (t_ u)) & ofQ z u \in s}. exists (Tagged is_realC Ry) => [|_] /=. by rewrite -Dx sQof2 Dt subvP_adjoin ?memv_adjoin. by exists (ofQ z u); rewrite ?p_s // sQof2 Dt memv_adjoin. without loss{z_s s_p} [u Dp s_y]: p mon_p p0_le0 / {u | minPoly Qx u = p ^ Qxz & ofQ z u \in s}. - move=> IHp; move: {2}_.+1 (ltnSn (size p)) => d. 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 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. have /dvdpP/sig_eqW[r Dp]: q %| p. rewrite -(dvdp_map QxzM) -Dq minPoly_dvdp //. by apply: polyOver_poly => j _; rewrite -sQof2 QxzE Dx. by rewrite -(fmorph_root (ofQ z)) Dy -map_poly_comp (eq_map_poly QxzE). have mon_r: r \is monic by rewrite Dp monicMr in mon_p. have [q0_le0 | q0_gt0] := lerP ((q ^ QxR).[0]) 0. by apply: (IHp q) => //; exists u; rewrite ?Dy. have r0_le0: (r ^ QxR).[0] <= 0. by rewrite -(ler_pmul2r q0_gt0) mul0r -hornerM -rmorphM -Dp. apply: (IHd r mon_r) => // [w rw0|]. by rewrite s_p // Dp rmorphM rootM rw0. apply: leq_trans le_p_d; rewrite Dp size_Mmonic ?monic_neq0 // addnC. by rewrite -(size_map_poly QxzM q) -Dq size_minPoly !ltnS leq_addl. exists u => {s s_y}//; set y := ofQ z (t_ u); set p1 := minPoly Qx u in Dp. have /QtoQ[Qyz QyzE]: y \in sQ z := sQof z (t_ u). pose q1_ v := Fadjoin_poly Qx u (Qyz v). have{} QyzE v: Qyz v = (q1_ v).[u]. by rewrite Fadjoin_poly_eq // -Dt -sQof2 QyzE sQof. have /all_sig2[q_ coqp Dq] v: {q | v != 0 -> coprimep p q & q ^ Qxz = q1_ v}. have /pQwx[q Dq]: q1_ v \is a polyOver Qx by apply: Fadjoin_polyOver. exists q => // nz_v; rewrite -(coprimep_map QxzM) -Dp -Dq -gcdp_eqp1. have /minPoly_irr/orP[] // := dvdp_gcdl p1 (q1_ v). by rewrite gcdp_polyOver ?minPolyOver ?Fadjoin_polyOver. rewrite -/p1 {1}/eqp dvdp_gcd => /and3P[_ _ /dvdp_leq/=/implyP]. rewrite size_minPoly ltnNge size_poly (contraNneq _ nz_v) // => q1v0. by rewrite -(fmorph_eq0 [rmorphism of Qyz]) /= QyzE q1v0 horner0. pose h2 : R := 2%:R^-1; have nz2: 2%:R != 0 :> R by rewrite pnatr_eq0. pose itv ab := [pred c : R | ab.1 <= c <= ab.2]. pose wid ab : R := ab.2 - ab.1; pose mid ab := (ab.1 + ab.2) * h2. pose sub_itv ab cd := cd.1 <= ab.1 :> R /\ ab.2 <= cd.2 :> R. pose xup q ab := [/\ q.[ab.1] <= 0, q.[ab.2] >= 0 & ab.1 <= ab.2 :> R]. pose narrow q ab (c := mid ab) := if q.[c] >= 0 then (ab.1, c) else (c, ab.2). pose find k q := iter k (narrow q). have findP k q ab (cd := find k q ab): xup q ab -> [/\ xup q cd, sub_itv cd ab & wid cd = wid ab / (2 ^ k)%:R]. - rewrite {}/cd; case: ab => a b xq_ab. elim: k => /= [|k]; first by rewrite divr1. 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 // | /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: (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}. - move=> xab; have ub_ab := poly_itv_bound _ ab.1 ab.2. have [Mu MuP] := ub_ab r; have /all_sig[Mq MqP] j := ub_ab q^`N(j). pose d := wid ab; pose dq := \poly_(i < (size q).-1) Mq i.+1. have d_ge0: 0 <= d by rewrite subr_ge0; case: xab. have [Mdq MdqP] := poly_disk_bound dq d. pose n := Num.bound (Mu * Mdq * d); exists n => c /= /andP[]. 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 (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 (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: le_lt_trans (_ : Mu * Mdq * wid (a1, b1) < h2); last first. rewrite {}Dab1 mulrA ltr_pdivr_mulr ?ltr0n ?expn_gt0 //. 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 //. 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] := (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 // (le_trans _ (MqPx1 _)). rewrite mulr_suml ler_sum // => j _; rewrite normrM -mulrA -exprSr. 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 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. rewrite /lim; suffices /eqP ->: q_ 0 == 0 by rewrite rmorph0 horner0. by rewrite -(map_poly_eq0 QxzM) Dq /q1_ !raddf0. have limN v a: lim (- v) a = - lim v a. rewrite /lim; suffices ->: q_ (- v) = - q_ v by rewrite rmorphN hornerN. by apply: (map_poly_inj QxzM); rewrite Dq /q1_ !raddfN /= Dq. pose lim_nz n v := exists2 e, e > 0 & {in Iab_ n, forall a, e < `|lim v a| }. have /(all_sig_cond 0%N)[n_ nzP] v: v != 0 -> {n | lim_nz n v}. move=> nz_v; do [move/(_ v nz_v); rewrite -(coprimep_map QxR)] in coqp. have /sig_eqW[r r_pq_1] := Bezout_eq1_coprimepP _ _ coqp. 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 lt_maxr ltr01. by rewrite le_maxr 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 ?(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 -iterD -!/(find _ _) -!/(ab_ _) addnC !inE. 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 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 | /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 (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/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 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)) (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 ltxx. exists (n_ v), e => // n le_vn; rewrite (posE n) // in v_gt0. 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 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 (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. rewrite geq_max => /andP[le_mk le_nk]; rewrite /nlim /lim. have ->: q_ (v + w) = q_ v + q_ w. by apply: (map_poly_inj QxzM); rewrite rmorphD /= !{1}Dq /q1_ !raddfD. by rewrite rmorphD hornerD ltr_add ?v_gtd ?w_gte. have posM 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]]. have /dvdpP[r /(canRL (subrK _))Dqvw]: p %| q_ (v * w) - q_ v * q_ w. rewrite -(dvdp_map QxzM) rmorphB rmorphM /= !Dq -Dp minPoly_dvdp //. by rewrite rpredB 1?rpredM ?Fadjoin_polyOver. by rewrite rootE !hornerE -!QyzE rmorphM subrr. have /(find_root ((d * e)^-1 *: r ^ QxR))[N ub_rp] := xab0. pose f := d * e * h2; apply/posP; exists (maxn N (maxn m n)), f => [|k]. by rewrite !mulr_gt0 ?invr_gt0 ?ltr0n. rewrite !geq_max => /and3P[/ab_le/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 ?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 := (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 !(eq_sym 0) oppr_eq0 opprK posN. have [-> | /posVneg/orP[v_gt0 | v_lt0]] := eqVneq; 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 Ry := LtRealFieldOfField (RealLtMixin posD posM posNneg posB posVneg absN absE (rrefl _)). have archiRy := @rat_algebraic_archimedean Ry _ alg_integral. by exists (ArchiFieldType Ry archiRy); apply: [rmorphism of idfun]. have some_realC: realC. suffices /all_sig[f QfK] x: {a | in_alg (Q 0) a = x}. exists 0, [archiFieldType of rat], f. exact: can2_rmorphism (inj_can_sym QfK (fmorph_inj _)) QfK. have /Fadjoin1_polyP/sig_eqW[q]: x \in <<1; 0>>%VS by rewrite -sQof2 rmorph0. by exists q.[0]; rewrite -horner_map rmorph0. pose fix xR n : realC := if n isn't n'.+1 then some_realC else if unpickle (nth 0%N (CodeSeq.decode n') 1) isn't Some (p, c) then xR n' else tag (add_Rroot (xR n') p c). pose x_ n := tag (xR n). have sRle m n: (m <= n)%N -> {subset sQ (x_ m) <= sQ (x_ n)}. move/subnK <-; elim: {n}(n - m)%N => // n IHn x /IHn{IHn}Rx. rewrite addSn /x_ /=; case: (unpickle _) => [[p c]|] //=. by case: (add_Rroot _ _ _) => yR /= /(sQtrans _ x)->. have xRroot n p c: has_Rroot (xR n) p c -> {m | n <= m & root_in (xR m) p}%N. case/and4P=> Rp mon_p Rc Dc; pose m := CodeSeq.code [:: n; pickle (p, c)]. have le_n_m: (n <= m)%N by apply/ltnW/(allP (CodeSeq.ltn_code _))/mem_head. exists m.+1; rewrite ?leqW /x_ //= CodeSeq.codeK pickleK. case: (add_Rroot _ _ _) => yR /= _; apply; apply/and4P. by split=> //; first apply: polyOverS Rp; apply: (sRle n). have /all_sig[z_ /all_and3[Ri_R Ri_i defRi]] n (x := x_ n): {z | [/\ x \in sQ z, i \in sQ z & <<<<1; inQ z x>>; inQ z i>> = fullv]}. - have [z /and3P[z_x z_i _] Dzi] := PET [:: x; i]. by exists z; rewrite -adjoin_seq1 -adjoin_cons. pose i_ n := inQ (z_ n) i; pose R_ n := <<1; inQ (z_ n) (x_ n)>>%AS. have memRi n: <> =i predT by move=> u; rewrite defRi memvf. have sCle m n: (m <= n)%N -> {subset sQ (z_ m) <= sQ (z_ n)}. move/sRle=> Rmn _ /sQ_inQ[u <-]. have /Fadjoin_polyP[p /polyOverP Rp ->] := memRi m u. rewrite -horner_map inQ_K ?rpred_horner //=; apply/polyOver_poly=> j _. by apply: sQtrans (Ri_R n); rewrite Rmn // -(inQ_K _ _ (Ri_R m)) sQof2. 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 -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. by move=> R; rewrite size_addl ?size_polyXn ?size_poly1. have minp_i n (p_i := minPoly (R_ n) (i_ n)): p_i = 'X^2 + 1. have p_dv_X2_1: p_i %| 'X^2 + 1. rewrite minPoly_dvdp ?rpredD ?rpredX ?rpred1 ?polyOverX //. rewrite -(fmorph_root (ofQ _)) inQ_K // rmorphD rmorph1 /= map_polyXn. by rewrite rootE hornerD hornerXn hornerC Di2 addNr. apply/eqP; rewrite -eqp_monic ?monic_minPoly //; last first. by rewrite monicE lead_coefE szX2_1 coefD coefXn coefC addr0. rewrite -dvdp_size_eqp // eqn_leq dvdp_leq -?size_poly_eq0 ?szX2_1 //= ltnNge. by rewrite size_minPoly ltnS leq_eqVlt orbF adjoin_deg_eq1 -sQof2 !inQ_K. have /all_sig[n_ FTA] z: {n | z \in sQ (z_ n)}. without loss [z_i gal_z]: z / i \in sQ z /\ is_Gal z. have [y /and3P[/sQtrans y_z /sQtrans y_i _] _] := PET [:: z; i]. have [t /sQtrans t_y gal_t] := galQ y. by case/(_ t)=> [|n]; last exists n; rewrite ?y_z ?y_i ?t_y. apply/sig_eqW; have n := 0%N. have [p]: exists p, [&& p \is monic, root p z & p \is a polyOver (sQ (z_ n))]. have [p mon_p pz0] := algC z; exists (p ^ QtoC). by rewrite map_monic mon_p pz0 -(pQof (z_ n)); apply/polyOver_poly. have [d lepd] := ubnP (size p); elim: d => // d IHd in p n lepd * => pz0. have [t [t_C t_z gal_t]]: exists t, [/\ z_ n \in sQ t, z \in sQ t & is_Gal t]. have [y /and3P[y_C y_z _]] := PET [:: z_ n; z]. by have [t /(sQtrans y)t_y] := galQ y; exists t; rewrite !t_y. pose Qt := SplittingFieldType rat (Q t) gal_t; have /QtoQ[CnQt CnQtE] := t_C. pose Rn : {subfield Qt} := (CnQt @: R_ n)%AS; pose i_t : Qt := CnQt (i_ n). pose Cn : {subfield Qt} := <>%AS. have defCn: Cn = limg CnQt :> {vspace Q t} by rewrite /= -aimg_adjoin defRi. have memRn u: (u \in Rn) = (ofQ t u \in sQ (x_ n)). by rewrite /= aimg_adjoin aimg1 -sQof2 CnQtE inQ_K. have memCn u: (u \in Cn) = (ofQ t u \in sQ (z_ n)). have [v Dv genCn] := genQz (z_ n). by rewrite -Dv -CnQtE sQof2 defCn -genCn aimg_adjoin aimg1. have Dit: ofQ t i_t = i by rewrite CnQtE inQ_K. have Dit2: i_t ^+ 2 = -1. by apply: (fmorph_inj (ofQ t)); rewrite rmorphX rmorphN1 Dit. have dimCn: \dim_Rn Cn = 2. rewrite -adjoin_degreeE adjoin_degree_aimg. by apply: succn_inj; rewrite -size_minPoly minp_i. have /sQ_inQ[u_z Dz] := t_z; pose Rz := <>%AS. have{p lepd pz0} le_Rz_d: (\dim_Cn Rz < d)%N. rewrite -ltnS -adjoin_degreeE -size_minPoly (leq_trans _ lepd) // !ltnS. have{pz0} [mon_p pz0 Cp] := and3P pz0. have{Cp} Dp: ((p ^ inQ (z_ n)) ^ CnQt) ^ ofQ t = p. by rewrite -map_poly_comp (eq_map_poly CnQtE) inQpK. rewrite -Dp size_map_poly dvdp_leq ?monic_neq0 -?(map_monic (ofQ _)) ?Dp //. rewrite defCn minPoly_dvdp //; try by rewrite -(fmorph_root (ofQ t)) Dz Dp. by apply/polyOver_poly=> j _; rewrite memv_img ?memvf. have [sRCn sCnRz]: (Rn <= Cn)%VS /\ (Cn <= Rz)%VS by rewrite !subv_adjoin. have sRnRz := subv_trans sRCn sCnRz. have{gal_z} galRz: galois Rn Rz. apply/and3P; split=> //; apply/splitting_normalField=> //. pose u : SplittingFieldType rat (Q z) gal_z := inQ z z. have /QtoQ[Qzt QztE] := t_z; exists (minPoly 1 u ^ Qzt). have /polyOver1P[q ->] := minPolyOver 1 u; apply/polyOver_poly=> j _. by rewrite coef_map linearZZ rmorph1 rpredZ ?rpred1. have [s /eqP Ds] := splitting_field_normal 1 u. rewrite Ds; exists (map Qzt s); first by rewrite map_rp eqpxx. apply/eqP; rewrite eqEsubv; apply/andP; split. apply/Fadjoin_seqP; split=> // _ /mapP[w s_w ->]. by rewrite (subvP (adjoinSl u_z (sub1v _))) // -sQof2 Dz QztE. rewrite /= adjoinC (Fadjoin_idP _) -/Rz; last first. by rewrite (subvP (adjoinSl _ (sub1v _))) // -sQof2 Dz Dit. rewrite /= -adjoin_seq1 adjoin_seqSr //; apply/allP=> /=; rewrite andbT. rewrite -(mem_map (fmorph_inj (ofQ _))) -map_comp (eq_map QztE); apply/mapP. by exists u; rewrite ?inQ_K // -root_prod_XsubC -Ds root_minPoly. have galCz: galois Cn Rz by rewrite (galoisS _ galRz) ?sRCn. have [Cz | C'z]:= boolP (u_z \in Cn); first by exists n; rewrite -Dz -memCn. pose G := 'Gal(Rz / Cn)%G; have{C'z} ntG: G :!=: 1%g. rewrite trivg_card1 -galois_dim 1?(galoisS _ galCz) ?subvv //=. by rewrite -adjoin_degreeE adjoin_deg_eq1. pose extRz m := exists2 w, ofQ t w \in sQ (z_ m) & w \in [predD Rz & Cn]. suffices [m le_n_m [w Cw /andP[C'w Rz_w]]]: exists2 m, (n <= m)%N & extRz m. pose p := minPoly <> u_z; apply: (IHd (p ^ ofQ t) m). apply: leq_trans le_Rz_d; rewrite size_map_poly size_minPoly ltnS. rewrite adjoin_degreeE adjoinC (addv_idPl Rz_w) agenv_id. rewrite ltn_divLR ?adim_gt0 // mulnC. rewrite muln_divCA ?field_dimS ?subv_adjoin // ltn_Pmulr ?adim_gt0 //. by rewrite -adjoin_degreeE ltnNge leq_eqVlt orbF adjoin_deg_eq1. rewrite map_monic monic_minPoly -Dz fmorph_root root_minPoly /=. have /polyOverP Cw_p: p \is a polyOver <>%VS by apply: minPolyOver. apply/polyOver_poly=> j _; have /Fadjoin_polyP[q Cq {j}->] := Cw_p j. rewrite -horner_map rpred_horner //; apply/polyOver_poly=> j _. by rewrite (sCle n) // -memCn (polyOverP Cq). have [evenG | oddG] := boolP (2.-group G); last first. have [P /and3P[sPG evenP oddPG]] := Sylow_exists 2 'Gal(Rz / Rn). have [w defQw] := PET_Qz t [aspace of fixedField P]. pose pw := minPoly Rn w; pose p := (- pw * (pw \Po - 'X)) ^ ofQ t. have sz_pw: (size pw).-1 = #|'Gal(Rz / Rn) : P|. rewrite size_minPoly adjoin_degreeE -dim_fixed_galois //= -defQw. congr (\dim_Rn _); apply/esym/eqP; rewrite eqEsubv adjoinSl ?sub1v //=. by apply/FadjoinP; rewrite memv_adjoin /= defQw -galois_connection. have mon_p: p \is monic. have mon_pw: pw \is monic := monic_minPoly _ _. rewrite map_monic mulNr -mulrN monicMl // monicE. rewrite !(lead_coefN, lead_coef_comp) ?size_opp ?size_polyX //. by rewrite lead_coefX sz_pw -signr_odd odd_2'nat oddPG mulrN1 opprK. have Dp0: p.[0] = - ofQ t pw.[0] ^+ 2. rewrite -(rmorph0 (ofQ t)) horner_map hornerM rmorphM. by rewrite horner_comp !hornerN hornerX oppr0 rmorphN mulNr. have Rpw: pw \is a polyOver Rn by apply: minPolyOver. have Rp: p \is a polyOver (sQ (x_ n)). apply/polyOver_poly=> j _; rewrite -memRn; apply: polyOverP j => /=. by rewrite rpredM 1?polyOver_comp ?rpredN ?polyOverX. have Rp0: ofQ t pw.[0] \in sQ (x_ n) by rewrite -memRn rpred_horner ?rpred0. have [|{mon_p Rp Rp0 Dp0}m lenm p_Rm_0] := xRroot n p (ofQ t pw.[0]). by rewrite /has_Rroot mon_p Rp Rp0 -Dp0 /=. have{p_Rm_0} [y Ry pw_y]: {y | y \in sQ (x_ m) & root (pw ^ ofQ t) y}. apply/sig2W; have [y Ry] := p_Rm_0. rewrite [p]rmorphM /= map_comp_poly !rmorphN /= map_polyX. rewrite rootM rootN root_comp hornerN hornerX. by case/orP; [exists y | exists (- y)]; rewrite ?rpredN. have [u Rz_u Dy]: exists2 u, u \in Rz & y = ofQ t u. have Rz_w: w \in Rz by rewrite -sub_adjoin1v defQw capvSl. have [sg [Gsg _ Dpw]] := galois_factors sRnRz galRz w Rz_w. set s := map _ sg in Dpw. have /mapP[u /mapP[g Gg Du] ->]: y \in map (ofQ t) s. by rewrite -root_prod_XsubC -/(rp C _) -map_rp -[rp _ _]Dpw. by exists u; rewrite // Du memv_gal. have{pw_y} pw_u: root pw u by rewrite -(fmorph_root (ofQ t)) -Dy. exists m => //; exists u; first by rewrite -Dy; apply: sQtrans Ry _. rewrite inE /= Rz_u andbT; apply: contra oddG => Cu. suffices: 2.-group 'Gal(Rz / Rn). apply: pnat_dvd; rewrite -!galois_dim // ?(galoisS _ galQr) ?sRCz //. rewrite dvdn_divLR ?field_dimS ?adim_gt0 //. by rewrite mulnC muln_divCA ?field_dimS ?dvdn_mulr. congr (2.-group _): evenP; apply/eqP. rewrite eqEsubset sPG -indexg_eq1 (pnat_1 _ oddPG) // -sz_pw. have (pu := minPoly Rn u): (pu %= pw) || (pu %= 1). by rewrite minPoly_irr ?minPoly_dvdp ?minPolyOver. rewrite /= -size_poly_eq1 {1}size_minPoly orbF => /eqp_size <-. rewrite size_minPoly /= adjoin_degreeE (@pnat_dvd _ 2) // -dimCn. rewrite dvdn_divLR ?divnK ?adim_gt0 ?field_dimS ?subv_adjoin //. exact/FadjoinP. have [w Rz_w deg_w]: exists2 w, w \in Rz & adjoin_degree Cn w = 2. have [P sPG iPG]: exists2 P : {group gal_of Rz}, P \subset G & #|G : P| = 2. have [_ _ [k oG]] := pgroup_pdiv evenG ntG. have [P [sPG _ oP]] := normal_pgroup evenG (normal_refl G) (leq_pred _). by exists P => //; rewrite -divgS // oP oG pfactorK // -expnB ?subSnn. have [w defQw] := PET_Qz _ [aspace of fixedField P]. exists w; first by rewrite -sub_adjoin1v defQw capvSl. rewrite adjoin_degreeE -iPG -dim_fixed_galois // -defQw; congr (\dim_Cn _). apply/esym/eqP; rewrite eqEsubv adjoinSl ?sub1v //=; apply/FadjoinP. by rewrite memv_adjoin /= defQw -galois_connection. have nz2: 2%:R != 0 :> Qt by move/charf0P: (charQ (Q t)) => ->. without loss{deg_w} [C'w Cw2]: w Rz_w / w \notin Cn /\ w ^+ 2 \in Cn. pose p := minPoly Cn w; pose v := p`_1 / 2%:R. have /polyOverP Cp: p \is a polyOver Cn := minPolyOver Cn w. have Cv: v \in Cn by rewrite rpred_div ?rpred_nat ?Cp. move/(_ (v + w)); apply; first by rewrite rpredD // subvP_adjoin. split; first by rewrite rpredDl // -adjoin_deg_eq1 deg_w. rewrite addrC -[_ ^+ 2]subr0 -(rootP (root_minPoly Cn w)) -/p. rewrite sqrrD [_ - _]addrAC rpredD ?rpredX // -mulr_natr -mulrA divfK //. rewrite [w ^+ 2 + _]addrC mulrC -rpredN opprB horner_coef. have /monicP := monic_minPoly Cn w; rewrite lead_coefE size_minPoly deg_w. by rewrite 2!big_ord_recl big_ord1 => ->; rewrite mulr1 mul1r addrK Cp. without loss R'w2: w Rz_w C'w Cw2 / w ^+ 2 \notin Rn. move=> IHw; have [Rw2 | /IHw] := boolP (w ^+ 2 \in Rn); last exact. have R'it: i_t \notin Rn by rewrite memRn Dit. pose v := 1 + i_t; have R'v: v \notin Rn by rewrite rpredDl ?rpred1. have Cv: v \in Cn by rewrite rpredD ?rpred1 ?memv_adjoin. have nz_v: v != 0 by rewrite (memPnC R'v) ?rpred0. apply: (IHw (v * w)); last 1 [|] || by rewrite fpredMl // subvP_adjoin. by rewrite exprMn rpredM // rpredX. rewrite exprMn fpredMr //=; last by rewrite expf_eq0 (memPnC C'w) ?rpred0. by rewrite sqrrD Dit2 expr1n addrC addKr -mulrnAl fpredMl ?rpred_nat. pose rect_w2 u v := [/\ u \in Rn, v \in Rn & u + i_t * (v * 2%:R) = w ^+ 2]. have{Cw2} [u [v [Ru Rv Dw2]]]: {u : Qt & {v | rect_w2 u v}}. rewrite /rect_w2 -(Fadjoin_poly_eq Cw2); set p := Fadjoin_poly Rn i_t _. have /polyOverP Rp: p \is a polyOver Rn by apply: Fadjoin_polyOver. exists p`_0, (p`_1 / 2%:R); split; rewrite ?rpred_div ?rpred_nat //. rewrite divfK // (horner_coef_wide _ (size_Fadjoin_poly _ _ _)) -/p. by rewrite adjoin_degreeE dimCn big_ord_recl big_ord1 mulr1 mulrC. pose p := Poly [:: - (ofQ t v ^+ 2); 0; - ofQ t u; 0; 1]. have [|m lenm [x Rx px0]] := xRroot n p (ofQ t v). rewrite /has_Rroot 2!unfold_in lead_coefE horner_coef0 -memRn Rv. rewrite (@PolyK _ 1) ?oner_eq0 //= !eqxx !rpred0 ?rpred1 ?rpredN //=. by rewrite !andbT rpredX -memRn. suffices [y Cy Dy2]: {y | y \in sQ (z_ m) & ofQ t w ^+ 2 == y ^+ 2}. exists m => //; exists w; last by rewrite inE C'w. by move: Dy2; rewrite eqf_sqr => /pred2P[]->; rewrite ?rpredN. exists (x + i * (ofQ t v / x)). rewrite rpredD 1?rpredM ?rpred_div //= (sQtrans (x_ m)) //. by rewrite (sRle n) // -memRn. rewrite rootE /horner (@PolyK _ 1) ?oner_eq0 //= ?addr0 ?mul0r in px0. rewrite add0r mul1r -mulrA -expr2 subr_eq0 in px0. have nz_x2: x ^+ 2 != 0. apply: contraNneq R'w2 => y2_0; rewrite -Dw2 mulrCA. suffices /eqP->: v == 0 by rewrite mul0r addr0. by rewrite y2_0 mulr0 eq_sym sqrf_eq0 fmorph_eq0 in px0. apply/eqP/esym/(mulIf nz_x2); rewrite -exprMn -rmorphX -Dw2 rmorphD rmorphM. rewrite Dit mulrDl -expr2 mulrA divfK; last by rewrite expf_eq0 in nz_x2. rewrite mulr_natr addrC sqrrD exprMn Di2 mulN1r -(eqP px0) -mulNr opprB. by rewrite -mulrnAl -mulrnAr -rmorphMn -!mulrDl addrAC subrK. have inFTA n z: (n_ z <= n)%N -> z = ofQ (z_ n) (inQ (z_ n) z). by move/sCle=> le_zn; rewrite inQ_K ?le_zn. pose is_cj n cj := {in R_ n, cj =1 id} /\ cj (i_ n) = - i_ n. have /all_sig[cj_ /all_and2[cj_R cj_i]] n: {cj : 'AEnd(Q (z_ n)) | is_cj n cj}. have cj_P: root (minPoly (R_ n) (i_ n) ^ \1%VF) (- i_ n). rewrite minp_i -(fmorph_root (ofQ _)) !rmorphD !rmorph1 /= !map_polyXn. by rewrite rmorphN inQ_K // rootE hornerD hornerXn hornerC sqrrN Di2 addNr. have cj_M: ahom_in fullv (kHomExtend (R_ n) \1 (i_ n) (- i_ n)). by rewrite -defRi -k1HomE kHomExtendP ?sub1v ?kHom1. exists (AHom cj_M); split=> [y /kHomExtend_id->|]; first by rewrite ?id_lfunE. by rewrite (kHomExtend_val (kHom1 1 _)). pose conj_ n z := ofQ _ (cj_ n (inQ _ z)); pose conj z := conj_ (n_ z) z. have conjK n m z: (n_ z <= n)%N -> (n <= m)%N -> conj_ m (conj_ n z) = z. move/sCle=> le_z_n le_n_m; have /le_z_n/sQ_inQ[u <-] := FTA z. have /QtoQ[Qmn QmnE]: z_ n \in sQ (z_ m) by rewrite (sCle n). rewrite /conj_ ofQ_K -!QmnE !ofQ_K -!comp_lfunE; congr (ofQ _ _). move: u (memRi n u); apply/eqlfun_inP/FadjoinP; split=> /=. apply/eqlfun_inP=> y Ry; rewrite !comp_lfunE !cj_R //. by move: Ry; rewrite -!sQof2 QmnE !inQ_K //; apply: sRle. apply/eqlfunP; rewrite !comp_lfunE cj_i !linearN /=. suffices ->: Qmn (i_ n) = i_ m by rewrite cj_i ?opprK. by apply: (fmorph_inj (ofQ _)); rewrite QmnE !inQ_K. have conjE n z: (n_ z <= n)%N -> conj z = conj_ n z. move/leq_trans=> le_zn; set x := conj z; set y := conj_ n z. have [m [le_xm le_ym le_nm]] := maxn3 (n_ x) (n_ y) n. by have /conjK/=/can_in_inj := leqnn m; apply; rewrite ?conjK // le_zn. suffices conjM: rmorphism conj. exists (RMorphism conjM) => [z | /(_ i)/eqP/idPn[]] /=. by have [n [/conjE-> /(conjK (n_ z))->]] := maxn3 (n_ (conj z)) (n_ z) 0%N. rewrite /conj/conj_ cj_i rmorphN inQ_K // eq_sym -addr_eq0 -mulr2n -mulr_natl. rewrite mulf_neq0 ?(memPnC (R'i 0%N)) ?rpred0 //. by have /charf0P-> := ftrans (fmorph_char QtoC) (char_num _). do 2?split=> [x y|]; last pose n1 := n_ 1. - have [m [le_xm le_ym le_xym]] := maxn3 (n_ x) (n_ y) (n_ (x - y)). by rewrite !(conjE m) // (inFTA m x) // (inFTA m y) -?rmorphB /conj_ ?ofQ_K. - have [m [le_xm le_ym le_xym]] := maxn3 (n_ x) (n_ y) (n_ (x * y)). by rewrite !(conjE m) // (inFTA m x) // (inFTA m y) -?rmorphM /conj_ ?ofQ_K. by rewrite /conj -/n1 -(rmorph1 (ofQ (z_ n1))) /conj_ ofQ_K !rmorph1. Qed. math-comp-mathcomp-1.12.0/mathcomp/field/algnum.v000066400000000000000000001153211375767750300216620ustar00rootroot00000000000000(* (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 ssralg finalg zmodp poly ssrnum ssrint rat. From mathcomp Require Import polydiv intdiv algC matrix mxalgebra mxpoly. From mathcomp Require Import vector falgebra fieldext separable galois. From mathcomp Require Import cyclotomic. (******************************************************************************) (* This file provides a few basic results and constructions in algebraic *) (* number theory, that are used in the character theory library. Most of *) (* these could be generalized to a more abstract setting. Note that the type *) (* of abstract number fields is simply extFieldType rat. We define here: *) (* x \in Crat_span X <=> x is a Q-linear combination of elements of *) (* X : seq algC. *) (* x \in Cint_span X <=> x is a Z-linear combination of elements of *) (* X : seq algC. *) (* x \in Aint <=> x : algC is an algebraic integer, i.e., the (monic) *) (* polynomial of x over Q has integer coefficients. *) (* (e %| a)%A <=> e divides a with respect to algebraic integers, *) (* (e %| a)%Ax i.e., a is in the algebraic integer ideal generated *) (* by e. This is is notation for a \in dvdA e, where *) (* dvdv is the (collective) predicate for the Aint *) (* ideal generated by e. As in the (e %| a)%C notation *) (* e and a can be coerced to algC from nat or int. *) (* The (e %| a)%Ax display form is a workaround for *) (* design limitations of the Coq Notation facilities. *) (* (a == b %[mod e])%A, (a != b %[mod e])%A <=> *) (* a is equal (resp. not equal) to b mod e, i.e., a and *) (* b belong to the same e * Aint class. We do not *) (* force a, b and e to be algebraic integers. *) (* #[x]%C == the multiplicative order of x, i.e., the n such that *) (* x is an nth primitive root of unity, or 0 if x is not *) (* a root of unity. *) (* In addition several lemmas prove the (constructive) existence of number *) (* fields and of automorphisms of algC. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope algC_scope. Declare Scope algC_expanded_scope. Import GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Notation ZtoQ := (intr : int -> rat). Local Notation ZtoC := (intr : int -> algC). Local Notation QtoC := (ratr : rat -> algC). Local Notation intrp := (map_poly intr). Local Notation pZtoQ := (map_poly ZtoQ). Local Notation pZtoC := (map_poly ZtoC). Local Notation pQtoC := (map_poly ratr). Local Definition intr_inj_ZtoC := (intr_inj : injective ZtoC). Local Hint Resolve intr_inj_ZtoC : core. Local Notation QtoCm := [rmorphism of QtoC]. (* Number fields and rational spans. *) Lemma algC_PET (s : seq algC) : {z | exists a : nat ^ size s, z = \sum_(i < size s) s`_i *+ a i & exists ps, s = [seq (pQtoC p).[z] | p <- ps]}. Proof. elim: s => [|x s [z /sig_eqW[a Dz] /sig_eqW[ps Ds]]]. by exists 0; [exists [ffun _ => 2]; rewrite big_ord0 | exists nil]. have r_exists (y : algC): {r | r != 0 & root (pQtoC r) y}. have [r [_ mon_r] dv_r] := minCpolyP y. by exists r; rewrite ?monic_neq0 ?dv_r. suffices /sig_eqW[[n [|px [|pz []]]]// [Dpx Dpz]]: exists np, let zn := x *+ np.1 + z in [:: x; z] = [seq (pQtoC p).[zn] | p <- np.2]. - exists (x *+ n + z). exists [ffun i => oapp a n (unlift ord0 i)]. rewrite /= big_ord_recl ffunE unlift_none Dz; congr (_ + _). by apply: eq_bigr => i _; rewrite ffunE liftK. exists (px :: [seq p \Po pz | p <- ps]); rewrite /= -Dpx; congr (_ :: _). rewrite -map_comp Ds; apply: eq_map => p /=. by rewrite map_comp_poly horner_comp -Dpz. have [rx nz_rx rx0] := r_exists x. have [rz nz_rz rz0] := r_exists (- z). have char0_Q: [char rat] =i pred0 by apply: char_num. have [n [[pz Dpz] [px Dpx]]] := char0_PET nz_rz rz0 nz_rx rx0 char0_Q. by exists (n, [:: px; - pz]); rewrite /= !raddfN hornerN -[z]opprK Dpz Dpx. Qed. Canonical subfx_unitAlgType (F L : fieldType) iota (z : L) p := Eval hnf in [unitAlgType F of subFExtend iota z p]. Lemma num_field_exists (s : seq algC) : {Qs : fieldExtType rat & {QsC : {rmorphism Qs -> algC} & {s1 : seq Qs | map QsC s1 = s & <<1 & s1>>%VS = fullv}}}. Proof. have [z /sig_eqW[a Dz] /sig_eqW[ps Ds]] := algC_PET s. suffices [Qs [QsC [z1 z1C z1gen]]]: {Qs : fieldExtType rat & {QsC : {rmorphism Qs -> algC} & {z1 : Qs | QsC z1 = z & forall xx, exists p, fieldExt_horner z1 p = xx}}}. - set inQs := fieldExt_horner z1 in z1gen *; pose s1 := map inQs ps. have inQsK p: QsC (inQs p) = (pQtoC p).[z]. rewrite /= -horner_map z1C -map_poly_comp; congr _.[z]. apply: eq_map_poly => b /=; apply: canRL (mulfK _) _. by rewrite intr_eq0 denq_eq0. rewrite /= mulrzr -rmorphMz scalerMzl -{1}[b]divq_num_den -mulrzr. by rewrite divfK ?intr_eq0 ?denq_eq0 // scaler_int rmorph_int. exists Qs, QsC, s1; first by rewrite -map_comp Ds (eq_map inQsK). have sz_ps: size ps = size s by rewrite Ds size_map. apply/vspaceP=> x; rewrite memvf; have [p {x}<-] := z1gen x. elim/poly_ind: p => [|p b ApQs]; first by rewrite /inQs rmorph0 mem0v. rewrite /inQs rmorphD rmorphM /= fieldExt_hornerX fieldExt_hornerC -/inQs /=. suffices ->: z1 = \sum_(i < size s) s1`_i *+ a i. rewrite memvD ?memvZ ?mem1v ?memvM ?memv_suml // => i _. by rewrite rpredMn ?seqv_sub_adjoin ?mem_nth // size_map sz_ps. apply: (fmorph_inj QsC); rewrite z1C Dz rmorph_sum; apply: eq_bigr => i _. by rewrite rmorphMn {1}Ds !(nth_map 0) ?sz_ps //= inQsK. have [r [Dr /monic_neq0 nz_r] dv_r] := minCpolyP z. have rz0: root (pQtoC r) z by rewrite dv_r. have irr_r: irreducible_poly r. by apply/(subfx_irreducibleP rz0 nz_r)=> q qz0 nzq; rewrite dvdp_leq // -dv_r. exists (SubFieldExtType rz0 irr_r), (subfx_inj_rmorphism QtoCm z r). exists (subfx_root _ z r) => [|x]; first exact: subfx_inj_root. by have{x} [p ->] := subfxEroot rz0 nz_r x; exists p. Qed. Definition in_Crat_span s x := exists a : rat ^ size s, x = \sum_i QtoC (a i) * s`_i. Fact Crat_span_subproof s x : decidable (in_Crat_span s x). Proof. have [Qxs [QxsC [[|x1 s1] // [<- <-] {x s} _]]] := num_field_exists (x :: s). have QxsC_Z a zz: QxsC (a *: zz) = QtoC a * QxsC zz. rewrite mulrAC; apply: (canRL (mulfK _)); first by rewrite intr_eq0 denq_eq0. by rewrite mulrzr mulrzl -!rmorphMz scalerMzl -mulrzr -numqE scaler_int. apply: decP (x1 \in <>%VS) _; rewrite /in_Crat_span size_map. apply: (iffP idP) => [/coord_span-> | [a Dx]]. move: (coord _) => a; exists [ffun i => a i x1]; rewrite rmorph_sum. by apply: eq_bigr => i _; rewrite ffunE (nth_map 0). have{Dx} ->: x1 = \sum_i a i *: s1`_i. apply: (fmorph_inj QxsC); rewrite Dx rmorph_sum. by apply: eq_bigr => i _; rewrite QxsC_Z (nth_map 0). by apply: memv_suml => i _; rewrite memvZ ?memv_span ?mem_nth. Qed. Definition Crat_span s : pred algC := Crat_span_subproof s. Lemma Crat_spanP s x : reflect (in_Crat_span s x) (x \in Crat_span s). Proof. exact: sumboolP. Qed. Fact Crat_span_key s : pred_key (Crat_span s). Proof. by []. Qed. Canonical Crat_span_keyed s := KeyedPred (Crat_span_key s). Lemma mem_Crat_span s : {subset s <= Crat_span s}. Proof. move=> _ /(nthP 0)[ix ltxs <-]; pose i0 := Ordinal ltxs. apply/Crat_spanP; exists [ffun i => (i == i0)%:R]. rewrite (bigD1_ord i0) //= ffunE eqxx // rmorph1 mul1r. by rewrite big1 ?addr0 // => i; rewrite ffunE rmorph_nat mulr_natl lift_eqF. Qed. Fact Crat_span_zmod_closed s : zmod_closed (Crat_span s). Proof. split=> [|_ _ /Crat_spanP[x ->] /Crat_spanP[y ->]]. apply/Crat_spanP; exists 0. by apply/esym/big1=> i _; rewrite ffunE rmorph0 mul0r. apply/Crat_spanP; exists (x - y); rewrite -sumrB; apply: eq_bigr => i _. by rewrite -mulrBl -rmorphB !ffunE. Qed. Canonical Crat_span_opprPred s := OpprPred (Crat_span_zmod_closed s). Canonical Crat_span_addrPred s := AddrPred (Crat_span_zmod_closed s). Canonical Crat_span_zmodPred s := ZmodPred (Crat_span_zmod_closed s). Section MoreAlgCaut. Implicit Type rR : unitRingType. Lemma alg_num_field (Qz : fieldExtType rat) a : a%:A = ratr a :> Qz. Proof. by rewrite -in_algE fmorph_eq_rat. Qed. Lemma rmorphZ_num (Qz : fieldExtType rat) rR (f : {rmorphism Qz -> rR}) a x : f (a *: x) = ratr a * f x. Proof. by rewrite -mulr_algl rmorphM alg_num_field fmorph_rat. Qed. Lemma fmorph_numZ (Qz1 Qz2 : fieldExtType rat) (f : {rmorphism Qz1 -> Qz2}) : scalable f. Proof. by move=> a x; rewrite rmorphZ_num -alg_num_field mulr_algl. Qed. Definition NumLRmorphism Qz1 Qz2 f := AddLRMorphism (@fmorph_numZ Qz1 Qz2 f). End MoreAlgCaut. Section NumFieldProj. Variables (Qn : fieldExtType rat) (QnC : {rmorphism Qn -> algC}). Lemma Crat_spanZ b a : {in Crat_span b, forall x, ratr a * x \in Crat_span b}. Proof. move=> _ /Crat_spanP[a1 ->]; apply/Crat_spanP; exists [ffun i => a * a1 i]. by rewrite mulr_sumr; apply: eq_bigr => i _; rewrite ffunE mulrA -rmorphM. Qed. Lemma Crat_spanM b : {in Crat & Crat_span b, forall a x, a * x \in Crat_span b}. Proof. by move=> _ x /CratP[a ->]; apply: Crat_spanZ. Qed. (* In principle CtoQn could be taken to be additive and Q-linear, but this *) (* would require a limit construction. *) Lemma num_field_proj : {CtoQn | CtoQn 0 = 0 & cancel QnC CtoQn}. Proof. pose b := vbasis {:Qn}. have Qn_bC (u : {x | x \in Crat_span (map QnC b)}): {y | QnC y = sval u}. case: u => _ /= /Crat_spanP/sig_eqW[a ->]. exists (\sum_i a i *: b`_i); rewrite rmorph_sum; apply: eq_bigr => i _. by rewrite rmorphZ_num (nth_map 0) // -(size_map QnC). pose CtoQn x := oapp (fun u => sval (Qn_bC u)) 0 (insub x). suffices QnCK: cancel QnC CtoQn by exists CtoQn; rewrite // -(rmorph0 QnC). move=> x; rewrite /CtoQn insubT => /= [|Qn_x]; last first. by case: (Qn_bC _) => x1 /= /fmorph_inj. rewrite (coord_vbasis (memvf x)) rmorph_sum rpred_sum // => i _. rewrite rmorphZ_num Crat_spanZ ?mem_Crat_span // -/b. by rewrite -tnth_nth -tnth_map mem_tnth. Qed. Lemma restrict_aut_to_num_field (nu : {rmorphism algC -> algC}) : (forall x, exists y, nu (QnC x) = QnC y) -> {nu0 : {lrmorphism Qn -> Qn} | {morph QnC : x / nu0 x >-> nu x}}. Proof. move=> Qn_nu; pose nu0 x := sval (sig_eqW (Qn_nu x)). have QnC_nu0: {morph QnC : x / nu0 x >-> nu x}. by rewrite /nu0 => x; case: (sig_eqW _). suffices nu0M: rmorphism nu0 by exists (NumLRmorphism (RMorphism nu0M)). do 2?split=> [x y|]; apply: (fmorph_inj QnC); rewrite ?QnC_nu0 ?rmorph1 //. by rewrite ?(rmorphB, QnC_nu0). by rewrite ?(rmorphM, QnC_nu0). Qed. Lemma map_Qnum_poly (nu : {rmorphism algC -> algC}) p : p \in polyOver 1%VS -> map_poly (nu \o QnC) p = (map_poly QnC p). Proof. move=> Qp; apply/polyP=> i; rewrite /= !coef_map /=. have /vlineP[a ->]: p`_i \in 1%VS by apply: polyOverP. by rewrite alg_num_field !fmorph_rat. Qed. End NumFieldProj. Lemma restrict_aut_to_normal_num_field (Qn : splittingFieldType rat) (QnC : {rmorphism Qn -> algC})(nu : {rmorphism algC -> algC}) : {nu0 : {lrmorphism Qn -> Qn} | {morph QnC : x / nu0 x >-> nu x}}. Proof. apply: restrict_aut_to_num_field => x. case: (splitting_field_normal 1%AS x) => rs /eqP Hrs. have: root (map_poly (nu \o QnC) (minPoly 1%AS x)) (nu (QnC x)). by rewrite fmorph_root root_minPoly. rewrite map_Qnum_poly ?minPolyOver // Hrs. rewrite [map_poly _ _](_:_ = \prod_(y <- map QnC rs) ('X - y%:P)); last first. rewrite big_map rmorph_prod; apply: eq_bigr => i _. by rewrite rmorphB /= map_polyX map_polyC. rewrite root_prod_XsubC. by case/mapP => y _ ?; exists y. Qed. (* Integral spans. *) Lemma dec_Cint_span (V : vectType algC) m (s : m.-tuple V) v : decidable (inIntSpan s v). Proof. have s_s (i : 'I_m): s`_i \in <>%VS by rewrite memv_span ?memt_nth. have s_Zs a: \sum_(i < m) s`_i *~ a i \in <>%VS. by rewrite memv_suml // => i _; rewrite -scaler_int memvZ. case s_v: (v \in <>%VS); last by right=> [[a Dv]]; rewrite Dv s_Zs in s_v. pose IzT := {: 'I_m * 'I_(\dim <>)}; pose Iz := 'I_#|IzT|. pose b := vbasis <>. pose z_s := [seq coord b ij.2 (tnth s ij.1) | ij : IzT]. pose rank2 j i: Iz := enum_rank (i, j); pose val21 (p : Iz) := (enum_val p).1. pose inQzs w := [forall j, Crat_span z_s (coord b j w)]. have enum_pairK j: {in predT, cancel (rank2 j) val21}. by move=> i; rewrite /val21 enum_rankK. have Qz_Zs a: inQzs (\sum_(i < m) s`_i *~ a i). apply/forallP=> j; apply/Crat_spanP; rewrite /in_Crat_span size_map -cardE. exists [ffun ij => (a (val21 ij))%:Q *+ ((enum_val ij).2 == j)]. rewrite linear_sum {1}(reindex_onto _ _ (enum_pairK j)). rewrite big_mkcond; apply: eq_bigr => ij _ /=; rewrite nth_image (tnth_nth 0). rewrite (can2_eq (@enum_rankK _) (@enum_valK _)) ffunE -scaler_int /val21. case Dij: (enum_val ij) => [i j1]; rewrite xpair_eqE eqxx /= eq_sym -mulrb. by rewrite linearZ rmorphMn rmorph_int mulrnAl; case: eqP => // ->. case Qz_v: (inQzs v); last by right=> [[a Dv]]; rewrite Dv Qz_Zs in Qz_v. have [Qz [QzC [z1s Dz_s _]]] := num_field_exists z_s. have sz_z1s: size z1s = #|IzT| by rewrite -(size_map QzC) Dz_s size_map cardE. have xv j: {x | coord b j v = QzC x}. apply: sig_eqW; have /Crat_spanP[x ->] := forallP Qz_v j. exists (\sum_ij x ij *: z1s`_ij); rewrite rmorph_sum. apply: eq_bigr => ij _; rewrite mulrAC. apply: canLR (mulfK _) _; first by rewrite intr_eq0 denq_neq0. rewrite mulrzr -rmorphMz scalerMzl -(mulrzr (x _)) -numqE scaler_int. by rewrite rmorphMz mulrzl -(nth_map _ 0) ?Dz_s // -(size_map QzC) Dz_s. pose sz := [tuple [ffun j => z1s`_(rank2 j i)] | i < m]. have [Zsv | Zs'v] := dec_Qint_span sz [ffun j => sval (xv j)]. left; have{Zsv} [a Dv] := Zsv; exists a. transitivity (\sum_j \sum_(i < m) QzC ((sz`_i *~ a i) j) *: b`_j). rewrite {1}(coord_vbasis s_v) -/b; apply: eq_bigr => j _. rewrite -scaler_suml; congr (_ *: _). have{Dv} /ffunP/(_ j) := Dv; rewrite sum_ffunE !ffunE -rmorph_sum => <-. by case: (xv j). rewrite exchange_big; apply: eq_bigr => i _. rewrite (coord_vbasis (s_s i)) -/b mulrz_suml; apply: eq_bigr => j _. rewrite scalerMzl ffunMzE rmorphMz; congr ((_ *~ _) *: _). rewrite nth_mktuple ffunE -(nth_map _ 0) ?sz_z1s // Dz_s. by rewrite nth_image enum_rankK /= (tnth_nth 0). right=> [[a Dv]]; case: Zs'v; exists a. apply/ffunP=> j; rewrite sum_ffunE !ffunE; apply: (fmorph_inj QzC). case: (xv j) => /= _ <-; rewrite Dv linear_sum rmorph_sum. apply: eq_bigr => i _; rewrite nth_mktuple raddfMz !ffunMzE rmorphMz ffunE. by rewrite -(nth_map _ 0 QzC) ?sz_z1s // Dz_s nth_image enum_rankK -tnth_nth. Qed. Definition Cint_span (s : seq algC) : pred algC := fun x => dec_Cint_span (in_tuple [seq \row_(i < 1) y | y <- s]) (\row_i x). Fact Cint_span_key s : pred_key (Cint_span s). Proof. by []. Qed. Canonical Cint_span_keyed s := KeyedPred (Cint_span_key s). Lemma Cint_spanP n (s : n.-tuple algC) x : reflect (inIntSpan s x) (x \in Cint_span s). Proof. rewrite unfold_in; case: (dec_Cint_span _ _) => [Zs_x | Zs'x] /=. left; have{Zs_x} [] := Zs_x; rewrite /= size_map size_tuple => a /rowP/(_ 0). rewrite !mxE => ->; exists a; rewrite summxE; apply: eq_bigr => i _. by rewrite -scaler_int (nth_map 0) ?size_tuple // !mxE mulrzl. right=> [[a Dx]]; have{Zs'x} [] := Zs'x. rewrite /inIntSpan /= size_map size_tuple; exists a. apply/rowP=> i0; rewrite !mxE summxE Dx; apply: eq_bigr => i _. by rewrite -scaler_int mxE mulrzl (nth_map 0) ?size_tuple // !mxE. Qed. Lemma mem_Cint_span s : {subset s <= Cint_span s}. Proof. move=> _ /(nthP 0)[ix ltxs <-]; apply/(Cint_spanP (in_tuple s)). exists [ffun i => i == Ordinal ltxs : int]. rewrite (bigD1 (Ordinal ltxs)) //= ffunE eqxx. by rewrite big1 ?addr0 // => i; rewrite ffunE => /negbTE->. Qed. Lemma Cint_span_zmod_closed s : zmod_closed (Cint_span s). Proof. have sP := Cint_spanP (in_tuple s); split=> [|_ _ /sP[x ->] /sP[y ->]]. by apply/sP; exists 0; rewrite big1 // => i; rewrite ffunE. apply/sP; exists (x - y); rewrite -sumrB; apply: eq_bigr => i _. by rewrite !ffunE raddfB. Qed. Canonical Cint_span_opprPred s := OpprPred (Cint_span_zmod_closed s). Canonical Cint_span_addrPred s := AddrPred (Cint_span_zmod_closed s). Canonical Cint_span_zmodPred s := ZmodPred (Cint_span_zmod_closed s). (* Automorphism extensions. *) Lemma extend_algC_subfield_aut (Qs : fieldExtType rat) (QsC : {rmorphism Qs -> algC}) (phi : {rmorphism Qs -> Qs}) : {nu : {rmorphism algC -> algC} | {morph QsC : x / phi x >-> nu x}}. Proof. pose numF_inj (Qr : fieldExtType rat) := {rmorphism Qr -> algC}. pose subAut := {Qr : _ & numF_inj Qr * {lrmorphism Qr -> Qr}}%type. pose SubAut := existT _ _ (_, _) : subAut. pose Sdom (mu : subAut) := projT1 mu. pose Sinj (mu : subAut) : {rmorphism Sdom mu -> algC} := (projT2 mu).1. 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 -[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. by rewrite /= SinjZ rmorph1 mulr1. have ext1 mu0 x: {mu1 | exists y, x = Sinj mu1 y & exists2 in01 : {lrmorphism _}, Sinj mu0 =1 Sinj mu1 \o in01 & {morph in01: y / Saut mu0 y >-> Saut mu1 y}}. - pose b0 := vbasis {:Sdom mu0}. have [z _ /sig_eqW[[|px ps] // [Dx Ds]]] := algC_PET (x :: map (Sinj mu0) b0). have [p [_ mon_p] /(_ p) pz0] := minCpolyP z; rewrite dvdpp in pz0. have [r Dr] := closed_field_poly_normal (pQtoC p : {poly algC}). rewrite lead_coef_map {mon_p}(monicP mon_p) rmorph1 scale1r in Dr. have{pz0} rz: z \in r by rewrite -root_prod_XsubC -Dr. have [Qr [QrC [rr Drr genQr]]] := num_field_exists r. have{rz} [zz Dz]: {zz | QrC zz = z}. by move: rz; rewrite -Drr => /mapP/sig2_eqW[zz]; exists zz. have{ps Ds} [in01 Din01]: {in01 : {lrmorphism _} | Sinj mu0 =1 QrC \o in01}. have in01P y: {yy | Sinj mu0 y = QrC yy}. exists (\sum_i coord b0 i y *: (map_poly (in_alg Qr) ps`_i).[zz]). rewrite {1}(coord_vbasis (memvf y)) !rmorph_sum; apply: eq_bigr => i _. rewrite !SinjZ; congr (_ * _); rewrite -(nth_map _ 0) ?size_tuple // Ds. rewrite -horner_map Dz Sinj_poly (nth_map 0) //. by have:= congr1 size Ds; rewrite !size_map size_tuple => <-. pose in01 y := sval (in01P y). have Din01 y: Sinj mu0 y = QrC (in01 y) by rewrite /in01; case: (in01P y). suffices in01M: lrmorphism in01 by exists (LRMorphism in01M). pose rwM := (=^~ Din01, SinjZ, rmorph1, rmorphB, rmorphM). by do 3?split; try move=> ? ?; apply: (fmorph_inj QrC); rewrite !rwM. have {z zz Dz px} Dx: exists xx, x = QrC xx. exists (map_poly (in_alg Qr) px).[zz]. by rewrite -horner_map Dz Sinj_poly Dx. pose lin01 := linfun in01; pose K := (lin01 @: fullv)%VS. have memK y: reflect (exists yy, y = in01 yy) (y \in K). apply: (iffP memv_imgP) => [[yy _ ->] | [yy ->]]; by exists yy; rewrite ?lfunE ?memvf. have algK: is_aspace K. rewrite /is_aspace has_algid1; last first. by apply/memK; exists 1; rewrite rmorph1. apply/prodvP=> _ _ /memK[y1 ->] /memK[y2 ->]. by apply/memK; exists (y1 * y2); rewrite rmorphM. have ker_in01: lker lin01 == 0%VS. by apply/lker0P=> y1 y2; rewrite !lfunE; apply: fmorph_inj. pose f := (lin01 \o linfun (Saut mu0) \o lin01^-1)%VF. have Df y: f (in01 y) = in01 (Saut mu0 y). transitivity (f (lin01 y)); first by rewrite !lfunE. by do 4!rewrite lfunE /=; rewrite lker0_lfunK. have hom_f: kHom 1 (ASpace algK) f. apply/kHomP; split=> [_ _ /memK[y1 ->] /memK[y2 ->] |_ /vlineP[a ->]]. by rewrite -rmorphM !Df !rmorphM. by rewrite -(rmorph1 in01) -linearZ /= Df {1}linearZ /= rmorph1. pose pr := map_poly (in_alg Qr) p. have Qpr: pr \is a polyOver 1%VS. by apply/polyOverP=> i; rewrite coef_map memvZ ?memv_line. have splitQr: splittingFieldFor K pr fullv. apply: splittingFieldForS (sub1v (Sub K algK)) (subvf _) _; exists rr => //. congr (_ %= _): (eqpxx pr); apply/(map_poly_inj QrC). rewrite Sinj_poly Dr -Drr big_map rmorph_prod; apply: eq_bigr => zz _. by rewrite rmorphB /= map_polyX map_polyC. have [f1 aut_f1 Df1]:= kHom_extends (sub1v (ASpace algK)) hom_f Qpr splitQr. pose nu := LRMorphism (kHom_lrmorphism aut_f1). exists (SubAut Qr QrC nu) => //; exists in01 => //= y. by rewrite -Df -Df1 //; apply/memK; exists y. have phiZ: scalable phi. move=> a y; do 2!rewrite -mulr_algl -in_algE. by rewrite -[a]divq_num_den !(fmorph_div, rmorphM, rmorph_int). pose fix ext n := if n is i.+1 then oapp (fun x => s2val (ext1 (ext i) x)) (ext i) (unpickle i) else SubAut Qs QsC (AddLRMorphism phiZ). have mem_ext x n: (pickle x < n)%N -> {xx | Sinj (ext n) xx = x}. move=> ltxn; apply: sig_eqW; elim: n ltxn => // n IHn. rewrite ltnS leq_eqVlt => /predU1P[<- | /IHn[xx <-]] /=. by rewrite pickleK /=; case: (ext1 _ x) => mu [xx]; exists xx. case: (unpickle n) => /= [y|]; last by exists xx. case: (ext1 _ y) => mu /= _ [in_mu inj_in_mu _]. by exists (in_mu xx); rewrite inj_in_mu. pose nu x := Sinj _ (Saut _ (sval (mem_ext x _ (ltnSn _)))). have nu_inj n y: nu (Sinj (ext n) y) = Sinj (ext n) (Saut (ext n) y). rewrite /nu; case: (mem_ext _ _ _); move: _.+1 => n1 y1 Dy /=. without loss /subnK Dn1: n n1 y y1 Dy / (n <= n1)%N. by move=> IH; case/orP: (leq_total n n1) => /IH => [/(_ y) | /(_ y1)]->. move: (n1 - n)%N => k in Dn1; elim: k => [|k IHk] in n Dn1 y Dy *. by move: y1 Dy; rewrite -Dn1 => y1 /fmorph_inj ->. rewrite addSnnS in Dn1; move/IHk: Dn1 => /=. case: (unpickle _) => [z|] /=; last exact. case: (ext1 _ _) => mu /= _ [in_mu Dinj Daut]. by rewrite Dy => /(_ _ (Dinj _))->; rewrite -Daut Dinj. suffices nuM: rmorphism nu. by exists (RMorphism nuM) => x; rewrite /= (nu_inj 0%N). pose le_nu (x : algC) n := (pickle x < n)%N. have max3 x1 x2 x3: exists n, [/\ le_nu x1 n, le_nu x2 n & le_nu x3 n]. exists (maxn (pickle x1) (maxn (pickle x2) (pickle x3))).+1. by apply/and3P; rewrite /le_nu !ltnS -!geq_max. do 2?split; try move=> x1 x2. - have [n] := max3 (x1 - x2) x1 x2. case=> /mem_ext[y Dx] /mem_ext[y1 Dx1] /mem_ext[y2 Dx2]. rewrite -Dx nu_inj; rewrite -Dx1 -Dx2 -rmorphB in Dx. by rewrite (fmorph_inj _ Dx) !rmorphB -!nu_inj Dx1 Dx2. - have [n] := max3 (x1 * x2) x1 x2. case=> /mem_ext[y Dx] /mem_ext[y1 Dx1] /mem_ext[y2 Dx2]. rewrite -Dx nu_inj; rewrite -Dx1 -Dx2 -rmorphM in Dx. by rewrite (fmorph_inj _ Dx) !rmorphM -!nu_inj Dx1 Dx2. by rewrite -(rmorph1 QsC) (nu_inj 0%N) !rmorph1. Qed. (* Extended automorphisms of Q_n. *) Lemma Qn_aut_exists k n : coprime k n -> {u : {rmorphism algC -> algC} | forall z, z ^+ n = 1 -> u z = z ^+ k}. Proof. have [-> /eqnP | n_gt0 co_k_n] := posnP n. by rewrite gcdn0 => ->; exists [rmorphism of idfun]. have [z prim_z] := C_prim_root_exists n_gt0. have [Qn [QnC [[|zn []] // [Dz]]] genQn] := num_field_exists [:: z]. pose phi := kHomExtend 1 \1 zn (zn ^+ k). have homQn1: kHom 1 1 (\1%VF : 'End(Qn)) by rewrite kHom1. have pzn_zk0: root (map_poly \1%VF (minPoly 1 zn)) (zn ^+ k). rewrite -(fmorph_root QnC) rmorphX Dz -map_poly_comp. rewrite (@eq_map_poly _ _ _ QnC) => [|a]; last by rewrite /= id_lfunE. set p1 := map_poly _ _. have [q1 Dp1]: exists q1, p1 = pQtoC q1. have aP i: (minPoly 1 zn)`_i \in 1%VS. by apply/polyOverP; apply: minPolyOver. have{aP} a_ i := sig_eqW (vlineP _ _ (aP i)). exists (\poly_(i < size (minPoly 1 zn)) sval (a_ i)). apply/polyP=> i; rewrite coef_poly coef_map coef_poly /=. case: ifP => _; rewrite ?rmorph0 //; case: (a_ i) => a /= ->. apply: canRL (mulfK _) _; first by rewrite intr_eq0 denq_eq0. by rewrite mulrzr -rmorphMz scalerMzl -mulrzr -numqE scaler_int rmorph_int. have: root p1 z by rewrite -Dz fmorph_root root_minPoly. rewrite Dp1; have [q2 [Dq2 _] ->] := minCpolyP z. case/dvdpP=> r1 ->; rewrite rmorphM rootM /= -Dq2; apply/orP; right. rewrite (minCpoly_cyclotomic prim_z) /cyclotomic. rewrite (bigD1 (Ordinal (ltn_pmod k n_gt0))) ?coprime_modl //=. by rewrite rootM root_XsubC prim_expr_mod ?eqxx. have phiM: lrmorphism phi. by apply/kHom_lrmorphism; rewrite -genQn span_seq1 /= kHomExtendP. have [nu Dnu] := extend_algC_subfield_aut QnC (RMorphism phiM). exists nu => _ /(prim_rootP prim_z)[i ->]. rewrite rmorphX exprAC -Dz -Dnu /= -{1}[zn]hornerX /phi. rewrite (kHomExtend_poly homQn1) ?polyOverX //. rewrite map_polyE map_id_in => [|?]; last by rewrite id_lfunE. by rewrite polyseqK hornerX rmorphX. Qed. (* Algebraic integers. *) Definition Aint : {pred algC} := fun x => minCpoly x \is a polyOver Cint. Fact Aint_key : pred_key Aint. Proof. by []. Qed. Canonical Aint_keyed := KeyedPred Aint_key. Lemma root_monic_Aint p x : root p x -> p \is monic -> p \is a polyOver Cint -> x \in Aint. Proof. have pZtoQtoC pz: pQtoC (pZtoQ pz) = pZtoC pz. by rewrite -map_poly_comp; apply: eq_map_poly => b; rewrite /= rmorph_int. move=> px0 mon_p /floorCpP[pz Dp]; rewrite unfold_in. move: px0; rewrite Dp -pZtoQtoC; have [q [-> mon_q] ->] := minCpolyP x. case/dvdpP_rat_int=> qz [a nz_a Dq] [r]. move/(congr1 (fun q1 => lead_coef (a *: pZtoQ q1))). rewrite rmorphM scalerAl -Dq lead_coefZ lead_coefM /=. have /monicP->: pZtoQ pz \is monic by rewrite -(map_monic QtoCm) pZtoQtoC -Dp. rewrite (monicP mon_q) mul1r mulr1 lead_coef_map_inj //; last exact: intr_inj. rewrite Dq => ->; apply/polyOverP=> i; rewrite !(coefZ, coef_map). by rewrite -rmorphM /= rmorph_int Cint_int. Qed. Lemma Cint_rat_Aint z : z \in Crat -> z \in Aint -> z \in Cint. Proof. case/CratP=> a ->{z} /polyOverP/(_ 0%N). have [p [Dp mon_p] dv_p] := minCpolyP (ratr a); rewrite Dp coef_map. suffices /eqP->: p == 'X - a%:P by rewrite polyseqXsubC /= rmorphN rpredN. rewrite -eqp_monic ?monicXsubC // irredp_XsubC //. by rewrite -(size_map_poly QtoCm) -Dp neq_ltn size_minCpoly orbT. by rewrite -dv_p fmorph_root root_XsubC. Qed. Lemma Aint_Cint : {subset Cint <= Aint}. Proof. move=> x; rewrite -polyOverXsubC. by apply: root_monic_Aint; rewrite ?monicXsubC ?root_XsubC. Qed. Lemma Aint_int x : x%:~R \in Aint. Proof. by rewrite Aint_Cint ?Cint_int. Qed. Lemma Aint0 : 0 \in Aint. Proof. exact: (Aint_int 0). Qed. Lemma Aint1 : 1 \in Aint. Proof. exact: (Aint_int 1). Qed. Hint Resolve Aint0 Aint1 : core. Lemma Aint_unity_root n x : (n > 0)%N -> n.-unity_root x -> x \in Aint. Proof. move=> n_gt0 xn1; apply: root_monic_Aint xn1 (monic_Xn_sub_1 _ n_gt0) _. by apply/polyOverP=> i; rewrite coefB coefC -mulrb coefXn /= rpredB ?rpred_nat. Qed. Lemma Aint_prim_root n z : n.-primitive_root z -> z \in Aint. Proof. move=> pr_z; apply/(Aint_unity_root (prim_order_gt0 pr_z))/unity_rootP. exact: prim_expr_order. Qed. Lemma Aint_Cnat : {subset Cnat <= Aint}. Proof. by move=> z /Cint_Cnat/Aint_Cint. Qed. (* This is Isaacs, Lemma (3.3) *) Lemma Aint_subring_exists (X : seq algC) : {subset X <= Aint} -> {S : pred algC & (*a*) subring_closed S /\ (*b*) {subset X <= S} & (*c*) {Y : {n : nat & n.-tuple algC} & {subset tagged Y <= S} & forall x, reflect (inIntSpan (tagged Y) x) (x \in S)}}. Proof. move=> AZ_X; pose m := (size X).+1. pose n (i : 'I_m) := (size (minCpoly X`_i)).-2; pose N := (\max_i n i).+1. pose IY := family (fun i => [pred e : 'I_N | e <= n i]%N). have IY_0: 0 \in IY by apply/familyP=> // i; rewrite ffunE. pose inIY := enum_rank_in IY_0. pose Y := [seq \prod_(i < m) X`_i ^+ (f : 'I_N ^ m) i | f in IY]. have S_P := Cint_spanP [tuple of Y]; set S := Cint_span _ in S_P. have sYS: {subset Y <= S} by apply: mem_Cint_span. have S_1: 1 \in S. by apply/sYS/imageP; exists 0 => //; rewrite big1 // => i; rewrite ffunE. have SmulX (i : 'I_m): {in S, forall x, x * X`_i \in S}. move=> _ /S_P[x ->]; rewrite mulr_suml rpred_sum // => j _. rewrite mulrzAl rpredMz {x}// nth_image mulrC (bigD1 i) //= mulrA -exprS. move: {j}(enum_val j) (familyP (enum_valP j)) => f fP. have:= fP i; rewrite inE /= leq_eqVlt => /predU1P[-> | fi_ltn]; last first. apply/sYS/imageP; have fiK: (inord (f i).+1 : 'I_N) = (f i).+1 :> nat. by rewrite inordK // ltnS (bigmax_sup i). exists (finfun [eta f with i |-> inord (f i).+1]). apply/familyP=> i1; rewrite inE ffunE /= fun_if fiK. by case: eqP => [-> // | _]; apply: fP. rewrite (bigD1 i isT) ffunE /= eqxx fiK; congr (_ * _). by apply: eq_bigr => i1; rewrite ffunE /= => /negPf->. have [/monicP ] := (minCpoly_monic X`_i, root_minCpoly X`_i). rewrite /root horner_coef lead_coefE -(subnKC (size_minCpoly _)) subn2. rewrite big_ord_recr /= addrC addr_eq0 => ->; rewrite mul1r => /eqP->. have /floorCpP[p Dp]: X`_i \in Aint. by have [/(nth_default 0)-> | /(mem_nth 0)/AZ_X] := leqP (size X) i. rewrite -/(n i) Dp mulNr rpredN // mulr_suml rpred_sum // => [[e le_e]] /= _. rewrite coef_map -mulrA mulrzl rpredMz ?sYS //; apply/imageP. have eK: (inord e : 'I_N) = e :> nat by rewrite inordK // ltnS (bigmax_sup i). exists (finfun [eta f with i |-> inord e]). apply/familyP=> i1; rewrite inE ffunE /= fun_if eK. by case: eqP => [-> // | _]; apply: fP. rewrite (bigD1 i isT) ffunE /= eqxx eK; congr (_ * _). by apply: eq_bigr => i1; rewrite ffunE /= => /negPf->. exists S; last by exists (Tagged (fun n => n.-tuple _) [tuple of Y]). split=> [|x Xx]; last first. by rewrite -[x]mul1r -(nth_index 0 Xx) (SmulX (Ordinal _)) // ltnS index_size. split=> // x y Sx Sy; first by rewrite rpredB. case/S_P: Sy => {y}[y ->]; rewrite mulr_sumr rpred_sum //= => j. rewrite mulrzAr rpredMz {y}// nth_image; move: {j}(enum_val j) => f. elim/big_rec: _ => [|i y _ IHy] in x Sx *; first by rewrite mulr1. rewrite mulrA {y}IHy //. elim: {f}(f i : nat) => [|e IHe] in x Sx *; first by rewrite mulr1. by rewrite exprS mulrA IHe // SmulX. Qed. Section AlgIntSubring. Import DefaultKeying GRing.DefaultPred perm. (* This is Isaacs, Theorem (3.4). *) Theorem fin_Csubring_Aint S n (Y : n.-tuple algC) : mulr_closed S -> (forall x, reflect (inIntSpan Y x) (x \in S)) -> {subset S <= Aint}. Proof. have ZP_C c: (ZtoC c)%:P \is a polyOver Cint by rewrite raddfMz rpred_int. move=> mulS S_P x Sx; pose v := \row_(i < n) Y`_i. have [v0 | nz_v] := eqVneq v 0. case/S_P: Sx => {}x ->; rewrite big1 ?isAlgInt0 // => i _. by have /rowP/(_ i) := v0; rewrite !mxE => ->; rewrite mul0rz. have sYS (i : 'I_n): x * Y`_i \in S. by rewrite rpredM //; apply/S_P/Cint_spanP/mem_Cint_span/memt_nth. pose A := \matrix_(i, j < n) sval (sig_eqW (S_P _ (sYS j))) i. pose p := char_poly (map_mx ZtoC A). have: p \is a polyOver Cint. rewrite rpred_sum // => s _; rewrite rpredMsign rpred_prod // => j _. by rewrite !mxE /= rpredB ?rpredMn ?polyOverX. apply: root_monic_Aint (char_poly_monic _). rewrite -eigenvalue_root_char; apply/eigenvalueP; exists v => //. apply/rowP=> j; case dAj: (sig_eqW (S_P _ (sYS j))) => [a DxY]. by rewrite !mxE DxY; apply: eq_bigr => i _; rewrite !mxE dAj /= mulrzr. Qed. (* This is Isaacs, Corollary (3.5). *) Corollary Aint_subring : subring_closed Aint. Proof. suff rAZ: {in Aint &, forall x y, (x - y \in Aint) * (x * y \in Aint)}. by split=> // x y AZx AZy; rewrite rAZ. move=> x y AZx AZy. have [|S [ringS] ] := @Aint_subring_exists [:: x; y]; first exact/allP/and3P. move=> /allP/and3P[Sx Sy _] [Y _ genYS]. have AZ_S := fin_Csubring_Aint ringS genYS. by have [_ S_B S_M] := ringS; rewrite !AZ_S ?S_B ?S_M. Qed. Canonical Aint_opprPred := OpprPred Aint_subring. Canonical Aint_addrPred := AddrPred Aint_subring. Canonical Aint_mulrPred := MulrPred Aint_subring. Canonical Aint_zmodPred := ZmodPred Aint_subring. Canonical Aint_semiringPred := SemiringPred Aint_subring. Canonical Aint_smulrPred := SmulrPred Aint_subring. Canonical Aint_subringPred := SubringPred Aint_subring. End AlgIntSubring. Lemma Aint_aut (nu : {rmorphism algC -> algC}) x : (nu x \in Aint) = (x \in Aint). Proof. by rewrite !unfold_in minCpoly_aut. Qed. Definition dvdA (e : Algebraics.divisor) : {pred algC} := fun z => if e == 0 then z == 0 else z / e \in Aint. Fact dvdA_key e : pred_key (dvdA e). Proof. by []. Qed. Canonical dvdA_keyed e := KeyedPred (dvdA_key e). Delimit Scope algC_scope with A. Delimit Scope algC_expanded_scope with Ax. Notation "e %| x" := (x \in dvdA e) : algC_expanded_scope. Notation "e %| x" := (@in_mem Algebraics.divisor x (mem (dvdA e))) : algC_scope. Fact dvdA_zmod_closed e : zmod_closed (dvdA e). Proof. split=> [|x y]; first by rewrite unfold_in mul0r eqxx rpred0 ?if_same. rewrite ![(e %| _)%A]unfold_in. case: ifP => [_ x0 /eqP-> | _]; first by rewrite subr0. by rewrite mulrBl; apply: rpredB. Qed. Canonical dvdA_opprPred e := OpprPred (dvdA_zmod_closed e). Canonical dvdA_addrPred e := AddrPred (dvdA_zmod_closed e). Canonical dvdA_zmodPred e := ZmodPred (dvdA_zmod_closed e). Definition eqAmod (e x y : Algebraics.divisor) := (e %| x - y)%A. Notation "x == y %[mod e ]" := (eqAmod e x y) : algC_scope. Notation "x != y %[mod e ]" := (~~ (eqAmod e x y)) : algC_scope. Lemma eqAmod_refl e x : (x == x %[mod e])%A. Proof. by rewrite /eqAmod subrr rpred0. Qed. Hint Resolve eqAmod_refl : core. Lemma eqAmod_sym e x y : ((x == y %[mod e]) = (y == x %[mod e]))%A. Proof. by rewrite /eqAmod -opprB rpredN. Qed. Lemma eqAmod_trans e y x z : (x == y %[mod e] -> y == z %[mod e] -> x == z %[mod e])%A. Proof. by move=> Exy Eyz; rewrite /eqAmod -[x](subrK y) -addrA rpredD. Qed. Lemma eqAmod_transl e x y z : (x == y %[mod e])%A -> (x == z %[mod e])%A = (y == z %[mod e])%A. Proof. by move/(sym_left_transitive (eqAmod_sym e) (@eqAmod_trans e)). Qed. Lemma eqAmod_transr e x y z : (x == y %[mod e])%A -> (z == x %[mod e])%A = (z == y %[mod e])%A. Proof. by move/(sym_right_transitive (eqAmod_sym e) (@eqAmod_trans e)). Qed. Lemma eqAmod0 e x : (x == 0 %[mod e])%A = (e %| x)%A. Proof. by rewrite /eqAmod subr0. Qed. Lemma eqAmodN e x y : (- x == y %[mod e])%A = (x == - y %[mod e])%A. Proof. by rewrite eqAmod_sym /eqAmod !opprK addrC. Qed. Lemma eqAmodDr e x y z : (y + x == z + x %[mod e])%A = (y == z %[mod e])%A. Proof. by rewrite /eqAmod addrAC opprD !addrA subrK. Qed. Lemma eqAmodDl e x y z : (x + y == x + z %[mod e])%A = (y == z %[mod e])%A. Proof. by rewrite !(addrC x) eqAmodDr. Qed. Lemma eqAmodD e x1 x2 y1 y2 : (x1 == x2 %[mod e] -> y1 == y2 %[mod e] -> x1 + y1 == x2 + y2 %[mod e])%A. Proof. by rewrite -(eqAmodDl e x2 y1) -(eqAmodDr e y1); apply: eqAmod_trans. Qed. Lemma eqAmodm0 e : (e == 0 %[mod e])%A. Proof. by rewrite /eqAmod subr0 unfold_in; case: ifPn => // /divff->. Qed. Hint Resolve eqAmodm0 : core. Lemma eqAmodMr e : {in Aint, forall z x y, x == y %[mod e] -> x * z == y * z %[mod e]}%A. Proof. move=> z Zz x y. rewrite /eqAmod -mulrBl ![(e %| _)%A]unfold_in mulf_eq0 mulrAC. by case: ifP => [_ -> // | _ Exy]; apply: rpredM. Qed. Lemma eqAmodMl e : {in Aint, forall z x y, x == y %[mod e] -> z * x == z * y %[mod e]}%A. Proof. by move=> z Zz x y Exy; rewrite !(mulrC z) eqAmodMr. Qed. Lemma eqAmodMl0 e : {in Aint, forall x, x * e == 0 %[mod e]}%A. Proof. by move=> x Zx; rewrite -(mulr0 x) eqAmodMl. Qed. Lemma eqAmodMr0 e : {in Aint, forall x, e * x == 0 %[mod e]}%A. Proof. by move=> x Zx; rewrite /= mulrC eqAmodMl0. Qed. Lemma eqAmod_addl_mul e : {in Aint, forall x y, x * e + y == y %[mod e]}%A. Proof. by move=> x Zx y; rewrite -{2}[y]add0r eqAmodDr eqAmodMl0. Qed. Lemma eqAmodM e : {in Aint &, forall x1 y2 x2 y1, x1 == x2 %[mod e] -> y1 == y2 %[mod e] -> x1 * y1 == x2 * y2 %[mod e]}%A. Proof. move=> x1 y2 Zx1 Zy2 x2 y1 eq_x /(eqAmodMl Zx1)/eqAmod_trans-> //. exact: eqAmodMr. Qed. Lemma eqAmod_rat : {in Crat & &, forall e m n, (m == n %[mod e])%A = (m == n %[mod e])%C}. Proof. move=> e m n Qe Qm Qn; rewrite /eqCmod unfold_in /eqAmod unfold_in. case: ifPn => // nz_e; apply/idP/idP=> [/Cint_rat_Aint | /Aint_Cint] -> //. by rewrite rpred_div ?rpredB. Qed. Lemma eqAmod0_rat : {in Crat &, forall e n, (n == 0 %[mod e])%A = (e %| n)%C}. Proof. by move=> e n Qe Qn; rewrite /= eqAmod_rat /eqCmod ?subr0 ?Crat0. Qed. Lemma eqAmod_nat (e m n : nat) : (m == n %[mod e])%A = (m == n %[mod e])%N. Proof. by rewrite eqAmod_rat ?rpred_nat // eqCmod_nat. Qed. Lemma eqAmod0_nat (e m : nat) : (m == 0 %[mod e])%A = (e %| m)%N. Proof. by rewrite eqAmod0_rat ?rpred_nat // dvdC_nat. Qed. (* Multiplicative order. *) Definition orderC x := let p := minCpoly x in oapp val 0%N [pick n : 'I_(2 * size p ^ 2) | p == intrp 'Phi_n]. Notation "#[ x ]" := (orderC x) : C_scope. Lemma exp_orderC x : x ^+ #[x]%C = 1. Proof. rewrite /orderC; case: pickP => //= [] [n _] /= /eqP Dp. have n_gt0: (0 < n)%N. rewrite lt0n; apply: contraTneq (size_minCpoly x) => n0. by rewrite Dp n0 Cyclotomic0 rmorph1 size_poly1. have [z prim_z] := C_prim_root_exists n_gt0. rewrite prim_expr_order // -(root_cyclotomic prim_z). by rewrite -Cintr_Cyclotomic // -Dp root_minCpoly. Qed. Lemma dvdn_orderC x n : (#[x]%C %| n)%N = (x ^+ n == 1). Proof. apply/idP/eqP=> [|x_n_1]; first by apply: expr_dvd; apply: exp_orderC. have [-> | n_gt0] := posnP n; first by rewrite dvdn0. have [m prim_x m_dv_n] := prim_order_exists n_gt0 x_n_1. have{n_gt0} m_gt0 := dvdn_gt0 n_gt0 m_dv_n; congr (_ %| n)%N: m_dv_n. pose p := minCpoly x; have Dp: p = cyclotomic x m := minCpoly_cyclotomic prim_x. rewrite /orderC; case: pickP => /= [k /eqP Dp_k | no_k]; last first. suffices lt_m_2p: (m < 2 * size p ^ 2)%N. have /eqP[] := no_k (Ordinal lt_m_2p). by rewrite /= -/p Dp -Cintr_Cyclotomic. rewrite Dp size_cyclotomic (sqrnD 1) addnAC mulnDr -add1n leq_add //. suffices: (m <= \prod_(q <- primes m | q == 2) q * totient m ^ 2)%N. have [m_even | m_odd] := boolP (2 \in primes m). by rewrite -big_filter filter_pred1_uniq ?primes_uniq // big_seq1. by rewrite big_hasC ?has_pred1 // => /leq_trans-> //; apply: leq_addl. rewrite big_mkcond totientE // -mulnn -!big_split /=. rewrite {1}[m]prod_prime_decomp // prime_decompE big_map /= !big_seq. elim/big_ind2: _ => // [n1 m1 n2 m2 | q]; first exact: leq_mul. rewrite mem_primes => /and3P[q_pr _ q_dv_m]. rewrite lognE q_pr m_gt0 q_dv_m /=; move: (logn q _) => k. rewrite !mulnA expnS leq_mul //. case: (ltngtP q 2) (prime_gt1 q_pr) => // [q_gt2|->] _. rewrite mul1n mulnAC mulnn -{1}[q]muln1 leq_mul ?expn_gt0 ?prime_gt0 //. by rewrite -(subnKC q_gt2) (ltn_exp2l 1). by rewrite !muln1 -expnS (ltn_exp2l 0). have k_prim_x: k.-primitive_root x. have k_gt0: (0 < k)%N. rewrite lt0n; apply: contraTneq (size_minCpoly x) => k0. by rewrite Dp_k k0 Cyclotomic0 rmorph1 size_poly1. have [z prim_z] := C_prim_root_exists k_gt0. rewrite -(root_cyclotomic prim_z) -Cintr_Cyclotomic //. by rewrite -Dp_k root_minCpoly. apply/eqP; rewrite eqn_dvd !(@prim_order_dvd _ _ x) //. by rewrite !prim_expr_order ?eqxx. Qed. math-comp-mathcomp-1.12.0/mathcomp/field/all_field.v000066400000000000000000000004101375767750300223020ustar00rootroot00000000000000Require Export algC. Require Export algebraics_fundamentals. Require Export algnum. Require Export closed_field. Require Export cyclotomic. Require Export falgebra. Require Export fieldext. Require Export finfield. Require Export galois. Require Export separable. math-comp-mathcomp-1.12.0/mathcomp/field/closed_field.v000066400000000000000000001160311375767750300230120ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype choice ssrnat seq. From mathcomp Require Import fintype generic_quotient bigop ssralg poly. From mathcomp Require Import polydiv matrix mxpoly countalg ring_quotient. (******************************************************************************) (* This files contains two main contributions: *) (* 1. Theorem "closed_field_QEMixin" *) (* A proof that algebraically closed field enjoy quantifier elimination, *) (* as described in *) (* ``A formal quantifier elimination for algebraically closed fields'', *) (* proceedings of Calculemus 2010, by Cyril Cohen and Assia Mahboubi *) (* *) (* We constructs an instance of quantifier elimination mixin, *) (* (see the ssralg library) from the theory of polynomials with coefficients *) (* is an algebraically closed field (see the polydiv library). *) (* The algebraic operations operating on fomulae are implemented in CPS style *) (* We provide one CPS counterpart for each operation involved in the proof *) (* of quantifier elimination. See the paper for more details. *) (* *) (* 2. Theorems "countable_field_extension" and "countable_algebraic_closure" *) (* constructions for both simple extension and algebraic closure of *) (* countable fields, by Georges Gonthier. *) (* Note that the construction of the algebraic closure relies on the *) (* above mentionned quantifier elimination. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. Import Pdiv.Ring. Import PreClosedField. Module ClosedFieldQE. Section ClosedFieldQE. Variables (F : fieldType) (F_closed : GRing.ClosedField.axiom F). Notation fF := (@GRing.formula F). Notation tF := (@GRing.term F). Notation qf f := (GRing.qf_form f && GRing.rformula f). Definition polyF := seq tF. Lemma qf_simpl (f : fF) : (qf f -> GRing.qf_form f) * (qf f -> GRing.rformula f). Proof. by split=> /andP[]. Qed. Notation cps T := ((T -> fF) -> fF). Definition ret T1 : T1 -> cps T1 := fun x k => k x. Arguments ret {T1} x k /. Definition bind T1 T2 (x : cps T1) (f : T1 -> cps T2) : cps T2 := fun k => x (fun x => f x k). Arguments bind {T1 T2} x f k /. Notation "''let' x <- y ; z" := (bind y (fun x => z)) (at level 99, x at level 0, y at level 0, format "'[hv' ''let' x <- y ; '/' z ']'"). Definition cpsif T (c : fF) (t : T) (e : T) : cps T := fun k => GRing.If c (k t) (k e). Arguments cpsif {T} c t e k /. Notation "''if' c1 'then' c2 'else' c3" := (cpsif c1%T c2%T c3%T) (at level 200, right associativity, format "'[hv ' ''if' c1 '/' '[' 'then' c2 ']' '/' '[' 'else' c3 ']' ']'"). Notation eval := GRing.eval. Notation rterm := GRing.rterm. Notation qf_eval := GRing.qf_eval. Fixpoint eval_poly (e : seq F) pf := if pf is c :: q then eval_poly e q * 'X + (eval e c)%:P else 0. Definition rpoly (p : polyF) := all (@rterm F) p. Definition sizeT : polyF -> cps nat := (fix loop p := if p isn't c :: q then ret 0%N else 'let n <- loop q; if n is m.+1 then ret m.+2 else 'if (c == 0) then 0%N else 1%N). Definition qf_red_cps T (x : cps T) (y : _ -> T) := forall e k, qf_eval e (x k) = qf_eval e (k (y e)). Notation "x ->_ e y" := (qf_red_cps x (fun e => y)) (e ident, at level 90, format "x ->_ e y"). Definition qf_cps T D (x : cps T) := forall k, (forall y, D y -> qf (k y)) -> qf (x k). Lemma qf_cps_ret T D (x : T) : D x -> qf_cps D (ret x). Proof. move=> ??; exact. Qed. Hint Resolve qf_cps_ret : core. Lemma qf_cps_bind T1 D1 T2 D2 (x : cps T1) (f : T1 -> cps T2) : qf_cps D1 x -> (forall x, D1 x -> qf_cps D2 (f x)) -> qf_cps D2 (bind x f). Proof. by move=> xP fP k kP /=; apply: xP => y ?; apply: fP. Qed. Lemma qf_cps_if T D (c : fF) (t : T) (e : T) : qf c -> D t -> D e -> qf_cps D ('if c then t else e). Proof. move=> qfc Dt De k kP /=; have [qft qfe] := (kP _ Dt, kP _ De). by do !rewrite qf_simpl //. Qed. Lemma sizeTP (pf : polyF) : sizeT pf ->_e size (eval_poly e pf). Proof. elim: pf=> [|c qf qfP /=]; first by rewrite /= size_poly0. move=> e k; rewrite size_MXaddC qfP -(size_poly_eq0 (eval_poly _ _)). by case: (size (eval_poly e qf))=> //=; case: eqP; rewrite // orbF. Qed. Lemma sizeT_qf (p : polyF) : rpoly p -> qf_cps xpredT (sizeT p). Proof. elim: p => /= [_|c p ihp /andP[rc rq]]; first exact: qf_cps_ret. apply: qf_cps_bind; first exact: ihp. move=> [|n] //= _; last exact: qf_cps_ret. by apply: qf_cps_if; rewrite //= rc. Qed. Definition isnull (p : polyF) : cps bool := 'let n <- sizeT p; ret (n == 0%N). Lemma isnullP (p : polyF) : isnull p ->_e (eval_poly e p == 0). Proof. by move=> e k; rewrite sizeTP size_poly_eq0. Qed. Lemma isnull_qf (p : polyF) : rpoly p -> qf_cps xpredT (isnull p). Proof. move=> rp; apply: qf_cps_bind; first exact: sizeT_qf. by move=> ? _; apply: qf_cps_ret. Qed. Definition lt_sizeT (p q : polyF) : cps bool := 'let n <- sizeT p; 'let m <- sizeT q; ret (n < m). Definition lift (p : {poly F}) := map GRing.Const p. Lemma eval_lift (e : seq F) (p : {poly F}) : eval_poly e (lift p) = p. Proof. elim/poly_ind: p => [|p c]; first by rewrite /lift polyseq0. rewrite -cons_poly_def /lift polyseq_cons /nilp. case pn0: (_ == _) => /=; last by move->; rewrite -cons_poly_def. move=> _; rewrite polyseqC. case c0: (_==_)=> /=. move: pn0; rewrite (eqP c0) size_poly_eq0; move/eqP->. by apply: val_inj=> /=; rewrite polyseq_cons // polyseq0. by rewrite mul0r add0r; apply: val_inj=> /=; rewrite polyseq_cons // /nilp pn0. Qed. Fixpoint lead_coefT p : cps tF := if p is c :: q then 'let l <- lead_coefT q; 'if (l == 0) then c else l else ret 0%T. Lemma lead_coefTP (k : tF -> fF) : (forall x e, qf_eval e (k x) = qf_eval e (k (eval e x)%:T%T)) -> forall (p : polyF) (e : seq F), qf_eval e (lead_coefT p k) = qf_eval e (k (lead_coef (eval_poly e p))%:T%T). Proof. move=> kP p e; elim: p => [|a p IHp]/= in k kP e *. by rewrite lead_coef0 kP. rewrite IHp; last by move=> *; rewrite //= -kP. rewrite GRing.eval_If /= lead_coef_eq0. case p'0: (_ == _); first by rewrite (eqP p'0) mul0r add0r lead_coefC -kP. rewrite lead_coefDl ?lead_coefMX // polyseqC size_mul ?p'0 //; last first. by rewrite -size_poly_eq0 size_polyX. rewrite size_polyX addnC /=; case: (_ == _)=> //=. by rewrite ltnS lt0n size_poly_eq0 p'0. Qed. Lemma lead_coefT_qf (p : polyF) : rpoly p -> qf_cps (@rterm _) (lead_coefT p). Proof. elim: p => [_|c q ihp //= /andP[rc rq]]; first by apply: qf_cps_ret. apply: qf_cps_bind => [|y ty]; first exact: ihp. by apply: qf_cps_if; rewrite //= ty. Qed. Fixpoint amulXnT (a : tF) (n : nat) : polyF := if n is n'.+1 then 0%T :: (amulXnT a n') else [:: a]. Lemma eval_amulXnT (a : tF) (n : nat) (e : seq F) : eval_poly e (amulXnT a n) = (eval e a)%:P * 'X^n. Proof. elim: n=> [|n] /=; first by rewrite expr0 mulr1 mul0r add0r. by move->; rewrite addr0 -mulrA -exprSr. Qed. Lemma ramulXnT: forall a n, rterm a -> rpoly (amulXnT a n). Proof. by move=> a n; elim: n a=> [a /= -> //|n ihn a ra]; apply: ihn. Qed. Fixpoint sumpT (p q : polyF) := match p, q with a :: p, b :: q => (a + b)%T :: sumpT p q | [::], q => q | p, [::] => p end. Arguments sumpT : simpl nomatch. Lemma eval_sumpT (p q : polyF) (e : seq F) : eval_poly e (sumpT p q) = (eval_poly e p) + (eval_poly e q). Proof. elim: p q => [|a p Hp] q /=; first by rewrite add0r. case: q => [|b q] /=; first by rewrite addr0. rewrite Hp mulrDl -!addrA; congr (_ + _); rewrite polyCD addrC -addrA. by congr (_ + _); rewrite addrC. Qed. Lemma rsumpT (p q : polyF) : rpoly p -> rpoly q -> rpoly (sumpT p q). Proof. elim: p q=> [|a p ihp] q rp rq //; move: rp; case/andP=> ra rp. case: q rq => [|b q]; rewrite /= ?ra ?rp //=. by case/andP=> -> rq //=; apply: ihp. Qed. Fixpoint mulpT (p q : polyF) := if p isn't a :: p then [::] else sumpT [seq (a * x)%T | x <- q] (0%T :: mulpT p q). Lemma eval_mulpT (p q : polyF) (e : seq F) : eval_poly e (mulpT p q) = (eval_poly e p) * (eval_poly e q). Proof. elim: p q=> [|a p Hp] q /=; first by rewrite mul0r. rewrite eval_sumpT /= Hp addr0 mulrDl addrC mulrAC; congr (_ + _). by elim: q=> [|b q Hq] /=; rewrite ?mulr0 // Hq polyCM mulrDr mulrA. Qed. Lemma rpoly_map_mul (t : tF) (p : polyF) (rt : rterm t) : rpoly [seq (t * x)%T | x <- p] = rpoly p. Proof. by rewrite /rpoly all_map; apply/eq_all => x; rewrite /= rt. Qed. Lemma rmulpT (p q : polyF) : rpoly p -> rpoly q -> rpoly (mulpT p q). Proof. elim: p q=> [|a p ihp] q rp rq //=; move: rp; case/andP=> ra rp /=. apply: rsumpT; last exact: ihp. by rewrite rpoly_map_mul. Qed. Definition opppT : polyF -> polyF := map (GRing.Mul (- 1%T)%T). Lemma eval_opppT (p : polyF) (e : seq F) : eval_poly e (opppT p) = - eval_poly e p. Proof. by elim: p; rewrite /= ?oppr0 // => ? ? ->; rewrite !mulNr opprD polyCN mul1r. Qed. Definition natmulpT n : polyF -> polyF := map (GRing.Mul n%:R%T). Lemma eval_natmulpT (p : polyF) (n : nat) (e : seq F) : eval_poly e (natmulpT n p) = (eval_poly e p) *+ n. Proof. elim: p; rewrite //= ?mul0rn // => c p ->. rewrite mulrnDl mulr_natl polyCMn; congr (_ + _). by rewrite -mulr_natl mulrAC -mulrA mulr_natl mulrC. Qed. Fixpoint redivp_rec_loopT (q : polyF) sq cq (c : nat) (qq r : polyF) (n : nat) {struct n} : cps (nat * polyF * polyF) := 'let sr <- sizeT r; if sr < sq then ret (c, qq, r) else 'let lr <- lead_coefT r; let m := amulXnT lr (sr - sq) in let qq1 := sumpT (mulpT qq [::cq]) m in let r1 := sumpT (mulpT r ([::cq])) (opppT (mulpT m q)) in if n is n1.+1 then redivp_rec_loopT q sq cq c.+1 qq1 r1 n1 else ret (c.+1, qq1, r1). Fixpoint redivp_rec_loop (q : {poly F}) sq cq (k : nat) (qq r : {poly F}) (n : nat) {struct n} := if size r < sq then (k, qq, r) else let m := (lead_coef r) *: 'X^(size r - sq) in let qq1 := qq * cq%:P + m in let r1 := r * cq%:P - m * q in if n is n1.+1 then redivp_rec_loop q sq cq k.+1 qq1 r1 n1 else (k.+1, qq1, r1). Lemma redivp_rec_loopTP (k : nat * polyF * polyF -> fF) : (forall c qq r e, qf_eval e (k (c,qq,r)) = qf_eval e (k (c, lift (eval_poly e qq), lift (eval_poly e r)))) -> forall q sq cq c qq r n e (d := redivp_rec_loop (eval_poly e q) sq (eval e cq) c (eval_poly e qq) (eval_poly e r) n), qf_eval e (redivp_rec_loopT q sq cq c qq r n k) = qf_eval e (k (d.1.1, lift d.1.2, lift d.2)). Proof. move=> Pk q sq cq c qq r n e /=. elim: n c qq r k Pk e => [|n Pn] c qq r k Pk e; rewrite sizeTP. case ltrq : (_ < _); first by rewrite /= ltrq /= -Pk. rewrite lead_coefTP => [|a p]; rewrite Pk. rewrite ?(eval_mulpT,eval_amulXnT,eval_sumpT,eval_opppT) //=. by rewrite ltrq //= mul_polyC ?(mul0r,add0r). by symmetry; rewrite Pk ?(eval_mulpT,eval_amulXnT,eval_sumpT, eval_opppT). case ltrq : (_<_); first by rewrite /= ltrq Pk. rewrite lead_coefTP. rewrite Pn ?(eval_mulpT,eval_amulXnT,eval_sumpT,eval_opppT) //=. by rewrite ltrq //= mul_polyC ?(mul0r,add0r). rewrite -/redivp_rec_loopT => x e'. rewrite Pn; last by move=> *; rewrite Pk. symmetry; rewrite Pn; last by move=> *; rewrite Pk. rewrite Pk ?(eval_lift,eval_mulpT,eval_amulXnT,eval_sumpT,eval_opppT). by rewrite mul_polyC ?(mul0r,add0r). Qed. Lemma redivp_rec_loopT_qf (q : polyF) (sq : nat) (cq : tF) (c : nat) (qq r : polyF) (n : nat) : rpoly q -> rterm cq -> rpoly qq -> rpoly r -> qf_cps (fun x => [&& rpoly x.1.2 & rpoly x.2]) (redivp_rec_loopT q sq cq c qq r n). Proof. do ![move=>x/(pair x){x}] => rw; elim: n => [|n IHn]//= in q sq cq c qq r rw *; apply: qf_cps_bind; do ?[by apply: sizeT_qf; rewrite !rw] => sr _; case: ifPn => // _; do ?[by apply: qf_cps_ret; rewrite //= ?rw]; apply: qf_cps_bind; do ?[by apply: lead_coefT_qf; rewrite !rw] => lr /= rlr; [apply: qf_cps_ret|apply: IHn]; by do !rewrite ?(rsumpT,rmulpT,ramulXnT,rpoly_map_mul,rlr,rw) //=. Qed. Definition redivpT (p : polyF) (q : polyF) : cps (nat * polyF * polyF) := 'let b <- isnull q; if b then ret (0%N, [::0%T], p) else 'let sq <- sizeT q; 'let sp <- sizeT p; 'let lq <- lead_coefT q; redivp_rec_loopT q sq lq 0 [::0%T] p sp. Lemma redivp_rec_loopP (q : {poly F}) (c : nat) (qq r : {poly F}) (n : nat) : redivp_rec q c qq r n = redivp_rec_loop q (size q) (lead_coef q) c qq r n. Proof. by elim: n c qq r => [| n Pn] c qq r //=; rewrite Pn. Qed. Lemma redivpTP (k : nat * polyF * polyF -> fF) : (forall c qq r e, qf_eval e (k (c,qq,r)) = qf_eval e (k (c, lift (eval_poly e qq), lift (eval_poly e r)))) -> forall p q e (d := redivp (eval_poly e p) (eval_poly e q)), qf_eval e (redivpT p q k) = qf_eval e (k (d.1.1, lift d.1.2, lift d.2)). Proof. move=> Pk p q e /=; rewrite isnullP unlock /=. case q0 : (eval_poly e q == 0) => /=; first by rewrite Pk /= mul0r add0r polyC0. rewrite !sizeTP lead_coefTP /=; last by move=> *; rewrite !redivp_rec_loopTP. rewrite redivp_rec_loopTP /=; last by move=> *; rewrite Pk. by rewrite mul0r add0r polyC0 redivp_rec_loopP. Qed. Lemma redivpT_qf (p : polyF) (q : polyF) : rpoly p -> rpoly q -> qf_cps (fun x => [&& rpoly x.1.2 & rpoly x.2]) (redivpT p q). Proof. move=> rp rq; apply: qf_cps_bind => [|[] _]; first exact: isnull_qf. by apply: qf_cps_ret. apply: qf_cps_bind => [|sp _]; first exact: sizeT_qf. apply: qf_cps_bind => [|sq _]; first exact: sizeT_qf. apply: qf_cps_bind => [|lq rlq]; first exact: lead_coefT_qf. by apply: redivp_rec_loopT_qf => //=. Qed. Definition rmodpT (p : polyF) (q : polyF) : cps polyF := 'let d <- redivpT p q; ret d.2. Definition rdivpT (p : polyF) (q : polyF) : cps polyF := 'let d <- redivpT p q; ret d.1.2. Definition rscalpT (p : polyF) (q : polyF) : cps nat := 'let d <- redivpT p q; ret d.1.1. Definition rdvdpT (p : polyF) (q : polyF) : cps bool := 'let d <- rmodpT p q; isnull d. Fixpoint rgcdp_loop n (pp qq : {poly F}) {struct n} := let rr := rmodp pp qq in if rr == 0 then qq else if n is n1.+1 then rgcdp_loop n1 qq rr else rr. Fixpoint rgcdp_loopT n (pp : polyF) (qq : polyF) : cps polyF := 'let rr <- rmodpT pp qq; 'let nrr <- isnull rr; if nrr then ret qq else if n is n1.+1 then rgcdp_loopT n1 qq rr else ret rr. Lemma rgcdp_loopP (k : polyF -> fF) : (forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) -> forall n p q e, qf_eval e (rgcdp_loopT n p q k) = qf_eval e (k (lift (rgcdp_loop n (eval_poly e p) (eval_poly e q)))). Proof. move=> Pk n p q e; elim: n => /= [| m IHm] in p q e *; rewrite redivpTP /==> *; rewrite ?isnullP ?eval_lift -/(rmodp _ _); by case: (_ == _); do ?by rewrite -?Pk ?IHm ?eval_lift. Qed. Lemma rgcdp_loopT_qf (n : nat) (p : polyF) (q : polyF) : rpoly p -> rpoly q -> qf_cps rpoly (rgcdp_loopT n p q). Proof. elim: n => [|n IHn] in p q * => rp rq /=; (apply: qf_cps_bind=> [|rr rrr]; [ apply: qf_cps_bind => [|[[a u] v]]; do ?exact: redivpT_qf; by move=> /andP[/= ??]; apply: (@qf_cps_ret _ rpoly)| apply: qf_cps_bind => [|[] _]; by [apply: isnull_qf|apply: qf_cps_ret|apply: IHn]]). Qed. Definition rgcdpT (p : polyF) (q : polyF) : cps polyF := let aux p1 q1 : cps polyF := 'let b <- isnull p1; if b then ret q1 else 'let n <- sizeT p1; rgcdp_loopT n p1 q1 in 'let b <- lt_sizeT p q; if b then aux q p else aux p q. Lemma rgcdpTP (k : polyF -> fF) : (forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) -> forall p q e, qf_eval e (rgcdpT p q k) = qf_eval e (k (lift (rgcdp (eval_poly e p) (eval_poly e q)))). Proof. move=> Pk p q e; rewrite /rgcdpT /rgcdp !sizeTP /=. case: (_ < _); rewrite !isnullP /=; case: (_ == _); rewrite -?Pk ?sizeTP; by rewrite ?rgcdp_loopP. Qed. Lemma rgcdpT_qf (p : polyF) (q : polyF) : rpoly p -> rpoly q -> qf_cps rpoly (rgcdpT p q). Proof. move=> rp rq k kP; rewrite /rgcdpT /=; do ![rewrite sizeT_qf => // ? _]. case: (_ < _); rewrite ?isnull_qf // => -[]; rewrite ?kP // => _; by rewrite sizeT_qf => // ? _; rewrite rgcdp_loopT_qf. Qed. Fixpoint rgcdpTs (ps : seq polyF) : cps polyF := if ps is p :: pr then 'let pr <- rgcdpTs pr; rgcdpT p pr else ret [::0%T]. Lemma rgcdpTsP (k : polyF -> fF) : (forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) -> forall ps e, qf_eval e (rgcdpTs ps k) = qf_eval e (k (lift (\big[@rgcdp _/0%:P]_(i <- ps)(eval_poly e i)))). Proof. move=> Pk ps e; elim: ps k Pk => [|p ps Pps] /= k Pk. by rewrite /= big_nil Pk /= mul0r add0r. by rewrite big_cons Pps => *; rewrite !rgcdpTP // !eval_lift -?Pk. Qed. Lemma rgcdpTs_qf (ps : seq polyF) : all rpoly ps -> qf_cps rpoly (rgcdpTs ps). Proof. elim: ps => [_|c p ihp /andP[rc rp]] //=; first exact: qf_cps_ret. by apply: qf_cps_bind => [|r rr]; [apply: ihp|apply: rgcdpT_qf]. Qed. Fixpoint rgdcop_recT n (q : polyF) (p : polyF) := if n is m.+1 then 'let g <- rgcdpT p q; 'let sg <- sizeT g; if sg == 1%N then ret p else 'let r <- rdivpT p g; rgdcop_recT m q r else 'let b <- isnull q; ret [::b%:R%T]. Lemma rgdcop_recTP (k : polyF -> fF) : (forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) -> forall p q n e, qf_eval e (rgdcop_recT n p q k) = qf_eval e (k (lift (rgdcop_rec (eval_poly e p) (eval_poly e q) n))). Proof. move=> Pk p q n e; elim: n => [|n Pn] /= in k Pk p q e *. rewrite isnullP /=. by case: (_ == _); rewrite Pk /= mul0r add0r ?(polyC0, polyC1). rewrite /rcoprimep rgcdpTP ?sizeTP ?eval_lift => * /=. case: (_ == _); by do ?[rewrite /= ?(=^~Pk, redivpTP, rgcdpTP, sizeTP, Pn, eval_lift) //==> *]. do ?[rewrite /= ?(=^~Pk, redivpTP, rgcdpTP, sizeTP, Pn, eval_lift) //==> *]. case: (_ == _); by do ?[rewrite /= ?(=^~Pk, redivpTP, rgcdpTP, sizeTP, Pn, eval_lift) //==> *]. Qed. Lemma rgdcop_recT_qf (n : nat) (p : polyF) (q : polyF) : rpoly p -> rpoly q -> qf_cps rpoly (rgdcop_recT n p q). Proof. elim: n => [|n ihn] in p q * => k kP rp rq /=. by rewrite isnull_qf => //*; rewrite rq. rewrite rgcdpT_qf=> //*; rewrite sizeT_qf=> //*. case: (_ == _); rewrite ?kP ?rq //= redivpT_qf=> //= ? /andP[??]. by rewrite ihn. Qed. Definition rgdcopT q p := 'let sp <- sizeT p; rgdcop_recT sp q p. Lemma rgdcopTP (k : polyF -> fF) : (forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) -> forall p q e, qf_eval e (rgdcopT p q k) = qf_eval e (k (lift (rgdcop (eval_poly e p) (eval_poly e q)))). Proof. by move=> *; rewrite sizeTP rgdcop_recTP 1?Pk. Qed. Lemma rgdcopT_qf (p : polyF) (q : polyF) : rpoly p -> rpoly q -> qf_cps rpoly (rgdcopT p q). Proof. by move=> rp rq k kP; rewrite sizeT_qf => //*; rewrite rgdcop_recT_qf. Qed. Definition ex_elim_seq (ps : seq polyF) (q : polyF) : fF := ('let g <- rgcdpTs ps; 'let d <- rgdcopT q g; 'let n <- sizeT d; ret (n != 1%N)) GRing.Bool. Lemma ex_elim_seqP (ps : seq polyF) (q : polyF) (e : seq F) : let gp := (\big[@rgcdp _/0%:P]_(p <- ps)(eval_poly e p)) in qf_eval e (ex_elim_seq ps q) = (size (rgdcop (eval_poly e q) gp) != 1%N). Proof. by do ![rewrite (rgcdpTsP,rgdcopTP,sizeTP,eval_lift) //= | move=> * //=]. Qed. Lemma ex_elim_seq_qf (ps : seq polyF) (q : polyF) : all rpoly ps -> rpoly q -> qf (ex_elim_seq ps q). Proof. move=> rps rq; apply: rgcdpTs_qf=> // g rg; apply: rgdcopT_qf=> // d rd. exact : sizeT_qf. Qed. Fixpoint abstrX (i : nat) (t : tF) := match t with | 'X_n => if n == i then [::0; 1] else [::t] | - x => opppT (abstrX i x) | x + y => sumpT (abstrX i x) (abstrX i y) | x * y => mulpT (abstrX i x) (abstrX i y) | x *+ n => natmulpT n (abstrX i x) | x ^+ n => let ax := (abstrX i x) in iter n (mulpT ax) [::1] | _ => [::t] end%T. Lemma abstrXP (i : nat) (t : tF) (e : seq F) (x : F) : rterm t -> (eval_poly e (abstrX i t)).[x] = eval (set_nth 0 e i x) t. Proof. elim: t => [n | r | n | t tP s sP | t tP | t tP n | t tP s sP | t tP | t tP n] h. - move=> /=; case ni: (_ == _); rewrite //= ?(mul0r,add0r,addr0,polyC1,mul1r,hornerX,hornerC); by rewrite // nth_set_nth /= ni. - by rewrite /= mul0r add0r hornerC. - by rewrite /= mul0r add0r hornerC. - by case/andP: h => *; rewrite /= eval_sumpT hornerD tP ?sP. - by rewrite /= eval_opppT hornerN tP. - by rewrite /= eval_natmulpT hornerMn tP. - by case/andP: h => *; rewrite /= eval_mulpT hornerM tP ?sP. - by []. - elim: n h => [|n ihn] rt; first by rewrite /= expr0 mul0r add0r hornerC. by rewrite /= eval_mulpT exprSr hornerM ihn // mulrC tP. Qed. Lemma rabstrX (i : nat) (t : tF) : rterm t -> rpoly (abstrX i t). Proof. elim: t; do ?[ by move=> * //=; do ?case: (_ == _)]. - move=> t irt s irs /=; case/andP=> rt rs. by apply: rsumpT; rewrite ?irt ?irs //. - by move=> t irt /= rt; rewrite rpoly_map_mul ?irt //. - by move=> t irt /= n rt; rewrite rpoly_map_mul ?irt //. - move=> t irt s irs /=; case/andP=> rt rs. by apply: rmulpT; rewrite ?irt ?irs //. - move=> t irt /= n rt; move: (irt rt) => {}rt; elim: n => [|n ihn] //=. exact: rmulpT. Qed. Implicit Types tx ty : tF. Lemma abstrX_mulM (i : nat) : {morph abstrX i : x y / x * y >-> mulpT x y}%T. Proof. by []. Qed. Lemma abstrX1 (i : nat) : abstrX i 1%T = [::1%T]. Proof. done. Qed. Lemma eval_poly_mulM e : {morph eval_poly e : x y / mulpT x y >-> x * y}. Proof. by move=> x y; rewrite eval_mulpT. Qed. Lemma eval_poly1 e : eval_poly e [::1%T] = 1. Proof. by rewrite /= mul0r add0r. Qed. Notation abstrX_bigmul := (big_morph _ (abstrX_mulM _) (abstrX1 _)). Notation eval_bigmul := (big_morph _ (eval_poly_mulM _) (eval_poly1 _)). Notation bigmap_id := (big_map _ (fun _ => true) id). Lemma rseq_poly_map (x : nat) (ts : seq tF) : all (@rterm _) ts -> all rpoly (map (abstrX x) ts). Proof. by elim: ts => //= t ts iht; case/andP=> rt rts; rewrite rabstrX // iht. Qed. Definition ex_elim (x : nat) (pqs : seq tF * seq tF) := ex_elim_seq (map (abstrX x) pqs.1) (abstrX x (\big[GRing.Mul/1%T]_(q <- pqs.2) q)). Lemma ex_elim_qf (x : nat) (pqs : seq tF * seq tF) : GRing.dnf_rterm pqs -> qf (ex_elim x pqs). case: pqs => ps qs; case/andP=> /= rps rqs. apply: ex_elim_seq_qf; first exact: rseq_poly_map. apply: rabstrX=> /=. elim: qs rqs=> [|t ts iht] //=; first by rewrite big_nil. by case/andP=> rt rts; rewrite big_cons /= rt /= iht. Qed. Lemma holds_conj : forall e i x ps, all (@rterm _) ps -> (GRing.holds (set_nth 0 e i x) (foldr (fun t : tF => GRing.And (t == 0)) GRing.True%T ps) <-> all ((@root _)^~ x) (map (eval_poly e \o abstrX i) ps)). Proof. move=> e i x; elim=> [|p ps ihps] //=. case/andP=> rp rps; rewrite rootE abstrXP //. constructor; first by case=> -> hps; rewrite eqxx /=; apply/ihps. by case/andP; move/eqP=> -> psr; split=> //; apply/ihps. Qed. Lemma holds_conjn (e : seq F) (i : nat) (x : F) (ps : seq tF) : all (@rterm _) ps -> (GRing.holds (set_nth 0 e i x) (foldr (fun t : tF => GRing.And (t != 0)) GRing.True ps) <-> all (fun p => ~~root p x) (map (eval_poly e \o abstrX i) ps)). Proof. elim: ps => [|p ps ihps] //=. case/andP=> rp rps; rewrite rootE abstrXP //. constructor; first by case=> /eqP-> hps /=; apply/ihps. by case/andP=> pr psr; split; first apply/eqP=> //; apply/ihps. Qed. Lemma holds_ex_elim: GRing.valid_QE_proj ex_elim. Proof. move=> i [ps qs] /= e; case/andP=> /= rps rqs. rewrite ex_elim_seqP big_map. have -> : \big[@rgcdp _/0%:P]_(j <- ps) eval_poly e (abstrX i j) = \big[@rgcdp _/0%:P]_(j <- (map (eval_poly e) (map (abstrX i) (ps)))) j. by rewrite !big_map. rewrite -!map_comp. have aux I (l : seq I) (P : I -> {poly F}) : \big[(@gcdp F)/0]_(j <- l) P j %= \big[(@rgcdp F)/0]_(j <- l) P j. elim: l => [| u l ihl] /=; first by rewrite !big_nil eqpxx. rewrite !big_cons; move: ihl; move/(eqp_gcdr (P u)) => h. by apply: eqp_trans h _; rewrite eqp_sym; apply: eqp_rgcd_gcd. case g0: (\big[(@rgcdp F)/0%:P]_(j <- map (eval_poly e \o abstrX i) ps) j == 0). rewrite (eqP g0) rgdcop0. case m0 : (_ == 0)=> //=; rewrite ?(size_poly1,size_poly0) //=. rewrite abstrX_bigmul eval_bigmul -bigmap_id in m0. constructor=> [[x] // []] //. case=> _; move/holds_conjn=> hc; move/hc:rqs. by rewrite -root_bigmul //= (eqP m0) root0. constructor; move/negP:m0; move/negP=>m0. case: (closed_nonrootP F_closed _ m0) => x {m0}. rewrite abstrX_bigmul eval_bigmul -bigmap_id root_bigmul=> m0. exists x; do 2?constructor=> //; last by apply/holds_conjn. apply/holds_conj; rewrite //= -root_biggcd. by rewrite (eqp_root (aux _ _ _ )) (eqP g0) root0. apply: (iffP (closed_rootP F_closed _)) => -[x Px]; exists x; move: Px => //=. rewrite (eqp_root (eqp_rgdco_gdco _ _)) root_gdco ?g0 //. rewrite -(eqp_root (aux _ _ _ )) root_biggcd abstrX_bigmul eval_bigmul. rewrite -bigmap_id root_bigmul; case/andP=> psr qsr. do 2?constructor; first by apply/holds_conj. by apply/holds_conjn. rewrite (eqp_root (eqp_rgdco_gdco _ _)) root_gdco ?g0 // -(eqp_root (aux _ _ _)). rewrite root_biggcd abstrX_bigmul eval_bigmul -bigmap_id. rewrite root_bigmul=> [[] // [hps hqs]]; apply/andP. constructor; first by apply/holds_conj. by apply/holds_conjn. Qed. Lemma wf_ex_elim : GRing.wf_QE_proj ex_elim. Proof. by move=> i bc /= rbc; apply: ex_elim_qf. Qed. Definition Mixin := QEdecFieldMixin wf_ex_elim holds_ex_elim. End ClosedFieldQE. End ClosedFieldQE. Notation closed_field_QEMixin := ClosedFieldQE.Mixin. Import CodeSeq. Lemma countable_field_extension (F : countFieldType) (p : {poly F}) : size p > 1 -> {E : countFieldType & {FtoE : {rmorphism F -> E} & {w : E | root (map_poly FtoE p) w & forall u : E, exists q, u = (map_poly FtoE q).[w]}}}. Proof. pose fix d i := if i is i1.+1 then let d1 := oapp (gcdp (d i1)) 0 (unpickle i1) in if size d1 > 1 then d1 else d i1 else p. move=> p_gt1; have sz_d i: size (d i) > 1 by elim: i => //= i IHi; case: ifP. have dv_d i j: i <= j -> d j %| d i. move/subnK <-; elim: {j}(j - i)%N => //= j IHj; case: ifP => //=. case: (unpickle _) => /= [q _|]; last by rewrite size_poly0. exact: dvdp_trans (dvdp_gcdl _ _) IHj. pose I : pred {poly F} := [pred q | d (pickle q).+1 %| q]. have I'co q i: q \notin I -> i > pickle q -> coprimep q (d i). rewrite inE => I'q /dv_d/coprimep_dvdl-> //; apply: contraR I'q. rewrite coprimep_sym /coprimep /= pickleK /= neq_ltn. case: ifP => [_ _| ->]; first exact: dvdp_gcdr. rewrite orbF ltnS leqn0 size_poly_eq0 gcdp_eq0 -size_poly_eq0. by rewrite -leqn0 leqNgt ltnW //. have memI q: reflect (exists i, d i %| q) (q \in I). apply: (iffP idP) => [|[i dv_di_q]]; first by exists (pickle q).+1. have [le_i_q | /I'co i_co_q] := leqP i (pickle q). rewrite inE /= pickleK /=; case: ifP => _; first exact: dvdp_gcdr. exact: dvdp_trans (dv_d _ _ le_i_q) dv_di_q. apply: contraR i_co_q _. by rewrite /coprimep (eqp_size (dvdp_gcd_idr dv_di_q)) neq_ltn sz_d orbT. have I_ideal : idealr_closed I. split=> [||a q1 q2 Iq1 Iq2]; first exact: dvdp0. by apply/memI=> [[i /idPn[]]]; rewrite dvdp1 neq_ltn sz_d orbT. apply/memI; exists (maxn (pickle q1).+1 (pickle q2).+1); apply: dvdp_add. by apply: dvdp_mull; apply: dvdp_trans Iq1; apply/dv_d/leq_maxl. by apply: dvdp_trans Iq2; apply/dv_d/leq_maxr. pose Iaddkey := GRing.Pred.Add (DefaultPredKey I) I_ideal. pose Iidkey := MkIdeal (GRing.Pred.Zmod Iaddkey I_ideal) I_ideal. pose E := ComRingType _ (@Quotient.mulqC _ _ _ (KeyedPred Iidkey)). pose PtoE : {rmorphism {poly F} -> E} := [rmorphism of \pi_E%qT : {poly F} -> E]. have PtoEd i: PtoE (d i) = 0. by apply/eqP; rewrite piE Quotient.equivE subr0; apply/memI; exists i. pose Einv (z : E) (q := repr z) (dq := d (pickle q).+1) := let q_unitP := Bezout_eq1_coprimepP q dq in if q_unitP is ReflectT ex_uv then PtoE (sval (sig_eqW ex_uv)).1 else 0. have Einv0: Einv 0 = 0. rewrite /Einv; case: Bezout_eq1_coprimepP => // ex_uv. case/negP: (oner_neq0 E); rewrite piE -[_ 1]/(PtoE 1); have [uv <-] := ex_uv. by rewrite rmorphD !rmorphM PtoEd /= reprK !mulr0 addr0. have EmulV: GRing.Field.axiom Einv. rewrite /Einv=> z nz_z; case: Bezout_eq1_coprimepP => [ex_uv |]; last first. move/Bezout_eq1_coprimepP; rewrite I'co //. by rewrite piE -{1}[z]reprK -Quotient.idealrBE subr0 in nz_z. apply/eqP; case: sig_eqW => {ex_uv} [uv uv1]; set i := _.+1 in uv1 *. rewrite piE /= -[z]reprK -(rmorphM PtoE) -Quotient.idealrBE. by rewrite -uv1 opprD addNKr -mulNr; apply/memI; exists i; apply: dvdp_mull. pose Efield := FieldType _ (FieldMixin EmulV Einv0). pose Ecount := CountType Efield (CanCountMixin reprK). pose FtoE := [rmorphism of PtoE \o polyC]; pose w : E := PtoE 'X. have defPtoE q: (map_poly FtoE q).[w] = PtoE q. by rewrite map_poly_comp horner_map [_.['X]]comp_polyXr. exists [countFieldType of Ecount], FtoE, w => [|u]. by rewrite /root defPtoE (PtoEd 0%N). by exists (repr u); rewrite defPtoE /= reprK. Qed. Lemma countable_algebraic_closure (F : countFieldType) : {K : countClosedFieldType & {FtoK : {rmorphism F -> K} | integralRange FtoK}}. Proof. pose minXp (R : ringType) (p : {poly R}) := if size p > 1 then p else 'X. have minXp_gt1 R p: size (minXp R p) > 1. by rewrite /minXp; case: ifP => // _; rewrite size_polyX. have minXpE (R : ringType) (p : {poly R}) : size p > 1 -> minXp R p = p. by rewrite /minXp => ->. have ext1 p := countable_field_extension (minXp_gt1 _ p). pose ext1fT E p := tag (ext1 E p). pose ext1to E p : {rmorphism _ -> ext1fT E p} := tag (tagged (ext1 E p)). pose ext1w E p : ext1fT E p := s2val (tagged (tagged (ext1 E p))). have ext1root E p: root (map_poly (ext1to E p) (minXp E p)) (ext1w E p). by rewrite /ext1w; case: (tagged (tagged (ext1 E p))). have ext1gen E p u: {q | u = (map_poly (ext1to E p) q).[ext1w E p]}. by apply: sig_eqW; rewrite /ext1w; case: (tagged (tagged (ext1 E p))) u. pose pExtEnum (E : countFieldType) := nat -> {poly E}. pose Ext := {E : countFieldType & pExtEnum E}; pose MkExt : Ext := Tagged _ _. pose EtoInc (E : Ext) i := ext1to (tag E) (tagged E i). pose incEp E i j := let v := map_poly (EtoInc E i) (tagged E j) in if decode j is [:: i1; k] then if i1 == i then odflt v (unpickle k) else v else v. pose fix E_ i := if i is i1.+1 then MkExt _ (incEp (E_ i1) i1) else MkExt F \0. pose E i := tag (E_ i); pose Krep := {i : nat & E i}. pose fix toEadd i k : {rmorphism E i -> E (k + i)%N} := if k is k1.+1 then [rmorphism of EtoInc _ (k1 + i)%N \o toEadd _ _] else [rmorphism of idfun]. pose toE i j (le_ij : i <= j) := ecast j {rmorphism E i -> E j} (subnK le_ij) (toEadd i (j - i)%N). have toEeq i le_ii: toE i i le_ii =1 id. by rewrite /toE; move: (subnK _); rewrite subnn => ?; rewrite eq_axiomK. have toEleS i j leij leiSj z: toE i j.+1 leiSj z = EtoInc _ _ (toE i j leij z). rewrite /toE; move: (j - i)%N {leij leiSj}(subnK _) (subnK _) => k. by case: j /; rewrite (addnK i k.+1) => eq_kk; rewrite [eq_kk]eq_axiomK. have toEirr := congr1 ((toE _ _)^~ _) (bool_irrelevance _ _). have toEtrans j i k leij lejk leik z: toE i k leik z = toE j k lejk (toE i j leij z). - elim: k leik lejk => [|k IHk] leiSk lejSk. by case: j => // in leij lejSk *; rewrite toEeq. have:= lejSk; rewrite {1}leq_eqVlt ltnS => /predU1P[Dk | lejk]. by rewrite -Dk in leiSk lejSk *; rewrite toEeq. by have leik := leq_trans leij lejk; rewrite !toEleS -IHk. have [leMl leMr] := (leq_maxl, leq_maxr); pose le_max := (leq_max, leqnn, orbT). pose pairK (x y : Krep) (m := maxn _ _) := (toE _ m (leMl _ _) (tagged x), toE _ m (leMr _ _) (tagged y)). pose eqKrep x y := prod_curry (@eq_op _) (pairK x y). have eqKrefl : reflexive eqKrep by move=> z; apply/eqP; apply: toEirr. have eqKsym : symmetric eqKrep. move=> z1 z2; rewrite {1}/eqKrep /= eq_sym; move: (leMl _ _) (leMr _ _). by rewrite maxnC => lez1m lez2m; congr (_ == _); apply: toEirr. have eqKtrans : transitive eqKrep. rewrite /eqKrep /= => z2 z1 z3 /eqP eq_z12 /eqP eq_z23. rewrite -(inj_eq (fmorph_inj (toE _ _ (leMr (tag z2) _)))). rewrite -!toEtrans ?le_max // maxnCA maxnA => lez3m lez1m. rewrite {lez1m}(toEtrans (maxn (tag z1) (tag z2))) // {}eq_z12. do [rewrite -toEtrans ?le_max // -maxnA => lez2m] in lez3m *. by rewrite (toEtrans (maxn (tag z2) (tag z3))) // eq_z23 -toEtrans. pose K := {eq_quot (EquivRel _ eqKrefl eqKsym eqKtrans)}%qT. have cntK : Countable.mixin_of K := CanCountMixin reprK. pose EtoKrep i (x : E i) : K := \pi%qT (Tagged E x). have [EtoK piEtoK]: {EtoK | forall i, EtoKrep i =1 EtoK i} by exists EtoKrep. pose FtoK := EtoK 0%N; rewrite {}/EtoKrep in piEtoK. have eqEtoK i j x y: toE i _ (leMl i j) x = toE j _ (leMr i j) y -> EtoK i x = EtoK j y. - by move/eqP=> eq_xy; rewrite -!piEtoK; apply/eqmodP. have toEtoK j i leij x : EtoK j (toE i j leij x) = EtoK i x. by apply: eqEtoK; rewrite -toEtrans. have EtoK_0 i: EtoK i 0 = FtoK 0 by apply: eqEtoK; rewrite !rmorph0. have EtoK_1 i: EtoK i 1 = FtoK 1 by apply: eqEtoK; rewrite !rmorph1. have EtoKeq0 i x: (EtoK i x == FtoK 0) = (x == 0). by rewrite /FtoK -!piEtoK eqmodE /= /eqKrep /= rmorph0 fmorph_eq0. have toErepr m i leim x lerm: toE _ m lerm (tagged (repr (EtoK i x))) = toE i m leim x. - have: (Tagged E x == repr (EtoK i x) %[mod K])%qT by rewrite reprK piEtoK. rewrite eqmodE /= /eqKrep; case: (repr _) => j y /= in lerm * => /eqP /=. have leijm: maxn i j <= m by rewrite geq_max leim. by move/(congr1 (toE _ _ leijm)); rewrite -!toEtrans. pose Kadd (x y : K) := EtoK _ (prod_curry +%R (pairK (repr x) (repr y))). pose Kopp (x : K) := EtoK _ (- tagged (repr x)). pose Kmul (x y : K) := EtoK _ (prod_curry *%R (pairK (repr x) (repr y))). pose Kinv (x : K) := EtoK _ (tagged (repr x))^-1. have EtoK_D i: {morph EtoK i : x y / x + y >-> Kadd x y}. move=> x y; apply: eqEtoK; set j := maxn (tag _) _; rewrite !rmorphD. by rewrite -!toEtrans ?le_max // => lexm leym; rewrite !toErepr. have EtoK_N i: {morph EtoK i : x / - x >-> Kopp x}. by move=> x; apply: eqEtoK; set j := tag _; rewrite !rmorphN toErepr. have EtoK_M i: {morph EtoK i : x y / x * y >-> Kmul x y}. move=> x y; apply: eqEtoK; set j := maxn (tag _) _; rewrite !rmorphM. by rewrite -!toEtrans ?le_max // => lexm leym; rewrite !toErepr. have EtoK_V i: {morph EtoK i : x / x^-1 >-> Kinv x}. by move=> x; apply: eqEtoK; set j := tag _; rewrite !fmorphV toErepr. case: {toErepr}I in (Kadd) (Kopp) (Kmul) (Kinv) EtoK_D EtoK_N EtoK_M EtoK_V. pose inEi i z := {x : E i | z = EtoK i x}; have KtoE z: {i : nat & inEi i z}. by elim/quotW: z => [[i x] /=]; exists i, x; rewrite piEtoK. have inEle i j z: i <= j -> inEi i z -> inEi j z. by move=> leij [x ->]; exists (toE i j leij x); rewrite toEtoK. have KtoE2 z1 z2: {i : nat & inEi i z1 & inEi i z2}. have [[i1 Ez1] [i2 Ez2]] := (KtoE z1, KtoE z2). by exists (maxn i1 i2); [apply: inEle Ez1 | apply: inEle Ez2]. have KtoE3 z1 z2 z3: {i : nat & inEi i z1 & inEi i z2 * inEi i z3}%type. have [[i1 Ez1] [i2 Ez2 Ez3]] := (KtoE z1, KtoE2 z2 z3). by exists (maxn i1 i2); [apply: inEle Ez1 | split; apply: inEle (leMr _ _) _]. have KaddC: commutative Kadd. by move=> u v; have [i [x ->] [y ->]] := KtoE2 u v; rewrite -!EtoK_D addrC. have KaddA: associative Kadd. move=> u v w; have [i [x ->] [[y ->] [z ->]]] := KtoE3 u v w. by rewrite -!EtoK_D addrA. have Kadd0: left_id (FtoK 0) Kadd. by move=> u; have [i [x ->]] := KtoE u; rewrite -(EtoK_0 i) -EtoK_D add0r. have KaddN: left_inverse (FtoK 0) Kopp Kadd. by move=> u; have [i [x ->]] := KtoE u; rewrite -EtoK_N -EtoK_D addNr EtoK_0. pose Kzmod := ZmodType K (ZmodMixin KaddA KaddC Kadd0 KaddN). have KmulC: commutative Kmul. by move=> u v; have [i [x ->] [y ->]] := KtoE2 u v; rewrite -!EtoK_M mulrC. have KmulA: @associative Kzmod Kmul. move=> u v w; have [i [x ->] [[y ->] [z ->]]] := KtoE3 u v w. by rewrite -!EtoK_M mulrA. have Kmul1: left_id (FtoK 1) Kmul. by move=> u; have [i [x ->]] := KtoE u; rewrite -(EtoK_1 i) -EtoK_M mul1r. have KmulD: left_distributive Kmul Kadd. move=> u v w; have [i [x ->] [[y ->] [z ->]]] := KtoE3 u v w. by rewrite -!(EtoK_M, EtoK_D) mulrDl. have Kone_nz: FtoK 1 != FtoK 0 by rewrite EtoKeq0 oner_neq0. pose KringMixin := ComRingMixin KmulA KmulC Kmul1 KmulD Kone_nz. pose Kring := ComRingType (RingType Kzmod KringMixin) KmulC. have KmulV: @GRing.Field.axiom Kring Kinv. move=> u; have [i [x ->]] := KtoE u; rewrite EtoKeq0 => nz_x. by rewrite -EtoK_V -[_ * _]EtoK_M mulVf ?EtoK_1. have Kinv0: Kinv (FtoK 0) = FtoK 0 by rewrite -EtoK_V invr0. pose Kuring := [comUnitRingType of UnitRingType _ (FieldUnitMixin KmulV Kinv0)]. pose KfieldMixin := @FieldMixin _ _ KmulV Kinv0. pose Kidomain := IdomainType Kuring (FieldIdomainMixin KfieldMixin). pose Kfield := FieldType Kidomain KfieldMixin. have EtoKrmorphism i: rmorphism (EtoK i : E i -> Kfield). by do 2?split=> [x y|]; rewrite ?EtoK_D ?EtoK_N ?EtoK_M ?EtoK_1. pose EtoKM := RMorphism (EtoKrmorphism _); have EtoK_E: EtoK _ = EtoKM _ by []. have toEtoKp := @eq_map_poly _ Kring _ _(toEtoK _ _ _). have Kclosed: GRing.ClosedField.axiom Kfield. move=> n pK n_gt0; pose m0 := \max_(i < n) tag (KtoE (pK i)); pose m := m0.+1. have /fin_all_exists[pE DpE] (i : 'I_n): exists y, EtoK m y = pK i. pose u := KtoE (pK i); have leum0: tag u <= m0 by rewrite (bigmax_sup i). by have [y ->] := tagged u; exists (toE _ _ (leqW leum0) y); rewrite toEtoK. pose p := 'X^n - rVpoly (\row_i pE i); pose j := code [:: m0; pickle p]. pose pj := tagged (E_ j) j; pose w : E j.+1 := ext1w (E j) pj. have lemj: m <= j by rewrite (allP (ltn_code _)) ?mem_head. exists (EtoKM j.+1 w); apply/eqP; rewrite -subr_eq0; apply/eqP. transitivity (EtoKM j.+1 (map_poly (toE m j.+1 (leqW lemj)) p).[w]). rewrite -horner_map -map_poly_comp toEtoKp EtoK_E; move/EtoKM: w => w. rewrite rmorphB [_ 'X^n]map_polyXn !hornerE hornerXn; congr (_ - _ : Kring). rewrite (@horner_coef_wide _ n) ?size_map_poly ?size_poly //. by apply: eq_bigr => i _; rewrite coef_map coef_rVpoly valK mxE /= DpE. suffices Dpj: map_poly (toE m j lemj) p = pj. apply/eqP; rewrite EtoKeq0 (eq_map_poly (toEleS _ _ _ _)) map_poly_comp Dpj. rewrite -rootE -[pj]minXpE ?ext1root // -Dpj size_map_poly. by rewrite size_addl ?size_polyXn ltnS ?size_opp ?size_poly. rewrite {w}/pj; set j0 := (j in tagged (E_ _) j). elim: {+}j lemj => // k IHk lemSk; rewrite {}/j0 in IHk *. have:= lemSk; rewrite leq_eqVlt ltnS => /predU1P[Dm | lemk]. rewrite -{}Dm in lemSk *; rewrite {k IHk lemSk}(eq_map_poly (toEeq m _)). by rewrite map_poly_id //= /incEp codeK eqxx pickleK. rewrite (eq_map_poly (toEleS _ _ _ _)) map_poly_comp {}IHk //= /incEp codeK. by rewrite -if_neg neq_ltn lemk. suffices{Kclosed} algF_K: {FtoK : {rmorphism F -> Kfield} | integralRange FtoK}. pose Kdec := DecFieldType Kfield (closed_field_QEMixin Kclosed). pose KclosedField := ClosedFieldType Kdec Kclosed. by exists [countClosedFieldType of CountType KclosedField cntK]. exists (EtoKM 0%N) => /= z; have [i [{}z ->]] := KtoE z. suffices{z} /(_ z)[p mon_p]: integralRange (toE 0%N i isT). by rewrite -(fmorph_root (EtoKM i)) -map_poly_comp toEtoKp; exists p. rewrite /toE /E; clear - minXp_gt1 ext1root ext1gen. move: (i - 0)%N (subnK _) => n; case: i /. elim: n => [|n IHn] /= z; first exact: integral_id. have{z} [q ->] := ext1gen _ _ z; set pn := tagged (E_ _) _. apply: integral_horner. by apply/integral_poly=> i; rewrite coef_map; apply: integral_rmorph. apply: integral_root (ext1root _ _) _. by rewrite map_poly_eq0 -size_poly_gt0 ltnW. by apply/integral_poly=> i; rewrite coef_map; apply: integral_rmorph. Qed. math-comp-mathcomp-1.12.0/mathcomp/field/cyclotomic.v000066400000000000000000000350701375767750300225460ustar00rootroot00000000000000(* (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 ssralg poly finset fingroup finalg zmodp cyclic. From mathcomp Require Import ssrnum ssrint polydiv rat intdiv mxpoly. From mathcomp Require Import vector falgebra fieldext separable galois algC. (******************************************************************************) (* This file provides few basic properties of cyclotomic polynomials. *) (* We define: *) (* cyclotomic z n == the factorization of the nth cyclotomic polynomial in *) (* a ring R in which z is an nth primitive root of unity. *) (* 'Phi_n == the nth cyclotomic polynomial in int. *) (* This library is quite limited, and should be extended in the future. In *) (* particular the irreducibity of 'Phi_n is only stated indirectly, as the *) (* fact that its embedding in the algebraics (algC) is the minimal polynomial *) (* of an nth primitive root of unity. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory Num.Theory. Local Open Scope ring_scope. Section CyclotomicPoly. Section Ring. Variable R : ringType. Definition cyclotomic (z : R) n := \prod_(k < n | coprime k n) ('X - (z ^+ k)%:P). Lemma cyclotomic_monic z n : cyclotomic z n \is monic. Proof. exact: monic_prod_XsubC. Qed. Lemma size_cyclotomic z n : size (cyclotomic z n) = (totient n).+1. Proof. rewrite /cyclotomic -big_filter size_prod_XsubC; congr _.+1. case: big_enumP => _ _ _ [_ ->]. rewrite totient_count_coprime -big_mkcond big_mkord -sum1_card. by apply: eq_bigl => k; rewrite coprime_sym. Qed. End Ring. Lemma separable_Xn_sub_1 (R : idomainType) n : n%:R != 0 :> R -> @separable_poly R ('X^n - 1). Proof. case: n => [/eqP// | n nz_n]; rewrite /separable_poly linearB /= derivC subr0. rewrite derivXn -scaler_nat coprimepZr //= exprS -scaleN1r coprimep_sym. by rewrite coprimep_addl_mul coprimepZr ?coprimep1 // (signr_eq0 _ 1). Qed. Section Field. Variables (F : fieldType) (n : nat) (z : F). Hypothesis prim_z : n.-primitive_root z. Let n_gt0 := prim_order_gt0 prim_z. Lemma root_cyclotomic x : root (cyclotomic z n) x = n.-primitive_root x. Proof. transitivity (x \in [seq z ^+ i | i : 'I_n in [pred i : 'I_n | coprime i n]]). by rewrite -root_prod_XsubC big_image. apply/imageP/idP=> [[k co_k_n ->] | prim_x]. by rewrite prim_root_exp_coprime. have [k Dx] := prim_rootP prim_z (prim_expr_order prim_x). exists (Ordinal (ltn_pmod k n_gt0)) => /=; last by rewrite prim_expr_mod. by rewrite inE coprime_modl -(prim_root_exp_coprime k prim_z) -Dx. Qed. Lemma prod_cyclotomic : 'X^n - 1 = \prod_(d <- divisors n) cyclotomic (z ^+ (n %/ d)) d. Proof. have in_d d: (d %| n)%N -> val (@inord n d) = d by move/dvdn_leq/inordK=> /= ->. have dv_n k: (n %/ gcdn k n %| n)%N. by rewrite -{3}(divnK (dvdn_gcdr k n)) dvdn_mulr. have [uDn _ inDn] := divisors_correct n_gt0. have defDn: divisors n = map val (map (@inord n) (divisors n)). by rewrite -map_comp map_id_in // => d; rewrite inDn => /in_d. rewrite defDn big_map big_uniq /=; last first. by rewrite -(map_inj_uniq val_inj) -defDn. pose h (k : 'I_n) : 'I_n.+1 := inord (n %/ gcdn k n). rewrite -(factor_Xn_sub_1 prim_z) big_mkord. rewrite (partition_big h (dvdn^~ n)) /= => [|k _]; last by rewrite in_d ?dv_n. apply: eq_big => d; first by rewrite -(mem_map val_inj) -defDn inDn. set q := (n %/ d)%N => d_dv_n. have [q_gt0 d_gt0]: (0 < q /\ 0 < d)%N by apply/andP; rewrite -muln_gt0 divnK. have fP (k : 'I_d): (q * k < n)%N by rewrite divn_mulAC ?ltn_divLR ?ltn_pmul2l. rewrite (reindex (fun k => Ordinal (fP k))); last first. have f'P (k : 'I_n): (k %/ q < d)%N by rewrite ltn_divLR // mulnC divnK. exists (fun k => Ordinal (f'P k)) => [k _ | k /eqnP/=]. by apply: val_inj; rewrite /= mulKn. rewrite in_d // => Dd; apply: val_inj; rewrite /= mulnC divnK // /q -Dd. by rewrite divnA ?mulKn ?dvdn_gcdl ?dvdn_gcdr. apply: eq_big => k; rewrite ?exprM // -val_eqE in_d //=. rewrite -eqn_mul ?dvdn_gcdr ?gcdn_gt0 ?n_gt0 ?orbT //. rewrite -[n in gcdn _ n](divnK d_dv_n) -muln_gcdr mulnCA mulnA divnK //. by rewrite mulnC eqn_mul // divnn n_gt0 eq_sym. Qed. End Field. End CyclotomicPoly. Local Notation ZtoQ := (intr : int -> rat). Local Notation ZtoC := (intr : int -> algC). Local Notation QtoC := (ratr : rat -> algC). Local Notation intrp := (map_poly intr). Local Notation pZtoQ := (map_poly ZtoQ). Local Notation pZtoC := (map_poly ZtoC). Local Notation pQtoC := (map_poly ratr). Local Definition algC_intr_inj := @intr_inj [numDomainType of algC]. Local Hint Resolve algC_intr_inj : core. Local Notation QtoC_M := (ratr_rmorphism [numFieldType of algC]). Lemma C_prim_root_exists n : (n > 0)%N -> {z : algC | n.-primitive_root z}. Proof. pose p : {poly algC} := 'X^n - 1; have [r Dp] := closed_field_poly_normal p. move=> n_gt0; apply/sigW; rewrite (monicP _) ?monic_Xn_sub_1 // scale1r in Dp. have rn1: all n.-unity_root r by apply/allP=> z; rewrite -root_prod_XsubC -Dp. have sz_r: (n < (size r).+1)%N. by rewrite -(size_prod_XsubC r id) -Dp size_Xn_sub_1. have [|z] := hasP (has_prim_root n_gt0 rn1 _ sz_r); last by exists z. by rewrite -separable_prod_XsubC -Dp separable_Xn_sub_1 // pnatr_eq0 -lt0n. Qed. (* (Integral) Cyclotomic polynomials. *) Definition Cyclotomic n : {poly int} := let: exist z _ := C_prim_root_exists (ltn0Sn n.-1) in map_poly floorC (cyclotomic z n). Notation "''Phi_' n" := (Cyclotomic n) (at level 8, n at level 2, format "''Phi_' n"). Lemma Cyclotomic_monic n : 'Phi_n \is monic. Proof. rewrite /'Phi_n; case: (C_prim_root_exists _) => z /= _. rewrite monicE lead_coefE coef_map_id0 ?(int_algC_K 0) ?getCint0 //. by rewrite size_poly_eq -lead_coefE (monicP (cyclotomic_monic _ _)) (intCK 1). Qed. Lemma Cintr_Cyclotomic n z : n.-primitive_root z -> pZtoC 'Phi_n = cyclotomic z n. Proof. elim/ltn_ind: n z => n IHn z0 prim_z0. rewrite /'Phi_n; case: (C_prim_root_exists _) => z /=. have n_gt0 := prim_order_gt0 prim_z0; rewrite prednK // => prim_z. have [uDn _ inDn] := divisors_correct n_gt0. pose q := \prod_(d <- rem n (divisors n)) 'Phi_d. have mon_q: q \is monic by apply: monic_prod => d _; apply: Cyclotomic_monic. have defXn1: cyclotomic z n * pZtoC q = 'X^n - 1. rewrite (prod_cyclotomic prim_z) (big_rem n) ?inDn //=. rewrite divnn n_gt0 rmorph_prod /=; congr (_ * _). apply: eq_big_seq => d; rewrite mem_rem_uniq ?inE //= inDn => /andP[n'd ddvn]. by rewrite -IHn ?dvdn_prim_root // ltn_neqAle n'd dvdn_leq. have mapXn1 (R1 R2 : ringType) (f : {rmorphism R1 -> R2}): map_poly f ('X^n - 1) = 'X^n - 1. - by rewrite rmorphB /= rmorph1 map_polyXn. have nz_q: pZtoC q != 0. by rewrite -size_poly_eq0 size_map_inj_poly // size_poly_eq0 monic_neq0. have [r def_zn]: exists r, cyclotomic z n = pZtoC r. have defZtoC: ZtoC =1 QtoC \o ZtoQ by move=> a; rewrite /= rmorph_int. have /dvdpP[r0 Dr0]: map_poly ZtoQ q %| 'X^n - 1. rewrite -(dvdp_map QtoC_M) mapXn1 -map_poly_comp. by rewrite -(eq_map_poly defZtoC) -defXn1 dvdp_mull. have [r [a nz_a Dr]] := rat_poly_scale r0. exists (zprimitive r); apply: (mulIf nz_q); rewrite defXn1. rewrite -rmorphM -(zprimitive_monic mon_q) -zprimitiveM /=. have ->: r * q = a *: ('X^n - 1). apply: (map_inj_poly (intr_inj : injective ZtoQ)) => //. rewrite map_polyZ mapXn1 Dr0 Dr -scalerAl scalerKV ?intr_eq0 //. by rewrite rmorphM. by rewrite zprimitiveZ // zprimitive_monic ?monic_Xn_sub_1 ?mapXn1. rewrite floorCpK; last by apply/polyOverP=> i; rewrite def_zn coef_map Cint_int. pose f e (k : 'I_n) := Ordinal (ltn_pmod (k * e) n_gt0). have [e Dz0] := prim_rootP prim_z (prim_expr_order prim_z0). have co_e_n: coprime e n by rewrite -(prim_root_exp_coprime e prim_z) -Dz0. have injf: injective (f e). apply: can_inj (f (egcdn e n).1) _ => k; apply: val_inj => /=. rewrite modnMml -mulnA -modnMmr -{1}(mul1n e). by rewrite (chinese_modr co_e_n 0) modnMmr muln1 modn_small. rewrite [_ n](reindex_inj injf); apply: eq_big => k /=. by rewrite coprime_modl coprimeMl co_e_n andbT. by rewrite prim_expr_mod // mulnC exprM -Dz0. Qed. Lemma prod_Cyclotomic n : (n > 0)%N -> \prod_(d <- divisors n) 'Phi_d = 'X^n - 1. Proof. move=> n_gt0; have [z prim_z] := C_prim_root_exists n_gt0. apply: (map_inj_poly (intr_inj : injective ZtoC)) => //. rewrite rmorphB rmorph1 rmorph_prod /= map_polyXn (prod_cyclotomic prim_z). apply: eq_big_seq => d; rewrite -dvdn_divisors // => d_dv_n. by rewrite -Cintr_Cyclotomic ?dvdn_prim_root. Qed. Lemma Cyclotomic0 : 'Phi_0 = 1. Proof. rewrite /'Phi_0; case: (C_prim_root_exists _) => z /= _. by rewrite -[1]polyseqK /cyclotomic big_ord0 map_polyE !polyseq1 /= (intCK 1). Qed. Lemma size_Cyclotomic n : size 'Phi_n = (totient n).+1. Proof. have [-> | n_gt0] := posnP n; first by rewrite Cyclotomic0 polyseq1. have [z prim_z] := C_prim_root_exists n_gt0. rewrite -(size_map_inj_poly (can_inj intCK)) //. by rewrite (Cintr_Cyclotomic prim_z) size_cyclotomic. Qed. Lemma minCpoly_cyclotomic n z : n.-primitive_root z -> minCpoly z = cyclotomic z n. Proof. move=> prim_z; have n_gt0 := prim_order_gt0 prim_z. have Dpz := Cintr_Cyclotomic prim_z; set pz := cyclotomic z n in Dpz *. have mon_pz: pz \is monic by apply: cyclotomic_monic. have pz0: root pz z by rewrite root_cyclotomic. have [pf [Dpf mon_pf] dv_pf] := minCpolyP z. have /dvdpP_rat_int[f [af nz_af Df] [g /esym Dfg]]: pf %| pZtoQ 'Phi_n. rewrite -dv_pf; congr (root _ z): pz0; rewrite -Dpz -map_poly_comp. by apply: eq_map_poly => b; rewrite /= rmorph_int. without loss{nz_af} [mon_f mon_g]: af f g Df Dfg / f \is monic /\ g \is monic. move=> IH; pose cf := lead_coef f; pose cg := lead_coef g. have cfg1: cf * cg = 1. by rewrite -lead_coefM Dfg (monicP (Cyclotomic_monic n)). apply: (IH (af *~ cf) (f *~ cg) (g *~ cf)). - by rewrite rmorphMz -scalerMzr scalerMzl -mulrzA cfg1. - by rewrite mulrzAl mulrzAr -mulrzA cfg1. by rewrite !(intz, =^~ scaler_int) !monicE !lead_coefZ mulrC cfg1. have{af} Df: pQtoC pf = pZtoC f. have:= congr1 lead_coef Df. rewrite lead_coefZ lead_coef_map_inj //; last exact: intr_inj. rewrite !(monicP _) // mulr1 Df => <-; rewrite scale1r -map_poly_comp. by apply: eq_map_poly => b; rewrite /= rmorph_int. have [/size1_polyC Dg | g_gt1] := leqP (size g) 1. rewrite monicE Dg lead_coefC in mon_g. by rewrite -Dpz -Dfg Dg (eqP mon_g) mulr1 Dpf. have [zk gzk0]: exists zk, root (pZtoC g) zk. have [rg] := closed_field_poly_normal (pZtoC g). rewrite lead_coef_map_inj // (monicP mon_g) scale1r => Dg. rewrite -(size_map_inj_poly (can_inj intCK)) // Dg in g_gt1. rewrite size_prod_XsubC in g_gt1. by exists rg`_0; rewrite Dg root_prod_XsubC mem_nth. have [k cokn Dzk]: exists2 k, coprime k n & zk = z ^+ k. have: root pz zk by rewrite -Dpz -Dfg rmorphM rootM gzk0 orbT. rewrite -[pz](big_image _ _ _ (fun r => 'X - r%:P)) root_prod_XsubC. by case/imageP=> k; exists k. have co_fg (R : idomainType): n%:R != 0 :> R -> @coprimep R (intrp f) (intrp g). move=> nz_n; have: separable_poly (intrp ('X^n - 1) : {poly R}). by rewrite rmorphB rmorph1 /= map_polyXn separable_Xn_sub_1. rewrite -prod_Cyclotomic // (big_rem n) -?dvdn_divisors //= -Dfg. by rewrite !rmorphM /= !separable_mul => /and3P[] /and3P[]. suffices fzk0: root (pZtoC f) zk. have [] // := negP (coprimep_root (co_fg _ _) fzk0). by rewrite pnatr_eq0 -lt0n. move: gzk0 cokn; rewrite {zk}Dzk; elim/ltn_ind: k => k IHk gzk0 cokn. have [|k_gt1] := leqP k 1; last have [p p_pr /dvdnP[k1 Dk]] := pdivP k_gt1. rewrite -[leq k 1](mem_iota 0 2) !inE => /pred2P[k0 | ->]; last first. by rewrite -Df dv_pf. have /eqP := size_Cyclotomic n; rewrite -Dfg size_Mmonic ?monic_neq0 //. rewrite k0 /coprime gcd0n in cokn; rewrite (eqP cokn). rewrite -(size_map_inj_poly (can_inj intCK)) // -Df -Dpf. by rewrite -(subnKC g_gt1) -(subnKC (size_minCpoly z)) !addnS. move: cokn; rewrite Dk coprimeMl => /andP[cok1n]. rewrite prime_coprime // (dvdn_charf (char_Fp p_pr)) => /co_fg {co_fg}. have charFpX: p \in [char {poly 'F_p}]. by rewrite (rmorph_char (polyC_rmorphism _)) ?char_Fp. rewrite -(coprimep_pexpr _ _ (prime_gt0 p_pr)) -(Frobenius_autE charFpX). rewrite -[g]comp_polyXr map_comp_poly -horner_map /= Frobenius_autE -rmorphX. rewrite -!map_poly_comp (@eq_map_poly _ _ _ (polyC \o *~%R 1)); last first. by move=> a; rewrite /= !rmorph_int. rewrite map_poly_comp -[_.[_]]map_comp_poly /= => co_fg. suffices: coprimep (pZtoC f) (pZtoC (g \Po 'X^p)). move/coprimep_root=> /=/(_ (z ^+ k1))/implyP. rewrite map_comp_poly map_polyXn horner_comp hornerXn. rewrite -exprM -Dk [_ == 0]gzk0 implybF => /negP[]. have: root pz (z ^+ k1). by rewrite root_cyclotomic // prim_root_exp_coprime. rewrite -Dpz -Dfg rmorphM rootM => /orP[] //= /IHk-> //. rewrite -[k1]muln1 Dk ltn_pmul2l ?prime_gt1 //. by have:= ltnW k_gt1; rewrite Dk muln_gt0 => /andP[]. suffices: coprimep f (g \Po 'X^p). case/Bezout_coprimepP=> [[u v]]; rewrite -size_poly_eq1. rewrite -(size_map_inj_poly (can_inj intCK)) // rmorphD !rmorphM /=. rewrite size_poly_eq1 => {}co_fg; apply/Bezout_coprimepP. by exists (pZtoC u, pZtoC v). apply: contraLR co_fg => /coprimepPn[|d]; first exact: monic_neq0. rewrite andbC -size_poly_eq1 dvdp_gcd => /and3P[sz_d]. pose d1 := zprimitive d. have d_dv_mon h: d %| h -> h \is monic -> exists h1, h = d1 * h1. case/Pdiv.Idomain.dvdpP=> [[c h1] /= nz_c Dh] mon_h; exists (zprimitive h1). by rewrite -zprimitiveM mulrC -Dh zprimitiveZ ?zprimitive_monic. case/d_dv_mon=> // f1 Df1 /d_dv_mon[|f2 ->]. rewrite monicE lead_coefE size_comp_poly size_polyXn /=. rewrite comp_polyE coef_sum polySpred ?monic_neq0 //= mulnC. rewrite big_ord_recr /= -lead_coefE (monicP mon_g) scale1r. rewrite -exprM coefXn eqxx big1 ?add0r // => i _. rewrite coefZ -exprM coefXn eqn_pmul2l ?prime_gt0 //. by rewrite eqn_leq leqNgt ltn_ord mulr0. have monFp h: h \is monic -> size (map_poly intr h) = size h. by move=> mon_h; rewrite size_poly_eq // -lead_coefE (monicP mon_h) oner_eq0. apply/coprimepPn; last exists (map_poly intr d1). by rewrite -size_poly_eq0 monFp // size_poly_eq0 monic_neq0. rewrite Df1 !rmorphM dvdp_gcd !dvdp_mulr //= -size_poly_eq1. rewrite monFp ?size_zprimitive //. rewrite monicE [_ d1]intEsg sgz_lead_primitive -zprimitive_eq0 -/d1. rewrite -lead_coef_eq0 -absz_eq0. have/esym/eqP := congr1 (absz \o lead_coef) Df1. by rewrite /= (monicP mon_f) lead_coefM abszM muln_eq1 => /andP[/eqP-> _]. Qed. math-comp-mathcomp-1.12.0/mathcomp/field/falgebra.v000066400000000000000000001354041375767750300221460ustar00rootroot00000000000000(* (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 fintype div tuple finfun bigop ssralg. From mathcomp Require Import finalg zmodp matrix vector poly. (******************************************************************************) (* Finite dimensional free algebras, usually known as F-algebras. *) (* FalgType K == the interface type for F-algebras over K; it simply *) (* joins the unitAlgType K and vectType K interfaces. *) (* [FalgType K of aT] == an FalgType K structure for a type aT that has both *) (* unitAlgType K and vectType K canonical structures. *) (* [FalgType K of aT for vT] == an FalgType K structure for a type aT with a *) (* unitAlgType K canonical structure, given a structure *) (* vT : vectType K whose lmodType K projection matches *) (* the canonical lmodType for aT. *) (* FalgUnitRingType T == a default unitRingType structure for a type T with *) (* both algType and vectType structures. *) (* Any aT with an FalgType structure inherits all the Vector, Ring and *) (* Algebra operations, and supports the following additional operations: *) (* \dim_A M == (\dim M %/ dim A)%N -- free module dimension. *) (* amull u == the linear function v |-> u * v, for u, v : aT. *) (* amulr u == the linear function v |-> v * u, for u, v : aT. *) (* 1, f * g, f ^+ n == the identity function, the composite g \o f, the nth *) (* iterate of f, for 1, f, g in 'End(aT). This is just *) (* the usual F-algebra structure on 'End(aT). It is NOT *) (* canonical by default, but can be activated by the *) (* line Import FalgLfun. Beware also that (f^-1)%VF is *) (* the linear function inverse, not the ring inverse of *) (* f (though they do coincide when f is injective). *) (* 1%VS == the line generated by 1 : aT. *) (* (U * V)%VS == the smallest subspace of aT that contains all *) (* products u * v for u in U, v in V. *) (* (U ^+ n)%VS == (U * U * ... * U), n-times. U ^+ 0 = 1%VS *) (* 'C[u]%VS == the centraliser subspace of the vector u. *) (* 'C_U[v]%VS := (U :&: 'C[v])%VS. *) (* 'C(V)%VS == the centraliser subspace of the subspace V. *) (* 'C_U(V)%VS := (U :&: 'C(V))%VS. *) (* 'Z(V)%VS == the center subspace of the subspace V. *) (* agenv U == the smallest subalgebra containing U ^+ n for all n. *) (* <>%VS == agenv (U + <[v]>) (adjoin v to U). *) (* <>%VS == agenv (U + <>) (adjoin vs to U). *) (* {aspace aT} == a subType of {vspace aT} consisting of sub-algebras *) (* of aT (see below); for A : {aspace aT}, subvs_of A *) (* has a canonical FalgType K structure. *) (* is_aspace U <=> the characteristic predicate of {aspace aT} stating *) (* that U is closed under product and contains an *) (* identity element, := has_algid U && (U * U <= U)%VS. *) (* algid A == the identity element of A : {aspace aT}, which need *) (* not be equal to 1 (indeed, in a Wedderburn *) (* decomposition it is not even a unit in aT). *) (* is_algid U e <-> e : aT is an identity element for the subspace U: *) (* e in U, e != 0 & e * u = u * e = u for all u in U. *) (* has_algid U <=> there is an e such that is_algid U e. *) (* [aspace of U] == a clone of an existing {aspace aT} structure on *) (* U : {vspace aT} (more instances of {aspace aT} will *) (* be defined in extFieldType). *) (* [aspace of U for A] == a clone of A : {aspace aT} for U : {vspace aT}. *) (* 1%AS == the canonical sub-algebra 1%VS. *) (* {:aT}%AS == the canonical full algebra. *) (* <>%AS == the canonical algebra for agenv U; note that this is *) (* unrelated to <>%VS, the subspace spanned by vs. *) (* <>%AS == the canonical algebra for <>%VS. *) (* <>%AS == the canonical algebra for <>%VS. *) (* ahom_in U f <=> f : 'Hom(aT, rT) is a multiplicative homomorphism *) (* inside U, and in addition f 1 = 1 (even if U doesn't *) (* contain 1). Note that f @: U need not be a *) (* subalgebra when U is, as f could annilate U. *) (* 'AHom(aT, rT) == the type of algebra homomorphisms from aT to rT, *) (* where aT and rT ARE FalgType structures. Elements of *) (* 'AHom(aT, rT) coerce to 'End(aT, rT) and aT -> rT. *) (* --> Caveat: aT and rT must denote actual FalgType structures, not their *) (* projections on Type. *) (* 'AEnd(aT) == algebra endomorphisms of aT (:= 'AHom(aT, aT)). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope aspace_scope. Declare Scope lrfun_scope. Local Open Scope ring_scope. Reserved Notation "{ 'aspace' T }" (at level 0, format "{ 'aspace' T }"). Reserved Notation "<< U & vs >>" (at level 0, format "<< U & vs >>"). Reserved Notation "<< U ; x >>" (at level 0, format "<< U ; x >>"). Reserved Notation "''AHom' ( T , rT )" (at level 8, format "''AHom' ( T , rT )"). Reserved Notation "''AEnd' ( T )" (at level 8, format "''AEnd' ( T )"). Notation "\dim_ E V" := (divn (\dim V) (\dim E)) (at level 10, E at level 2, V at level 8, format "\dim_ E V") : nat_scope. Import GRing.Theory. (* Finite dimensional algebra *) Module Falgebra. (* Supply a default unitRing mixin for the default unitAlgType base type. *) Section DefaultBase. Variables (K : fieldType) (A : algType K). Lemma BaseMixin : Vector.mixin_of A -> GRing.UnitRing.mixin_of A. Proof. move=> vAm; pose vA := VectType K A vAm. pose am u := linfun (u \o* idfun : vA -> vA). have amE u v : am u v = v * u by rewrite lfunE. pose uam := [pred u | lker (am u) == 0%VS]. pose vam := [fun u => if u \in uam then (am u)^-1%VF 1 else u]. have vamKl: {in uam, left_inverse 1 vam *%R}. by move=> u Uu; rewrite /= Uu -amE lker0_lfunVK. exists uam vam => // [u Uu | u v [_ uv1] | u /negbTE/= -> //]. by apply/(lker0P Uu); rewrite !amE -mulrA vamKl // mul1r mulr1. by apply/lker0P=> w1 w2 /(congr1 (am v)); rewrite !amE -!mulrA uv1 !mulr1. Qed. Definition BaseType T := fun c vAm & phant_id c (GRing.UnitRing.Class (BaseMixin vAm)) => fun (vT : vectType K) & phant vT & phant_id (Vector.mixin (Vector.class vT)) vAm => @GRing.UnitRing.Pack T c. End DefaultBase. Section ClassDef. Variable R : ringType. Implicit Type phR : phant R. Set Primitive Projections. Record class_of A := Class { base1 : GRing.UnitAlgebra.class_of R A; mixin : Vector.mixin_of (GRing.Lmodule.Pack _ base1) }. Unset Primitive Projections. Local Coercion base1 : class_of >-> GRing.UnitAlgebra.class_of. Definition base2 A c := @Vector.Class _ _ (@base1 A c) (mixin c). Local Coercion base2 : class_of >-> Vector.class_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 pack := fun bT b & phant_id (@GRing.UnitAlgebra.class R phR bT) (b : GRing.UnitAlgebra.class_of R T) => fun mT m & phant_id (@Vector.class R phR mT) (@Vector.Class R T b m) => Pack (Phant R) (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @GRing.Zmodule.Pack cT class. Definition lmodType := @GRing.Lmodule.Pack R phR cT class. Definition ringType := @GRing.Ring.Pack cT class. Definition unitRingType := @GRing.UnitRing.Pack cT class. Definition lalgType := @GRing.Lalgebra.Pack R phR cT class. Definition algType := @GRing.Algebra.Pack R phR cT class. Definition unitAlgType := @GRing.UnitAlgebra.Pack R phR cT class. Definition vectType := @Vector.Pack R phR cT class. Definition vect_ringType := @GRing.Ring.Pack vectType class. Definition vect_unitRingType := @GRing.UnitRing.Pack vectType class. Definition vect_lalgType := @GRing.Lalgebra.Pack R phR vectType class. Definition vect_algType := @GRing.Algebra.Pack R phR vectType class. Definition vect_unitAlgType := @GRing.UnitAlgebra.Pack R phR vectType class. End ClassDef. Module Exports. Coercion base1 : class_of >-> GRing.UnitAlgebra.class_of. Coercion base2 : class_of >-> Vector.class_of. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> GRing.Zmodule.type. Canonical zmodType. Coercion lmodType : type>-> GRing.Lmodule.type. Canonical lmodType. Coercion ringType : type >-> GRing.Ring.type. Canonical ringType. Coercion unitRingType : type >-> GRing.UnitRing.type. Canonical unitRingType. Coercion lalgType : type >-> GRing.Lalgebra.type. Canonical lalgType. Coercion algType : type >-> GRing.Algebra.type. Canonical algType. Coercion unitAlgType : type >-> GRing.UnitAlgebra.type. Canonical unitAlgType. Coercion vectType : type >-> Vector.type. Canonical vectType. Canonical vect_ringType. Canonical vect_unitRingType. Canonical vect_lalgType. Canonical vect_algType. Canonical vect_unitAlgType. Notation FalgType R := (type (Phant R)). Notation "[ 'FalgType' R 'of' A ]" := (@pack _ (Phant R) A _ _ id _ _ id) (at level 0, format "[ 'FalgType' R 'of' A ]") : form_scope. Notation "[ 'FalgType' R 'of' A 'for' vT ]" := (@pack _ (Phant R) A _ _ id vT _ idfun) (at level 0, format "[ 'FalgType' R 'of' A 'for' vT ]") : form_scope. Notation FalgUnitRingType T := (@BaseType _ _ T _ _ id _ (Phant T) id). End Exports. End Falgebra. Export Falgebra.Exports. Notation "1" := (vline 1) : vspace_scope. Canonical matrix_FalgType (K : fieldType) n := [FalgType K of 'M[K]_n.+1]. Canonical regular_FalgType (R : comUnitRingType) := [FalgType R of R^o]. Lemma regular_fullv (K : fieldType) : (fullv = 1 :> {vspace K^o})%VS. Proof. by apply/esym/eqP; rewrite eqEdim subvf dim_vline oner_eq0 dimvf. Qed. Section Proper. Variables (R : ringType) (aT : FalgType R). Import Vector.InternalTheory. Lemma FalgType_proper : Vector.dim aT > 0. Proof. rewrite lt0n; apply: contraNneq (oner_neq0 aT) => aT0. by apply/eqP/v2r_inj; do 2!move: (v2r _); rewrite aT0 => u v; rewrite !thinmx0. Qed. End Proper. Module FalgLfun. Section FalgLfun. Variable (R : comRingType) (aT : FalgType R). Implicit Types f g : 'End(aT). Canonical Falg_fun_ringType := lfun_ringType (FalgType_proper aT). Canonical Falg_fun_lalgType := lfun_lalgType (FalgType_proper aT). Canonical Falg_fun_algType := lfun_algType (FalgType_proper aT). Lemma lfun_mulE f g u : (f * g) u = g (f u). Proof. exact: lfunE. Qed. Lemma lfun_compE f g : (g \o f)%VF = f * g. Proof. by []. Qed. End FalgLfun. Section InvLfun. Variable (K : fieldType) (aT : FalgType K). Implicit Types f g : 'End(aT). Definition lfun_invr f := if lker f == 0%VS then f^-1%VF else f. Lemma lfun_mulVr f : lker f == 0%VS -> f^-1%VF * f = 1. Proof. exact: lker0_compfV. Qed. Lemma lfun_mulrV f : lker f == 0%VS -> f * f^-1%VF = 1. Proof. exact: lker0_compVf. Qed. Fact lfun_mulRVr f : lker f == 0%VS -> lfun_invr f * f = 1. Proof. by move=> Uf; rewrite /lfun_invr Uf lfun_mulVr. Qed. Fact lfun_mulrRV f : lker f == 0%VS -> f * lfun_invr f = 1. Proof. by move=> Uf; rewrite /lfun_invr Uf lfun_mulrV. Qed. Fact lfun_unitrP f g : g * f = 1 /\ f * g = 1 -> lker f == 0%VS. Proof. case=> _ fK; apply/lker0P; apply: can_inj (g) _ => u. by rewrite -lfun_mulE fK lfunE. Qed. Lemma lfun_invr_out f : lker f != 0%VS -> lfun_invr f = f. Proof. by rewrite /lfun_invr => /negPf->. Qed. Definition lfun_unitRingMixin := UnitRingMixin lfun_mulRVr lfun_mulrRV lfun_unitrP lfun_invr_out. Canonical lfun_unitRingType := UnitRingType 'End(aT) lfun_unitRingMixin. Canonical lfun_unitAlgType := [unitAlgType K of 'End(aT)]. Canonical Falg_fun_FalgType := [FalgType K of 'End(aT)]. Lemma lfun_invE f : lker f == 0%VS -> f^-1%VF = f^-1. Proof. by rewrite /f^-1 /= /lfun_invr => ->. Qed. End InvLfun. End FalgLfun. Section FalgebraTheory. Variables (K : fieldType) (aT : FalgType K). Implicit Types (u v : aT) (U V W : {vspace aT}). Import FalgLfun. Definition amull u : 'End(aT) := linfun (u \*o @idfun aT). Definition amulr u : 'End(aT) := linfun (u \o* @idfun aT). Lemma amull_inj : injective amull. Proof. by move=> u v /lfunP/(_ 1); rewrite !lfunE /= !mulr1. Qed. Lemma amulr_inj : injective amulr. Proof. by move=> u v /lfunP/(_ 1); rewrite !lfunE /= !mul1r. Qed. Fact amull_is_linear : linear amull. Proof. move=> a u v; apply/lfunP => w. by rewrite !lfunE /= scale_lfunE !lfunE /= mulrDl scalerAl. Qed. Canonical amull_additive := Eval hnf in Additive amull_is_linear. Canonical amull_linear := Eval hnf in AddLinear amull_is_linear. (* amull is a converse ring morphism *) Lemma amull1 : amull 1 = \1%VF. Proof. by apply/lfunP => z; rewrite id_lfunE lfunE /= mul1r. Qed. Lemma amullM u v : (amull (u * v) = amull v * amull u)%VF. Proof. by apply/lfunP => w; rewrite comp_lfunE !lfunE /= mulrA. Qed. Lemma amulr_is_lrmorphism : lrmorphism amulr. Proof. split=> [|a u]; last by apply/lfunP=> w; rewrite scale_lfunE !lfunE /= scalerAr. split=> [u v|]; first by apply/lfunP => w; do 3!rewrite !lfunE /= ?mulrBr. split=> [u v|]; last by apply/lfunP=> w; rewrite id_lfunE !lfunE /= mulr1. by apply/lfunP=> w; rewrite comp_lfunE !lfunE /= mulrA. Qed. Canonical amulr_additive := Eval hnf in Additive amulr_is_lrmorphism. Canonical amulr_linear := Eval hnf in AddLinear amulr_is_lrmorphism. Canonical amulr_rmorphism := Eval hnf in AddRMorphism amulr_is_lrmorphism. Canonical amulr_lrmorphism := Eval hnf in LRMorphism amulr_is_lrmorphism. Lemma lker0_amull u : u \is a GRing.unit -> lker (amull u) == 0%VS. Proof. by move=> Uu; apply/lker0P=> v w; rewrite !lfunE; apply: mulrI. Qed. Lemma lker0_amulr u : u \is a GRing.unit -> lker (amulr u) == 0%VS. Proof. by move=> Uu; apply/lker0P=> v w; rewrite !lfunE; apply: mulIr. Qed. Lemma lfun1_poly (p : {poly aT}) : map_poly \1%VF p = p. Proof. by apply: map_poly_id => u _; apply: id_lfunE. Qed. Fact prodv_key : unit. Proof. by []. Qed. Definition prodv := locked_with prodv_key (fun U V => <>%VS). Canonical prodv_unlockable := [unlockable fun prodv]. Local Notation "A * B" := (prodv A B) : vspace_scope. Lemma memv_mul U V : {in U & V, forall u v, u * v \in (U * V)%VS}. Proof. move=> u v /coord_vbasis-> /coord_vbasis->. rewrite mulr_suml; apply: memv_suml => i _. rewrite mulr_sumr; apply: memv_suml => j _. rewrite -scalerAl -scalerAr !memvZ // [prodv]unlock memv_span //. by apply/allpairsP; exists ((vbasis U)`_i, (vbasis V)`_j); rewrite !memt_nth. Qed. Lemma prodvP {U V W} : reflect {in U & V, forall u v, u * v \in W} (U * V <= W)%VS. Proof. apply: (iffP idP) => [sUVW u v Uu Vv | sUVW]. by rewrite (subvP sUVW) ?memv_mul. rewrite [prodv]unlock; apply/span_subvP=> _ /allpairsP[[u v] /= [Uu Vv ->]]. by rewrite sUVW ?vbasis_mem. Qed. Lemma prodv_line u v : (<[u]> * <[v]> = <[u * v]>)%VS. Proof. apply: subv_anti; rewrite -memvE memv_mul ?memv_line // andbT. apply/prodvP=> _ _ /vlineP[a ->] /vlineP[b ->]. by rewrite -scalerAr -scalerAl !memvZ ?memv_line. Qed. Lemma dimv1: \dim (1%VS : {vspace aT}) = 1%N. Proof. by rewrite dim_vline oner_neq0. Qed. Lemma dim_prodv U V : \dim (U * V) <= \dim U * \dim V. Proof. by rewrite unlock (leq_trans (dim_span _)) ?size_tuple. Qed. Lemma vspace1_neq0 : (1 != 0 :> {vspace aT})%VS. Proof. by rewrite -dimv_eq0 dimv1. Qed. Lemma vbasis1 : exists2 k, k != 0 & vbasis 1 = [:: k%:A] :> seq aT. Proof. move: (vbasis 1) (@vbasisP K aT 1); rewrite dim_vline oner_neq0. case/tupleP=> x X0; rewrite {X0}tuple0 => defX; have Xx := mem_head x nil. have /vlineP[k def_x] := basis_mem defX Xx; exists k; last by rewrite def_x. by have:= basis_not0 defX Xx; rewrite def_x scaler_eq0 oner_eq0 orbF. Qed. Lemma prod0v : left_zero 0%VS prodv. Proof. move=> U; apply/eqP; rewrite -dimv_eq0 -leqn0 (leq_trans (dim_prodv 0 U)) //. by rewrite dimv0. Qed. Lemma prodv0 : right_zero 0%VS prodv. Proof. move=> U; apply/eqP; rewrite -dimv_eq0 -leqn0 (leq_trans (dim_prodv U 0)) //. by rewrite dimv0 muln0. Qed. Canonical prodv_muloid := Monoid.MulLaw prod0v prodv0. Lemma prod1v : left_id 1%VS prodv. Proof. move=> U; apply/subv_anti/andP; split. by apply/prodvP=> _ u /vlineP[a ->] Uu; rewrite mulr_algl memvZ. by apply/subvP=> u Uu; rewrite -[u]mul1r memv_mul ?memv_line. Qed. Lemma prodv1 : right_id 1%VS prodv. Proof. move=> U; apply/subv_anti/andP; split. by apply/prodvP=> u _ Uu /vlineP[a ->]; rewrite mulr_algr memvZ. by apply/subvP=> u Uu; rewrite -[u]mulr1 memv_mul ?memv_line. Qed. Lemma prodvS U1 U2 V1 V2 : (U1 <= U2 -> V1 <= V2 -> U1 * V1 <= U2 * V2)%VS. Proof. move/subvP=> sU12 /subvP sV12; apply/prodvP=> u v Uu Vv. by rewrite memv_mul ?sU12 ?sV12. Qed. Lemma prodvSl U1 U2 V : (U1 <= U2 -> U1 * V <= U2 * V)%VS. Proof. by move/prodvS->. Qed. Lemma prodvSr U V1 V2 : (V1 <= V2 -> U * V1 <= U * V2)%VS. Proof. exact: prodvS. Qed. Lemma prodvDl : left_distributive prodv addv. Proof. move=> U1 U2 V; apply/esym/subv_anti/andP; split. by rewrite subv_add 2?prodvS ?addvSl ?addvSr. apply/prodvP=> _ v /memv_addP[u1 Uu1 [u2 Uu2 ->]] Vv. by rewrite mulrDl memv_add ?memv_mul. Qed. Lemma prodvDr : right_distributive prodv addv. Proof. move=> U V1 V2; apply/esym/subv_anti/andP; split. by rewrite subv_add 2?prodvS ?addvSl ?addvSr. apply/prodvP=> u _ Uu /memv_addP[v1 Vv1 [v2 Vv2 ->]]. by rewrite mulrDr memv_add ?memv_mul. Qed. Canonical addv_addoid := Monoid.AddLaw prodvDl prodvDr. Lemma prodvA : associative prodv. Proof. move=> U V W; rewrite -(span_basis (vbasisP U)) span_def !big_distrl /=. apply: eq_bigr => u _; rewrite -(span_basis (vbasisP W)) span_def !big_distrr. apply: eq_bigr => w _; rewrite -(span_basis (vbasisP V)) span_def /=. rewrite !(big_distrl, big_distrr) /=; apply: eq_bigr => v _. by rewrite !prodv_line mulrA. Qed. Canonical prodv_monoid := Monoid.Law prodvA prod1v prodv1. Definition expv U n := iterop n.+1.-1 prodv U 1%VS. Local Notation "A ^+ n" := (expv A n) : vspace_scope. Lemma expv0 U : (U ^+ 0 = 1)%VS. Proof. by []. Qed. Lemma expv1 U : (U ^+ 1 = U)%VS. Proof. by []. Qed. Lemma expv2 U : (U ^+ 2 = U * U)%VS. Proof. by []. Qed. Lemma expvSl U n : (U ^+ n.+1 = U * U ^+ n)%VS. Proof. by case: n => //; rewrite prodv1. Qed. Lemma expv0n n : (0 ^+ n = if n is _.+1 then 0 else 1)%VS. Proof. by case: n => // n; rewrite expvSl prod0v. Qed. Lemma expv1n n : (1 ^+ n = 1)%VS. Proof. by elim: n => // n IHn; rewrite expvSl IHn prodv1. Qed. Lemma expvD U m n : (U ^+ (m + n) = U ^+ m * U ^+ n)%VS. Proof. by elim: m => [|m IHm]; rewrite ?prod1v // !expvSl IHm prodvA. Qed. Lemma expvSr U n : (U ^+ n.+1 = U ^+ n * U)%VS. Proof. by rewrite -addn1 expvD. Qed. Lemma expvM U m n : (U ^+ (m * n) = U ^+ m ^+ n)%VS. Proof. by elim: n => [|n IHn]; rewrite ?muln0 // mulnS expvD IHn expvSl. Qed. Lemma expvS U V n : (U <= V -> U ^+ n <= V ^+ n)%VS. Proof. move=> sUV; elim: n => [|n IHn]; first by rewrite !expv0 subvv. by rewrite !expvSl prodvS. Qed. Lemma expv_line u n : (<[u]> ^+ n = <[u ^+ n]>)%VS. Proof. elim: n => [|n IH]; first by rewrite expr0 expv0. by rewrite exprS expvSl IH prodv_line. Qed. (* Centralisers and centers. *) Definition centraliser1_vspace u := lker (amulr u - amull u). Local Notation "'C [ u ]" := (centraliser1_vspace u) : vspace_scope. Definition centraliser_vspace V := (\bigcap_i 'C[tnth (vbasis V) i])%VS. Local Notation "'C ( V )" := (centraliser_vspace V) : vspace_scope. Definition center_vspace V := (V :&: 'C(V))%VS. Local Notation "'Z ( V )" := (center_vspace V) : vspace_scope. Lemma cent1vP u v : reflect (u * v = v * u) (u \in 'C[v]%VS). Proof. by rewrite (sameP eqlfunP eqP) !lfunE /=; apply: eqP. Qed. Lemma cent1v1 u : 1 \in 'C[u]%VS. Proof. by apply/cent1vP; rewrite commr1. Qed. Lemma cent1v_id u : u \in 'C[u]%VS. Proof. exact/cent1vP. Qed. Lemma cent1vX u n : u ^+ n \in 'C[u]%VS. Proof. exact/cent1vP/esym/commrX. Qed. Lemma cent1vC u v : (u \in 'C[v])%VS = (v \in 'C[u])%VS. Proof. exact/cent1vP/cent1vP. Qed. Lemma centvP u V : reflect {in V, forall v, u * v = v * u} (u \in 'C(V))%VS. Proof. apply: (iffP subv_bigcapP) => [cVu y /coord_vbasis-> | cVu i _]. apply/esym/cent1vP/rpred_sum=> i _; apply: rpredZ. by rewrite -tnth_nth cent1vC memvE cVu. exact/cent1vP/cVu/vbasis_mem/mem_tnth. Qed. Lemma centvsP U V : reflect {in U & V, commutative *%R} (U <= 'C(V))%VS. Proof. by apply: (iffP subvP) => [cUV u v | cUV u] /cUV-/centvP; apply. Qed. Lemma subv_cent1 U v : (U <= 'C[v])%VS = (v \in 'C(U)%VS). Proof. by apply/subvP/centvP=> cUv u Uu; apply/cent1vP; rewrite 1?cent1vC cUv. Qed. Lemma centv1 V : 1 \in 'C(V)%VS. Proof. by apply/centvP=> v _; rewrite commr1. Qed. Lemma centvX V u n : u \in 'C(V)%VS -> u ^+ n \in 'C(V)%VS. Proof. by move/centvP=> cVu; apply/centvP=> v /cVu/esym/commrX->. Qed. Lemma centvC U V : (U <= 'C(V))%VS = (V <= 'C(U))%VS. Proof. by apply/centvsP/centvsP=> cUV u v UVu /cUV->. Qed. Lemma centerv_sub V : ('Z(V) <= V)%VS. Proof. exact: capvSl. Qed. Lemma cent_centerv V : (V <= 'C('Z(V)))%VS. Proof. by rewrite centvC capvSr. Qed. (* Building the predicate that checks is a vspace has a unit *) Definition is_algid e U := [/\ e \in U, e != 0 & {in U, forall u, e * u = u /\ u * e = u}]. Fact algid_decidable U : decidable (exists e, is_algid e U). Proof. have [-> | nzU] := eqVneq U 0%VS. by right=> [[e []]]; rewrite memv0 => ->. pose X := vbasis U; pose feq f1 f2 := [tuple of map f1 X ++ map f2 X]. have feqL f i: tnth (feq _ f _) (lshift _ i) = f X`_i. set v := f _; rewrite (tnth_nth v) /= nth_cat size_map size_tuple. by rewrite ltn_ord (nth_map 0) ?size_tuple. have feqR f i: tnth (feq _ _ f) (rshift _ i) = f X`_i. set v := f _; rewrite (tnth_nth v) /= nth_cat size_map size_tuple. by rewrite ltnNge leq_addr addKn /= (nth_map 0) ?size_tuple. apply: decP (vsolve_eq (feq _ amulr amull) (feq _ id id) U) _. apply: (iffP (vsolve_eqP _ _ _)) => [[e Ue id_e] | [e [Ue _ id_e]]]. suffices idUe: {in U, forall u, e * u = u /\ u * e = u}. exists e; split=> //; apply: contraNneq nzU => e0; rewrite -subv0. by apply/subvP=> u /idUe[<- _]; rewrite e0 mul0r mem0v. move=> u /coord_vbasis->; rewrite mulr_sumr mulr_suml. split; apply/eq_bigr=> i _; rewrite -(scalerAr, scalerAl); congr (_ *: _). by have:= id_e (lshift _ i); rewrite !feqL lfunE. by have:= id_e (rshift _ i); rewrite !feqR lfunE. have{id_e} /all_and2[ideX idXe]:= id_e _ (vbasis_mem (mem_tnth _ X)). exists e => // k; rewrite -[k]splitK. by case: (split k) => i; rewrite !(feqL, feqR) lfunE /= -tnth_nth. Qed. Definition has_algid : pred {vspace aT} := algid_decidable. Lemma has_algidP {U} : reflect (exists e, is_algid e U) (has_algid U). Proof. exact: sumboolP. Qed. Lemma has_algid1 U : 1 \in U -> has_algid U. Proof. move=> U1; apply/has_algidP; exists 1; split; rewrite ?oner_eq0 // => u _. by rewrite mulr1 mul1r. Qed. Definition is_aspace U := has_algid U && (U * U <= U)%VS. Structure aspace := ASpace {asval :> {vspace aT}; _ : is_aspace asval}. Definition aspace_of of phant aT := aspace. Local Notation "{ 'aspace' T }" := (aspace_of (Phant T)) : type_scope. Canonical aspace_subType := Eval hnf in [subType for asval]. Definition aspace_eqMixin := [eqMixin of aspace by <:]. Canonical aspace_eqType := Eval hnf in EqType aspace aspace_eqMixin. Definition aspace_choiceMixin := [choiceMixin of aspace by <:]. Canonical aspace_choiceType := Eval hnf in ChoiceType aspace aspace_choiceMixin. Canonical aspace_of_subType := Eval hnf in [subType of {aspace aT}]. Canonical aspace_of_eqType := Eval hnf in [eqType of {aspace aT}]. Canonical aspace_of_choiceType := Eval hnf in [choiceType of {aspace aT}]. Definition clone_aspace U (A : {aspace aT}) := fun algU & phant_id algU (valP A) => @ASpace U algU : {aspace aT}. Fact aspace1_subproof : is_aspace 1. Proof. by rewrite /is_aspace prod1v -memvE has_algid1 memv_line. Qed. Canonical aspace1 : {aspace aT} := ASpace aspace1_subproof. Lemma aspacef_subproof : is_aspace fullv. Proof. by rewrite /is_aspace subvf has_algid1 ?memvf. Qed. Canonical aspacef : {aspace aT} := ASpace aspacef_subproof. Lemma polyOver1P p : reflect (exists q, p = map_poly (in_alg aT) q) (p \is a polyOver 1%VS). Proof. apply: (iffP idP) => [/allP/=Qp | [q ->]]; last first. by apply/polyOverP=> j; rewrite coef_map rpredZ ?memv_line. exists (map_poly (coord [tuple 1] 0) p). rewrite -map_poly_comp map_poly_id // => _ /Qp/vlineP[a ->] /=. by rewrite linearZ /= (coord_free 0) ?mulr1 // seq1_free ?oner_eq0. Qed. End FalgebraTheory. Delimit Scope aspace_scope with AS. Bind Scope aspace_scope with aspace. Bind Scope aspace_scope with aspace_of. Arguments asval {K aT} a%AS. Arguments clone_aspace [K aT U%VS A%AS algU] _. Notation "{ 'aspace' T }" := (aspace_of (Phant T)) : type_scope. Notation "A * B" := (prodv A B) : vspace_scope. Notation "A ^+ n" := (expv A n) : vspace_scope. Notation "'C [ u ]" := (centraliser1_vspace u) : vspace_scope. Notation "'C_ U [ v ]" := (capv U 'C[v]) : vspace_scope. Notation "'C_ ( U ) [ v ]" := (capv U 'C[v]) (only parsing) : vspace_scope. Notation "'C ( V )" := (centraliser_vspace V) : vspace_scope. Notation "'C_ U ( V )" := (capv U 'C(V)) : vspace_scope. Notation "'C_ ( U ) ( V )" := (capv U 'C(V)) (only parsing) : vspace_scope. Notation "'Z ( V )" := (center_vspace V) : vspace_scope. Notation "1" := (aspace1 _) : aspace_scope. Notation "{ : aT }" := (aspacef aT) : aspace_scope. Notation "[ 'aspace' 'of' U ]" := (@clone_aspace _ _ U _ _ id) (at level 0, format "[ 'aspace' 'of' U ]") : form_scope. Notation "[ 'aspace' 'of' U 'for' A ]" := (@clone_aspace _ _ U A _ idfun) (at level 0, format "[ 'aspace' 'of' U 'for' A ]") : form_scope. Arguments prodvP {K aT U V W}. Arguments cent1vP {K aT u v}. Arguments centvP {K aT u V}. Arguments centvsP {K aT U V}. Arguments has_algidP {K aT U}. Arguments polyOver1P {K aT p}. Section AspaceTheory. Variables (K : fieldType) (aT : FalgType K). Implicit Types (u v e : aT) (U V : {vspace aT}) (A B : {aspace aT}). Import FalgLfun. Lemma algid_subproof U : {e | e \in U & has_algid U ==> (U <= lker (amull e - 1) :&: lker (amulr e - 1))%VS}. Proof. apply: sig2W; case: has_algidP => [[e]|]; last by exists 0; rewrite ?mem0v. case=> Ae _ idAe; exists e => //; apply/subvP=> u /idAe[eu_u ue_u]. by rewrite memv_cap !memv_ker !lfun_simp /= eu_u ue_u subrr eqxx. Qed. Definition algid U := s2val (algid_subproof U). Lemma memv_algid U : algid U \in U. Proof. by rewrite /algid; case: algid_subproof. Qed. Lemma algidl A : {in A, left_id (algid A) *%R}. Proof. rewrite /algid; case: algid_subproof => e _ /=; have /andP[-> _] := valP A. move/subvP=> idAe u /idAe/memv_capP[]. by rewrite memv_ker !lfun_simp /= subr_eq0 => /eqP. Qed. Lemma algidr A : {in A, right_id (algid A) *%R}. Proof. rewrite /algid; case: algid_subproof => e _ /=; have /andP[-> _] := valP A. move/subvP=> idAe u /idAe/memv_capP[_]. by rewrite memv_ker !lfun_simp /= subr_eq0 => /eqP. Qed. Lemma unitr_algid1 A u : u \in A -> u \is a GRing.unit -> algid A = 1. Proof. by move=> Eu /mulrI; apply; rewrite mulr1 algidr. Qed. Lemma algid_eq1 A : (algid A == 1) = (1 \in A). Proof. by apply/eqP/idP=> [<- | /algidr <-]; rewrite ?memv_algid ?mul1r. Qed. Lemma algid_neq0 A : algid A != 0. Proof. have /andP[/has_algidP[u [Au nz_u _]] _] := valP A. by apply: contraNneq nz_u => e0; rewrite -(algidr Au) e0 mulr0. Qed. Lemma dim_algid A : \dim <[algid A]> = 1%N. Proof. by rewrite dim_vline algid_neq0. Qed. Lemma adim_gt0 A : (0 < \dim A)%N. Proof. by rewrite -(dim_algid A) dimvS // -memvE ?memv_algid. Qed. Lemma not_asubv0 A : ~~ (A <= 0)%VS. Proof. by rewrite subv0 -dimv_eq0 -lt0n adim_gt0. Qed. Lemma adim1P {A} : reflect (A = <[algid A]>%VS :> {vspace aT}) (\dim A == 1%N). Proof. rewrite eqn_leq adim_gt0 -(memv_algid A) andbC -(dim_algid A) -eqEdim eq_sym. exact: eqP. Qed. Lemma asubv A : (A * A <= A)%VS. Proof. by have /andP[] := valP A. Qed. Lemma memvM A : {in A &, forall u v, u * v \in A}. Proof. exact/prodvP/asubv. Qed. Lemma prodv_id A : (A * A)%VS = A. Proof. apply/eqP; rewrite eqEsubv asubv; apply/subvP=> u Au. by rewrite -(algidl Au) memv_mul // memv_algid. Qed. Lemma prodv_sub U V A : (U <= A -> V <= A -> U * V <= A)%VS. Proof. by move=> sUA sVA; rewrite -prodv_id prodvS. Qed. Lemma expv_id A n : (A ^+ n.+1)%VS = A. Proof. by elim: n => // n IHn; rewrite !expvSl prodvA prodv_id -expvSl. Qed. Lemma limg_amulr U v : (amulr v @: U = U * <[v]>)%VS. Proof. rewrite -(span_basis (vbasisP U)) limg_span !span_def big_distrl /= big_map. by apply: eq_bigr => u; rewrite prodv_line lfunE. Qed. Lemma memv_cosetP {U v w} : reflect (exists2 u, u\in U & w = u * v) (w \in U * <[v]>)%VS. Proof. rewrite -limg_amulr. by apply: (iffP memv_imgP) => [] [u] Uu ->; exists u; rewrite ?lfunE. Qed. Lemma dim_cosetv_unit V u : u \is a GRing.unit -> \dim (V * <[u]>) = \dim V. Proof. by move/lker0_amulr/eqP=> Uu; rewrite -limg_amulr limg_dim_eq // Uu capv0. Qed. Lemma memvV A u : (u^-1 \in A) = (u \in A). Proof. suffices{u} invA: invr_closed A by apply/idP/idP=> /invA; rewrite ?invrK. move=> u Au; have [Uu | /invr_out-> //] := boolP (u \is a GRing.unit). rewrite memvE -(limg_ker0 _ _ (lker0_amulr Uu)) limg_line lfunE /= mulVr //. suff ->: (amulr u @: A)%VS = A by rewrite -memvE -algid_eq1 (unitr_algid1 Au). by apply/eqP; rewrite limg_amulr -dimv_leqif_eq ?prodv_sub ?dim_cosetv_unit. Qed. Fact aspace_cap_subproof A B : algid A \in B -> is_aspace (A :&: B). Proof. move=> BeA; apply/andP. split; [apply/has_algidP | by rewrite subv_cap !prodv_sub ?capvSl ?capvSr]. exists (algid A); rewrite /is_algid algid_neq0 memv_cap memv_algid. by split=> // u /memv_capP[Au _]; rewrite ?algidl ?algidr. Qed. Definition aspace_cap A B BeA := ASpace (@aspace_cap_subproof A B BeA). Fact centraliser1_is_aspace u : is_aspace 'C[u]. Proof. rewrite /is_aspace has_algid1 ?cent1v1 //=. apply/prodvP=> v w /cent1vP-cuv /cent1vP-cuw. by apply/cent1vP; rewrite -mulrA cuw !mulrA cuv. Qed. Canonical centraliser1_aspace u := ASpace (centraliser1_is_aspace u). Fact centraliser_is_aspace V : is_aspace 'C(V). Proof. rewrite /is_aspace has_algid1 ?centv1 //=. apply/prodvP=> u w /centvP-cVu /centvP-cVw. by apply/centvP=> v Vv; rewrite /= -mulrA cVw // !mulrA cVu. Qed. Canonical centraliser_aspace V := ASpace (centraliser_is_aspace V). Lemma centv_algid A : algid A \in 'C(A)%VS. Proof. by apply/centvP=> u Au; rewrite algidl ?algidr. Qed. Canonical center_aspace A := [aspace of 'Z(A) for aspace_cap (centv_algid A)]. Lemma algid_center A : algid 'Z(A) = algid A. Proof. rewrite -(algidl (subvP (centerv_sub A) _ (memv_algid _))) algidr //=. by rewrite memv_cap memv_algid centv_algid. Qed. Lemma Falgebra_FieldMixin : GRing.IntegralDomain.axiom aT -> GRing.Field.mixin_of aT. Proof. move=> domT u nz_u; apply/unitrP. have kerMu: lker (amulr u) == 0%VS. rewrite eqEsubv sub0v andbT; apply/subvP=> v; rewrite memv_ker lfunE /=. by move/eqP/domT; rewrite (negPf nz_u) orbF memv0. have /memv_imgP[v _ vu1]: 1 \in limg (amulr u); last rewrite lfunE /= in vu1. suffices /eqP->: limg (amulr u) == fullv by rewrite memvf. by rewrite -dimv_leqif_eq ?subvf ?limg_dim_eq // (eqP kerMu) capv0. exists v; split=> //; apply: (lker0P kerMu). by rewrite !lfunE /= -mulrA -vu1 mulr1 mul1r. Qed. Section SkewField. Hypothesis fieldT : GRing.Field.mixin_of aT. Lemma skew_field_algid1 A : algid A = 1. Proof. by rewrite (unitr_algid1 (memv_algid A)) ?fieldT ?algid_neq0. Qed. Lemma skew_field_module_semisimple A M : let sumA X := (\sum_(x <- X) A * <[x]>)%VS in (A * M <= M)%VS -> {X | [/\ sumA X = M, directv (sumA X) & 0 \notin X]}. Proof. move=> sumA sAM_M; pose X := Nil aT; pose k := (\dim (A * M) - \dim (sumA X))%N. have: (\dim (A * M) - \dim (sumA X) < k.+1)%N by []. have: [/\ (sumA X <= A * M)%VS, directv (sumA X) & 0 \notin X]. by rewrite /sumA directvE /= !big_nil sub0v dimv0. elim: {X k}k.+1 (X) => // k IHk X [sAX_AM dxAX nzX]; rewrite ltnS => leAXk. have [sM_AX | /subvPn/sig2W[y My notAXy]] := boolP (M <= sumA X)%VS. by exists X; split=> //; apply/eqP; rewrite eqEsubv (subv_trans sAX_AM). have nz_y: y != 0 by rewrite (memPnC notAXy) ?mem0v. pose AY := sumA (y :: X). have sAY_AM: (AY <= A * M)%VS by rewrite [AY]big_cons subv_add ?prodvSr. have dxAY: directv AY. rewrite directvE /= !big_cons [_ == _]directv_addE dxAX directvE eqxx /=. rewrite -/(sumA X) eqEsubv sub0v andbT -limg_amulr. apply/subvP=> _ /memv_capP[/memv_imgP[a Aa ->]]; rewrite lfunE /= => AXay. rewrite memv0 (mulIr_eq0 a (mulIr _)) ?fieldT //. apply: contraR notAXy => /fieldT-Ua; rewrite -[y](mulKr Ua) /sumA. by rewrite -big_distrr -(prodv_id A) /= -prodvA big_distrr memv_mul ?memvV. apply: (IHk (y :: X)); first by rewrite !inE eq_sym negb_or nz_y. rewrite -subSn ?dimvS // (directvP dxAY) /= big_cons -(directvP dxAX) /=. rewrite subnDA (leq_trans _ leAXk) ?leq_sub2r // leq_subLR -add1n leq_add2r. by rewrite dim_cosetv_unit ?fieldT ?adim_gt0. Qed. Lemma skew_field_module_dimS A M : (A * M <= M)%VS -> \dim A %| \dim M. Proof. case/skew_field_module_semisimple=> X [<- /directvP-> nzX] /=. rewrite big_seq prime.dvdn_sum // => x /(memPn nzX)nz_x. by rewrite dim_cosetv_unit ?fieldT. Qed. Lemma skew_field_dimS A B : (A <= B)%VS -> \dim A %| \dim B. Proof. by move=> sAB; rewrite skew_field_module_dimS ?prodv_sub. Qed. End SkewField. End AspaceTheory. (* Note that local centraliser might not be proper sub-algebras. *) Notation "'C [ u ]" := (centraliser1_aspace u) : aspace_scope. Notation "'C ( V )" := (centraliser_aspace V) : aspace_scope. Notation "'Z ( A )" := (center_aspace A) : aspace_scope. Arguments adim1P {K aT A}. Arguments memv_cosetP {K aT U v w}. Section Closure. Variables (K : fieldType) (aT : FalgType K). Implicit Types (u v : aT) (U V W : {vspace aT}). (* Subspaces of an F-algebra form a Kleene algebra *) Definition agenv U := (\sum_(i < \dim {:aT}) U ^+ i)%VS. Local Notation "<< U & vs >>" := (agenv (U + <>)) : vspace_scope. Local Notation "<< U ; x >>" := (agenv (U + <[x]>)) : vspace_scope. Lemma agenvEl U : agenv U = (1 + U * agenv U)%VS. Proof. pose f V := (1 + U * V)%VS; rewrite -/(f _); pose n := \dim {:aT}. have ->: agenv U = iter n f 0%VS. rewrite /agenv -/n; elim: n => [|n IHn]; first by rewrite big_ord0. rewrite big_ord_recl /= -{}IHn; congr (1 + _)%VS; rewrite big_distrr /=. by apply: eq_bigr => i; rewrite expvSl. have fS i j: i <= j -> (iter i f 0 <= iter j f 0)%VS. by elim: i j => [|i IHi] [|j] leij; rewrite ?sub0v //= addvS ?prodvSr ?IHi. suffices /(@trajectP _ f _ n.+1)[i le_i_n Dfi]: looping f 0%VS n.+1. by apply/eqP; rewrite eqEsubv -iterS fS // Dfi fS. apply: contraLR (dimvS (subvf (iter n.+1 f 0%VS))); rewrite -/n -ltnNge. rewrite -looping_uniq; elim: n.+1 => // i IHi; rewrite trajectSr rcons_uniq. rewrite {1}trajectSr mem_rcons inE negb_or eq_sym eqEdim fS ?leqW // -ltnNge. by rewrite -andbA => /and3P[lt_fi _ /IHi/leq_ltn_trans->]. Qed. Lemma agenvEr U : agenv U = (1 + agenv U * U)%VS. Proof. rewrite [lhs in lhs = _]agenvEl big_distrr big_distrl /=; congr (_ + _)%VS. by apply: eq_bigr => i _ /=; rewrite -expvSr -expvSl. Qed. Lemma agenv_modl U V : (U * V <= V -> agenv U * V <= V)%VS. Proof. rewrite big_distrl /= => idlU_V; apply/subv_sumP=> [[i _] /= _]. elim: i => [|i]; first by rewrite expv0 prod1v. by apply: subv_trans; rewrite expvSr -prodvA prodvSr. Qed. Lemma agenv_modr U V : (V * U <= V -> V * agenv U <= V)%VS. Proof. rewrite big_distrr /= => idrU_V; apply/subv_sumP=> [[i _] /= _]. elim: i => [|i]; first by rewrite expv0 prodv1. by apply: subv_trans; rewrite expvSl prodvA prodvSl. Qed. Fact agenv_is_aspace U : is_aspace (agenv U). Proof. rewrite /is_aspace has_algid1; last by rewrite memvE agenvEl addvSl. by rewrite agenv_modl // [V in (_ <= V)%VS]agenvEl addvSr. Qed. Canonical agenv_aspace U : {aspace aT} := ASpace (agenv_is_aspace U). Lemma agenvE U : agenv U = agenv_aspace U. Proof. by []. Qed. (* Kleene algebra properties *) Lemma agenvM U : (agenv U * agenv U)%VS = agenv U. Proof. exact: prodv_id. Qed. Lemma agenvX n U : (agenv U ^+ n.+1)%VS = agenv U. Proof. exact: expv_id. Qed. Lemma sub1_agenv U : (1 <= agenv U)%VS. Proof. by rewrite agenvEl addvSl. Qed. Lemma sub_agenv U : (U <= agenv U)%VS. Proof. by rewrite 2!agenvEl addvC prodvDr prodv1 -addvA addvSl. Qed. Lemma subX_agenv U n : (U ^+ n <= agenv U)%VS. Proof. by case: n => [|n]; rewrite ?sub1_agenv // -(agenvX n) expvS // sub_agenv. Qed. Lemma agenv_sub_modl U V : (1 <= V -> U * V <= V -> agenv U <= V)%VS. Proof. move=> s1V /agenv_modl; apply: subv_trans. by rewrite -[Us in (Us <= _)%VS]prodv1 prodvSr. Qed. Lemma agenv_sub_modr U V : (1 <= V -> V * U <= V -> agenv U <= V)%VS. Proof. move=> s1V /agenv_modr; apply: subv_trans. by rewrite -[Us in (Us <= _)%VS]prod1v prodvSl. Qed. Lemma agenv_id U : agenv (agenv U) = agenv U. Proof. apply/eqP; rewrite eqEsubv sub_agenv andbT. by rewrite agenv_sub_modl ?sub1_agenv ?agenvM. Qed. Lemma agenvS U V : (U <= V -> agenv U <= agenv V)%VS. Proof. move=> sUV; rewrite agenv_sub_modl ?sub1_agenv //. by rewrite -[Vs in (_ <= Vs)%VS]agenvM prodvSl ?(subv_trans sUV) ?sub_agenv. Qed. Lemma agenv_add_id U V : agenv (agenv U + V) = agenv (U + V). Proof. apply/eqP; rewrite eqEsubv andbC agenvS ?addvS ?sub_agenv //=. rewrite agenv_sub_modl ?sub1_agenv //. rewrite -[rhs in (_ <= rhs)%VS]agenvM prodvSl // subv_add agenvS ?addvSl //=. exact: subv_trans (addvSr U V) (sub_agenv _). Qed. Lemma subv_adjoin U x : (U <= <>)%VS. Proof. by rewrite (subv_trans (sub_agenv _)) ?agenvS ?addvSl. Qed. Lemma subv_adjoin_seq U xs : (U <= <>)%VS. Proof. by rewrite (subv_trans (sub_agenv _)) // ?agenvS ?addvSl. Qed. Lemma memv_adjoin U x : x \in <>%VS. Proof. by rewrite memvE (subv_trans (sub_agenv _)) ?agenvS ?addvSr. Qed. Lemma seqv_sub_adjoin U xs : {subset xs <= <>%VS}. Proof. by apply/span_subvP; rewrite (subv_trans (sub_agenv _)) ?agenvS ?addvSr. Qed. Lemma subvP_adjoin U x y : y \in U -> y \in <>%VS. Proof. exact/subvP/subv_adjoin. Qed. Lemma adjoin_nil V : <>%VS = agenv V. Proof. by rewrite span_nil addv0. Qed. Lemma adjoin_cons V x rs : <>%VS = << <> & rs>>%VS. Proof. by rewrite span_cons addvA agenv_add_id. Qed. Lemma adjoin_rcons V rs x : <>%VS = << <>%VS; x>>%VS. Proof. by rewrite -cats1 span_cat addvA span_seq1 agenv_add_id. Qed. Lemma adjoin_seq1 V x : <>%VS = <>%VS. Proof. by rewrite adjoin_cons adjoin_nil agenv_id. Qed. Lemma adjoinC V x y : << <>; y>>%VS = << <>; x>>%VS. Proof. by rewrite !agenv_add_id -!addvA (addvC <[x]>%VS). Qed. Lemma adjoinSl U V x : (U <= V -> <> <= <>)%VS. Proof. by move=> sUV; rewrite agenvS ?addvS. Qed. Lemma adjoin_seqSl U V rs : (U <= V -> <> <= <>)%VS. Proof. by move=> sUV; rewrite agenvS ?addvS. Qed. Lemma adjoin_seqSr U rs1 rs2 : {subset rs1 <= rs2} -> (<> <= <>)%VS. Proof. by move/sub_span=> s_rs12; rewrite agenvS ?addvS. Qed. End Closure. Notation "<< U >>" := (agenv_aspace U) : aspace_scope. Notation "<< U & vs >>" := (agenv (U + <>)) : vspace_scope. Notation "<< U ; x >>" := (agenv (U + <[x]>)) : vspace_scope. Notation "<< U & vs >>" := << U + <> >>%AS : aspace_scope. Notation "<< U ; x >>" := << U + <[x]> >>%AS : aspace_scope. Section SubFalgType. (* The FalgType structure of subvs_of A for A : {aspace aT}. *) (* We can't use the rpred-based mixin, because A need not contain 1. *) Variable (K : fieldType) (aT : FalgType K) (A : {aspace aT}). Definition subvs_one := Subvs (memv_algid A). Definition subvs_mul (u v : subvs_of A) := Subvs (subv_trans (memv_mul (subvsP u) (subvsP v)) (asubv _)). Fact subvs_mulA : associative subvs_mul. Proof. by move=> x y z; apply/val_inj/mulrA. Qed. Fact subvs_mu1l : left_id subvs_one subvs_mul. Proof. by move=> x; apply/val_inj/algidl/(valP x). Qed. Fact subvs_mul1 : right_id subvs_one subvs_mul. Proof. by move=> x; apply/val_inj/algidr/(valP x). Qed. Fact subvs_mulDl : left_distributive subvs_mul +%R. Proof. move=> x y z; apply/val_inj/mulrDl. Qed. Fact subvs_mulDr : right_distributive subvs_mul +%R. Proof. move=> x y z; apply/val_inj/mulrDr. Qed. Definition subvs_ringMixin := RingMixin subvs_mulA subvs_mu1l subvs_mul1 subvs_mulDl subvs_mulDr (algid_neq0 _). Canonical subvs_ringType := Eval hnf in RingType (subvs_of A) subvs_ringMixin. Lemma subvs_scaleAl k (x y : subvs_of A) : k *: (x * y) = (k *: x) * y. Proof. exact/val_inj/scalerAl. Qed. Canonical subvs_lalgType := Eval hnf in LalgType K (subvs_of A) subvs_scaleAl. Lemma subvs_scaleAr k (x y : subvs_of A) : k *: (x * y) = x * (k *: y). Proof. exact/val_inj/scalerAr. Qed. Canonical subvs_algType := Eval hnf in AlgType K (subvs_of A) subvs_scaleAr. Canonical subvs_unitRingType := Eval hnf in FalgUnitRingType (subvs_of A). Canonical subvs_unitAlgType := Eval hnf in [unitAlgType K of subvs_of A]. Canonical subvs_FalgType := Eval hnf in [FalgType K of subvs_of A]. Implicit Type w : subvs_of A. Lemma vsval_unitr w : vsval w \is a GRing.unit -> w \is a GRing.unit. Proof. case: w => /= u Au Uu; have Au1: u^-1 \in A by rewrite memvV. apply/unitrP; exists (Subvs Au1). by split; apply: val_inj; rewrite /= ?mulrV ?mulVr ?(unitr_algid1 Au). Qed. Lemma vsval_invr w : vsval w \is a GRing.unit -> val w^-1 = (val w)^-1. Proof. move=> Uu; have def_w: w / w * w = w by rewrite divrK ?vsval_unitr. by apply: (mulrI Uu); rewrite -[in u in u / _]def_w ?mulrK. Qed. End SubFalgType. Section AHom. Variable K : fieldType. Section Class_Def. Variables aT rT : FalgType K. Definition ahom_in (U : {vspace aT}) (f : 'Hom(aT, rT)) := all2rel (fun x y : aT => f (x * y) == f x * f y) (vbasis U) && (f 1 == 1). Lemma ahom_inP {f : 'Hom(aT, rT)} {U : {vspace aT}} : reflect ({in U &, {morph f : x y / x * y >-> x * y}} * (f 1 = 1)) (ahom_in U f). Proof. apply: (iffP andP) => [[/allrelP fM /eqP f1] | [fM f1]]; last first. rewrite f1; split=> //; apply/allrelP => x y Ax Ay. by rewrite fM // vbasis_mem. split=> // x y /coord_vbasis -> /coord_vbasis ->. rewrite !mulr_suml ![f _]linear_sum mulr_suml; apply: eq_bigr => i _ /=. rewrite !mulr_sumr linear_sum; apply: eq_bigr => j _ /=. rewrite !linearZ -!scalerAr -!scalerAl 2!linearZ /=; congr (_ *: (_ *: _)). by apply/eqP/fM; apply: memt_nth. Qed. Lemma ahomP {f : 'Hom(aT, rT)} : reflect (lrmorphism f) (ahom_in {:aT} f). Proof. apply: (iffP ahom_inP) => [[fM f1] | fRM_P]; last first. pose fRM := LRMorphism fRM_P. by split; [apply: in2W (rmorphM fRM) | apply: (rmorph1 fRM)]. split; last exact: linearZZ; split; first exact: linearB. by split=> // x y; rewrite fM ?memvf. Qed. Structure ahom := AHom {ahval :> 'Hom(aT, rT); _ : ahom_in {:aT} ahval}. Canonical ahom_subType := Eval hnf in [subType for ahval]. Definition ahom_eqMixin := [eqMixin of ahom by <:]. Canonical ahom_eqType := Eval hnf in EqType ahom ahom_eqMixin. Definition ahom_choiceMixin := [choiceMixin of ahom by <:]. Canonical ahom_choiceType := Eval hnf in ChoiceType ahom ahom_choiceMixin. Fact linfun_is_ahom (f : {lrmorphism aT -> rT}) : ahom_in {:aT} (linfun f). Proof. by apply/ahom_inP; split=> [x y|]; rewrite !lfunE ?rmorphM ?rmorph1. Qed. Canonical linfun_ahom f := AHom (linfun_is_ahom f). End Class_Def. Arguments ahom_in [aT rT]. Arguments ahom_inP {aT rT f U}. Arguments ahomP {aT rT f}. Section LRMorphism. Variables aT rT sT : FalgType K. Fact ahom_is_lrmorphism (f : ahom aT rT) : lrmorphism f. Proof. by apply/ahomP; case: f. Qed. Canonical ahom_rmorphism f := Eval hnf in AddRMorphism (ahom_is_lrmorphism f). Canonical ahom_lrmorphism f := Eval hnf in AddLRMorphism (ahom_is_lrmorphism f). Lemma ahomWin (f : ahom aT rT) U : ahom_in U f. Proof. by apply/ahom_inP; split; [apply: in2W (rmorphM _) | apply: rmorph1]. Qed. Lemma id_is_ahom (V : {vspace aT}) : ahom_in V \1. Proof. by apply/ahom_inP; split=> [x y|] /=; rewrite !id_lfunE. Qed. Canonical id_ahom := AHom (id_is_ahom (aspacef aT)). Lemma comp_is_ahom (V : {vspace aT}) (f : 'Hom(rT, sT)) (g : 'Hom(aT, rT)) : ahom_in {:rT} f -> ahom_in V g -> ahom_in V (f \o g). Proof. move=> /ahom_inP fM /ahom_inP gM; apply/ahom_inP. by split=> [x y Vx Vy|] /=; rewrite !comp_lfunE gM // fM ?memvf. Qed. Canonical comp_ahom (f : ahom rT sT) (g : ahom aT rT) := AHom (comp_is_ahom (valP f) (valP g)). Lemma aimgM (f : ahom aT rT) U V : (f @: (U * V) = f @: U * f @: V)%VS. Proof. apply/eqP; rewrite eqEsubv; apply/andP; split; last first. apply/prodvP=> _ _ /memv_imgP[u Hu ->] /memv_imgP[v Hv ->]. by rewrite -rmorphM memv_img // memv_mul. apply/subvP=> _ /memv_imgP[w UVw ->]; rewrite memv_preim (subvP _ w UVw) //. by apply/prodvP=> u v Uu Vv; rewrite -memv_preim rmorphM memv_mul // memv_img. Qed. Lemma aimg1 (f : ahom aT rT) : (f @: 1 = 1)%VS. Proof. by rewrite limg_line rmorph1. Qed. Lemma aimgX (f : ahom aT rT) U n : (f @: (U ^+ n) = f @: U ^+ n)%VS. Proof. elim: n => [|n IH]; first by rewrite !expv0 aimg1. by rewrite !expvSl aimgM IH. Qed. Lemma aimg_agen (f : ahom aT rT) U : (f @: agenv U)%VS = agenv (f @: U). Proof. apply/eqP; rewrite eqEsubv; apply/andP; split. by rewrite limg_sum; apply/subv_sumP => i _; rewrite aimgX subX_agenv. apply: agenv_sub_modl; first by rewrite -(aimg1 f) limgS // sub1_agenv. by rewrite -aimgM limgS // [rhs in (_ <= rhs)%VS]agenvEl addvSr. Qed. Lemma aimg_adjoin (f : ahom aT rT) U x : (f @: <> = <>)%VS. Proof. by rewrite aimg_agen limgD limg_line. Qed. Lemma aimg_adjoin_seq (f : ahom aT rT) U xs : (f @: <> = <>)%VS. Proof. by rewrite aimg_agen limgD limg_span. Qed. Fact ker_sub_ahom_is_aspace (f g : ahom aT rT) : is_aspace (lker (ahval f - ahval g)). Proof. rewrite /is_aspace has_algid1; last by apply/eqlfunP; rewrite !rmorph1. apply/prodvP=> a b /eqlfunP Dfa /eqlfunP Dfb. by apply/eqlfunP; rewrite !rmorphM /= Dfa Dfb. Qed. Canonical ker_sub_ahom_aspace f g := ASpace (ker_sub_ahom_is_aspace f g). End LRMorphism. Canonical fixedSpace_aspace aT (f : ahom aT aT) := [aspace of fixedSpace f]. End AHom. Arguments ahom_in [K aT rT]. Notation "''AHom' ( aT , rT )" := (ahom aT rT) : type_scope. Notation "''AEnd' ( aT )" := (ahom aT aT) : type_scope. Delimit Scope lrfun_scope with AF. Bind Scope lrfun_scope with ahom. Notation "\1" := (@id_ahom _ _) : lrfun_scope. Notation "f \o g" := (comp_ahom f g) : lrfun_scope. math-comp-mathcomp-1.12.0/mathcomp/field/fieldext.v000066400000000000000000002065501375767750300222100ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype tuple finfun bigop ssralg finalg. From mathcomp Require Import zmodp matrix vector falgebra poly polydiv mxpoly. From mathcomp Require Import generic_quotient. (******************************************************************************) (* * Finite dimensional field extentions *) (* fieldExtType F == the interface type for finite field extensions of F *) (* it simply combines the fieldType and FalgType F *) (* interfaces. *) (* [fieldExtType F of L] == a fieldExt F structure for a type L that has both *) (* FalgType F and fieldType canonical instances. The *) (* field class instance must be manifest with explicit *) (* comRing, idomain, and field mixins. If L has an *) (* abstract field class should use the 'for' variant. *) (* [fieldExtType F of L for K] == a fieldExtType F structure for a type L *) (* that has an FalgType F canonical structure, given *) (* a K : fieldType whose unitRingType projection *) (* coincides with the canonical unitRingType for F. *) (* {subfield L} == the type of subfields of L that are also extensions *) (* of F; since we are in a finite dimensional setting *) (* these are exactly the F-subalgebras of L, and *) (* indeed {subfield L} is just display notation for *) (* {aspace L} when L is an extFieldType. *) (* --> All aspace operations apply to {subfield L}, but there are several *) (* additional lemmas and canonical instances specific to {subfield L} *) (* spaces, e.g., subvs_of E is an extFieldType F when E : {subfield L}. *) (* --> Also note that not all constructive subfields have type {subfield E} *) (* in the same way that not all constructive subspaces have type *) (* {vspace E}. These types only include the so called "detachable" *) (* subspaces (and subalgebras). *) (* *) (* (E :&: F)%AS, (E * F)%AS == the intersection and product (meet and join) *) (* of E and F as subfields. *) (* subFExtend iota z p == Given a field morphism iota : F -> L, this is a *) (* type for the field F^iota(z) obtained by *) (* adjoining z to the image of F in L under iota. *) (* The construction requires a non-zero polynomial *) (* p in F such that z is a root of p^iota; it *) (* returns the field F^iota if this is not so. *) (* However, p need not be irredicible. *) (* subfx_inj x == The injection of F^iota(z) into L. *) (* inj_subfx iota z p x == The injection of F into F^iota(z). *) (* subfx_eval iota z p q == Given q : {poly F} returns q.[z] as a value of *) (* type F^iota(z). *) (* subfx_root iota z p == The generator of F^iota(z) over F. *) (* SubFieldExtType pz0 irr_p == A fieldExtType F structure for F^iota(z) *) (* (more precisely, subFExtend iota z p), given *) (* proofs pz0: root (map_poly iota p) z and *) (* irr_p : irreducible_poly p. The corresponding *) (* vectType substructure (SubfxVectType pz0 irr_p) *) (* has dimension (size p).-1 over F. *) (* minPoly K x == the monic minimal polynomial of x over the *) (* subfield K. *) (* adjoin_degree K x == the degree of the minimial polynomial or the *) (* dimension of K(x)/K. *) (* Fadjoin_poly K x y == a polynomial p over K such that y = p.[x]. *) (* *) (* fieldOver F == L, but with an extFieldType (subvs_of F) *) (* structure, for F : {subfield L} *) (* vspaceOver F V == the smallest subspace of fieldOver F containing *) (* V; this coincides with V if V is an F-module. *) (* baseFieldType L == L, but with an extFieldType F0 structure, when L *) (* has a canonical extFieldType F structure and F *) (* in turn has an extFieldType F0 structure. *) (* baseVspace V == the subspace of baseFieldType L that coincides *) (* with V : {vspace L}. *) (* --> Some caution must be exercised when using fieldOver and baseFieldType, *) (* because these are convertible to L while carrying different Lmodule *) (* structures. This means that the safeguards engineered in the ssralg *) (* library that normally curb the Coq kernel's inclination to diverge are *) (* no longer effectcive, so additional precautions should be taken when *) (* matching or rewriting terms of the form a *: u, because Coq may take *) (* forever to realize it's dealing with a *: in the wrong structure. The *) (* baseField_scaleE and fieldOver_scaleE lemmas should be used to expand *) (* or fold such "trans-structure" operations explicitly beforehand. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GRing.Theory. Module FieldExt. Import GRing. Section FieldExt. Variable R : ringType. Set Primitive Projections. Record class_of T := Class { base : Falgebra.class_of R T; comm_ext : commutative (Ring.mul base); idomain_ext : IntegralDomain.axiom (Ring.Pack base); field_ext : Field.mixin_of (UnitRing.Pack base) }. Unset Primitive Projections. Local Coercion base : class_of >-> Falgebra.class_of. Section Bases. Variables (T : Type) (c : class_of T). Definition base1 := ComRing.Class (@comm_ext T c). Definition base2 := @ComUnitRing.Class T base1 c. Definition base3 := @IntegralDomain.Class T base2 (@idomain_ext T c). Definition base4 := @Field.Class T base3 (@field_ext T c). Definition base5 := @ComAlgebra.Class R T (@base T c) (@comm_ext T c). Definition base6 := @ComUnitAlgebra.Class R T base5 c. End Bases. Local Coercion base1 : class_of >-> ComRing.class_of. Local Coercion base2 : class_of >-> ComUnitRing.class_of. Local Coercion base3 : class_of >-> IntegralDomain.class_of. Local Coercion base4 : class_of >-> Field.class_of. Local Coercion base5 : class_of >-> ComAlgebra.class_of. Local Coercion base6 : class_of >-> ComUnitAlgebra.class_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 pack := fun (bT : Falgebra.type phR) b & phant_id (Falgebra.class bT : Falgebra.class_of R bT) (b : Falgebra.class_of R T) => fun mT Cm IDm Fm & phant_id (GRing.ComRing.mixin (Field.class mT)) Cm & phant_id (GRing.IntegralDomain.mixin (Field.class mT)) IDm & phant_id (GRing.Field.mixin (Field.class mT)) Fm => Pack phR (@Class T b Cm IDm Fm). Definition pack_eta K := let cK := Field.class K in let Cm := ComRing.mixin cK in let IDm := IntegralDomain.mixin cK in let Fm := Field.mixin cK in fun (bT : Falgebra.type phR) b & phant_id (Falgebra.class bT) b => fun cT_ & phant_id (@Class T b) cT_ => @Pack phR T (cT_ Cm IDm Fm). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @IntegralDomain.Pack cT class. Definition fieldType := @Field.Pack cT class. Definition lmodType := @Lmodule.Pack R phR cT class. Definition lalgType := @Lalgebra.Pack R phR cT class. Definition algType := @Algebra.Pack R phR cT class. Definition unitAlgType := @UnitAlgebra.Pack R phR cT class. Definition comAlgType := @ComAlgebra.Pack R phR cT class. Definition comUnitAlgType := @ComUnitAlgebra.Pack R phR cT class. Definition vectType := @Vector.Pack R phR cT class. Definition FalgType := @Falgebra.Pack R phR cT class. Definition Falg_comRingType := @ComRing.Pack FalgType class. Definition Falg_comUnitRingType := @ComUnitRing.Pack FalgType class. Definition Falg_comAlgType := @ComAlgebra.Pack R phR FalgType class. Definition Falg_comUnitAlgType := @ComUnitAlgebra.Pack R phR FalgType class. Definition Falg_idomainType := @IntegralDomain.Pack FalgType class. Definition Falg_fieldType := @Field.Pack FalgType class. Definition vect_comRingType := @ComRing.Pack vectType class. Definition vect_comUnitRingType := @ComUnitRing.Pack vectType class. Definition vect_comAlgType := @ComAlgebra.Pack R phR vectType class. Definition vect_comUnitAlgType := @ComUnitAlgebra.Pack R phR vectType class. Definition vect_idomainType := @IntegralDomain.Pack vectType class. Definition vect_fieldType := @Field.Pack vectType class. Definition comUnitAlg_idomainType := @IntegralDomain.Pack comUnitAlgType class. Definition comUnitAlg_fieldType := @Field.Pack comUnitAlgType class. Definition unitAlg_idomainType := @IntegralDomain.Pack unitAlgType class. Definition unitAlg_fieldType := @Field.Pack unitAlgType class. Definition comAlg_idomainType := @IntegralDomain.Pack comAlgType class. Definition comAlg_fieldType := @Field.Pack comAlgType class. Definition alg_idomainType := @IntegralDomain.Pack algType class. Definition alg_fieldType := @Field.Pack algType class. Definition lalg_idomainType := @IntegralDomain.Pack lalgType class. Definition lalg_fieldType := @Field.Pack lalgType class. Definition lmod_idomainType := @IntegralDomain.Pack lmodType class. Definition lmod_fieldType := @Field.Pack lmodType class. End FieldExt. Module Exports. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion base : class_of >-> Falgebra.class_of. Coercion base4 : class_of >-> Field.class_of. Coercion base6 : class_of >-> ComUnitAlgebra.class_of. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> IntegralDomain.type. Canonical idomainType. Coercion fieldType : type >-> Field.type. Canonical fieldType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Coercion algType : type >-> Algebra.type. Canonical algType. Coercion unitAlgType : type >-> UnitAlgebra.type. Canonical unitAlgType. Coercion comAlgType : type >-> ComAlgebra.type. Canonical comAlgType. Coercion comUnitAlgType : type >-> ComUnitAlgebra.type. Canonical comUnitAlgType. Coercion vectType : type >-> Vector.type. Canonical vectType. Coercion FalgType : type >-> Falgebra.type. Canonical FalgType. Canonical Falg_comRingType. Canonical Falg_comUnitRingType. Canonical Falg_comAlgType. Canonical Falg_comUnitAlgType. Canonical Falg_idomainType. Canonical Falg_fieldType. Canonical vect_comRingType. Canonical vect_comUnitRingType. Canonical vect_comAlgType. Canonical vect_comUnitAlgType. Canonical vect_idomainType. Canonical vect_fieldType. Canonical comUnitAlg_idomainType. Canonical comUnitAlg_fieldType. Canonical unitAlg_idomainType. Canonical unitAlg_fieldType. Canonical comAlg_idomainType. Canonical comAlg_fieldType. Canonical alg_idomainType. Canonical alg_fieldType. Canonical lalg_idomainType. Canonical lalg_fieldType. Canonical lmod_idomainType. Canonical lmod_fieldType. Notation fieldExtType R := (type (Phant R)). Notation "[ 'fieldExtType' F 'of' L ]" := (@pack _ (Phant F) L _ _ id _ _ _ _ id id id) (at level 0, format "[ 'fieldExtType' F 'of' L ]") : form_scope. Notation "[ 'fieldExtType' F 'of' L 'for' K ]" := (@pack_eta _ (Phant F) L K _ _ id _ id) (at level 0, format "[ 'fieldExtType' F 'of' L 'for' K ]") : form_scope. Notation "{ 'subfield' L }" := (@aspace_of _ (FalgType _) (Phant L)) (at level 0, format "{ 'subfield' L }") : type_scope. End Exports. End FieldExt. Export FieldExt.Exports. Canonical regular_fieldExtType (F : fieldType) := [fieldExtType F of F^o for F]. Section FieldExtTheory. Variables (F0 : fieldType) (L : fieldExtType F0). Implicit Types (U V M : {vspace L}) (E F K : {subfield L}). Lemma dim_cosetv U x : x != 0 -> \dim (U * <[x]>) = \dim U. Proof. move=> nz_x; rewrite -limg_amulr limg_dim_eq //. apply/eqP; rewrite -subv0; apply/subvP=> y. by rewrite memv_cap memv0 memv_ker lfunE mulf_eq0 (negPf nz_x) orbF => /andP[]. Qed. Lemma prodvC : commutative (@prodv F0 L). Proof. move=> U V; without loss suffices subC: U V / (U * V <= V * U)%VS. by apply/eqP; rewrite eqEsubv !{1}subC. by apply/prodvP=> x y Ux Vy; rewrite mulrC memv_mul. Qed. Canonical prodv_comoid := Monoid.ComLaw prodvC. Lemma prodvCA : left_commutative (@prodv F0 L). Proof. exact: Monoid.mulmCA. Qed. Lemma prodvAC : right_commutative (@prodv F0 L). Proof. exact: Monoid.mulmAC. Qed. Lemma algid1 K : algid K = 1. Proof. exact/skew_field_algid1/fieldP. Qed. Lemma mem1v K : 1 \in K. Proof. by rewrite -algid_eq1 algid1. Qed. Lemma sub1v K : (1 <= K)%VS. Proof. exact: mem1v. Qed. Lemma subfield_closed K : agenv K = K. Proof. by apply/eqP; rewrite eqEsubv sub_agenv agenv_sub_modr ?sub1v ?asubv. Qed. Lemma AHom_lker0 (rT : FalgType F0) (f : 'AHom(L, rT)) : lker f == 0%VS. Proof. by apply/lker0P; apply: fmorph_inj. Qed. Lemma AEnd_lker0 (f : 'AEnd(L)) : lker f == 0%VS. Proof. exact: AHom_lker0. Qed. Fact aimg_is_aspace (rT : FalgType F0) (f : 'AHom(L, rT)) (E : {subfield L}) : is_aspace (f @: E). Proof. rewrite /is_aspace -aimgM limgS ?prodv_id // has_algid1 //. by apply/memv_imgP; exists 1; rewrite ?mem1v ?rmorph1. Qed. Canonical aimg_aspace rT f E := ASpace (@aimg_is_aspace rT f E). Lemma Fadjoin_idP {K x} : reflect (<>%VS = K) (x \in K). Proof. apply: (iffP idP) => [/addv_idPl-> | <-]; first exact: subfield_closed. exact: memv_adjoin. Qed. Lemma Fadjoin0 K : <>%VS = K. Proof. by rewrite addv0 subfield_closed. Qed. Lemma Fadjoin_nil K : <>%VS = K. Proof. by rewrite adjoin_nil subfield_closed. Qed. Lemma FadjoinP {K x E} : reflect (K <= E /\ x \in E)%VS (<>%AS <= E)%VS. Proof. apply: (iffP idP) => [sKxE | /andP]. by rewrite (subvP sKxE) ?memv_adjoin // (subv_trans _ sKxE) ?subv_adjoin. by rewrite -subv_add => /agenvS; rewrite subfield_closed. Qed. Lemma Fadjoin_seqP {K} {rs : seq L} {E} : reflect (K <= E /\ {subset rs <= E})%VS (<> <= E)%VS. Proof. apply: (iffP idP) => [sKrsE | [sKE /span_subvP/(conj sKE)/andP]]. split=> [|x rs_x]; first exact: subv_trans (subv_adjoin_seq _ _) sKrsE. by rewrite (subvP sKrsE) ?seqv_sub_adjoin. by rewrite -subv_add => /agenvS; rewrite subfield_closed. Qed. Lemma alg_polyOver E p : map_poly (in_alg L) p \is a polyOver E. Proof. by apply/(polyOverS (subvP (sub1v _)))/polyOver1P; exists p. Qed. Lemma sub_adjoin1v x E : (<<1; x>> <= E)%VS = (x \in E)%VS. Proof. by rewrite (sameP FadjoinP andP) sub1v. Qed. Fact vsval_multiplicative K : multiplicative (vsval : subvs_of K -> L). Proof. by split => //=; apply: algid1. Qed. Canonical vsval_rmorphism K := AddRMorphism (vsval_multiplicative K). Canonical vsval_lrmorphism K : {lrmorphism subvs_of K -> L} := [lrmorphism of vsval]. Lemma vsval_invf K (w : subvs_of K) : val w^-1 = (vsval w)^-1. Proof. have [-> | Uv] := eqVneq w 0; first by rewrite !invr0. by apply: vsval_invr; rewrite unitfE. Qed. Fact aspace_divr_closed K : divr_closed K. Proof. by split=> [|u v Ku Kv]; rewrite ?mem1v ?memvM ?memvV. Qed. Canonical aspace_mulrPred K := MulrPred (aspace_divr_closed K). Canonical aspace_divrPred K := DivrPred (aspace_divr_closed K). Canonical aspace_smulrPred K := SmulrPred (aspace_divr_closed K). Canonical aspace_sdivrPred K := SdivrPred (aspace_divr_closed K). Canonical aspace_semiringPred K := SemiringPred (aspace_divr_closed K). Canonical aspace_subringPred K := SubringPred (aspace_divr_closed K). Canonical aspace_subalgPred K := SubalgPred (memv_submod_closed K). Canonical aspace_divringPred K := DivringPred (aspace_divr_closed K). Canonical aspace_divalgPred K := DivalgPred (memv_submod_closed K). Definition subvs_mulC K := [comRingMixin of subvs_of K by <:]. Canonical subvs_comRingType K := Eval hnf in ComRingType (subvs_of K) (@subvs_mulC K). Canonical subvs_comUnitRingType K := Eval hnf in [comUnitRingType of subvs_of K]. Definition subvs_mul_eq0 K := [idomainMixin of subvs_of K by <:]. Canonical subvs_idomainType K := Eval hnf in IdomainType (subvs_of K) (@subvs_mul_eq0 K). Lemma subvs_fieldMixin K : GRing.Field.mixin_of (@subvs_idomainType K). Proof. by move=> w nz_w; rewrite unitrE -val_eqE /= vsval_invf algid1 divff. Qed. Canonical subvs_fieldType K := Eval hnf in FieldType (subvs_of K) (@subvs_fieldMixin K). Canonical subvs_fieldExtType K := Eval hnf in [fieldExtType F0 of subvs_of K]. Lemma polyOver_subvs {K} {p : {poly L}} : reflect (exists q : {poly subvs_of K}, p = map_poly vsval q) (p \is a polyOver K). Proof. apply: (iffP polyOverP) => [Hp | [q ->] i]; last by rewrite coef_map // subvsP. exists (\poly_(i < size p) (Subvs (Hp i))); rewrite -{1}[p]coefK. by apply/polyP=> i; rewrite coef_map !coef_poly; case: ifP. Qed. Lemma divp_polyOver K : {in polyOver K &, forall p q, p %/ q \is a polyOver K}. Proof. move=> _ _ /polyOver_subvs[p ->] /polyOver_subvs[q ->]. by apply/polyOver_subvs; exists (p %/ q); rewrite map_divp. Qed. Lemma modp_polyOver K : {in polyOver K &, forall p q, p %% q \is a polyOver K}. Proof. move=> _ _ /polyOver_subvs[p ->] /polyOver_subvs[q ->]. by apply/polyOver_subvs; exists (p %% q); rewrite map_modp. Qed. Lemma gcdp_polyOver K : {in polyOver K &, forall p q, gcdp p q \is a polyOver K}. Proof. move=> _ _ /polyOver_subvs[p ->] /polyOver_subvs[q ->]. by apply/polyOver_subvs; exists (gcdp p q); rewrite gcdp_map. Qed. Fact prodv_is_aspace E F : is_aspace (E * F). Proof. rewrite /is_aspace prodvCA -!prodvA prodvA !prodv_id has_algid1 //=. by rewrite -[1]mulr1 memv_mul ?mem1v. Qed. Canonical prodv_aspace E F : {subfield L} := ASpace (prodv_is_aspace E F). Fact field_mem_algid E F : algid E \in F. Proof. by rewrite algid1 mem1v. Qed. Canonical capv_aspace E F : {subfield L} := aspace_cap (field_mem_algid E F). Lemma polyOverSv U V : (U <= V)%VS -> {subset polyOver U <= polyOver V}. Proof. by move/subvP=> sUV; apply: polyOverS. Qed. Lemma field_subvMl F U : (U <= F * U)%VS. Proof. by rewrite -{1}[U]prod1v prodvSl ?sub1v. Qed. Lemma field_subvMr U F : (U <= U * F)%VS. Proof. by rewrite prodvC field_subvMl. Qed. Lemma field_module_eq F M : (F * M <= M)%VS -> (F * M)%VS = M. Proof. by move=> modM; apply/eqP; rewrite eqEsubv modM field_subvMl. Qed. Lemma sup_field_module F E : (F * E <= E)%VS = (F <= E)%VS. Proof. apply/idP/idP; first exact: subv_trans (field_subvMr F E). by move/(prodvSl E)/subv_trans->; rewrite ?asubv. Qed. Lemma field_module_dimS F M : (F * M <= M)%VS -> (\dim F %| \dim M)%N. Proof. exact/skew_field_module_dimS/fieldP. Qed. Lemma field_dimS F E : (F <= E)%VS -> (\dim F %| \dim E)%N. Proof. exact/skew_field_dimS/fieldP. Qed. Lemma dim_field_module F M : (F * M <= M)%VS -> \dim M = (\dim_F M * \dim F)%N. Proof. by move/field_module_dimS/divnK. Qed. Lemma dim_sup_field F E : (F <= E)%VS -> \dim E = (\dim_F E * \dim F)%N. Proof. by move/field_dimS/divnK. Qed. Lemma field_module_semisimple F M (m := \dim_F M) : (F * M <= M)%VS -> {X : m.-tuple L | {subset X <= M} /\ 0 \notin X & let FX := (\sum_(i < m) F * <[X`_i]>)%VS in FX = M /\ directv FX}. Proof. move=> modM; have dimM: (m * \dim F)%N = \dim M by rewrite -dim_field_module. have [X [defM dxFX nzX]] := skew_field_module_semisimple (@fieldP L) modM. have szX: size X == m. rewrite -(eqn_pmul2r (adim_gt0 F)) dimM -defM (directvP dxFX) /=. rewrite -sum1_size big_distrl; apply/eqP/eq_big_seq => x Xx /=. by rewrite mul1n dim_cosetv ?(memPn nzX). rewrite directvE /= !(big_nth 0) (eqP szX) !big_mkord -directvE /= in defM dxFX. exists (Tuple szX) => //; split=> // _ /tnthP[i ->]; rewrite (tnth_nth 0) /=. by rewrite -defM memvE (sumv_sup i) ?field_subvMl. Qed. Section FadjoinPolyDefinitions. Variables (U : {vspace L}) (x : L). Definition adjoin_degree := (\dim_U <>).-1.+1. Local Notation n := adjoin_degree. Definition Fadjoin_sum := (\sum_(i < n) U * <[x ^+ i]>)%VS. Definition Fadjoin_poly v : {poly L} := \poly_(i < n) (sumv_pi Fadjoin_sum (inord i) v / x ^+ i). Definition minPoly : {poly L} := 'X^n - Fadjoin_poly (x ^+ n). Lemma size_Fadjoin_poly v : size (Fadjoin_poly v) <= n. Proof. exact: size_poly. Qed. Lemma Fadjoin_polyOver v : Fadjoin_poly v \is a polyOver U. Proof. apply/(all_nthP 0) => i _; rewrite coef_poly /=. case: ifP => lti; last exact: mem0v. have /memv_cosetP[y Uy ->] := memv_sum_pi (erefl Fadjoin_sum) (inord i) v. rewrite inordK //; have [-> | /mulfK-> //] := eqVneq (x ^+ i) 0. by rewrite mulr0 mul0r mem0v. Qed. Fact Fadjoin_poly_is_linear : linear_for (in_alg L \; *:%R) Fadjoin_poly. Proof. move=> a u v; apply/polyP=> i; rewrite coefD coefZ !coef_poly. case: ifP => lti; last by rewrite mulr0 addr0. by rewrite linearP mulrA -mulrDl mulr_algl. Qed. Canonical Fadjoin_poly_additive := Additive Fadjoin_poly_is_linear. Canonical Fadjoin_poly_linear := AddLinear Fadjoin_poly_is_linear. Lemma size_minPoly : size minPoly = n.+1. Proof. by rewrite size_addl ?size_polyXn // size_opp ltnS size_poly. Qed. Lemma monic_minPoly : minPoly \is monic. Proof. rewrite monicE /lead_coef size_minPoly coefB coefXn eqxx. by rewrite nth_default ?subr0 ?size_poly. Qed. End FadjoinPolyDefinitions. Section FadjoinPoly. Variables (K : {subfield L}) (x : L). Local Notation n := (adjoin_degree (asval K) x). Local Notation sumKx := (Fadjoin_sum (asval K) x). Lemma adjoin_degreeE : n = \dim_K <>. Proof. by rewrite [n]prednK // divn_gt0 ?adim_gt0 // dimvS ?subv_adjoin. Qed. Lemma dim_Fadjoin : \dim <> = (n * \dim K)%N. Proof. by rewrite adjoin_degreeE -dim_sup_field ?subv_adjoin. Qed. Lemma adjoin0_deg : adjoin_degree K 0 = 1%N. Proof. by rewrite /adjoin_degree addv0 subfield_closed divnn adim_gt0. Qed. Lemma adjoin_deg_eq1 : (n == 1%N) = (x \in K). Proof. rewrite (sameP Fadjoin_idP eqP) adjoin_degreeE; have sK_Kx := subv_adjoin K x. apply/eqP/idP=> [dimKx1 | /eqP->]; last by rewrite divnn adim_gt0. by rewrite eq_sym eqEdim sK_Kx /= (dim_sup_field sK_Kx) dimKx1 mul1n. Qed. Lemma Fadjoin_sum_direct : directv sumKx. Proof. rewrite directvE /=; case: (ubnPgeq n) (isT : n > 0) => -[//|m] ltmn _. elim: m ltmn => [|m IHm] ltm1n; rewrite ?big_ord1 // !(big_ord_recr m.+1) /=. do [move/(_ (ltnW ltm1n))/eqP; set S := (\sum_i _)%VS] in IHm *. rewrite -IHm dimv_add_leqif; apply/subvP=> z; rewrite memv_cap => /andP[Sz]. case/memv_cosetP=> y Ky Dz; rewrite memv0 Dz mulf_eq0 expf_eq0 /=. apply: contraLR ltm1n => /norP[nz_y nz_x]. rewrite -leqNgt -(leq_pmul2r (adim_gt0 K)) -dim_Fadjoin. have{IHm} ->: (m.+1 * \dim K)%N = \dim S. rewrite -[m.+1]card_ord -sum_nat_const IHm. by apply: eq_bigr => i; rewrite dim_cosetv ?expf_neq0. apply/dimvS/agenv_sub_modl; first by rewrite (sumv_sup 0) //= prodv1 sub1v. rewrite prodvDl subv_add -[S]big_distrr prodvA prodv_id subvv !big_distrr /=. apply/subv_sumP=> i _; rewrite -expv_line prodvCA -expvSl expv_line. have [ltim | lemi] := ltnP i m; first by rewrite (sumv_sup (Sub i.+1 _)). have{lemi} /eqP->: i == m :> nat by rewrite eqn_leq leq_ord. rewrite -big_distrr -2!{2}(prodv_id K) /= -!prodvA big_distrr -/S prodvSr //=. by rewrite -(canLR (mulKf nz_y) Dz) -memvE memv_mul ?rpredV. Qed. Let nz_x_i (i : 'I_n) : x ^+ i != 0. Proof. by rewrite expf_eq0; case: eqP i => [->|_] [[]] //; rewrite adjoin0_deg. Qed. Lemma Fadjoin_eq_sum : <>%VS = sumKx. Proof. apply/esym/eqP; rewrite eqEdim eq_leq ?andbT. apply/subv_sumP=> i _; rewrite -agenvM prodvS ?subv_adjoin //. by rewrite -expv_line (subv_trans (subX_agenv _ _)) ?agenvS ?addvSr. rewrite dim_Fadjoin -[n]card_ord -sum_nat_const (directvP Fadjoin_sum_direct). by apply: eq_bigr => i _; rewrite /= dim_cosetv. Qed. Lemma Fadjoin_poly_eq v : v \in <>%VS -> (Fadjoin_poly K x v).[x] = v. Proof. move/(sumv_pi_sum Fadjoin_eq_sum)=> {2}<-; rewrite horner_poly. by apply: eq_bigr => i _; rewrite inord_val mulfVK. Qed. Lemma mempx_Fadjoin p : p \is a polyOver K -> p.[x] \in <>%VS. Proof. move=> Kp; rewrite rpred_horner ?memv_adjoin ?(polyOverS _ Kp) //. exact: subvP_adjoin. Qed. Lemma Fadjoin_polyP {v} : reflect (exists2 p, p \in polyOver K & v = p.[x]) (v \in <>%VS). Proof. apply: (iffP idP) => [Kx_v | [p Kp ->]]; last exact: mempx_Fadjoin. by exists (Fadjoin_poly K x v); rewrite ?Fadjoin_polyOver ?Fadjoin_poly_eq. Qed. Lemma Fadjoin_poly_unique p v : p \is a polyOver K -> size p <= n -> p.[x] = v -> Fadjoin_poly K x v = p. Proof. have polyKx q i: q \is a polyOver K -> q`_i * x ^+ i \in (K * <[x ^+ i]>)%VS. by move/polyOverP=> Kq; rewrite memv_mul ?Kq ?memv_line. move=> Kp szp Dv; have /Fadjoin_poly_eq/eqP := mempx_Fadjoin Kp. rewrite {1}Dv {Dv} !(@horner_coef_wide _ n) ?size_poly //. move/polyKx in Kp; have /polyKx K_pv := Fadjoin_polyOver K x v. rewrite (directv_sum_unique Fadjoin_sum_direct) // => /eqfunP eq_pq. apply/polyP=> i; have [leni|?] := leqP n i; last exact: mulIf (eq_pq (Sub i _)). by rewrite !nth_default ?(leq_trans _ leni) ?size_poly. Qed. Lemma Fadjoin_polyC v : v \in K -> Fadjoin_poly K x v = v%:P. Proof. move=> Kv; apply: Fadjoin_poly_unique; rewrite ?polyOverC ?hornerC //. by rewrite size_polyC (leq_trans (leq_b1 _)). Qed. Lemma Fadjoin_polyX : x \notin K -> Fadjoin_poly K x x = 'X. Proof. move=> K'x; apply: Fadjoin_poly_unique; rewrite ?polyOverX ?hornerX //. by rewrite size_polyX ltn_neqAle andbT eq_sym adjoin_deg_eq1. Qed. Lemma minPolyOver : minPoly K x \is a polyOver K. Proof. by rewrite /minPoly rpredB ?rpredX ?polyOverX ?Fadjoin_polyOver. Qed. Lemma minPolyxx : (minPoly K x).[x] = 0. Proof. by rewrite !hornerE hornerXn Fadjoin_poly_eq ?subrr ?rpredX ?memv_adjoin. Qed. Lemma root_minPoly : root (minPoly K x) x. Proof. exact/rootP/minPolyxx. Qed. Lemma Fadjoin_poly_mod p : p \is a polyOver K -> Fadjoin_poly K x p.[x] = p %% minPoly K x. Proof. move=> Kp; rewrite {1}(divp_eq p (minPoly K x)) 2!hornerE minPolyxx mulr0 add0r. apply: Fadjoin_poly_unique => //; first by rewrite modp_polyOver // minPolyOver. by rewrite -ltnS -size_minPoly ltn_modp // monic_neq0 ?monic_minPoly. Qed. Lemma minPoly_XsubC : reflect (minPoly K x = 'X - x%:P) (x \in K). Proof. set p := minPoly K x; apply: (iffP idP) => [Kx | Dp]; last first. suffices ->: x = - p`_0 by rewrite rpredN (polyOverP minPolyOver). by rewrite Dp coefB coefX coefC add0r opprK. rewrite (@all_roots_prod_XsubC _ p [:: x]) /= ?root_minPoly //. by rewrite big_seq1 (monicP (monic_minPoly K x)) scale1r. by apply/eqP; rewrite size_minPoly eqSS adjoin_deg_eq1. Qed. Lemma root_small_adjoin_poly p : p \is a polyOver K -> size p <= n -> root p x = (p == 0). Proof. move=> Kp szp; apply/rootP/eqP=> [px0 | ->]; last by rewrite horner0. rewrite -(Fadjoin_poly_unique Kp szp px0). by apply: Fadjoin_poly_unique; rewrite ?polyOver0 ?size_poly0 ?horner0. Qed. Lemma minPoly_irr p : p \is a polyOver K -> p %| minPoly K x -> (p %= minPoly K x) || (p %= 1). Proof. rewrite dvdp_eq; set q := _ %/ _ => Kp def_pq. have Kq: q \is a polyOver K by rewrite divp_polyOver // minPolyOver. move: q Kq def_pq root_minPoly (size_minPoly K x) => q Kq /eqP->. rewrite rootM => pqx0 szpq. have [nzq nzp]: q != 0 /\ p != 0. by apply/norP; rewrite -mulf_eq0 -size_poly_eq0 szpq. without loss{pqx0} qx0: q p Kp Kq nzp nzq szpq / root q x. move=> IH; case/orP: pqx0 => /IH{}IH; first exact: IH. have{IH} /orP[]: (q %= p * q) || (q %= 1) by apply: IH => //; rewrite mulrC. by rewrite orbC -{1}[q]mul1r eqp_mul2r // eqp_sym => ->. by rewrite -{1}[p]mul1r eqp_sym eqp_mul2r // => ->. apply/orP; right; rewrite -size_poly_eq1 eqn_leq lt0n size_poly_eq0 nzp andbT. rewrite -(leq_add2r (size q)) -leq_subLR subn1 -size_mul // mulrC szpq. by rewrite ltnNge; apply: contra nzq => /(root_small_adjoin_poly Kq) <-. Qed. Lemma minPoly_dvdp p : p \is a polyOver K -> root p x -> (minPoly K x) %| p. Proof. move=> Kp rootp. have gcdK : gcdp (minPoly K x) p \is a polyOver K. by rewrite gcdp_polyOver ?minPolyOver. have /orP[gcd_eqK|gcd_eq1] := minPoly_irr gcdK (dvdp_gcdl (minPoly K x) p). by rewrite -(eqp_dvdl _ gcd_eqK) dvdp_gcdr. case/negP: (root1 x). by rewrite -(eqp_root gcd_eq1) root_gcd rootp root_minPoly. Qed. End FadjoinPoly. Lemma minPolyS K E a : (K <= E)%VS -> minPoly E a %| minPoly K a. Proof. move=> sKE; apply: minPoly_dvdp; last exact: root_minPoly. by apply: (polyOverSv sKE); rewrite minPolyOver. Qed. Arguments Fadjoin_polyP {K x v}. Lemma Fadjoin1_polyP x v : reflect (exists p, v = (map_poly (in_alg L) p).[x]) (v \in <<1; x>>%VS). Proof. apply: (iffP Fadjoin_polyP) => [[_ /polyOver1P]|] [p ->]; first by exists p. by exists (map_poly (in_alg L) p) => //; apply: alg_polyOver. Qed. Section Horner. Variables z : L. Definition fieldExt_horner := horner_morph (fun x => mulrC z (in_alg L x)). Canonical fieldExtHorner_additive := [additive of fieldExt_horner]. Canonical fieldExtHorner_rmorphism := [rmorphism of fieldExt_horner]. Lemma fieldExt_hornerC b : fieldExt_horner b%:P = b%:A. Proof. exact: horner_morphC. Qed. Lemma fieldExt_hornerX : fieldExt_horner 'X = z. Proof. exact: horner_morphX. Qed. Fact fieldExt_hornerZ : scalable fieldExt_horner. Proof. move=> a p; rewrite -mul_polyC rmorphM /= fieldExt_hornerC. by rewrite -scalerAl mul1r. Qed. Canonical fieldExt_horner_linear := AddLinear fieldExt_hornerZ. Canonical fieldExt_horner_lrmorhism := [lrmorphism of fieldExt_horner]. End Horner. End FieldExtTheory. Notation "E :&: F" := (capv_aspace E F) : aspace_scope. Notation "'C_ E [ x ]" := (capv_aspace E 'C[x]) : aspace_scope. Notation "'C_ ( E ) [ x ]" := (capv_aspace E 'C[x]) (only parsing) : aspace_scope. Notation "'C_ E ( V )" := (capv_aspace E 'C(V)) : aspace_scope. Notation "'C_ ( E ) ( V )" := (capv_aspace E 'C(V)) (only parsing) : aspace_scope. Notation "E * F" := (prodv_aspace E F) : aspace_scope. Notation "f @: E" := (aimg_aspace f E) : aspace_scope. Arguments Fadjoin_idP {F0 L K x}. Arguments FadjoinP {F0 L K x E}. Arguments Fadjoin_seqP {F0 L K rs E}. Arguments polyOver_subvs {F0 L K p}. Arguments Fadjoin_polyP {F0 L K x v}. Arguments Fadjoin1_polyP {F0 L x v}. Arguments minPoly_XsubC {F0 L K x}. Section MapMinPoly. Variables (F0 : fieldType) (L rL : fieldExtType F0) (f : 'AHom(L, rL)). Variables (K : {subfield L}) (x : L). Lemma adjoin_degree_aimg : adjoin_degree (f @: K) (f x) = adjoin_degree K x. Proof. rewrite !adjoin_degreeE -aimg_adjoin. by rewrite !limg_dim_eq ?(eqP (AHom_lker0 f)) ?capv0. Qed. Lemma map_minPoly : map_poly f (minPoly K x) = minPoly (f @: K) (f x). Proof. set fp := minPoly (f @: K) (f x); pose fM := [rmorphism of f]. have [p Kp Dp]: exists2 p, p \is a polyOver K & map_poly f p = fp. have Kfp: fp \is a polyOver (f @: K)%VS by apply: minPolyOver. exists (map_poly f^-1%VF fp). apply/polyOver_poly=> j _; have /memv_imgP[y Ky ->] := polyOverP Kfp j. by rewrite lker0_lfunK ?AHom_lker0. rewrite -map_poly_comp map_poly_id // => _ /(allP Kfp)/memv_imgP[y _ ->]. by rewrite /= limg_lfunVK ?memv_img ?memvf. apply/eqP; rewrite -eqp_monic ?monic_map ?monic_minPoly // -Dp eqp_map. have: ~~ (p %= 1) by rewrite -size_poly_eq1 -(size_map_poly fM) Dp size_minPoly. apply: implyP; rewrite implyNb orbC eqp_sym minPoly_irr //. rewrite -(dvdp_map fM) Dp minPoly_dvdp ?fmorph_root ?root_minPoly //. by apply/polyOver_poly=> j _; apply/memv_img/polyOverP/minPolyOver. Qed. End MapMinPoly. (* Changing up the reference field of a fieldExtType. *) Section FieldOver. Variables (F0 : fieldType) (L : fieldExtType F0) (F : {subfield L}). Definition fieldOver of {vspace L} : Type := L. Local Notation K_F := (subvs_of F). Local Notation L_F := (fieldOver F). Canonical fieldOver_eqType := [eqType of L_F]. Canonical fieldOver_choiceType := [choiceType of L_F]. Canonical fieldOver_zmodType := [zmodType of L_F]. Canonical fieldOver_ringType := [ringType of L_F]. Canonical fieldOver_unitRingType := [unitRingType of L_F]. Canonical fieldOver_comRingType := [comRingType of L_F]. Canonical fieldOver_comUnitRingType := [comUnitRingType of L_F]. Canonical fieldOver_idomainType := [idomainType of L_F]. Canonical fieldOver_fieldType := [fieldType of L_F]. Definition fieldOver_scale (a : K_F) (u : L_F) : L_F := vsval a * u. Local Infix "*F:" := fieldOver_scale (at level 40). Fact fieldOver_scaleA a b u : a *F: (b *F: u) = (a * b) *F: u. Proof. exact: mulrA. Qed. Fact fieldOver_scale1 u : 1 *F: u = u. Proof. by rewrite /(1 *F: u) /= algid1 mul1r. Qed. Fact fieldOver_scaleDr a u v : a *F: (u + v) = a *F: u + a *F: v. Proof. exact: mulrDr. Qed. Fact fieldOver_scaleDl v a b : (a + b) *F: v = a *F: v + b *F: v. Proof. exact: mulrDl. Qed. Definition fieldOver_lmodMixin := LmodMixin fieldOver_scaleA fieldOver_scale1 fieldOver_scaleDr fieldOver_scaleDl. Canonical fieldOver_lmodType := LmodType K_F L_F fieldOver_lmodMixin. Lemma fieldOver_scaleE a (u : L) : a *: (u : L_F) = vsval a * u. Proof. by []. Qed. Fact fieldOver_scaleAl a u v : a *F: (u * v) = (a *F: u) * v. Proof. exact: mulrA. Qed. Canonical fieldOver_lalgType := LalgType K_F L_F fieldOver_scaleAl. Fact fieldOver_scaleAr a u v : a *F: (u * v) = u * (a *F: v). Proof. exact: mulrCA. Qed. Canonical fieldOver_algType := AlgType K_F L_F fieldOver_scaleAr. Canonical fieldOver_unitAlgType := [unitAlgType K_F of L_F]. Canonical fieldOver_comAlgType := [comAlgType K_F of L_F]. Canonical fieldOver_comUnitAlgType := [comUnitAlgType K_F of L_F]. Fact fieldOver_vectMixin : Vector.mixin_of fieldOver_lmodType. Proof. have [bL [_ nz_bL] [defL dxSbL]] := field_module_semisimple (subvf (F * _)). do [set n := \dim_F {:L} in bL nz_bL *; set SbL := (\sum_i _)%VS] in defL dxSbL. have in_bL i (a : K_F) : val a * (bL`_i : L_F) \in (F * <[bL`_i]>)%VS. by rewrite memv_mul ?(valP a) ?memv_line. have nz_bLi (i : 'I_n): bL`_i != 0 by rewrite (memPn nz_bL) ?memt_nth. pose r2v (v : 'rV[K_F]_n) : L_F := \sum_i v 0 i *: (bL`_i : L_F). have r2v_lin: linear r2v. move=> a u v; rewrite /r2v scaler_sumr -big_split /=; apply: eq_bigr => i _. by rewrite scalerA -scalerDl !mxE. have v2rP x: {r : 'rV[K_F]_n | x = r2v r}. apply: sig_eqW; have /memv_sumP[y Fy ->]: x \in SbL by rewrite defL memvf. have /fin_all_exists[r Dr] i: exists r, y i = r *: (bL`_i : L_F). by have /memv_cosetP[a Fa ->] := Fy i isT; exists (Subvs Fa). by exists (\row_i r i); apply: eq_bigr => i _; rewrite mxE. pose v2r x := sval (v2rP x). have v2rK: cancel v2r (Linear r2v_lin) by rewrite /v2r => x; case: (v2rP x). suffices r2vK: cancel r2v v2r. by exists n, v2r; [apply: can2_linear v2rK | exists r2v]. move=> r; apply/rowP=> i; apply/val_inj/(mulIf (nz_bLi i))/eqP; move: i isT. by apply/forall_inP; move/directv_sum_unique: dxSbL => <- //; apply/eqP/v2rK. Qed. Canonical fieldOver_vectType := VectType K_F L_F fieldOver_vectMixin. Canonical fieldOver_FalgType := [FalgType K_F of L_F]. Canonical fieldOver_fieldExtType := [fieldExtType K_F of L_F]. Implicit Types (V : {vspace L}) (E : {subfield L}). Lemma trivial_fieldOver : (1%VS : {vspace L_F}) =i F. Proof. move=> x; apply/vlineP/idP=> [[{}x ->] | Fx]. by rewrite fieldOver_scaleE mulr1 (valP x). by exists (vsproj F x); rewrite fieldOver_scaleE mulr1 vsprojK. Qed. Definition vspaceOver V := <>%VS. Lemma mem_vspaceOver V : vspaceOver V =i (F * V)%VS. Proof. move=> y; apply/idP/idP; last rewrite unlock; move/coord_span->. rewrite (@memv_suml F0 L) // => i _. by rewrite memv_mul ?subvsP // vbasis_mem ?memt_nth. rewrite memv_suml // => ij _; rewrite -tnth_nth; set x := tnth _ ij. have/allpairsP[[u z] /= [Fu Vz {x}->]]: x \in _ := mem_tnth ij _. by rewrite scalerAl (memvZ (Subvs _)) ?memvZ ?memv_span //= vbasis_mem. Qed. Lemma mem_aspaceOver E : (F <= E)%VS -> vspaceOver E =i E. Proof. by move=> sFE y; rewrite mem_vspaceOver field_module_eq ?sup_field_module. Qed. Fact aspaceOver_suproof E : is_aspace (vspaceOver E). Proof. rewrite /is_aspace has_algid1; last by rewrite mem_vspaceOver (@mem1v _ L). by apply/prodvP=> u v; rewrite !mem_vspaceOver; apply: memvM. Qed. Canonical aspaceOver E := ASpace (aspaceOver_suproof E). Lemma dim_vspaceOver M : (F * M <= M)%VS -> \dim (vspaceOver M) = \dim_F M. Proof. move=> modM; have [] := field_module_semisimple modM. set n := \dim_F M => b [Mb nz_b] [defM dx_b]. suff: basis_of (vspaceOver M) b by apply: size_basis. apply/andP; split. rewrite eqEsubv; apply/andP; split; apply/span_subvP=> u. by rewrite mem_vspaceOver field_module_eq // => /Mb. move/(@vbasis_mem _ _ _ M); rewrite -defM => /memv_sumP[{}u Fu ->]. apply: memv_suml => i _; have /memv_cosetP[a Fa ->] := Fu i isT. by apply: (memvZ (Subvs Fa)); rewrite memv_span ?memt_nth. apply/freeP=> a /(directv_sum_independent dx_b) a_0 i. have{a_0}: a i *: (b`_i : L_F) == 0. by rewrite a_0 {i}// => i _; rewrite memv_mul ?memv_line ?subvsP. by rewrite scaler_eq0=> /predU1P[] // /idPn[]; rewrite (memPn nz_b) ?memt_nth. Qed. Lemma dim_aspaceOver E : (F <= E)%VS -> \dim (vspaceOver E) = \dim_F E. Proof. by rewrite -sup_field_module; apply: dim_vspaceOver. Qed. Lemma vspaceOverP V_F : {V | [/\ V_F = vspaceOver V, (F * V <= V)%VS & V_F =i V]}. Proof. pose V := (F * <>)%VS. have idV: (F * V)%VS = V by rewrite prodvA prodv_id. suffices defVF: V_F = vspaceOver V. by exists V; split=> [||u]; rewrite ?defVF ?mem_vspaceOver ?idV. apply/vspaceP=> v; rewrite mem_vspaceOver idV. do [apply/idP/idP; last rewrite /V unlock] => [/coord_vbasis|/coord_span] ->. by apply: memv_suml => i _; rewrite memv_mul ?subvsP ?memv_span ?memt_nth. apply: memv_suml => i _; rewrite -tnth_nth; set xu := tnth _ i. have /allpairsP[[x u] /=]: xu \in _ := mem_tnth i _. case=> /vbasis_mem Fx /vbasis_mem Vu ->. rewrite scalerAl (coord_span Vu) mulr_sumr memv_suml // => j_. by rewrite -scalerCA (memvZ (Subvs _)) ?memvZ // vbasis_mem ?memt_nth. Qed. Lemma aspaceOverP (E_F : {subfield L_F}) : {E | [/\ E_F = aspaceOver E, (F <= E)%VS & E_F =i E]}. Proof. have [V [defEF modV memV]] := vspaceOverP E_F. have algE: has_algid V && (V * V <= V)%VS. rewrite has_algid1; last by rewrite -memV mem1v. by apply/prodvP=> u v; rewrite -!memV; apply: memvM. by exists (ASpace algE); rewrite -sup_field_module; split; first apply: val_inj. Qed. End FieldOver. (* Changing the reference field to a smaller field. *) Section BaseField. Variables (F0 : fieldType) (F : fieldExtType F0) (L : fieldExtType F). Definition baseField_type of phant L : Type := L. Notation L0 := (baseField_type (Phant (FieldExt.sort L))). Canonical baseField_eqType := [eqType of L0]. Canonical baseField_choiceType := [choiceType of L0]. Canonical baseField_zmodType := [zmodType of L0]. Canonical baseField_ringType := [ringType of L0]. Canonical baseField_unitRingType := [unitRingType of L0]. Canonical baseField_comRingType := [comRingType of L0]. Canonical baseField_comUnitRingType := [comUnitRingType of L0]. Canonical baseField_idomainType := [idomainType of L0]. Canonical baseField_fieldType := [fieldType of L0]. Definition baseField_scale (a : F0) (u : L0) : L0 := in_alg F a *: u. Local Infix "*F0:" := baseField_scale (at level 40). Fact baseField_scaleA a b u : a *F0: (b *F0: u) = (a * b) *F0: u. Proof. by rewrite [_ *F0: _]scalerA -rmorphM. Qed. Fact baseField_scale1 u : 1 *F0: u = u. Proof. by rewrite /(1 *F0: u) rmorph1 scale1r. Qed. Fact baseField_scaleDr a u v : a *F0: (u + v) = a *F0: u + a *F0: v. Proof. exact: scalerDr. Qed. Fact baseField_scaleDl v a b : (a + b) *F0: v = a *F0: v + b *F0: v. Proof. by rewrite -scalerDl -rmorphD. Qed. Definition baseField_lmodMixin := LmodMixin baseField_scaleA baseField_scale1 baseField_scaleDr baseField_scaleDl. Canonical baseField_lmodType := LmodType F0 L0 baseField_lmodMixin. Lemma baseField_scaleE a (u : L) : a *: (u : L0) = a%:A *: u. Proof. by []. Qed. Fact baseField_scaleAl a (u v : L0) : a *F0: (u * v) = (a *F0: u) * v. Proof. exact: scalerAl. Qed. Canonical baseField_lalgType := LalgType F0 L0 baseField_scaleAl. Fact baseField_scaleAr a u v : a *F0: (u * v) = u * (a *F0: v). Proof. exact: scalerAr. Qed. Canonical baseField_algType := AlgType F0 L0 baseField_scaleAr. Canonical baseField_unitAlgType := [unitAlgType F0 of L0]. Let n := \dim {:F}. Let bF : n.-tuple F := vbasis {:F}. Let coordF (x : F) := (coord_vbasis (memvf x)). Fact baseField_vectMixin : Vector.mixin_of baseField_lmodType. Proof. pose bL := vbasis {:L}; set m := \dim {:L} in bL. pose v2r (x : L0) := mxvec (\matrix_(i, j) coord bF j (coord bL i x)). have v2r_lin: linear v2r. move=> a x y; rewrite -linearP; congr (mxvec _); apply/matrixP=> i j. by rewrite !mxE linearP mulr_algl linearP. pose r2v r := \sum_(i < m) (\sum_(j < n) vec_mx r i j *: bF`_j) *: bL`_i. have v2rK: cancel v2r r2v. move=> x; transitivity (\sum_(i < m) coord bL i x *: bL`_i); last first. by rewrite -coord_vbasis ?memvf. (* GG: rewrite {2}(coord_vbasis (memvf x)) -/m would take 8s; *) (* The -/m takes 8s, and without it then apply: eq_bigr takes 12s. *) (* The time drops to 2s with a -[GRing.Field.ringType F]/(F : fieldType) *) apply: eq_bigr => i _; rewrite mxvecK; congr (_ *: _ : L). by rewrite (coordF (coord bL i x)); apply: eq_bigr => j _; rewrite mxE. exists (m * n)%N, v2r => //; exists r2v => // r. apply: (canLR vec_mxK); apply/matrixP=> i j; rewrite mxE. by rewrite !coord_sum_free ?(basis_free (vbasisP _)). Qed. Canonical baseField_vectType := VectType F0 L0 baseField_vectMixin. Canonical baseField_FalgType := [FalgType F0 of L0]. Canonical baseField_extFieldType := [fieldExtType F0 of L0]. Let F0ZEZ a x v : a *: ((x *: v : L) : L0) = (a *: x) *: v. Proof. by rewrite [a *: _]scalerA -scalerAl mul1r. Qed. Let baseVspace_basis V : seq L0 := [seq tnth bF ij.2 *: tnth (vbasis V) ij.1 | ij : 'I_(\dim V) * 'I_n]. Definition baseVspace V := <>%VS. Lemma mem_baseVspace V : baseVspace V =i V. Proof. move=> y; apply/idP/idP=> [/coord_span->|/coord_vbasis->]; last first. apply: memv_suml => i _; rewrite (coordF (coord _ i (y : L))) scaler_suml -/n. apply: memv_suml => j _; rewrite -/bF -F0ZEZ memvZ ?memv_span // -!tnth_nth. by apply/imageP; exists (i, j). (* GG: the F0ZEZ lemma avoids serious performance issues here. *) apply: memv_suml => k _; rewrite nth_image; case: (enum_val k) => i j /=. by rewrite F0ZEZ memvZ ?vbasis_mem ?mem_tnth. Qed. Lemma dim_baseVspace V : \dim (baseVspace V) = (\dim V * n)%N. Proof. pose bV0 := baseVspace_basis V; set m := \dim V in bV0 *. suffices /size_basis->: basis_of (baseVspace V) bV0. by rewrite card_prod !card_ord. rewrite /basis_of eqxx. apply/freeP=> s sb0 k; rewrite -(enum_valK k); case/enum_val: k => i j. have free_baseP := freeP (basis_free (vbasisP _)). move: j; apply: (free_baseP _ _ fullv); move: i; apply: (free_baseP _ _ V). transitivity (\sum_i \sum_j s (enum_rank (i, j)) *: bV0`_(enum_rank (i, j))). apply: eq_bigr => i _; rewrite scaler_suml; apply: eq_bigr => j _. by rewrite -F0ZEZ nth_image enum_rankK -!tnth_nth. rewrite pair_bigA (reindex _ (onW_bij _ (enum_val_bij _))); apply: etrans sb0. by apply: eq_bigr => k _; rewrite -{5 6}[k](enum_valK k); case/enum_val: k. Qed. Fact baseAspace_suproof (E : {subfield L}) : is_aspace (baseVspace E). Proof. rewrite /is_aspace has_algid1; last by rewrite mem_baseVspace (mem1v E). by apply/prodvP=> u v; rewrite !mem_baseVspace; apply: memvM. Qed. Canonical baseAspace E := ASpace (baseAspace_suproof E). Fact refBaseField_key : unit. Proof. by []. Qed. Definition refBaseField := locked_with refBaseField_key (baseAspace 1). Canonical refBaseField_unlockable := [unlockable of refBaseField]. Notation F1 := refBaseField. Lemma dim_refBaseField : \dim F1 = n. Proof. by rewrite [F1]unlock dim_baseVspace dimv1 mul1n. Qed. Lemma baseVspace_module V (V0 := baseVspace V) : (F1 * V0 <= V0)%VS. Proof. apply/prodvP=> u v; rewrite [F1]unlock !mem_baseVspace => /vlineP[x ->] Vv. by rewrite -(@scalerAl F L) mul1r; apply: memvZ. Qed. Lemma sub_baseField (E : {subfield L}) : (F1 <= baseVspace E)%VS. Proof. by rewrite -sup_field_module baseVspace_module. Qed. Lemma vspaceOver_refBase V : vspaceOver F1 (baseVspace V) =i V. Proof. move=> v; rewrite mem_vspaceOver field_module_eq ?baseVspace_module //. by rewrite mem_baseVspace. Qed. Lemma module_baseVspace M0 : (F1 * M0 <= M0)%VS -> {V | M0 = baseVspace V & M0 =i V}. Proof. move=> modM0; pose V := <>%VS. suffices memM0: M0 =i V. by exists V => //; apply/vspaceP=> v; rewrite mem_baseVspace memM0. move=> v; rewrite -{1}(field_module_eq modM0) -(mem_vspaceOver M0) {}/V. move: (vspaceOver F1 M0) => M. apply/idP/idP=> [/coord_vbasis|/coord_span]->; apply/memv_suml=> i _. rewrite /(_ *: _) /= /fieldOver_scale; case: (coord _ i _) => /= x. rewrite {1}[F1]unlock mem_baseVspace => /vlineP[{}x ->]. by rewrite -(@scalerAl F L) mul1r memvZ ?memv_span ?memt_nth. move: (coord _ i _) => x; rewrite -[_`_i]mul1r scalerAl -tnth_nth. have F1x: x%:A \in F1. by rewrite [F1]unlock mem_baseVspace (@memvZ F L) // mem1v. by congr (_ \in M): (memvZ (Subvs F1x) (vbasis_mem (mem_tnth i _))). Qed. Lemma module_baseAspace (E0 : {subfield L0}) : (F1 <= E0)%VS -> {E | E0 = baseAspace E & E0 =i E}. Proof. rewrite -sup_field_module => /module_baseVspace[E defE0 memE0]. suffices algE: is_aspace E by exists (ASpace algE); first apply: val_inj. rewrite /is_aspace has_algid1 -?memE0 ?mem1v //. by apply/prodvP=> u v; rewrite -!memE0; apply: memvM. Qed. End BaseField. Notation baseFieldType L := (baseField_type (Phant L)). (* Base of fieldOver, finally. *) Section MoreFieldOver. Variables (F0 : fieldType) (L : fieldExtType F0) (F : {subfield L}). Lemma base_vspaceOver V : baseVspace (vspaceOver F V) =i (F * V)%VS. Proof. by move=> v; rewrite mem_baseVspace mem_vspaceOver. Qed. Lemma base_moduleOver V : (F * V <= V)%VS -> baseVspace (vspaceOver F V) =i V. Proof. by move=> /field_module_eq defV v; rewrite base_vspaceOver defV. Qed. Lemma base_aspaceOver (E : {subfield L}) : (F <= E)%VS -> baseVspace (vspaceOver F E) =i E. Proof. by rewrite -sup_field_module; apply: base_moduleOver. Qed. End MoreFieldOver. Section SubFieldExtension. Local Open Scope quotient_scope. Variables (F L : fieldType) (iota : {rmorphism F -> L}). Variables (z : L) (p : {poly F}). Local Notation "p ^iota" := (map_poly (GRing.RMorphism.apply iota) p) (at level 2, format "p ^iota") : ring_scope. Let wf_p := (p != 0) && root p^iota z. Let p0 : {poly F} := if wf_p then (lead_coef p)^-1 *: p else 'X. Let z0 := if wf_p then z else 0. Let n := (size p0).-1. Let p0_mon : p0 \is monic. Proof. rewrite /p0; case: ifP => [/andP[nz_p _] | _]; last exact: monicX. by rewrite monicE lead_coefZ mulVf ?lead_coef_eq0. Qed. Let nz_p0 : p0 != 0. Proof. by rewrite monic_neq0 // p0_mon. Qed. Let p0z0 : root p0^iota z0. Proof. rewrite /p0 /z0; case: ifP => [/andP[_ pz0]|]; last by rewrite map_polyX rootX. by rewrite map_polyZ rootE hornerZ (rootP pz0) mulr0. Qed. Let n_gt0: 0 < n. Proof. rewrite /n -subn1 subn_gt0 -(size_map_poly iota). by rewrite (root_size_gt1 _ p0z0) ?map_poly_eq0. Qed. Let z0Ciota : commr_rmorph iota z0. Proof. by move=> x; apply: mulrC. Qed. Local Notation iotaPz := (horner_morph z0Ciota). Let iotaFz (x : 'rV[F]_n) := iotaPz (rVpoly x). Definition equiv_subfext x y := (iotaFz x == iotaFz y). Fact equiv_subfext_is_equiv : equiv_class_of equiv_subfext. Proof. by rewrite /equiv_subfext; split=> x // y w /eqP->. Qed. Canonical equiv_subfext_equiv := EquivRelPack equiv_subfext_is_equiv. Canonical equiv_subfext_encModRel := defaultEncModRel equiv_subfext. Definition subFExtend := {eq_quot equiv_subfext}. Canonical subFExtend_eqType := [eqType of subFExtend]. Canonical subFExtend_choiceType := [choiceType of subFExtend]. Canonical subFExtend_quotType := [quotType of subFExtend]. Canonical subFExtend_eqQuotType := [eqQuotType equiv_subfext of subFExtend]. Definition subfx_inj := lift_fun1 subFExtend iotaFz. Fact pi_subfx_inj : {mono \pi : x / iotaFz x >-> subfx_inj x}. Proof. unlock subfx_inj => x; apply/eqP; rewrite -/(equiv_subfext _ x). by rewrite -eqmodE reprK. Qed. Canonical pi_subfx_inj_morph := PiMono1 pi_subfx_inj. Let iotaPz_repr x : iotaPz (rVpoly (repr (\pi_(subFExtend) x))) = iotaFz x. Proof. by rewrite -/(iotaFz _) -!pi_subfx_inj reprK. Qed. Definition subfext0 := lift_cst subFExtend 0. Canonical subfext0_morph := PiConst subfext0. Definition subfext_add := lift_op2 subFExtend +%R. Fact pi_subfext_add : {morph \pi : x y / x + y >-> subfext_add x y}. Proof. unlock subfext_add => x y /=; apply/eqmodP/eqP. by rewrite /iotaFz !linearD /= !iotaPz_repr. Qed. Canonical pi_subfx_add_morph := PiMorph2 pi_subfext_add. Definition subfext_opp := lift_op1 subFExtend -%R. Fact pi_subfext_opp : {morph \pi : x / - x >-> subfext_opp x}. Proof. unlock subfext_opp => y /=; apply/eqmodP/eqP. by rewrite /iotaFz !linearN /= !iotaPz_repr. Qed. Canonical pi_subfext_opp_morph := PiMorph1 pi_subfext_opp. Fact addfxA : associative subfext_add. Proof. by move=> x y t; rewrite -[x]reprK -[y]reprK -[t]reprK !piE addrA. Qed. Fact addfxC : commutative subfext_add. Proof. by move=> x y; rewrite -[x]reprK -[y]reprK !piE addrC. Qed. Fact add0fx : left_id subfext0 subfext_add. Proof. by move=> x; rewrite -[x]reprK !piE add0r. Qed. Fact addfxN : left_inverse subfext0 subfext_opp subfext_add. Proof. by move=> x; rewrite -[x]reprK !piE addNr. Qed. Definition subfext_zmodMixin := ZmodMixin addfxA addfxC add0fx addfxN. Canonical subfext_zmodType := Eval hnf in ZmodType subFExtend subfext_zmodMixin. Let poly_rV_modp_K q : rVpoly (poly_rV (q %% p0) : 'rV[F]_n) = q %% p0. Proof. by apply: poly_rV_K; rewrite -ltnS -polySpred // ltn_modp. Qed. Let iotaPz_modp q : iotaPz (q %% p0) = iotaPz q. Proof. rewrite {2}(divp_eq q p0) rmorphD rmorphM /=. by rewrite [iotaPz p0](rootP p0z0) mulr0 add0r. Qed. Definition subfx_mul_rep (x y : 'rV[F]_n) : 'rV[F]_n := poly_rV ((rVpoly x) * (rVpoly y) %% p0). Definition subfext_mul := lift_op2 subFExtend subfx_mul_rep. Fact pi_subfext_mul : {morph \pi : x y / subfx_mul_rep x y >-> subfext_mul x y}. Proof. unlock subfext_mul => x y /=; apply/eqmodP/eqP. by rewrite /iotaFz !poly_rV_modp_K !iotaPz_modp !rmorphM /= !iotaPz_repr. Qed. Canonical pi_subfext_mul_morph := PiMorph2 pi_subfext_mul. Definition subfext1 := lift_cst subFExtend (poly_rV 1). Canonical subfext1_morph := PiConst subfext1. Fact mulfxA : associative (subfext_mul). Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> w; rewrite !piE /subfx_mul_rep. by rewrite !poly_rV_modp_K [_ %% p0 * _]mulrC !modp_mul // mulrA mulrC. Qed. Fact mulfxC : commutative subfext_mul. Proof. by elim/quotW=> x; elim/quotW=> y; rewrite !piE /subfx_mul_rep /= mulrC. Qed. Fact mul1fx : left_id subfext1 subfext_mul. Proof. elim/quotW=> x; rewrite !piE /subfx_mul_rep poly_rV_K ?size_poly1 // mul1r. by rewrite modp_small ?rVpolyK // (polySpred nz_p0) ltnS size_poly. Qed. Fact mulfx_addl : left_distributive subfext_mul subfext_add. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> w. by rewrite !piE /subfx_mul_rep linearD /= mulrDl modpD linearD. Qed. Fact nonzero1fx : subfext1 != subfext0. Proof. rewrite !piE /equiv_subfext /iotaFz !linear0. by rewrite poly_rV_K ?rmorph1 ?oner_eq0 // size_poly1. Qed. Definition subfext_comRingMixin := ComRingMixin mulfxA mulfxC mul1fx mulfx_addl nonzero1fx. Canonical subfext_Ring := Eval hnf in RingType subFExtend subfext_comRingMixin. Canonical subfext_comRing := Eval hnf in ComRingType subFExtend mulfxC. Definition subfx_poly_inv (q : {poly F}) : {poly F} := if iotaPz q == 0 then 0 else let r := gdcop q p0 in let: (u, v) := egcdp q r in ((u * q + v * r)`_0)^-1 *: u. Let subfx_poly_invE q : iotaPz (subfx_poly_inv q) = (iotaPz q)^-1. Proof. rewrite /subfx_poly_inv. have [-> | nzq] := eqVneq; first by rewrite rmorph0 invr0. rewrite [nth]lock -[_^-1]mul1r; apply: canRL (mulfK nzq) _; rewrite -rmorphM /=. have rz0: iotaPz (gdcop q p0) = 0. by apply/rootP; rewrite gdcop_map root_gdco ?map_poly_eq0 // p0z0 nzq. do [case: gdcopP => r _; rewrite (negPf nz_p0) orbF => co_r_q _] in rz0 *. case: (egcdp q r) (egcdpE q r) => u v /=/eqp_size/esym/eqP. rewrite coprimep_size_gcd 1?coprimep_sym // => /size_poly1P[a nz_a Da]. rewrite Da -scalerAl (canRL (addrK _) Da) -lock coefC linearZ linearB /=. by rewrite rmorphM /= rz0 mulr0 subr0 horner_morphC -rmorphM mulVf ?rmorph1. Qed. Definition subfx_inv_rep (x : 'rV[F]_n) : 'rV[F]_n := poly_rV (subfx_poly_inv (rVpoly x) %% p0). Definition subfext_inv := lift_op1 subFExtend subfx_inv_rep. Fact pi_subfext_inv : {morph \pi : x / subfx_inv_rep x >-> subfext_inv x}. Proof. unlock subfext_inv => x /=; apply/eqmodP/eqP; rewrite /iotaFz. by rewrite 2!{1}poly_rV_modp_K 2!{1}iotaPz_modp !subfx_poly_invE iotaPz_repr. Qed. Canonical pi_subfext_inv_morph := PiMorph1 pi_subfext_inv. Fact subfx_fieldAxiom : GRing.Field.axiom (subfext_inv : subFExtend -> subFExtend). Proof. elim/quotW=> x; apply: contraNeq; rewrite !piE /equiv_subfext /iotaFz !linear0. apply: contraR => nz_x; rewrite poly_rV_K ?size_poly1 // !poly_rV_modp_K. by rewrite iotaPz_modp rmorph1 rmorphM /= iotaPz_modp subfx_poly_invE mulVf. Qed. Fact subfx_inv0 : subfext_inv (0 : subFExtend) = (0 : subFExtend). Proof. apply/eqP; rewrite !piE /equiv_subfext /iotaFz /subfx_inv_rep !linear0. by rewrite /subfx_poly_inv rmorph0 eqxx mod0p !linear0. Qed. Definition subfext_unitRingMixin := FieldUnitMixin subfx_fieldAxiom subfx_inv0. Canonical subfext_unitRingType := Eval hnf in UnitRingType subFExtend subfext_unitRingMixin. Canonical subfext_comUnitRing := Eval hnf in [comUnitRingType of subFExtend]. Definition subfext_fieldMixin := @FieldMixin _ _ subfx_fieldAxiom subfx_inv0. Definition subfext_idomainMixin := FieldIdomainMixin subfext_fieldMixin. Canonical subfext_idomainType := Eval hnf in IdomainType subFExtend subfext_idomainMixin. Canonical subfext_fieldType := Eval hnf in FieldType subFExtend subfext_fieldMixin. Fact subfx_inj_is_rmorphism : rmorphism subfx_inj. Proof. do 2?split; last by rewrite piE /iotaFz poly_rV_K ?rmorph1 ?size_poly1. by elim/quotW=> x; elim/quotW=> y; rewrite !piE /iotaFz linearB rmorphB. elim/quotW=> x; elim/quotW=> y; rewrite !piE /subfx_mul_rep /iotaFz. by rewrite poly_rV_modp_K iotaPz_modp rmorphM. Qed. Canonical subfx_inj_additive := Additive subfx_inj_is_rmorphism. Canonical subfx_inj_rmorphism := RMorphism subfx_inj_is_rmorphism. Definition subfx_eval := lift_embed subFExtend (fun q => poly_rV (q %% p0)). Canonical subfx_eval_morph := PiEmbed subfx_eval. Definition subfx_root := subfx_eval 'X. Lemma subfx_eval_is_rmorphism : rmorphism subfx_eval. Proof. do 2?split=> [x y|] /=; apply/eqP; rewrite piE. - by rewrite -linearB modpD modNp. - by rewrite /subfx_mul_rep !poly_rV_modp_K !(modp_mul, mulrC _ y). by rewrite modp_small // size_poly1 -subn_gt0 subn1. Qed. Canonical subfx_eval_additive := Additive subfx_eval_is_rmorphism. Canonical subfx_eval_rmorphism := AddRMorphism subfx_eval_is_rmorphism. Definition inj_subfx := (subfx_eval \o polyC). Canonical inj_subfx_addidive := [additive of inj_subfx]. Canonical inj_subfx_rmorphism := [rmorphism of inj_subfx]. Lemma subfxE x: exists p, x = subfx_eval p. Proof. elim/quotW: x => x; exists (rVpoly x); apply/eqP; rewrite piE /equiv_subfext. by rewrite /iotaFz poly_rV_modp_K iotaPz_modp. Qed. Definition subfx_scale a x := inj_subfx a * x. Fact subfx_scalerA a b x : subfx_scale a (subfx_scale b x) = subfx_scale (a * b) x. Proof. by rewrite /subfx_scale rmorphM mulrA. Qed. Fact subfx_scaler1r : left_id 1 subfx_scale. Proof. by move=> x; rewrite /subfx_scale rmorph1 mul1r. Qed. Fact subfx_scalerDr : right_distributive subfx_scale +%R. Proof. by move=> a; apply: mulrDr. Qed. Fact subfx_scalerDl x : {morph subfx_scale^~ x : a b / a + b}. Proof. by move=> a b; rewrite /subfx_scale rmorphD mulrDl. Qed. Definition subfx_lmodMixin := LmodMixin subfx_scalerA subfx_scaler1r subfx_scalerDr subfx_scalerDl. Canonical subfx_lmodType := LmodType F subFExtend subfx_lmodMixin. Fact subfx_scaleAl : GRing.Lalgebra.axiom ( *%R : subFExtend -> _). Proof. by move=> a; apply: mulrA. Qed. Canonical subfx_lalgType := LalgType F subFExtend subfx_scaleAl. Fact subfx_scaleAr : GRing.Algebra.axiom subfx_lalgType. Proof. by move=> a; apply: mulrCA. Qed. Canonical subfx_algType := AlgType F subFExtend subfx_scaleAr. Canonical subfext_unitAlgType := [unitAlgType F of subFExtend]. Fact subfx_evalZ : scalable subfx_eval. Proof. by move=> a q; rewrite -mul_polyC rmorphM. Qed. Canonical subfx_eval_linear := AddLinear subfx_evalZ. Canonical subfx_eval_lrmorphism := [lrmorphism of subfx_eval]. Hypothesis (pz0 : root p^iota z). Section NonZero. Hypothesis nz_p : p != 0. Lemma subfx_inj_eval q : subfx_inj (subfx_eval q) = q^iota.[z]. Proof. by rewrite piE /iotaFz poly_rV_modp_K iotaPz_modp /iotaPz /z0 /wf_p nz_p pz0. Qed. Lemma subfx_inj_root : subfx_inj subfx_root = z. Proof. by rewrite subfx_inj_eval // map_polyX hornerX. Qed. Lemma subfx_injZ b x : subfx_inj (b *: x) = iota b * subfx_inj x. Proof. by rewrite rmorphM /= subfx_inj_eval // map_polyC hornerC. Qed. Lemma subfx_inj_base b : subfx_inj b%:A = iota b. Proof. by rewrite subfx_injZ rmorph1 mulr1. Qed. Lemma subfxEroot x : {q | x = (map_poly (in_alg subFExtend) q).[subfx_root]}. Proof. have /sig_eqW[q ->] := subfxE x; exists q. apply: (fmorph_inj subfx_inj_rmorphism). rewrite -horner_map /= subfx_inj_root subfx_inj_eval //. by rewrite -map_poly_comp (eq_map_poly subfx_inj_base). Qed. Lemma subfx_irreducibleP : (forall q, root q^iota z -> q != 0 -> size p <= size q) <-> irreducible_poly p. Proof. split=> [min_p | irr_p q qz0 nz_q]. split=> [|q nonC_q q_dv_p]. by rewrite -(size_map_poly iota) (root_size_gt1 _ pz0) ?map_poly_eq0. have /dvdpP[r Dp] := q_dv_p; rewrite -dvdp_size_eqp // eqn_leq dvdp_leq //=. have [nz_r nz_q]: r != 0 /\ q != 0 by apply/norP; rewrite -mulf_eq0 -Dp. have: root r^iota z || root q^iota z by rewrite -rootM -rmorphM -Dp. case/orP=> /min_p; [case/(_ _)/idPn=> // | exact]. rewrite polySpred // -leqNgt Dp size_mul //= polySpred // -subn2 ltn_subRL. by rewrite addSnnS addnC ltn_add2l ltn_neqAle eq_sym nonC_q size_poly_gt0. pose r := gcdp p q; have nz_r: r != 0 by rewrite gcdp_eq0 (negPf nz_p). suffices /eqp_size <-: r %= p by rewrite dvdp_leq ?dvdp_gcdr. rewrite (irr_p _) ?dvdp_gcdl // -(size_map_poly iota) gtn_eqF //. by rewrite (@root_size_gt1 _ z) ?map_poly_eq0 // gcdp_map root_gcd pz0. Qed. End NonZero. Section Irreducible. Hypothesis irr_p : irreducible_poly p. Let nz_p : p != 0. Proof. exact: irredp_neq0. Qed. (* The Vector axiom requires irreducibility. *) Lemma min_subfx_vectAxiom : Vector.axiom (size p).-1 subfx_lmodType. Proof. move/subfx_irreducibleP: irr_p => /=/(_ nz_p) min_p; set d := (size p).-1. have Dd: d.+1 = size p by rewrite polySpred. pose Fz2v x : 'rV_d := poly_rV (sval (sig_eqW (subfxE x)) %% p). pose vFz : 'rV_d -> subFExtend := subfx_eval \o rVpoly. have FLinj: injective subfx_inj by apply: fmorph_inj. have Fz2vK: cancel Fz2v vFz. move=> x; rewrite /vFz /Fz2v; case: (sig_eqW _) => /= q ->. apply: FLinj; rewrite !subfx_inj_eval // {2}(divp_eq q p) rmorphD rmorphM /=. by rewrite !hornerE (eqP pz0) mulr0 add0r poly_rV_K // -ltnS Dd ltn_modpN0. suffices vFzK: cancel vFz Fz2v. by exists Fz2v; [apply: can2_linear Fz2vK | exists vFz]. apply: inj_can_sym Fz2vK _ => v1 v2 /(congr1 subfx_inj)/eqP. rewrite -subr_eq0 -!raddfB /= subfx_inj_eval // => /min_p/implyP. rewrite leqNgt implybNN -Dd ltnS size_poly linearB subr_eq0 /=. by move/eqP/(can_inj rVpolyK). Qed. Definition SubfxVectMixin := VectMixin min_subfx_vectAxiom. Definition SubfxVectType := VectType F subFExtend SubfxVectMixin. Definition SubfxFalgType := Eval simpl in [FalgType F of SubfxVectType]. Definition SubFieldExtType := Eval simpl in [fieldExtType F of SubfxFalgType]. End Irreducible. End SubFieldExtension. Prenex Implicits subfx_inj. Lemma irredp_FAdjoin (F : fieldType) (p : {poly F}) : irreducible_poly p -> {L : fieldExtType F & \dim {:L} = (size p).-1 & {z | root (map_poly (in_alg L) p) z & <<1; z>>%VS = fullv}}. Proof. case=> p_gt1 irr_p; set n := (size p).-1; pose vL := [vectType F of 'rV_n]. have Dn: n.+1 = size p := ltn_predK p_gt1. have nz_p: p != 0 by rewrite -size_poly_eq0 -Dn. suffices [L dimL [toPF [toL toPF_K toL_K]]]: {L : fieldExtType F & \dim {:L} = (size p).-1 & {toPF : {linear L -> {poly F}} & {toL : {lrmorphism {poly F} -> L} | cancel toPF toL & forall q, toPF (toL q) = q %% p}}}. - exists L => //; pose z := toL 'X; set iota := in_alg _. suffices q_z q: toPF (map_poly iota q).[z] = q %% p. exists z; first by rewrite /root -(can_eq toPF_K) q_z modpp linear0. apply/vspaceP=> x; rewrite memvf; apply/Fadjoin_polyP. exists (map_poly iota (toPF x)). by apply/polyOverP=> i; rewrite coef_map memvZ ?mem1v. by apply: (can_inj toPF_K); rewrite q_z -toL_K toPF_K. elim/poly_ind: q => [|a q IHq]. by rewrite map_poly0 horner0 linear0 mod0p. rewrite rmorphD rmorphM /= map_polyX map_polyC hornerMXaddC linearD /=. rewrite linearZ /= -(rmorph1 toL) toL_K -modpZl alg_polyC modpD. congr (_ + _); rewrite -toL_K rmorphM /= -/z; congr (toPF (_ * z)). by apply: (can_inj toPF_K); rewrite toL_K. pose toL q : vL := poly_rV (q %% p); pose toPF (x : vL) := rVpoly x. have toL_K q : toPF (toL q) = q %% p. by rewrite /toPF poly_rV_K // -ltnS Dn ?ltn_modp -?Dn. have toPF_K: cancel toPF toL. by move=> x; rewrite /toL modp_small ?rVpolyK // -Dn ltnS size_poly. have toPinj := can_inj toPF_K. pose mul x y := toL (toPF x * toPF y); pose L1 := toL 1. have L1K: toPF L1 = 1 by rewrite toL_K modp_small ?size_poly1. have mulC: commutative mul by rewrite /mul => x y; rewrite mulrC. have mulA: associative mul. by move=> x y z; apply: toPinj; rewrite -!(mulC z) !toL_K !modp_mul mulrCA. have mul1: left_id L1 mul. by move=> x; apply: toPinj; rewrite mulC !toL_K modp_mul mulr1 -toL_K toPF_K. have mulD: left_distributive mul +%R. move=> x y z; apply: toPinj; rewrite /toPF raddfD /= -!/(toPF _). by rewrite !toL_K /toPF raddfD mulrDl modpD. have nzL1: L1 != 0 by rewrite -(inj_eq toPinj) L1K /toPF raddf0 oner_eq0. pose mulM := ComRingMixin mulA mulC mul1 mulD nzL1. pose rL := ComRingType (RingType vL mulM) mulC. have mulZl: GRing.Lalgebra.axiom mul. move=> a x y; apply: toPinj. by rewrite toL_K /toPF !linearZ /= -!/(toPF _) toL_K -scalerAl modpZl. have mulZr: GRing.Algebra.axiom (LalgType F rL mulZl). by move=> a x y; rewrite !(mulrC x) scalerAl. pose aL := AlgType F _ mulZr; pose urL := FalgUnitRingType aL. pose uaL := [unitAlgType F of AlgType F urL mulZr]. pose faL := [FalgType F of uaL]. have unitE: GRing.Field.mixin_of urL. move=> x nz_x; apply/unitrP; set q := toPF x. have nz_q: q != 0 by rewrite -(inj_eq toPinj) /toPF raddf0 in nz_x. have /Bezout_eq1_coprimepP[u upq1]: coprimep p q. apply: contraLR (leq_gcdpr p nz_q) => /irr_p/implyP. rewrite dvdp_gcdl -ltnNge /= => /eqp_size->. by rewrite (polySpred nz_p) ltnS size_poly. suffices: x * toL u.2 = 1 by exists (toL u.2); rewrite mulrC. apply: toPinj; rewrite !toL_K -upq1 modp_mul modpD mulrC. by rewrite modp_mull add0r. pose ucrL := [comUnitRingType of ComRingType urL mulC]. have mul0 := GRing.Field.IdomainMixin unitE. pose fL := FieldType (IdomainType ucrL mul0) unitE. exists [fieldExtType F of faL for fL]; first by rewrite dimvf; apply: mul1n. exists [linear of toPF as rVpoly]. suffices toLM: lrmorphism (toL : {poly F} -> aL) by exists (LRMorphism toLM). have toLlin: linear toL by move=> a q1 q2; rewrite -linearP -modpZl -modpD. do ?split; try exact: toLlin; move=> q r /=. by apply: toPinj; rewrite !toL_K modp_mul -!(mulrC r) modp_mul. Qed. (*Coq 8.3 processes this shorter proof correctly, but then crashes on Qed. In Coq 8.4 Qed takes about 18s. In Coq 8.7, everything seems to be all right *) (* Lemma Xirredp_FAdjoin' (F : fieldType) (p : {poly F}) : irreducible_poly p -> {L : fieldExtType F & Vector.dim L = (size p).-1 & {z | root (map_poly (in_alg L) p) z & <<1; z>>%VS = fullv}}. Proof. case=> p_gt1 irr_p; set n := (size p).-1; pose vL := [vectType F of 'rV_n]. have Dn: n.+1 = size p := ltn_predK p_gt1. have nz_p: p != 0 by rewrite -size_poly_eq0 -Dn. pose toL q : vL := poly_rV (q %% p). have toL_K q : rVpoly (toL q) = q %% p. by rewrite poly_rV_K // -ltnS Dn ?ltn_modp -?Dn. pose mul (x y : vL) : vL := toL (rVpoly x * rVpoly y). pose L1 : vL := poly_rV 1. have L1K: rVpoly L1 = 1 by rewrite poly_rV_K // size_poly1 -ltnS Dn. have mulC: commutative mul by rewrite /mul => x y; rewrite mulrC. have mulA: associative mul. by move=> x y z; rewrite -!(mulC z) /mul !toL_K /toL !modp_mul mulrCA. have mul1: left_id L1 mul. move=> x; rewrite /mul L1K mul1r /toL modp_small ?rVpolyK // -Dn ltnS. by rewrite size_poly. have mulD: left_distributive mul +%R. move=> x y z; apply: canLR rVpolyK _. by rewrite !raddfD mulrDl /= !toL_K /toL modpD. have nzL1: L1 != 0 by rewrite -(can_eq rVpolyK) L1K raddf0 oner_eq0. pose mulM := ComRingMixin mulA mulC mul1 mulD nzL1. pose rL := ComRingType (RingType vL mulM) mulC. have mulZl: GRing.Lalgebra.axiom mul. move=> a x y; apply: canRL rVpolyK _. by rewrite !linearZ /= toL_K -scalerAl modpZl. have mulZr: @GRing.Algebra.axiom _ (LalgType F rL mulZl). by move=> a x y; rewrite !(mulrC x) scalerAl. pose aL := AlgType F _ mulZr; pose urL := FalgUnitRingType aL. pose uaL := [unitAlgType F of AlgType F urL mulZr]. pose faL := [FalgType F of uaL]. have unitE: GRing.Field.mixin_of urL. move=> x nz_x; apply/unitrP; set q := rVpoly x. have nz_q: q != 0 by rewrite -(can_eq rVpolyK) raddf0 in nz_x. have /Bezout_eq1_coprimepP[u upq1]: coprimep p q. have /contraR := irr_p _ _ (dvdp_gcdl p q); apply. have: size (gcdp p q) <= size q by apply: leq_gcdpr. rewrite leqNgt; apply: contra; move/eqp_size ->. by rewrite (polySpred nz_p) ltnS size_poly. suffices: x * toL u.2 = 1 by exists (toL u.2); rewrite mulrC. congr (poly_rV _); rewrite toL_K modp_mul mulrC (canRL (addKr _) upq1). by rewrite -mulNr modp_addl_mul_small ?size_poly1. pose ucrL := [comUnitRingType of ComRingType urL mulC]. pose fL := FieldType (IdomainType ucrL (GRing.Field.IdomainMixin unitE)) unitE. exists [fieldExtType F of faL for fL]; first exact: mul1n. pose z : vL := toL 'X; set iota := in_alg _. have q_z q: rVpoly (map_poly iota q).[z] = q %% p. elim/poly_ind: q => [|a q IHq]. by rewrite map_poly0 horner0 linear0 mod0p. rewrite rmorphD rmorphM /= map_polyX map_polyC hornerMXaddC linearD /=. rewrite linearZ /= L1K alg_polyC modpD; congr (_ + _); last first. by rewrite modp_small // size_polyC; case: (~~ _) => //; apply: ltnW. by rewrite !toL_K IHq mulrC modp_mul mulrC modp_mul. exists z; first by rewrite /root -(can_eq rVpolyK) q_z modpp linear0. apply/vspaceP=> x; rewrite memvf; apply/Fadjoin_polyP. exists (map_poly iota (rVpoly x)). by apply/polyOverP=> i; rewrite coef_map memvZ ?mem1v. by apply/(can_inj rVpolyK); rewrite q_z modp_small // -Dn ltnS size_poly. Qed. *) math-comp-mathcomp-1.12.0/mathcomp/field/finfield.v000066400000000000000000000775751375767750300222010ustar00rootroot00000000000000(* (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 div tuple bigop prime finset fingroup. From mathcomp Require Import ssralg poly polydiv morphism action finalg zmodp. From mathcomp Require Import cyclic center pgroup abelian matrix mxpoly vector. From mathcomp Require Import falgebra fieldext separable galois. From mathcomp Require ssrnum ssrint algC cyclotomic. (******************************************************************************) (* Additional constructions and results on finite fields. *) (* *) (* FinFieldExtType L == A FinFieldType structure on the carrier of L, *) (* where L IS a fieldExtType F structure for an *) (* F that has a finFieldType structure. This *) (* does not take any existing finType structure *) (* on L; this should not be made canonical. *) (* FinSplittingFieldType F L == A SplittingFieldType F structure on the *) (* carrier of L, where L IS a fieldExtType F for *) (* an F with a finFieldType structure; this *) (* should not be made canonical. *) (* Import FinVector :: Declares canonical default finType, finRing, *) (* etc structures (including FinFieldExtType *) (* above) for abstract vectType, FalgType and *) (* fieldExtType over a finFieldType. This should *) (* be used with caution (e.g., local to a proof) *) (* as the finType so obtained may clash with the *) (* canonical one for standard types like matrix. *) (* PrimeCharType charRp == The carrier of a ringType R such that *) (* charRp : p \in [char R] holds. This type has *) (* canonical ringType, ..., fieldType structures *) (* compatible with those of R, as well as *) (* canonical lmodType 'F_p, ..., algType 'F_p *) (* structures, plus an FalgType structure if R *) (* is a finUnitRingType and a splittingFieldType *) (* struture if R is a finFieldType. *) (* FinSplittingFieldFor nz_p == sigma-pair whose sval is a splittingFieldType *) (* that is the splitting field for p : {poly F} *) (* over F : finFieldType, given nz_p : p != 0. *) (* PrimePowerField pr_p k_gt0 == sigma2-triple whose s2val is a finFieldType *) (* of characteristic p and order m = p ^ k, *) (* given pr_p : prime p and k_gt0 : k > 0. *) (* FinDomainFieldType domR == A finFieldType structure on a finUnitRingType *) (* R, given domR : GRing.IntegralDomain.axiom R. *) (* This is intended to be used inside proofs, *) (* where one cannot declare Canonical instances. *) (* Otherwise one should construct explicitly the *) (* intermediate structures using the ssralg and *) (* finalg constructors, and finDomain_mulrC domR *) (* finDomain_fieldP domR to prove commutativity *) (* and field axioms (the former is Wedderburn's *) (* little theorem). *) (* FinDomainSplittingFieldType domR charRp == A splittingFieldType structure *) (* that repackages the two constructions above. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope GRing.Theory FinRing.Theory. Local Open Scope ring_scope. Section FinRing. Variable R : finRingType. Lemma finRing_nontrivial : [set: R] != 1%g. Proof. by apply/trivgPn; exists 1; rewrite ?inE ?oner_neq0. Qed. Lemma finRing_gt1 : 1 < #|R|. Proof. by rewrite -cardsT cardG_gt1 finRing_nontrivial. Qed. End FinRing. Section FinField. Variable F : finFieldType. Lemma card_finField_unit : #|[set: {unit F}]| = #|F|.-1. Proof. by rewrite -(cardC1 0) cardsT card_sub; apply: eq_card => x; rewrite unitfE. Qed. Definition finField_unit x (nz_x : x != 0) := FinRing.unit F (etrans (unitfE x) nz_x). Lemma expf_card x : x ^+ #|F| = x :> F. Proof. rewrite -[RHS]mulr1 -(ltn_predK (finRing_gt1 F)) exprS. apply/eqP; rewrite -subr_eq0 -mulrBr mulf_eq0 subr_eq0 -implyNb -unitfE. apply/implyP=> Ux; rewrite -(val_unitX _ (Sub x _)) -val_unit1 val_eqE. by rewrite -order_dvdn -card_finField_unit order_dvdG ?inE. Qed. Lemma finField_genPoly : 'X^#|F| - 'X = \prod_x ('X - x%:P) :> {poly F}. Proof. set n := #|F|; set oppX := - 'X; set pF := LHS. have le_oppX_n: size oppX <= n by rewrite size_opp size_polyX finRing_gt1. have: size pF = (size (enum F)).+1 by rewrite -cardE size_addl size_polyXn. move/all_roots_prod_XsubC->; last by rewrite uniq_rootsE enum_uniq. by rewrite big_enum lead_coefDl ?size_polyXn // lead_coefXn scale1r. by apply/allP=> x _; rewrite rootE !hornerE hornerXn expf_card subrr. Qed. Lemma finCharP : {p | prime p & p \in [char F]}. Proof. pose e := exponent [set: F]; have e_gt0: e > 0 by apply: exponent_gt0. have: e%:R == 0 :> F by rewrite -zmodXgE expg_exponent // inE. by case/natf0_char/sigW=> // p charFp; exists p; rewrite ?(charf_prime charFp). Qed. Lemma finField_is_abelem : is_abelem [set: F]. Proof. have [p pr_p charFp] := finCharP. by apply/is_abelemP; exists p; last apply: fin_ring_char_abelem. Qed. Lemma card_finCharP p n : #|F| = (p ^ n)%N -> prime p -> p \in [char F]. Proof. move=> oF pr_p; rewrite inE pr_p -order_dvdn. rewrite (abelem_order_p finField_is_abelem) ?inE ?oner_neq0 //=. have n_gt0: n > 0 by rewrite -(ltn_exp2l _ _ (prime_gt1 pr_p)) -oF finRing_gt1. by rewrite cardsT oF -(prednK n_gt0) pdiv_pfactor. Qed. End FinField. Section CardVspace. Variables (F : finFieldType) (T : finType). Section Vector. Variable cvT : Vector.class_of F T. Let vT := Vector.Pack (Phant F) cvT. Lemma card_vspace (V : {vspace vT}) : #|V| = (#|F| ^ \dim V)%N. Proof. set n := \dim V; pose V2rV v := \row_i coord (vbasis V) i v. pose rV2V (rv : 'rV_n) := \sum_i rv 0 i *: (vbasis V)`_i. have rV2V_K: cancel rV2V V2rV. have freeV: free (vbasis V) := basis_free (vbasisP V). by move=> rv; apply/rowP=> i; rewrite mxE coord_sum_free. rewrite -[n]mul1n -card_matrix -(card_imset _ (can_inj rV2V_K)). apply: eq_card => v; apply/idP/imsetP=> [/coord_vbasis-> | [rv _ ->]]. by exists (V2rV v) => //; apply: eq_bigr => i _; rewrite mxE. by apply: (@rpred_sum vT) => i _; rewrite rpredZ ?vbasis_mem ?memt_nth. Qed. Lemma card_vspacef : #|{: vT}%VS| = #|T|. Proof. by apply: eq_card => v; rewrite (@memvf _ vT). Qed. End Vector. Variable caT : Falgebra.class_of F T. Let aT := Falgebra.Pack (Phant F) caT. Lemma card_vspace1 : #|(1%VS : {vspace aT})| = #|F|. Proof. by rewrite card_vspace (dimv1 aT). Qed. End CardVspace. Lemma VectFinMixin (R : finRingType) (vT : vectType R) : Finite.mixin_of vT. Proof. have v2rK := @Vector.InternalTheory.v2rK R vT. exact: CanFinMixin (v2rK : @cancel _ (CountType vT (CanCountMixin v2rK)) _ _). Qed. (* These instancces are not exported by default because they conflict with *) (* existing finType instances such as matrix_finType or primeChar_finType. *) Module FinVector. Section Interfaces. Variable F : finFieldType. Implicit Types (vT : vectType F) (aT : FalgType F) (fT : fieldExtType F). Canonical vect_finType vT := FinType vT (VectFinMixin vT). Canonical Falg_finType aT := FinType aT (VectFinMixin aT). Canonical fieldExt_finType fT := FinType fT (VectFinMixin fT). Canonical Falg_finRingType aT := [finRingType of aT]. Canonical fieldExt_finRingType fT := [finRingType of fT]. Canonical fieldExt_finFieldType fT := [finFieldType of fT]. Lemma finField_splittingField_axiom fT : SplittingField.axiom fT. Proof. exists ('X^#|fT| - 'X); first by rewrite rpredB 1?rpredX ?polyOverX. exists (enum fT); first by rewrite big_enum finField_genPoly eqpxx. by apply/vspaceP=> x; rewrite memvf seqv_sub_adjoin ?mem_enum. Qed. End Interfaces. End FinVector. Notation FinFieldExtType := FinVector.fieldExt_finFieldType. Notation FinSplittingFieldAxiom := (FinVector.finField_splittingField_axiom _). Notation FinSplittingFieldType F L := (SplittingFieldType F L FinSplittingFieldAxiom). Section PrimeChar. Variable p : nat. Section PrimeCharRing. Variable R0 : ringType. Definition PrimeCharType of p \in [char R0] : predArgType := R0. Hypothesis charRp : p \in [char R0]. Local Notation R := (PrimeCharType charRp). Implicit Types (a b : 'F_p) (x y : R). Canonical primeChar_eqType := [eqType of R]. Canonical primeChar_choiceType := [choiceType of R]. Canonical primeChar_zmodType := [zmodType of R]. Canonical primeChar_ringType := [ringType of R]. Definition primeChar_scale a x := a%:R * x. Local Infix "*p:" := primeChar_scale (at level 40). Let natrFp n : (inZp n : 'F_p)%:R = n%:R :> R. Proof. rewrite [in RHS](divn_eq n p) natrD mulrnA (mulrn_char charRp) add0r. by rewrite /= (Fp_cast (charf_prime charRp)). Qed. Lemma primeChar_scaleA a b x : a *p: (b *p: x) = (a * b) *p: x. Proof. by rewrite /primeChar_scale mulrA -natrM natrFp. Qed. Lemma primeChar_scale1 : left_id 1 primeChar_scale. Proof. by move=> x; rewrite /primeChar_scale mul1r. Qed. Lemma primeChar_scaleDr : right_distributive primeChar_scale +%R. Proof. by move=> a x y /=; rewrite /primeChar_scale mulrDr. Qed. Lemma primeChar_scaleDl x : {morph primeChar_scale^~ x: a b / a + b}. Proof. by move=> a b; rewrite /primeChar_scale natrFp natrD mulrDl. Qed. Definition primeChar_lmodMixin := LmodMixin primeChar_scaleA primeChar_scale1 primeChar_scaleDr primeChar_scaleDl. Canonical primeChar_lmodType := LmodType 'F_p R primeChar_lmodMixin. Lemma primeChar_scaleAl : GRing.Lalgebra.axiom ( *%R : R -> R -> R). Proof. by move=> a x y; apply: mulrA. Qed. Canonical primeChar_LalgType := LalgType 'F_p R primeChar_scaleAl. Lemma primeChar_scaleAr : GRing.Algebra.axiom primeChar_LalgType. Proof. by move=> a x y; rewrite ![a *: _]mulr_natl mulrnAr. Qed. Canonical primeChar_algType := AlgType 'F_p R primeChar_scaleAr. End PrimeCharRing. Local Notation type := @PrimeCharType. Canonical primeChar_unitRingType (R : unitRingType) charRp := [unitRingType of type R charRp]. Canonical primeChar_unitAlgType (R : unitRingType) charRp := [unitAlgType 'F_p of type R charRp]. Canonical primeChar_comRingType (R : comRingType) charRp := [comRingType of type R charRp]. Canonical primeChar_comUnitRingType (R : comUnitRingType) charRp := [comUnitRingType of type R charRp]. Canonical primeChar_idomainType (R : idomainType) charRp := [idomainType of type R charRp]. Canonical primeChar_fieldType (F : fieldType) charFp := [fieldType of type F charFp]. Section FinRing. Variables (R0 : finRingType) (charRp : p \in [char R0]). Local Notation R := (type _ charRp). Canonical primeChar_finType := [finType of R]. Canonical primeChar_finZmodType := [finZmodType of R]. Canonical primeChar_baseGroupType := [baseFinGroupType of R for +%R]. Canonical primeChar_groupType := [finGroupType of R for +%R]. Canonical primeChar_finRingType := [finRingType of R]. Canonical primeChar_finLmodType := [finLmodType 'F_p of R]. Canonical primeChar_finLalgType := [finLalgType 'F_p of R]. Canonical primeChar_finAlgType := [finAlgType 'F_p of R]. Let pr_p : prime p. Proof. exact: charf_prime charRp. Qed. Lemma primeChar_abelem : p.-abelem [set: R]. Proof. exact: fin_Fp_lmod_abelem. Qed. Lemma primeChar_pgroup : p.-group [set: R]. Proof. by case/and3P: primeChar_abelem. Qed. Lemma order_primeChar x : x != 0 :> R -> #[x]%g = p. Proof. by apply: (abelem_order_p primeChar_abelem); rewrite inE. Qed. Let n := logn p #|R|. Lemma card_primeChar : #|R| = (p ^ n)%N. Proof. by rewrite /n -cardsT {1}(card_pgroup primeChar_pgroup). Qed. Lemma primeChar_vectAxiom : Vector.axiom n (primeChar_lmodType charRp). Proof. have /isog_isom/=[f /isomP[injf im_f]]: [set: R] \isog [set: 'rV['F_p]_n]. rewrite (@isog_abelem_card _ _ p) fin_Fp_lmod_abelem //=. by rewrite !cardsT card_primeChar card_matrix mul1n card_Fp. exists f; last by exists (invm injf) => x; rewrite ?invmE ?invmK ?im_f ?inE. move=> a x y; rewrite [a *: _]mulr_natl morphM ?morphX ?inE // zmodXgE. by congr (_ + _); rewrite -scaler_nat natr_Zp. Qed. Definition primeChar_vectMixin := Vector.Mixin primeChar_vectAxiom. Canonical primeChar_vectType := VectType 'F_p R primeChar_vectMixin. Lemma primeChar_dimf : \dim {:primeChar_vectType} = n. Proof. by rewrite dimvf. Qed. End FinRing. Canonical primeChar_finUnitRingType (R : finUnitRingType) charRp := [finUnitRingType of type R charRp]. Canonical primeChar_finUnitAlgType (R : finUnitRingType) charRp := [finUnitAlgType 'F_p of type R charRp]. Canonical primeChar_FalgType (R : finUnitRingType) charRp := [FalgType 'F_p of type R charRp]. Canonical primeChar_finComRingType (R : finComRingType) charRp := [finComRingType of type R charRp]. Canonical primeChar_finComUnitRingType (R : finComUnitRingType) charRp := [finComUnitRingType of type R charRp]. Canonical primeChar_finIdomainType (R : finIdomainType) charRp := [finIdomainType of type R charRp]. Section FinField. Variables (F0 : finFieldType) (charFp : p \in [char F0]). Local Notation F := (type _ charFp). Canonical primeChar_finFieldType := [finFieldType of F]. (* We need to use the eta-long version of the constructor here as projections *) (* of the Canonical fieldType of F cannot be computed syntactically. *) Canonical primeChar_fieldExtType := [fieldExtType 'F_p of F for F0]. Canonical primeChar_splittingFieldType := FinSplittingFieldType 'F_p F. End FinField. End PrimeChar. Section FinSplittingField. Variable F : finFieldType. (* By card_vspace order K = #|K| for any finType structure on L; however we *) (* do not want to impose the FinVector instance here. *) Let order (L : vectType F) (K : {vspace L}) := (#|F| ^ \dim K)%N. Section FinGalois. Variable L : splittingFieldType F. Implicit Types (a b : F) (x y : L) (K E : {subfield L}). Let galL K : galois K {:L}. Proof. without loss {K} ->: K / K = 1%AS. by move=> IH_K; apply: galoisS (IH_K _ (erefl _)); rewrite sub1v subvf. apply/splitting_galoisField; pose finL := FinFieldExtType L. exists ('X^#|finL| - 'X); split; first by rewrite rpredB 1?rpredX ?polyOverX. rewrite (finField_genPoly finL) -big_enum /=. by rewrite separable_prod_XsubC ?(enum_uniq finL). exists (enum finL). by rewrite (@big_enum _ _ _ _ finL) (finField_genPoly finL) eqpxx. by apply/vspaceP=> x; rewrite memvf seqv_sub_adjoin ?(mem_enum finL). Qed. Fact galLgen K : {alpha | generator 'Gal({:L} / K) alpha & forall x, alpha x = x ^+ order K}. Proof. without loss{K} ->: K / K = 1%AS; last rewrite /order dimv1 expn1. case/(_ 1%AS)=> // alpha /eqP-defGalL; rewrite /order dimv1 expn1 => Dalpha. exists (alpha ^+ \dim K)%g => [|x]; last first. elim: (\dim K) => [|n IHn]; first by rewrite gal_id. by rewrite expgSr galM ?memvf // IHn Dalpha expnSr exprM. have sGalLK: 'Gal({:L} / K) \subset <[alpha]> by rewrite -defGalL galS ?sub1v. rewrite /generator {sGalLK}(eq_subG_cyclic _ sGalLK) ?cycle_cyclic ?cycleX //. rewrite -orderE orderXdiv orderE -defGalL -?{1}galois_dim ?dimv1 ?divn1 //. by rewrite field_dimS ?subvf. pose f x := x ^+ #|F|. have idfP x: reflect (f x = x) (x \in 1%VS). apply: (iffP (vlineP _ _)) => [[a ->] | xFx]. by rewrite -in_algE -[LHS]rmorphX expf_card. pose q := map_poly (in_alg L) ('X^#|F| - 'X). have: root q x. rewrite /q rmorphB /= map_polyXn map_polyX. by rewrite rootE !(hornerE, hornerXn) [x ^+ _]xFx subrr. have{q} ->: q = \prod_(z <- [seq b%:A | b : F]) ('X - z%:P). rewrite /q finField_genPoly rmorph_prod big_image /=. by apply: eq_bigr => b _; rewrite rmorphB /= map_polyX map_polyC. by rewrite root_prod_XsubC => /mapP[a]; exists a. have fM: rmorphism f. rewrite /f; do 2?split=> [x y|]; rewrite ?exprMn ?expr1n //. have [p _ charFp] := finCharP F; rewrite (card_primeChar charFp). elim: (logn _ _) => // n IHn; rewrite expnSr !exprM {}IHn. by rewrite -(char_lalg L) in charFp; rewrite -Frobenius_autE rmorphB. have fZ: linear f. move=> a x y; rewrite -mulr_algl [f _](rmorphD (RMorphism fM)) rmorphM /=. by rewrite (idfP _ _) ?mulr_algl ?memvZ // memv_line. have /kAut_to_gal[alpha galLalpha Dalpha]: kAut 1 {:L} (linfun (Linear fZ)). rewrite kAutfE; apply/kHomP; split=> [x y _ _ | x /idfP]; rewrite !lfunE //=. exact: (rmorphM (RMorphism fM)). have{} Dalpha: alpha =1 f by move=> a; rewrite -Dalpha ?memvf ?lfunE. suffices <-: fixedField [set alpha] = 1%AS. by rewrite gal_generated /generator; exists alpha. apply/vspaceP=> x; apply/fixedFieldP/idfP; rewrite ?memvf // => id_x. by rewrite -Dalpha id_x ?set11. by move=> _ /set1P->; rewrite Dalpha. Qed. Lemma finField_galois K E : (K <= E)%VS -> galois K E. Proof. move=> sKE; have /galois_fixedField <- := galL E. rewrite normal_fixedField_galois // -sub_abelian_normal ?galS //. apply: abelianS (galS _ (sub1v _)) _. by have [alpha /('Gal(_ / _) =P _)-> _] := galLgen 1; apply: cycle_abelian. Qed. Lemma finField_galois_generator K E : (K <= E)%VS -> {alpha | generator 'Gal(E / K) alpha & {in E, forall x, alpha x = x ^+ order K}}. Proof. move=> sKE; have [alpha defGalLK Dalpha] := galLgen K. have inKL_E: (K <= E <= {:L})%VS by rewrite sKE subvf. have nKE: normalField K E by have/and3P[] := finField_galois sKE. have galLKalpha: alpha \in 'Gal({:L} / K). by rewrite (('Gal(_ / _) =P _) defGalLK) cycle_id. exists (normalField_cast _ alpha) => [|x Ex]; last first. by rewrite (normalField_cast_eq inKL_E). rewrite /generator -(morphim_cycle (normalField_cast_morphism inKL_E nKE)) //. by rewrite -((_ =P <[alpha]>) defGalLK) normalField_img. Qed. End FinGalois. Lemma Fermat's_little_theorem (L : fieldExtType F) (K : {subfield L}) a : (a \in K) = (a ^+ order K == a). Proof. move: K a; wlog [{}L -> K a]: L / exists galL : splittingFieldType F, L = galL. by pose galL := (FinSplittingFieldType F L) => /(_ galL); apply; exists galL. have /galois_fixedField fixLK := finField_galois (subvf K). have [alpha defGalLK Dalpha] := finField_galois_generator (subvf K). rewrite -Dalpha ?memvf // -{1}fixLK (('Gal(_ / _) =P _) defGalLK). rewrite /cycle -gal_generated (galois_fixedField _) ?fixedField_galois //. by apply/fixedFieldP/eqP=> [|-> | alpha_x _ /set1P->]; rewrite ?memvf ?set11. Qed. End FinSplittingField. Section FinFieldExists. (* While the existence of finite splitting fields and of finite fields of *) (* arbitrary prime power order is mathematically straightforward, it is *) (* technically challenging to formalize in Coq. The Coq typechecker performs *) (* poorly for some of the deeply nested dependent types used in the *) (* construction, such as polynomials over extensions of extensions of finite *) (* fields. Any conversion in a nested structure parameter incurs a huge *) (* overhead as it is shared across term comparison by call-by-need evalution. *) (* The proof of FinSplittingFieldFor is contrived to mitigate this effect: *) (* the abbreviation map_poly_extField alone divides by 3 the proof checking *) (* time, by reducing the number of occurrences of field(Ext)Type structures *) (* in the subgoals; the succesive, apparently redundant 'suffices' localize *) (* some of the conversions to smaller subgoals, yielding a further 8-fold *) (* time gain. In particular, we construct the splitting field as a subtype *) (* of a recursive construction rather than prove that the latter yields *) (* precisely a splitting field. *) (* The apparently redundant type annotation reduces checking time by 30%. *) Let map_poly_extField (F : fieldType) (L : fieldExtType F) := map_poly (in_alg L) : {poly F} -> {poly L}. Local Notation "p ^%:A" := (map_poly_extField _ p) (at level 2, format "p ^%:A") : ring_scope. Lemma FinSplittingFieldFor (F : finFieldType) (p : {poly F}) : p != 0 -> {L : splittingFieldType F | splittingFieldFor 1 p^%:A {:L}}. Proof. have mapXsubC (f : {rmorphism _}) x: map_poly f ('X - x%:P) = 'X - (f x)%:P. by rewrite rmorphB /= map_polyX map_polyC. move=> nz_p; pose splits q := {zs | q %= \prod_(z <- zs) ('X - z%:P)}. suffices [L splitLp]: {L : fieldExtType F | splittingFieldFor 1 p^%:A {:L}}. by exists (FinSplittingFieldType F L). suffices [L [ys Dp]]: {L : fieldExtType F & splits L p^%:A}. pose Lp := subvs_of <<1 & ys>>; pose toL := linfun (vsval : Lp -> L). have [zs Dys]: {zs | map toL zs = ys}. exists (map (vsproj _) ys); rewrite -map_comp map_id_in // => y ys_y. by rewrite /= lfunE /= vsprojK ?seqv_sub_adjoin. exists [fieldExtType F of Lp], zs. set lhs := (lhs in lhs %= _); set rhs := (rhs in _ %= rhs). suffices: map_poly toL lhs %= map_poly toL rhs by rewrite eqp_map. rewrite -Dys big_map in Dp; apply: etrans Dp; apply: congr2. by rewrite -map_poly_comp; apply/eq_map_poly=> x; apply: rmorph_alg. by rewrite rmorph_prod; apply/eq_bigr=> z _; apply mapXsubC. set Lzs := LHS; pose Lys := (toL @: Lzs)%VS; apply/vspaceP=> u. have: val u \in Lys by rewrite /Lys aimg_adjoin_seq aimg1 Dys (valP u). by case/memv_imgP=> v Lzs_v; rewrite memvf lfunE => /val_inj->. move: {2}_.+1 (ltnSn (size p)) => n; elim: n => // n IHn in F p nz_p * => lbn. have [Cp|C'p] := leqP (size p) 1. pose L := [fieldExtType F of F^o for F]; exists L, [::]. by rewrite big_nil -size_poly_eq1 size_map_poly eqn_leq Cp size_poly_gt0. have [r r_dv_p irr_r]: {r | r %| p & irreducible_poly r}. pose rVp (v : 'rV_n) (r := rVpoly v) := (1 < size r) && (r %| p). have [v0 Dp]: {v0 | rVpoly v0 = p & rVp v0}. by exists (poly_rV p); rewrite /rVp poly_rV_K ?C'p /=. case/(arg_minnP (size \o rVpoly))=> /= v; set r := rVpoly v. case/andP=> C'r r_dv_p min_r; exists r => //; split=> // q C'q q_dv_r. have nz_r: r != 0 by rewrite -size_poly_gt0 ltnW. have le_q_r: size q <= size r by rewrite dvdp_leq. have [u Dq]: {u : 'rV_n | rVpoly u = q}. by exists (poly_rV q); rewrite poly_rV_K ?(leq_trans le_q_r) ?size_poly. rewrite -dvdp_size_eqp // eqn_leq le_q_r -Dq min_r // /rVp Dq. rewrite ltn_neqAle eq_sym C'q size_poly_gt0 (dvdpN0 q_dv_r) //=. exact: dvdp_trans q_dv_r r_dv_p. have{irr_r} [K _ [x rx0 defK]] := irredp_FAdjoin irr_r. have{r rx0 r_dv_p} /factor_theorem/sig_eqW[q Dp]: root p^%:A x. by rewrite -(divpK r_dv_p) [_^%:A]rmorphM rootM rx0 orbT. have Dszp: size p = size (q * ('X - x%:P)) by rewrite -Dp size_map_poly. have nz_q: q != 0. by move: nz_p; rewrite -size_poly_eq0 Dszp size_poly_eq0 mulf_eq0 => /norP[]. have [L [zs Dq]]: {L : fieldExtType K & splits L q^%:A}. apply: (IHn (FinFieldExtType K) q nz_q). by rewrite ltnS Dszp size_mul ?polyXsubC_eq0 ?size_XsubC ?addn2 in lbn. suffices: splits L p^%:A^%:A. rewrite -[_^%:A]map_poly_comp -(eq_map_poly (fun a => baseField_scaleE a 1)). by exists [fieldExtType F of baseFieldType L]. exists (x%:A :: zs); rewrite big_cons; set rhs := _ * _. by rewrite Dp mulrC [_^%:A]rmorphM /= mapXsubC /= eqp_mull. Qed. Lemma PrimePowerField p k (m := (p ^ k)%N) : prime p -> 0 < k -> {Fm : finFieldType | p \in [char Fm] & #|Fm| = m}. Proof. move=> pr_p k_gt0; have m_gt1: m > 1 by rewrite (ltn_exp2l 0) ?prime_gt1. have m_gt0 := ltnW m_gt1; have m1_gt0: m.-1 > 0 by rewrite -ltnS prednK. pose q := 'X^m - 'X; have Dq R: q R = ('X^m.-1 - 1) * ('X - 0). by rewrite subr0 mulrBl mul1r -exprSr prednK. have /FinSplittingFieldFor[/= L splitLq]: q [ringType of 'F_p] != 0. by rewrite Dq monic_neq0 ?rpredM ?monicXsubC ?monic_Xn_sub_1. rewrite [_^%:A]rmorphB rmorphX /= map_polyX -/(q L) in splitLq. have charL: p \in [char L] by rewrite char_lalg char_Fp. pose Fm := FinFieldExtType L; exists Fm => //. have /finField_galois_generator[/= a _ Da]: (1 <= {:L})%VS by apply: sub1v. pose Em := fixedSpace (a ^+ k)%g; rewrite card_Fp //= dimv1 expn1 in Da. have{splitLq} [zs DqL defL] := splitLq. have Uzs: uniq zs. rewrite -separable_prod_XsubC -(eqp_separable DqL) Dq separable_root andbC. rewrite /root !hornerE subr_eq0 eq_sym hornerXn expr0n gtn_eqF ?oner_eq0 //=. rewrite cyclotomic.separable_Xn_sub_1 // -subn1 natrB // subr_eq0. by rewrite natrX charf0 // expr0n gtn_eqF // eq_sym oner_eq0. suffices /eq_card->: Fm =i zs. apply: succn_inj; rewrite (card_uniqP _) //= -(size_prod_XsubC _ id). by rewrite -(eqp_size DqL) size_addl size_polyXn // size_opp size_polyX. have in_zs: zs =i Em. move=> z; rewrite -root_prod_XsubC -(eqp_root DqL) (sameP fixedSpaceP eqP). rewrite /root !hornerE subr_eq0 /= hornerXn /m; congr (_ == z). elim: (k) => [|i IHi]; first by rewrite gal_id. by rewrite expgSr expnSr exprM IHi galM ?Da ?memvf. suffices defEm: Em = {:L}%VS by move=> z; rewrite in_zs defEm memvf. apply/eqP; rewrite eqEsubv subvf -defL -[Em]subfield_closed agenvS //. by rewrite subv_add sub1v; apply/span_subvP=> z; rewrite in_zs. Qed. End FinFieldExists. Section FinDomain. Import order ssrnum ssrint algC cyclotomic Order.TTheory Num.Theory. Local Infix "%|" := dvdn. (* Hide polynomial divisibility. *) Variable R : finUnitRingType. Hypothesis domR : GRing.IntegralDomain.axiom R. Implicit Types x y : R. Let lregR x : x != 0 -> GRing.lreg x. Proof. by move=> xnz; apply: mulrI0_lreg => y /domR/orP[/idPn | /eqP]. Qed. Lemma finDomain_field : GRing.Field.mixin_of R. Proof. move=> x /lregR-regx; apply/unitrP; exists (invF regx 1). by split; first apply: (regx); rewrite ?mulrA f_invF // mulr1 mul1r. Qed. (* This is Witt's proof of Wedderburn's little theorem. *) Theorem finDomain_mulrC : @commutative R R *%R. Proof. have fieldR := finDomain_field. have [p p_pr charRp]: exists2 p, prime p & p \in [char R]. have [e /prod_prime_decomp->]: {e | (e > 0)%N & e%:R == 0 :> R}. by exists #|[set: R]%G|; rewrite // -order_dvdn order_dvdG ?inE. rewrite big_seq; elim/big_rec: _ => [|[p m] /= n]; first by rewrite oner_eq0. case/mem_prime_decomp=> p_pr _ _ IHn. elim: m => [|m IHm]; rewrite ?mul1n {IHn}// expnS -mulnA natrM. by case/eqP/domR/orP=> //; exists p; last apply/andP. pose Rp := PrimeCharType charRp; pose L : {vspace Rp} := fullv. pose G := [set: {unit R}]; pose ofG : {unit R} -> Rp := val. pose projG (E : {vspace Rp}) := [preim ofG of E]. have inG t nzt: Sub t (finDomain_field nzt) \in G by rewrite inE. have card_projG E: #|projG E| = (p ^ \dim E - 1)%N. transitivity #|E|.-1; last by rewrite subn1 card_vspace card_Fp. rewrite (cardD1 0) mem0v (card_preim val_inj) /=. apply: eq_card => x; congr (_ && _); rewrite [LHS]codom_val. by apply/idP/idP=> [/(memPn _ _)-> | /fieldR]; rewrite ?unitr0. pose C u := 'C[ofG u]%AS; pose Q := 'C(L)%AS; pose q := (p ^ \dim Q)%N. have defC u: 'C[u] =i projG (C u). by move=> v; rewrite cent1E !inE (sameP cent1vP eqP). have defQ: 'Z(G) =i projG Q. move=> u; rewrite !inE. apply/centP/centvP=> cGu v _; last exact/val_inj/cGu/memvf. by have [-> | /inG/cGu[]] := eqVneq v 0; first by rewrite commr0. have q_gt1: (1 < q)%N by rewrite (ltn_exp2l 0) ?prime_gt1 ?adim_gt0. pose n := \dim_Q L; have oG: #|G| = (q ^ n - 1)%N. rewrite -expnM mulnC divnK ?skew_field_dimS ?subvf // -card_projG. by apply: eq_card => u; rewrite !inE memvf. have oZ: #|'Z(G)| = (q - 1)%N by rewrite -card_projG; apply: eq_card. suffices n_le1: (n <= 1)%N. move=> u v; apply/centvsP: (memvf (u : Rp)) (memvf (v : Rp)) => {u v}. rewrite -(geq_leqif (dimv_leqif_sup (subvf Q))) -/L. by rewrite leq_divLR ?mul1n ?skew_field_dimS ?subvf in n_le1. 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) // -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 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: 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. rewrite rpred_horner ?rpred_nat //= -Cintr_Cyclotomic //. by apply/polyOverP=> i; rewrite coef_map ?rpred_int. suffices: (aq n %| (q - 1)%:R)%C. rewrite {1}[aq n]CintEsign ?Zaq // -(rpredMsign _ (aq n < 0)%R). rewrite dvdC_mul2l ?signr_eq0 //. have /CnatP[m ->]: `|aq n| \in Cnat by rewrite Cnat_norm_Cint ?Zaq. by rewrite leC_nat dvdC_nat; apply: dvdn_leq; rewrite subn_gt0. have prod_aq m: m %| n -> \prod_(d < n.+1 | d %| m) aq d = (q ^ m - 1)%:R. move=> m_dv_n; transitivity ('X^m - 1).[q%:R : algC]; last first. by rewrite !hornerE hornerXn -natrX natrB ?expn_gt0 ?prime_gt0. rewrite (prod_cyclotomic (dvdn_prim_root z_prim m_dv_n)). have def_divm: perm_eq (divisors m) [seq d <- index_iota 0 n.+1 | d %| m]. rewrite uniq_perm ?divisors_uniq ?filter_uniq ?iota_uniq // => d. rewrite -dvdn_divisors ?(dvdn_gt0 n_gt0) // mem_filter mem_iota ltnS /=. by apply/esym/andb_idr=> d_dv_m; rewrite dvdn_leq ?(dvdn_trans d_dv_m). rewrite (perm_big _ def_divm) big_filter big_mkord horner_prod. by apply: eq_bigr => d d_dv_m; rewrite -exprM muln_divA ?divnK. have /rpredBl<-: (aq n %| #|G|%:R)%C. rewrite oG -prod_aq // (bigD1 ord_max) //= dvdC_mulr //. by apply: rpred_prod => d /andP[/Zaq]. rewrite center_class_formula addrC oZ natrD addKr natr_sum /=. apply: rpred_sum => _ /imsetP[u /setDP[_ Z'u] ->]; rewrite -/G /=. have sQC: (Q <= C u)%VS by apply/subvP=> v /centvP-cLv; apply/cent1vP/cLv/memvf. have{sQC} /dvdnP[m Dm]: \dim Q %| \dim (C u) by apply: skew_field_dimS. have m_dv_n: m %| n by rewrite dvdn_divRL // -?Dm ?skew_field_dimS ?subvf. have m_gt0: (0 < m)%N := dvdn_gt0 n_gt0 m_dv_n. have{Dm} oCu: #|'C[u]| = (q ^ m - 1)%N. by rewrite -expnM mulnC -Dm (eq_card (defC u)) card_projG. have ->: #|u ^: G|%:R = \prod_(d < n.+1 | d %| n) (aq d / aq d ^+ (d %| m)). rewrite -index_cent1 natf_indexg ?subsetT //= setTI prodf_div prod_aq // -oG. congr (_ / _); rewrite big_mkcond oCu -prod_aq //= big_mkcond /=. by apply: eq_bigr => d _; case: ifP => [/dvdn_trans->| _]; rewrite ?if_same. rewrite (bigD1 ord_max) //= [n %| m](contraNF _ Z'u) => [|n_dv_m]; last first. rewrite -sub_cent1 subEproper eq_sym eqEcard subsetT oG oCu leq_sub2r //. by rewrite leq_exp2l // dvdn_leq. rewrite divr1 dvdC_mulr //; apply/rpred_prod => d /andP[/Zaq-Zaqd _]. have [-> | nz_aqd] := eqVneq (aq d) 0; first by rewrite mul0r. by rewrite -[aq d]expr1 -exprB ?leq_b1 ?unitfE ?rpredX. Qed. Definition FinDomainFieldType : finFieldType := let fin_unit_class := FinRing.UnitRing.class R in let com_class := GRing.ComRing.Class finDomain_mulrC in let com_unit_class := @GRing.ComUnitRing.Class R com_class fin_unit_class in let dom_class := @GRing.IntegralDomain.Class R com_unit_class domR in let field_class := @GRing.Field.Class R dom_class finDomain_field in let finfield_class := @FinRing.Field.Class R field_class fin_unit_class in FinRing.Field.Pack finfield_class. Definition FinDomainSplittingFieldType p (charRp : p \in [char R]) := let RoverFp := @primeChar_splittingFieldType p FinDomainFieldType charRp in [splittingFieldType 'F_p of R for RoverFp]. End FinDomain. math-comp-mathcomp-1.12.0/mathcomp/field/galois.v000066400000000000000000002124141375767750300216560ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype tuple finfun bigop ssralg poly. From mathcomp Require Import polydiv finset fingroup morphism quotient perm. From mathcomp Require Import action zmodp cyclic matrix mxalgebra vector. From mathcomp Require Import falgebra fieldext separable. (******************************************************************************) (* This file develops some basic Galois field theory, defining: *) (* splittingFieldFor K p E <-> E is the smallest field over K that splits p *) (* into linear factors. *) (* kHom K E f <=> f : 'End(L) is a ring morphism on E and fixes K. *) (* kAut K E f <=> f : 'End(L) is a kHom K E and f @: E == E. *) (* kHomExtend E f x y == a kHom K <> that extends f and maps x to y, *) (* when f \is a kHom K E and root (minPoly E x) y. *) (* *) (* splittingFieldFor K p E <-> E is splitting field for p over K: p splits in *) (* E and its roots generate E from K. *) (* splittingFieldType F == the interface type of splitting field extensions *) (* of F, that is, extensions generated by all the *) (* algebraic roots of some polynomial, or, *) (* equivalently, normal field extensions of F. *) (* SplittingField.axiom F L == the axiom stating that L is a splitting field. *) (* SplittingFieldType F L FsplitL == packs a proof FsplitL of the splitting *) (* field axiom for L into a splitingFieldType F, *) (* provided L has a fieldExtType F structure. *) (* [splittingFieldType F of L] == a clone of the canonical splittingFieldType *) (* structure for L. *) (*[splittingFieldType F of L for M] == an L-clone of the canonical *) (* splittingFieldType structure on M. *) (* *) (* gal_of E == the group_type of automorphisms of E over the *) (* base field F. *) (* 'Gal(E / K) == the group of automorphisms of E that fix K. *) (* fixedField s == the field fixed by the set of automorphisms s. *) (* fixedField set0 = E when set0 : {set: gal_of E} *) (* normalField K E <=> E is invariant for every 'Gal(L / K) for every L. *) (* galois K E <=> E is a normal and separable field extension of K. *) (* galTrace K E a == \sum_(f in 'Gal(E / K)) (f a). *) (* galNorm K E a == \prod_(f in 'Gal(E / K)) (f a). *) (* *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Reserved Notation "''Gal' ( A / B )" (at level 8, A at level 35, format "''Gal' ( A / B )"). Import GroupScope GRing.Theory. Local Open Scope ring_scope. Section SplittingFieldFor. Variables (F : fieldType) (L : fieldExtType F). Definition splittingFieldFor (U : {vspace L}) (p : {poly L}) (V : {vspace L}) := exists2 rs, p %= \prod_(z <- rs) ('X - z%:P) & <>%VS = V. Lemma splittingFieldForS (K M E : {subfield L}) p : (K <= M)%VS -> (M <= E)%VS -> splittingFieldFor K p E -> splittingFieldFor M p E. Proof. move=> sKM sKE [rs Dp genL]; exists rs => //; apply/eqP. rewrite eqEsubv -[in X in _ && (X <= _)%VS]genL adjoin_seqSl // andbT. by apply/Fadjoin_seqP; split; rewrite // -genL; apply: seqv_sub_adjoin. Qed. End SplittingFieldFor. Section kHom. Variables (F : fieldType) (L : fieldExtType F). Implicit Types (U V : {vspace L}) (K E : {subfield L}) (f g : 'End(L)). Definition kHom U V f := ahom_in V f && (U <= fixedSpace f)%VS. Lemma kHomP {K V f} : reflect [/\ {in V &, forall x y, f (x * y) = f x * f y} & {in K, forall x, f x = x}] (kHom K V f). Proof. apply: (iffP andP) => [[/ahom_inP[fM _] /subvP idKf] | [fM idKf]]. by split=> // x /idKf/fixedSpaceP. split; last by apply/subvP=> x /idKf/fixedSpaceP. by apply/ahom_inP; split=> //; rewrite idKf ?mem1v. Qed. Lemma kAHomP {U V} {f : 'AEnd(L)} : reflect {in U, forall x, f x = x} (kHom U V f). Proof. by rewrite /kHom ahomWin; apply: fixedSpacesP. Qed. Lemma kHom1 U V : kHom U V \1. Proof. by apply/kAHomP => u _; rewrite lfunE. Qed. Lemma k1HomE V f : kHom 1 V f = ahom_in V f. Proof. by apply: andb_idr => /ahom_inP[_ f1]; apply/fixedSpaceP. Qed. Lemma kHom_lrmorphism (f : 'End(L)) : reflect (lrmorphism f) (kHom 1 {:L} f). Proof. by rewrite k1HomE; apply: ahomP. Qed. Lemma k1AHom V (f : 'AEnd(L)) : kHom 1 V f. Proof. by rewrite k1HomE ahomWin. Qed. Lemma kHom_poly_id K E f p : kHom K E f -> p \is a polyOver K -> map_poly f p = p. Proof. by case/kHomP=> _ idKf /polyOverP Kp; apply/polyP=> i; rewrite coef_map /= idKf. Qed. Lemma kHomSl U1 U2 V f : (U1 <= U2)%VS -> kHom U2 V f -> kHom U1 V f. Proof. by rewrite /kHom => sU12 /andP[-> /(subv_trans sU12)]. Qed. Lemma kHomSr K V1 V2 f : (V1 <= V2)%VS -> kHom K V2 f -> kHom K V1 f. Proof. by move/subvP=> sV12 /kHomP[/(sub_in2 sV12)fM idKf]; apply/kHomP. Qed. Lemma kHomS K1 K2 V1 V2 f : (K1 <= K2)%VS -> (V1 <= V2)%VS -> kHom K2 V2 f -> kHom K1 V1 f. Proof. by move=> sK12 sV12 /(kHomSl sK12)/(kHomSr sV12). Qed. Lemma kHom_eq K E f g : (K <= E)%VS -> {in E, f =1 g} -> kHom K E f = kHom K E g. Proof. move/subvP=> sKE eq_fg; wlog suffices: f g eq_fg / kHom K E f -> kHom K E g. by move=> IH; apply/idP/idP; apply: IH => x /eq_fg. case/kHomP=> fM idKf; apply/kHomP. by split=> [x y Ex Ey | x Kx]; rewrite -!eq_fg ?fM ?rpredM // ?idKf ?sKE. Qed. Lemma kHom_inv K E f : kHom K E f -> {in E, {morph f : x / x^-1}}. Proof. case/kHomP=> fM idKf x Ex. have [-> | nz_x] := eqVneq x 0; first by rewrite linear0 invr0 linear0. have fxV: f x * f x^-1 = 1 by rewrite -fM ?rpredV ?divff // idKf ?mem1v. have Ufx: f x \is a GRing.unit by apply/unitrPr; exists (f x^-1). by apply: (mulrI Ufx); rewrite divrr. Qed. Lemma kHom_dim K E f : kHom K E f -> \dim (f @: E) = \dim E. Proof. move=> homKf; have [fM idKf] := kHomP homKf. apply/limg_dim_eq/eqP; rewrite -subv0; apply/subvP=> v. rewrite memv_cap memv0 memv_ker => /andP[Ev]; apply: contraLR => nz_v. by rewrite -unitfE unitrE -(kHom_inv homKf) // -fM ?rpredV ?divff ?idKf ?mem1v. Qed. Lemma kHom_is_rmorphism K E f : kHom K E f -> rmorphism (f \o vsval : subvs_of E -> L). Proof. case/kHomP=> fM idKf; split=> [a b|]; first exact: raddfB. by split=> [a b|] /=; [rewrite /= fM ?subvsP | rewrite algid1 idKf // mem1v]. Qed. Definition kHom_rmorphism K E f homKEf := RMorphism (@kHom_is_rmorphism K E f homKEf). Lemma kHom_horner K E f p x : kHom K E f -> p \is a polyOver E -> x \in E -> f p.[x] = (map_poly f p).[f x]. Proof. move=> homKf /polyOver_subvs[{}p -> Ex]; pose fRM := kHom_rmorphism homKf. by rewrite (horner_map _ _ (Subvs Ex)) -[f _](horner_map fRM) map_poly_comp. Qed. Lemma kHom_root K E f p x : kHom K E f -> p \is a polyOver E -> x \in E -> root p x -> root (map_poly f p) (f x). Proof. by move/kHom_horner=> homKf Ep Ex /rootP px0; rewrite /root -homKf ?px0 ?raddf0. Qed. Lemma kHom_root_id K E f p x : (K <= E)%VS -> kHom K E f -> p \is a polyOver K -> x \in E -> root p x -> root p (f x). Proof. move=> sKE homKf Kp Ex /(kHom_root homKf (polyOverSv sKE Kp) Ex). by rewrite (kHom_poly_id homKf). Qed. Section kHomExtend. Variables (K E : {subfield L}) (f : 'End(L)) (x y : L). Fact kHomExtend_subproof : linear (fun z => (map_poly f (Fadjoin_poly E x z)).[y]). Proof. move=> k a b; rewrite linearP /= raddfD hornerE; congr (_ + _). rewrite -[rhs in _ = rhs]mulr_algl -hornerZ /=; congr _.[_]. by apply/polyP => i; rewrite !(coefZ, coef_map) /= !mulr_algl linearZ. Qed. Definition kHomExtend := linfun (Linear kHomExtend_subproof). Lemma kHomExtendE z : kHomExtend z = (map_poly f (Fadjoin_poly E x z)).[y]. Proof. by rewrite lfunE. Qed. Hypotheses (sKE : (K <= E)%VS) (homKf : kHom K E f). Local Notation Px := (minPoly E x). Hypothesis fPx_y_0 : root (map_poly f Px) y. Lemma kHomExtend_id z : z \in E -> kHomExtend z = f z. Proof. by move=> Ez; rewrite kHomExtendE Fadjoin_polyC ?map_polyC ?hornerC. Qed. Lemma kHomExtend_val : kHomExtend x = y. Proof. have fX: map_poly f 'X = 'X by rewrite (kHom_poly_id homKf) ?polyOverX. have [Ex | E'x] := boolP (x \in E); last first. by rewrite kHomExtendE Fadjoin_polyX // fX hornerX. have:= fPx_y_0; rewrite (minPoly_XsubC Ex) raddfB /= map_polyC fX root_XsubC /=. by rewrite (kHomExtend_id Ex) => /eqP->. Qed. Lemma kHomExtend_poly p : p \in polyOver E -> kHomExtend p.[x] = (map_poly f p).[y]. Proof. move=> Ep; rewrite kHomExtendE (Fadjoin_poly_mod x) //. rewrite (divp_eq (map_poly f p) (map_poly f Px)). rewrite !hornerE (rootP fPx_y_0) mulr0 add0r. have [p1 ->] := polyOver_subvs Ep. have [Px1 ->] := polyOver_subvs (minPolyOver E x). by rewrite -map_modp -!map_poly_comp (map_modp (kHom_rmorphism homKf)). Qed. Lemma kHomExtendP : kHom K <> kHomExtend. Proof. have [fM idKf] := kHomP homKf. apply/kHomP; split=> [|z Kz]; last by rewrite kHomExtend_id ?(subvP sKE) ?idKf. move=> _ _ /Fadjoin_polyP[p Ep ->] /Fadjoin_polyP[q Eq ->]. rewrite -hornerM !kHomExtend_poly ?rpredM // -hornerM; congr _.[_]. apply/polyP=> i; rewrite coef_map !coefM /= linear_sum /=. by apply: eq_bigr => j _; rewrite !coef_map /= fM ?(polyOverP _). Qed. End kHomExtend. Definition kAut U V f := kHom U V f && (f @: V == V)%VS. Lemma kAutE K E f : kAut K E f = kHom K E f && (f @: E <= E)%VS. Proof. apply/andP/andP=> [[-> /eqP->] // | [homKf EfE]]. by rewrite eqEdim EfE /= (kHom_dim homKf). Qed. Lemma kAutS U1 U2 V f : (U1 <= U2)%VS -> kAut U2 V f -> kAut U1 V f. Proof. by move=> sU12 /andP[/(kHomSl sU12)homU1f EfE]; apply/andP. Qed. Lemma kHom_kAut_sub K E f : kAut K E f -> kHom K E f. Proof. by case/andP. Qed. Lemma kAut_eq K E (f g : 'End(L)) : (K <= E)%VS -> {in E, f =1 g} -> kAut K E f = kAut K E g. Proof. by move=> sKE eq_fg; rewrite !kAutE (kHom_eq sKE eq_fg) (eq_in_limg eq_fg). Qed. Lemma kAutfE K f : kAut K {:L} f = kHom K {:L} f. Proof. by rewrite kAutE subvf andbT. Qed. Lemma kAut1E E (f : 'AEnd(L)) : kAut 1 E f = (f @: E <= E)%VS. Proof. by rewrite kAutE k1AHom. Qed. Lemma kAutf_lker0 K f : kHom K {:L} f -> lker f == 0%VS. Proof. move/(kHomSl (sub1v _))/kHom_lrmorphism=> fM. by apply/lker0P; apply: (fmorph_inj (RMorphism fM)). Qed. Lemma inv_kHomf K f : kHom K {:L} f -> kHom K {:L} f^-1. Proof. move=> homKf; have [[fM idKf] kerf0] := (kHomP homKf, kAutf_lker0 homKf). have f1K: cancel f^-1%VF f by apply: lker0_lfunVK. apply/kHomP; split=> [x y _ _ | x Kx]; apply: (lker0P kerf0). by rewrite fM ?memvf ?{1}f1K. by rewrite f1K idKf. Qed. Lemma inv_is_ahom (f : 'AEnd(L)) : ahom_in {:L} f^-1. Proof. have /ahomP/kHom_lrmorphism hom1f := valP f. exact/ahomP/kHom_lrmorphism/inv_kHomf. Qed. Canonical inv_ahom (f : 'AEnd(L)) : 'AEnd(L) := AHom (inv_is_ahom f). Notation "f ^-1" := (inv_ahom f) : lrfun_scope. Lemma comp_kHom_img K E f g : kHom K (g @: E) f -> kHom K E g -> kHom K E (f \o g). Proof. move=> /kHomP[fM idKf] /kHomP[gM idKg]; apply/kHomP; split=> [x y Ex Ey | x Kx]. by rewrite !lfunE /= gM // fM ?memv_img. by rewrite lfunE /= idKg ?idKf. Qed. Lemma comp_kHom K E f g : kHom K {:L} f -> kHom K E g -> kHom K E (f \o g). Proof. by move/(kHomSr (subvf (g @: E))); apply: comp_kHom_img. Qed. Lemma kHom_extends K E f p U : (K <= E)%VS -> kHom K E f -> p \is a polyOver K -> splittingFieldFor E p U -> {g | kHom K U g & {in E, f =1 g}}. Proof. move=> sKE homEf Kp /sig2_eqW[rs Dp <-{U}]. set r := rs; have rs_r: all (mem rs) r by apply/allP. elim: r rs_r => [_|z r IHr /=/andP[rs_z rs_r]] /= in E f sKE homEf *. by exists f; rewrite ?Fadjoin_nil. set Ez := <>%AS; pose fpEz := map_poly f (minPoly E z). suffices{IHr} /sigW[y fpEz_y]: exists y, root fpEz y. have homEz_fz: kHom K Ez (kHomExtend E f z y) by apply: kHomExtendP. have sKEz: (K <= Ez)%VS := subv_trans sKE (subv_adjoin E z). have [g homGg Dg] := IHr rs_r _ _ sKEz homEz_fz. exists g => [|x Ex]; first by rewrite adjoin_cons. by rewrite -Dg ?subvP_adjoin // kHomExtend_id. have [m DfpEz]: {m | fpEz %= \prod_(w <- mask m rs) ('X - w%:P)}. apply: dvdp_prod_XsubC; rewrite -(eqp_dvdr _ Dp) -(kHom_poly_id homEf Kp). have /polyOver_subvs[q Dq] := polyOverSv sKE Kp. have /polyOver_subvs[qz Dqz] := minPolyOver E z. rewrite /fpEz Dq Dqz -2?{1}map_poly_comp (dvdp_map (kHom_rmorphism homEf)). rewrite -(dvdp_map [rmorphism of @vsval _ _ E]) -Dqz -Dq. by rewrite minPoly_dvdp ?(polyOverSv sKE) // (eqp_root Dp) root_prod_XsubC. exists (mask m rs)`_0; rewrite (eqp_root DfpEz) root_prod_XsubC mem_nth //. rewrite -ltnS -(size_prod_XsubC _ id) -(eqp_size DfpEz). rewrite size_poly_eq -?lead_coefE ?size_minPoly // (monicP (monic_minPoly E z)). by have [_ idKf] := kHomP homEf; rewrite idKf ?mem1v ?oner_eq0. Qed. End kHom. Notation "f ^-1" := (inv_ahom f) : lrfun_scope. Arguments kHomP {F L K V f}. Arguments kAHomP {F L U V f}. Arguments kHom_lrmorphism {F L f}. Module SplittingField. Import GRing. Section ClassDef. Variable F : fieldType. Definition axiom (L : fieldExtType F) := exists2 p : {poly L}, p \is a polyOver 1%VS & splittingFieldFor 1 p {:L}. Set Primitive Projections. Record class_of (L : Type) : Type := Class {base : FieldExt.class_of F L; mixin : axiom (FieldExt.Pack _ base)}. Unset Primitive Projections. Local Coercion base : class_of >-> FieldExt.class_of. Structure type (phF : phant F) := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variable (phF : phant F) (T : Type) (cT : type phF). Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack phF T c. Definition pack b0 (ax0 : axiom (@FieldExt.Pack F (Phant F) T b0)) := fun bT b & phant_id (@FieldExt.class F phF bT) b => fun ax & phant_id ax0 ax => Pack (Phant F) (@Class T b ax). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition zmodType := @Zmodule.Pack cT class. Definition ringType := @Ring.Pack cT class. Definition unitRingType := @UnitRing.Pack cT class. Definition comRingType := @ComRing.Pack cT class. Definition comUnitRingType := @ComUnitRing.Pack cT class. Definition idomainType := @IntegralDomain.Pack cT class. Definition fieldType := @Field.Pack cT class. Definition lmodType := @Lmodule.Pack F phF cT class. Definition lalgType := @Lalgebra.Pack F phF cT class. Definition algType := @Algebra.Pack F phF cT class. Definition unitAlgType := @UnitAlgebra.Pack F phF cT class. Definition comAlgType := @ComAlgebra.Pack F phF cT class. Definition comUnitAlgType := @ComUnitAlgebra.Pack F phF cT class. Definition vectType := @Vector.Pack F phF cT class. Definition FalgType := @Falgebra.Pack F phF cT class. Definition fieldExtType := @FieldExt.Pack F phF cT class. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Bind Scope ring_scope with sort. Coercion base : class_of >-> FieldExt.class_of. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion zmodType : type >-> Zmodule.type. Canonical zmodType. Coercion ringType : type >-> Ring.type. Canonical ringType. Coercion unitRingType : type >-> UnitRing.type. Canonical unitRingType. Coercion comRingType : type >-> ComRing.type. Canonical comRingType. Coercion comUnitRingType : type >-> ComUnitRing.type. Canonical comUnitRingType. Coercion idomainType : type >-> IntegralDomain.type. Canonical idomainType. Coercion fieldType : type >-> Field.type. Canonical fieldType. Coercion lmodType : type >-> Lmodule.type. Canonical lmodType. Coercion lalgType : type >-> Lalgebra.type. Canonical lalgType. Coercion algType : type >-> Algebra.type. Canonical algType. Coercion comAlgType : type >-> ComAlgebra.type. Canonical comAlgType. Coercion unitAlgType : type >-> UnitAlgebra.type. Canonical unitAlgType. Coercion comUnitAlgType : type >-> ComUnitAlgebra.type. Canonical comUnitAlgType. Coercion vectType : type >-> Vector.type. Canonical vectType. Coercion FalgType : type >-> Falgebra.type. Canonical FalgType. Coercion fieldExtType : type >-> FieldExt.type. Canonical fieldExtType. Notation splittingFieldType F := (type (Phant F)). Notation SplittingFieldType F L ax := (@pack _ (Phant F) L _ ax _ _ id _ id). Notation "[ 'splittingFieldType' F 'of' L 'for' K ]" := (@clone _ (Phant F) L K _ idfun) (at level 0, format "[ 'splittingFieldType' F 'of' L 'for' K ]") : form_scope. Notation "[ 'splittingFieldType' F 'of' L ]" := (@clone _ (Phant F) L _ _ id) (at level 0, format "[ 'splittingFieldType' F 'of' L ]") : form_scope. End Exports. End SplittingField. Export SplittingField.Exports. Lemma normal_field_splitting (F : fieldType) (L : fieldExtType F) : (forall (K : {subfield L}) x, exists r, minPoly K x == \prod_(y <- r) ('X - y%:P)) -> SplittingField.axiom L. Proof. move=> normalL; pose r i := sval (sigW (normalL 1%AS (tnth (vbasis {:L}) i))). have sz_r i: size (r i) <= \dim {:L}. rewrite -ltnS -(size_prod_XsubC _ id) /r; case: sigW => _ /= /eqP <-. rewrite size_minPoly ltnS; move: (tnth _ _) => x. by rewrite adjoin_degreeE dimv1 divn1 dimvS // subvf. pose mkf (z : L) := 'X - z%:P. exists (\prod_i \prod_(j < \dim {:L} | j < size (r i)) mkf (r i)`_j). apply: rpred_prod => i _; rewrite big_ord_narrow /= /r; case: sigW => rs /=. by rewrite (big_nth 0) big_mkord => /eqP <- {rs}; apply: minPolyOver. rewrite pair_big_dep /= -big_filter -(big_map _ xpredT mkf). set rF := map _ _; exists rF; first exact: eqpxx. apply/eqP; rewrite eqEsubv subvf -(span_basis (vbasisP {:L})). apply/span_subvP=> _ /tnthP[i ->]; set x := tnth _ i. have /tnthP[j ->]: x \in in_tuple (r i). by rewrite -root_prod_XsubC /r; case: sigW => _ /=/eqP<-; apply: root_minPoly. apply/seqv_sub_adjoin/mapP; rewrite (tnth_nth 0). exists (i, widen_ord (sz_r i) j) => //. by rewrite mem_filter /= ltn_ord mem_index_enum. Qed. Fact regular_splittingAxiom F : SplittingField.axiom (regular_fieldExtType F). Proof. exists 1; first exact: rpred1. by exists [::]; [rewrite big_nil eqpxx | rewrite Fadjoin_nil regular_fullv]. Qed. Canonical regular_splittingFieldType (F : fieldType) := SplittingFieldType F F^o (regular_splittingAxiom F). Section SplittingFieldTheory. Variables (F : fieldType) (L : splittingFieldType F). Implicit Types (U V W : {vspace L}). Implicit Types (K M E : {subfield L}). Lemma splittingFieldP : SplittingField.axiom L. Proof. by case: L => ? []. Qed. Lemma splittingPoly : {p : {poly L} | p \is a polyOver 1%VS & splittingFieldFor 1 p {:L}}. Proof. pose factF p s := (p \is a polyOver 1%VS) && (p %= \prod_(z <- s) ('X - z%:P)). suffices [[p rs] /andP[]]: {ps | factF F L ps.1 ps.2 & <<1 & ps.2>> = {:L}}%VS. by exists p; last exists rs. apply: sig2_eqW; have [p F0p [rs splitLp genLrs]] := splittingFieldP. by exists (p, rs); rewrite // /factF F0p splitLp. Qed. Fact fieldOver_splitting E : SplittingField.axiom (fieldOver_fieldExtType E). Proof. have [p Fp [r Dp defL]] := splittingFieldP; exists p. apply/polyOverP=> j; rewrite trivial_fieldOver. by rewrite (subvP (sub1v E)) ?(polyOverP Fp). exists r => //; apply/vspaceP=> x; rewrite memvf. have [L0 [_ _ defL0]] := @aspaceOverP _ _ E <<1 & r : seq (fieldOver E)>>. rewrite defL0; have: x \in <<1 & r>>%VS by rewrite defL (@memvf _ L). apply: subvP; apply/Fadjoin_seqP; rewrite -memvE -defL0 mem1v. by split=> // y r_y; rewrite -defL0 seqv_sub_adjoin. Qed. Canonical fieldOver_splittingFieldType E := SplittingFieldType (subvs_of E) (fieldOver E) (fieldOver_splitting E). Lemma enum_AEnd : {kAutL : seq 'AEnd(L) | forall f, f \in kAutL}. Proof. pose isAutL (s : seq 'AEnd(L)) (f : 'AEnd(L)) := kHom 1 {:L} f = (f \in s). suffices [kAutL in_kAutL] : {kAutL : seq 'AEnd(L) | forall f, isAutL kAutL f}. by exists kAutL => f; rewrite -in_kAutL k1AHom. have [p Kp /sig2_eqW[rs Dp defL]] := splittingPoly. do [rewrite {}/isAutL -(erefl (asval 1)); set r := rs; set E := 1%AS] in defL *. have [sKE rs_r]: (1 <= E)%VS /\ all (mem rs) r by split; last apply/allP. elim: r rs_r => [_|z r IHr /=/andP[rs_z rs_r]] /= in (E) sKE defL *. rewrite Fadjoin_nil in defL; exists [tuple \1%AF] => f; rewrite defL inE. apply/idP/eqP=> [/kAHomP f1 | ->]; last exact: kHom1. by apply/val_inj/lfunP=> x; rewrite id_lfunE f1 ?memvf. do [set Ez := <>%VS; rewrite adjoin_cons] in defL. have sEEz: (E <= Ez)%VS := subv_adjoin E z; have sKEz := subv_trans sKE sEEz. have{IHr} [homEz DhomEz] := IHr rs_r _ sKEz defL. have Ep: p \in polyOver E := polyOverSv sKE Kp. have{rs_z} pz0: root p z by rewrite (eqp_root Dp) root_prod_XsubC. pose pEz := minPoly E z; pose n := \dim_E Ez. have{pz0} [rz DpEz]: {rz : n.-tuple L | pEz %= \prod_(w <- rz) ('X - w%:P)}. have /dvdp_prod_XsubC[m DpEz]: pEz %| \prod_(w <- rs) ('X - w%:P). by rewrite -(eqp_dvdr _ Dp) minPoly_dvdp ?(polyOverSv sKE). suffices sz_rz: size (mask m rs) == n by exists (Tuple sz_rz). rewrite -[n]adjoin_degreeE -eqSS -size_minPoly. by rewrite (eqp_size DpEz) size_prod_XsubC. have fEz i (y := tnth rz i): {f : 'AEnd(L) | kHom E {:L} f & f z = y}. have homEfz: kHom E Ez (kHomExtend E \1 z y). rewrite kHomExtendP ?kHom1 // lfun1_poly. by rewrite (eqp_root DpEz) -/rz root_prod_XsubC mem_tnth. have splitFp: splittingFieldFor Ez p {:L}. exists rs => //; apply/eqP; rewrite eqEsubv subvf -defL adjoin_seqSr //. exact/allP. have [f homLf Df] := kHom_extends sEEz homEfz Ep splitFp. have [ahomf _] := andP homLf; exists (AHom ahomf) => //. rewrite -Df ?memv_adjoin ?(kHomExtend_val (kHom1 E E)) // lfun1_poly. by rewrite (eqp_root DpEz) root_prod_XsubC mem_tnth. exists [seq (s2val (fEz i) \o f)%AF| i <- enum 'I_n, f <- homEz] => f. apply/idP/allpairsP => [homLf | [[i g] [_ Hg ->]] /=]; last first. by case: (fEz i) => fi /= /comp_kHom->; rewrite ?(kHomSl sEEz) ?DhomEz. have /tnthP[i Dfz]: f z \in rz. rewrite memtE /= -root_prod_XsubC -(eqp_root DpEz). by rewrite (kHom_root_id _ homLf) ?memvf ?subvf ?minPolyOver ?root_minPoly. case Dfi: (fEz i) => [fi homLfi fi_z]; have kerfi0 := kAutf_lker0 homLfi. set fj := (fi ^-1 \o f)%AF; suffices Hfj : fj \in homEz. exists (i, fj) => //=; rewrite mem_enum inE Hfj; split => //. by apply/val_inj; rewrite {}Dfi /= (lker0_compVKf kerfi0). rewrite -DhomEz; apply/kAHomP => _ /Fadjoin_polyP[q Eq ->]. have homLfj: kHom E {:L} fj := comp_kHom (inv_kHomf homLfi) homLf. have /kHom_lrmorphism fjM := kHomSl (sub1v _) homLfj. rewrite -[fj _](horner_map (RMorphism fjM)) (kHom_poly_id homLfj) //=. by rewrite lfunE /= Dfz -fi_z lker0_lfunK. Qed. Lemma splitting_field_normal K x : exists r, minPoly K x == \prod_(y <- r) ('X - y%:P). Proof. pose q1 := minPoly 1 x; pose fx_root q (f : 'AEnd(L)) := root q (f x). have [[p F0p splitLp] [autL DautL]] := (splittingFieldP, enum_AEnd). suffices{K} autL_px q: q != 0 -> q %| q1 -> size q > 1 -> has (fx_root q) autL. set q := minPoly K x; have: q \is monic := monic_minPoly K x. have: q %| q1 by rewrite minPolyS // sub1v. have [d] := ubnP (size q); elim: d q => // d IHd q leqd q_dv_q1 mon_q. have nz_q: q != 0 := monic_neq0 mon_q. have [|q_gt1|q_1] := ltngtP (size q) 1; last first; last by rewrite polySpred. by exists nil; rewrite big_nil -eqp_monic ?monic1 // -size_poly_eq1 q_1. have /hasP[f autLf /factor_theorem[q2 Dq]] := autL_px q nz_q q_dv_q1 q_gt1. have mon_q2: q2 \is monic by rewrite -(monicMr _ (monicXsubC (f x))) -Dq. rewrite Dq size_monicM -?size_poly_eq0 ?size_XsubC ?addn2 //= ltnS in leqd. have q2_dv_q1: q2 %| q1 by rewrite (dvdp_trans _ q_dv_q1) // Dq dvdp_mulr. rewrite Dq; have [r /eqP->] := IHd q2 leqd q2_dv_q1 mon_q2. by exists (f x :: r); rewrite big_cons mulrC. have [d] := ubnP (size q); elim: d q => // d IHd q leqd nz_q q_dv_q1 q_gt1. without loss{d leqd IHd nz_q q_gt1} irr_q: q q_dv_q1 / irreducible_poly q. move=> IHq; apply: wlog_neg => not_autLx_q; apply: IHq => //. split=> // q2 q2_neq1 q2_dv_q; rewrite -dvdp_size_eqp // eqn_leq dvdp_leq //=. rewrite leqNgt; apply: contra not_autLx_q => ltq2q. have nz_q2: q2 != 0 by apply: contraTneq q2_dv_q => ->; rewrite dvd0p. have{q2_neq1} q2_gt1: size q2 > 1 by rewrite neq_ltn polySpred in q2_neq1 *. have{leqd ltq2q} ltq2d: size q2 < d by apply: leq_trans ltq2q _. apply: sub_has (IHd _ ltq2d nz_q2 (dvdp_trans q2_dv_q q_dv_q1) q2_gt1) => f. by rewrite /fx_root !root_factor_theorem => /dvdp_trans->. have{irr_q} [Lz [inLz [z qz0]]]: {Lz : fieldExtType F & {inLz : 'AHom(L, Lz) & {z : Lz | root (map_poly inLz q) z}}}. - have [Lz0 _ [z qz0 defLz]] := irredp_FAdjoin irr_q. pose Lz := baseField_extFieldType Lz0. pose inLz : {rmorphism L -> Lz} := [rmorphism of in_alg Lz0]. have inLzL_linear: linear (locked inLz). move=> a u v; rewrite -(@mulr_algl F Lz) baseField_scaleE. by rewrite -{1}mulr_algl rmorphD rmorphM -lock. have ihLzZ: ahom_in {:L} (linfun (Linear inLzL_linear)). by apply/ahom_inP; split=> [u v|]; rewrite !lfunE (rmorphM, rmorph1). exists Lz, (AHom ihLzZ), z; congr (root _ z): qz0. by apply: eq_map_poly => y; rewrite lfunE /= -lock. pose imL := [aspace of limg inLz]; pose pz := map_poly inLz p. have in_imL u: inLz u \in imL by rewrite memv_img ?memvf. have F0pz: pz \is a polyOver 1%VS. apply/polyOverP=> i; rewrite -(aimg1 inLz) coef_map /= memv_img //. exact: (polyOverP F0p). have{splitLp} splitLpz: splittingFieldFor 1 pz imL. have [r def_p defL] := splitLp; exists (map inLz r) => [|{def_p}]. move: def_p; rewrite -(eqp_map [rmorphism of inLz]) rmorph_prod. rewrite big_map; congr (_ %= _); apply: eq_big => // y _. by rewrite rmorphB /= map_polyX map_polyC. apply/eqP; rewrite eqEsubv /= -{2}defL {defL}; apply/andP; split. by apply/Fadjoin_seqP; rewrite sub1v; split=> // _ /mapP[y r_y ->]. elim/last_ind: r => [|r y IHr] /=; first by rewrite !Fadjoin_nil aimg1. rewrite map_rcons !adjoin_rcons /=. apply/subvP=> _ /memv_imgP[_ /Fadjoin_polyP[p1 r_p1 ->] ->]. rewrite -horner_map /= mempx_Fadjoin //=; apply/polyOverP=> i. by rewrite coef_map (subvP IHr) //= memv_img ?(polyOverP r_p1). have [f homLf fxz]: exists2 f : 'End(Lz), kHom 1 imL f & f (inLz x) = z. pose q1z := minPoly 1 (inLz x). have Dq1z: map_poly inLz q1 %| q1z. have F0q1z i: exists a, q1z`_i = a%:A by apply/vlineP/polyOverP/minPolyOver. have [q2 Dq2]: exists q2, q1z = map_poly inLz q2. exists (\poly_(i < size q1z) (sval (sig_eqW (F0q1z i)))%:A). rewrite -{1}[q1z]coefK; apply/polyP=> i; rewrite coef_map !{1}coef_poly. by case: sig_eqW => a; case: ifP; rewrite /= ?rmorph0 ?linearZ ?rmorph1. rewrite Dq2 dvdp_map minPoly_dvdp //. apply/polyOverP=> i; have[a] := F0q1z i. rewrite -(rmorph1 [rmorphism of inLz]) -linearZ. by rewrite Dq2 coef_map => /fmorph_inj->; rewrite rpredZ ?mem1v. by rewrite -(fmorph_root [rmorphism of inLz]) -Dq2 root_minPoly. have q1z_z: root q1z z. rewrite !root_factor_theorem in qz0 *. by apply: dvdp_trans qz0 (dvdp_trans _ Dq1z); rewrite dvdp_map. have map1q1z_z: root (map_poly \1%VF q1z) z. by rewrite map_poly_id => // ? _; rewrite lfunE. pose f0 := kHomExtend 1 \1 (inLz x) z. have{map1q1z_z} hom_f0 : kHom 1 <<1; inLz x>> f0. by apply: kHomExtendP map1q1z_z => //; apply: kHom1. have{} splitLpz: splittingFieldFor <<1; inLz x>> pz imL. have [r def_pz defLz] := splitLpz; exists r => //. apply/eqP; rewrite eqEsubv -{2}defLz adjoin_seqSl ?sub1v // andbT. apply/Fadjoin_seqP; split; last first. by rewrite /= -[limg _]defLz; apply: seqv_sub_adjoin. by apply/FadjoinP/andP; rewrite sub1v memv_img ?memvf. have [f homLzf Df] := kHom_extends (sub1v _) hom_f0 F0pz splitLpz. have [-> | x'z] := eqVneq (inLz x) z. by exists \1%VF; rewrite ?lfunE ?kHom1. exists f => //; rewrite -Df ?memv_adjoin ?(kHomExtend_val (kHom1 1 1)) //. by rewrite lfun1_poly. pose f1 := (inLz^-1 \o f \o inLz)%VF; have /kHomP[fM fFid] := homLf. have Df1 u: inLz (f1 u) = f (inLz u). rewrite !comp_lfunE limg_lfunVK //= -[limg _]/(asval imL). have [r def_pz defLz] := splitLpz; set r1 := r. have: inLz u \in <<1 & r1>>%VS by rewrite defLz. have: all (mem r) r1 by apply/allP. elim/last_ind: r1 {u}(inLz u) => [|r1 y IHr1] u. by rewrite Fadjoin_nil => _ Fu; rewrite fFid // (subvP (sub1v _)). rewrite all_rcons adjoin_rcons => /andP[rr1 ry] /Fadjoin_polyP[pu r1pu ->]. rewrite (kHom_horner homLf) -defLz; last exact: seqv_sub_adjoin; last first. by apply: polyOverS r1pu; apply/subvP/adjoin_seqSr/allP. apply: rpred_horner. by apply/polyOverP=> i; rewrite coef_map /= defLz IHr1 ?(polyOverP r1pu). rewrite seqv_sub_adjoin // -root_prod_XsubC -(eqp_root def_pz). rewrite (kHom_root_id _ homLf) ?sub1v //. by rewrite -defLz seqv_sub_adjoin. by rewrite (eqp_root def_pz) root_prod_XsubC. suffices f1_is_ahom : ahom_in {:L} f1. apply/hasP; exists (AHom f1_is_ahom); first exact: DautL. by rewrite /fx_root -(fmorph_root [rmorphism of inLz]) /= Df1 fxz. apply/ahom_inP; split=> [a b _ _|]; apply: (fmorph_inj [rmorphism of inLz]). by rewrite rmorphM /= !Df1 rmorphM fM ?in_imL. by rewrite /= Df1 /= fFid ?rmorph1 ?mem1v. Qed. Lemma kHom_to_AEnd K E f : kHom K E f -> {g : 'AEnd(L) | {in E, f =1 val g}}. Proof. move=> homKf; have{homKf} [homFf sFE] := (kHomSl (sub1v K) homKf, sub1v E). have [p Fp /(splittingFieldForS sFE (subvf E))splitLp] := splittingPoly. have [g0 homLg0 eq_fg] := kHom_extends sFE homFf Fp splitLp. by apply: exist (Sub g0 _) _ => //; apply/ahomP/kHom_lrmorphism. Qed. End SplittingFieldTheory. (* Hide the finGroup structure on 'AEnd(L) in a module so that we can control *) (* when it is exported. Most people will want to use the finGroup structure *) (* on 'Gal(E / K) and will not need this module. *) Module Import AEnd_FinGroup. Section AEnd_FinGroup. Variables (F : fieldType) (L : splittingFieldType F). Implicit Types (U V W : {vspace L}) (K M E : {subfield L}). Definition inAEnd f := SeqSub (svalP (enum_AEnd L) f). Fact inAEndK : cancel inAEnd val. Proof. by []. Qed. Definition AEnd_countMixin := Eval hnf in CanCountMixin inAEndK. Canonical AEnd_countType := Eval hnf in CountType 'AEnd(L) AEnd_countMixin. Canonical AEnd_subCountType := Eval hnf in [subCountType of 'AEnd(L)]. Definition AEnd_finMixin := Eval hnf in CanFinMixin inAEndK. Canonical AEnd_finType := Eval hnf in FinType 'AEnd(L) AEnd_finMixin. Canonical AEnd_subFinType := Eval hnf in [subFinType of 'AEnd(L)]. (* the group operation is the categorical composition operation *) Definition comp_AEnd (f g : 'AEnd(L)) : 'AEnd(L) := (g \o f)%AF. Fact comp_AEndA : associative comp_AEnd. Proof. by move=> f g h; apply: val_inj; symmetry; apply: comp_lfunA. Qed. Fact comp_AEnd1l : left_id \1%AF comp_AEnd. Proof. by move=> f; apply/val_inj/comp_lfun1r. Qed. Fact comp_AEndK : left_inverse \1%AF (@inv_ahom _ L) comp_AEnd. Proof. by move=> f; apply/val_inj; rewrite /= lker0_compfV ?AEnd_lker0. Qed. Definition AEnd_baseFinGroupMixin := FinGroup.Mixin comp_AEndA comp_AEnd1l comp_AEndK. Canonical AEnd_baseFinGroupType := BaseFinGroupType 'AEnd(L) AEnd_baseFinGroupMixin. Canonical AEnd_finGroupType := FinGroupType comp_AEndK. Definition kAEnd U V := [set f : 'AEnd(L) | kAut U V f]. Definition kAEndf U := kAEnd U {:L}. Lemma kAEnd_group_set K E : group_set (kAEnd K E). Proof. apply/group_setP; split=> [|f g]; first by rewrite inE /kAut kHom1 lim1g eqxx. rewrite !inE !kAutE => /andP[homKf EfE] /andP[/(kHomSr EfE)homKg EgE]. by rewrite (comp_kHom_img homKg homKf) limg_comp (subv_trans _ EgE) ?limgS. Qed. Canonical kAEnd_group K E := group (kAEnd_group_set K E). Canonical kAEndf_group K := [group of kAEndf K]. Lemma kAEnd_norm K E : kAEnd K E \subset 'N(kAEndf E)%g. Proof. apply/subsetP=> x; rewrite -groupV 2!in_set => /andP[_ /eqP ExE]. apply/subsetP=> _ /imsetP[y homEy ->]; rewrite !in_set !kAutfE in homEy *. apply/kAHomP=> u Eu; have idEy := kAHomP homEy; rewrite -ExE in idEy. by rewrite !lfunE /= lfunE /= idEy ?memv_img // lker0_lfunVK ?AEnd_lker0. Qed. Lemma mem_kAut_coset K E (g : 'AEnd(L)) : kAut K E g -> g \in coset (kAEndf E) g. Proof. move=> autEg; rewrite val_coset ?rcoset_refl //. by rewrite (subsetP (kAEnd_norm K E)) // inE. Qed. Lemma aut_mem_eqP E (x y : coset_of (kAEndf E)) f g : f \in x -> g \in y -> reflect {in E, f =1 g} (x == y). Proof. move=> x_f y_g; rewrite -(coset_mem x_f) -(coset_mem y_g). have [Nf Ng] := (subsetP (coset_norm x) f x_f, subsetP (coset_norm y) g y_g). rewrite (sameP eqP (rcoset_kercosetP Nf Ng)) mem_rcoset inE kAutfE. apply: (iffP kAHomP) => idEfg u Eu. by rewrite -(mulgKV g f) lfunE /= idEfg. by rewrite lfunE /= idEfg // lker0_lfunK ?AEnd_lker0. Qed. End AEnd_FinGroup. End AEnd_FinGroup. Section GaloisTheory. Variables (F : fieldType) (L : splittingFieldType F). Implicit Types (U V W : {vspace L}). Implicit Types (K M E : {subfield L}). (* We take Galois automorphisms for a subfield E to be automorphisms of the *) (* full field {:L} that operate in E taken modulo those that fix E pointwise. *) (* The type of Galois automorphisms of E is then the subtype of elements of *) (* the quotient kAEnd 1 E / kAEndf E, which we encapsulate in a specific *) (* wrapper to ensure stability of the gal_repr coercion insertion. *) Section gal_of_Definition. Variable V : {vspace L}. (* The <<_>>, which becomes redundant when V is a {subfield L}, ensures that *) (* the argument of [subg _] is syntactically a group. *) Inductive gal_of := Gal of [subg kAEnd_group 1 <> / kAEndf (agenv V)]. Definition gal (f : 'AEnd(L)) := Gal (subg _ (coset _ f)). Definition gal_sgval x := let: Gal u := x in u. Fact gal_sgvalK : cancel gal_sgval Gal. Proof. by case. Qed. Let gal_sgval_inj := can_inj gal_sgvalK. Definition gal_eqMixin := CanEqMixin gal_sgvalK. Canonical gal_eqType := Eval hnf in EqType gal_of gal_eqMixin. Definition gal_choiceMixin := CanChoiceMixin gal_sgvalK. Canonical gal_choiceType := Eval hnf in ChoiceType gal_of gal_choiceMixin. Definition gal_countMixin := CanCountMixin gal_sgvalK. Canonical gal_countType := Eval hnf in CountType gal_of gal_countMixin. Definition gal_finMixin := CanFinMixin gal_sgvalK. Canonical gal_finType := Eval hnf in FinType gal_of gal_finMixin. Definition gal_one := Gal 1%g. Definition gal_inv x := Gal (gal_sgval x)^-1. Definition gal_mul x y := Gal (gal_sgval x * gal_sgval y). Fact gal_oneP : left_id gal_one gal_mul. Proof. by move=> x; apply/gal_sgval_inj/mul1g. Qed. Fact gal_invP : left_inverse gal_one gal_inv gal_mul. Proof. by move=> x; apply/gal_sgval_inj/mulVg. Qed. Fact gal_mulP : associative gal_mul. Proof. by move=> x y z; apply/gal_sgval_inj/mulgA. Qed. Definition gal_finGroupMixin := FinGroup.Mixin gal_mulP gal_oneP gal_invP. Canonical gal_finBaseGroupType := Eval hnf in BaseFinGroupType gal_of gal_finGroupMixin. Canonical gal_finGroupType := Eval hnf in FinGroupType gal_invP. Coercion gal_repr u : 'AEnd(L) := repr (sgval (gal_sgval u)). Fact gal_is_morphism : {in kAEnd 1 (agenv V) &, {morph gal : x y / x * y}%g}. Proof. move=> f g /= autEa autEb; congr (Gal _). by rewrite !morphM ?mem_morphim // (subsetP (kAEnd_norm 1 _)). Qed. Canonical gal_morphism := Morphism gal_is_morphism. Lemma gal_reprK : cancel gal_repr gal. Proof. by case=> x; rewrite /gal coset_reprK sgvalK. Qed. Lemma gal_repr_inj : injective gal_repr. Proof. exact: can_inj gal_reprK. Qed. Lemma gal_AEnd x : gal_repr x \in kAEnd 1 (agenv V). Proof. rewrite /gal_repr; case/gal_sgval: x => _ /=/morphimP[g Ng autEg ->]. rewrite val_coset //=; case: repr_rcosetP => f; rewrite groupMr // !inE kAut1E. by rewrite kAutE -andbA => /and3P[_ /fixedSpace_limg-> _]. Qed. End gal_of_Definition. Prenex Implicits gal_repr. Lemma gal_eqP E {x y : gal_of E} : reflect {in E, x =1 y} (x == y). Proof. by rewrite -{1}(subfield_closed E); apply: aut_mem_eqP; apply: mem_repr_coset. Qed. Lemma galK E (f : 'AEnd(L)) : (f @: E <= E)%VS -> {in E, gal E f =1 f}. Proof. rewrite -kAut1E -{1 2}(subfield_closed E) => autEf. apply: (aut_mem_eqP (mem_repr_coset _) _ (eqxx _)). by rewrite subgK /= ?(mem_kAut_coset autEf) // ?mem_quotient ?inE. Qed. Lemma eq_galP E (f g : 'AEnd(L)) : (f @: E <= E)%VS -> (g @: E <= E)%VS -> reflect {in E, f =1 g} (gal E f == gal E g). Proof. move=> EfE EgE. by apply: (iffP gal_eqP) => Dfg a Ea; have:= Dfg a Ea; rewrite !{1}galK. Qed. Lemma limg_gal E (x : gal_of E) : (x @: E)%VS = E. Proof. by have:= gal_AEnd x; rewrite inE subfield_closed => /andP[_ /eqP]. Qed. Lemma memv_gal E (x : gal_of E) a : a \in E -> x a \in E. Proof. by move/(memv_img x); rewrite limg_gal. Qed. Lemma gal_id E a : (1 : gal_of E)%g a = a. Proof. by rewrite /gal_repr repr_coset1 id_lfunE. Qed. Lemma galM E (x y : gal_of E) a : a \in E -> (x * y)%g a = y (x a). Proof. rewrite /= -comp_lfunE; apply/eq_galP; rewrite ?limg_comp ?limg_gal //. by rewrite morphM /= ?gal_reprK ?gal_AEnd. Qed. Lemma galV E (x : gal_of E) : {in E, (x^-1)%g =1 x^-1%VF}. Proof. move=> a Ea; apply: canRL (lker0_lfunK (AEnd_lker0 _)) _. by rewrite -galM // mulVg gal_id. Qed. (* Standard mathematical notation for 'Gal(E / K) puts the larger field first.*) Definition galoisG V U := gal V @* <>. Local Notation "''Gal' ( V / U )" := (galoisG V U) : group_scope. Canonical galoisG_group E U := Eval hnf in [group of (galoisG E U)]. Local Notation "''Gal' ( V / U )" := (galoisG_group V U) : Group_scope. Section Automorphism. Lemma gal_cap U V : 'Gal(V / U) = 'Gal(V / U :&: V). Proof. by rewrite /galoisG -capvA capvv. Qed. Lemma gal_kAut K E x : (K <= E)%VS -> (x \in 'Gal(E / K)) = kAut K E x. Proof. move=> sKE; apply/morphimP/idP=> /= [[g EgE KautEg ->{x}] | KautEx]. rewrite genGid !inE kAut1E /= subfield_closed (capv_idPl sKE) in KautEg EgE. by apply: etrans KautEg; apply/(kAut_eq sKE); apply: galK. exists (x : 'AEnd(L)); rewrite ?gal_reprK ?gal_AEnd //. by rewrite (capv_idPl sKE) mem_gen ?inE. Qed. Lemma gal_kHom K E x : (K <= E)%VS -> (x \in 'Gal(E / K)) = kHom K E x. Proof. by move/gal_kAut->; rewrite /kAut limg_gal eqxx andbT. Qed. Lemma kAut_to_gal K E f : kAut K E f -> {x : gal_of E | x \in 'Gal(E / K) & {in E, f =1 x}}. Proof. case/andP=> homKf EfE; have [g Df] := kHom_to_AEnd homKf. have{homKf EfE} autEg: kAut (K :&: E) E g. rewrite /kAut -(kHom_eq (capvSr _ _) Df) (kHomSl (capvSl _ _) homKf) /=. by rewrite -(eq_in_limg Df). have FautEg := kAutS (sub1v _) autEg. exists (gal E g) => [|a Ea]; last by rewrite {f}Df // galK // -kAut1E. by rewrite mem_morphim /= ?subfield_closed ?genGid ?inE. Qed. Lemma fixed_gal K E x a : (K <= E)%VS -> x \in 'Gal(E / K) -> a \in K -> x a = a. Proof. by move/gal_kHom=> -> /kAHomP idKx /idKx. Qed. Lemma fixedPoly_gal K E x p : (K <= E)%VS -> x \in 'Gal(E / K) -> p \is a polyOver K -> map_poly x p = p. Proof. move=> sKE galEKx /polyOverP Kp; apply/polyP => i. by rewrite coef_map /= (fixed_gal sKE). Qed. Lemma root_minPoly_gal K E x a : (K <= E)%VS -> x \in 'Gal(E / K) -> a \in E -> root (minPoly K a) (x a). Proof. move=> sKE galEKx Ea; have homKx: kHom K E x by rewrite -gal_kHom. have K_Pa := minPolyOver K a; rewrite -[minPoly K a](fixedPoly_gal _ galEKx) //. by rewrite (kHom_root homKx) ?root_minPoly // (polyOverS (subvP sKE)). Qed. End Automorphism. Lemma gal_adjoin_eq K a x y : x \in 'Gal(<> / K) -> y \in 'Gal(<> / K) -> (x == y) = (x a == y a). Proof. move=> galKa_x galKa_y; apply/idP/eqP=> [/eqP-> // | eq_xy_a]. apply/gal_eqP => _ /Fadjoin_polyP[p Kp ->]. by rewrite -!horner_map !(fixedPoly_gal (subv_adjoin K a)) //= eq_xy_a. Qed. Lemma galS K M E : (K <= M)%VS -> 'Gal(E / M) \subset 'Gal(E / K). Proof. rewrite gal_cap (gal_cap K E) => sKM; apply/subsetP=> x. by rewrite !gal_kAut ?capvSr //; apply: kAutS; apply: capvS. Qed. Lemma gal_conjg K E x : 'Gal(E / K) :^ x = 'Gal(E / x @: K). Proof. without loss sKE: K / (K <= E)%VS. move=> IH_K; rewrite gal_cap {}IH_K ?capvSr //. transitivity 'Gal(E / x @: K :&: x @: E); last by rewrite limg_gal -gal_cap. congr 'Gal(E / _); apply/eqP; rewrite eqEsubv limg_cap; apply/subvP=> a. rewrite memv_cap => /andP[/memv_imgP[b Kb ->] /memv_imgP[c Ec] eq_bc]. by rewrite memv_img // memv_cap Kb (lker0P (AEnd_lker0 _) _ _ eq_bc). wlog suffices IHx: x K sKE / 'Gal(E / K) :^ x \subset 'Gal(E / x @: K). apply/eqP; rewrite eqEsubset IHx // -sub_conjgV (subset_trans (IHx _ _ _)) //. by apply/subvP=> _ /memv_imgP[a Ka ->]; rewrite memv_gal ?(subvP sKE). rewrite -limg_comp (etrans (eq_in_limg _) (lim1g _)) // => a /(subvP sKE)Ka. by rewrite !lfunE /= -galM // mulgV gal_id. apply/subsetP=> _ /imsetP[y galEy ->]; rewrite gal_cap gal_kHom ?capvSr //=. apply/kAHomP=> _ /memv_capP[/memv_imgP[a Ka ->] _]; have Ea := subvP sKE a Ka. by rewrite -galM // -conjgC galM // (fixed_gal sKE galEy). Qed. Definition fixedField V (A : {set gal_of V}) := (V :&: \bigcap_(x in A) fixedSpace x)%VS. Lemma fixedFieldP E {A : {set gal_of E}} a : a \in E -> reflect (forall x, x \in A -> x a = a) (a \in fixedField A). Proof. by rewrite memv_cap => ->; apply: (iffP subv_bigcapP) => cAa x /cAa/fixedSpaceP. Qed. Lemma mem_fixedFieldP E (A : {set gal_of E}) a : a \in fixedField A -> a \in E /\ (forall x, x \in A -> x a = a). Proof. by move=> fixAa; have [Ea _] := memv_capP fixAa; have:= fixedFieldP Ea fixAa. Qed. Fact fixedField_is_aspace E (A : {set gal_of E}) : is_aspace (fixedField A). Proof. rewrite /fixedField; elim/big_rec: _ {1}E => [|x K _ IH_K] M. exact: (valP (M :&: _)%AS). by rewrite capvA IH_K. Qed. Canonical fixedField_aspace E A : {subfield L} := ASpace (@fixedField_is_aspace E A). Lemma fixedField_bound E (A : {set gal_of E}) : (fixedField A <= E)%VS. Proof. exact: capvSl. Qed. Lemma fixedFieldS E (A B : {set gal_of E}) : A \subset B -> (fixedField B <= fixedField A)%VS. Proof. move/subsetP=> sAB; apply/subvP => a /mem_fixedFieldP[Ea cBa]. by apply/fixedFieldP; last apply: sub_in1 cBa. Qed. Lemma galois_connection_subv K E : (K <= E)%VS -> (K <= fixedField ('Gal(E / K)))%VS. Proof. move=> sKE; apply/subvP => a Ka; have Ea := subvP sKE a Ka. by apply/fixedFieldP=> // x galEx; apply: (fixed_gal sKE). Qed. Lemma galois_connection_subset E (A : {set gal_of E}): A \subset 'Gal(E / fixedField A). Proof. apply/subsetP => x Ax; rewrite gal_kAut ?capvSl // kAutE limg_gal subvv andbT. by apply/kAHomP=> a /mem_fixedFieldP[_ ->]. Qed. Lemma galois_connection K E (A : {set gal_of E}): (K <= E)%VS -> (A \subset 'Gal(E / K)) = (K <= fixedField A)%VS. Proof. move=> sKE; apply/idP/idP => [/fixedFieldS | /(galS E)]. exact/subv_trans/galois_connection_subv. exact/subset_trans/galois_connection_subset. Qed. Definition galTrace U V a := \sum_(x in 'Gal(V / U)) (x a). Definition galNorm U V a := \prod_(x in 'Gal(V / U)) (x a). Section TraceAndNormMorphism. Variables U V : {vspace L}. Fact galTrace_is_additive : additive (galTrace U V). Proof. by move=> a b /=; rewrite -sumrB; apply: eq_bigr => x _; rewrite rmorphB. Qed. Canonical galTrace_additive := Additive galTrace_is_additive. Lemma galNorm1 : galNorm U V 1 = 1. Proof. by apply: big1 => x _; rewrite rmorph1. Qed. Lemma galNormM : {morph galNorm U V : a b / a * b}. Proof. by move=> a b /=; rewrite -big_split; apply: eq_bigr => x _; rewrite rmorphM. Qed. Lemma galNormV : {morph galNorm U V : a / a^-1}. Proof. by move=> a /=; rewrite -prodfV; apply: eq_bigr => x _; rewrite fmorphV. Qed. Lemma galNormX n : {morph galNorm U V : a / a ^+ n}. Proof. move=> a; elim: n => [|n IHn]; first exact: galNorm1. by rewrite !exprS galNormM IHn. Qed. Lemma galNorm_prod (I : Type) (r : seq I) (P : pred I) (B : I -> L) : galNorm U V (\prod_(i <- r | P i) B i) = \prod_(i <- r | P i) galNorm U V (B i). Proof. exact: (big_morph _ galNormM galNorm1). Qed. Lemma galNorm0 : galNorm U V 0 = 0. Proof. by rewrite /galNorm (bigD1 1%g) ?group1 // rmorph0 /= mul0r. Qed. Lemma galNorm_eq0 a : (galNorm U V a == 0) = (a == 0). Proof. apply/idP/eqP=> [/prodf_eq0[x _] | ->]; last by rewrite galNorm0. by rewrite fmorph_eq0 => /eqP. Qed. End TraceAndNormMorphism. Section TraceAndNormField. Variables K E : {subfield L}. Lemma galTrace_fixedField a : a \in E -> galTrace K E a \in fixedField 'Gal(E / K). Proof. move=> Ea; apply/fixedFieldP=> [|x galEx]. by apply: rpred_sum => x _; apply: memv_gal. rewrite {2}/galTrace (reindex_acts 'R _ galEx) ?astabsR //=. by rewrite rmorph_sum; apply: eq_bigr => y _; rewrite galM ?lfunE. Qed. Lemma galTrace_gal a x : a \in E -> x \in 'Gal(E / K) -> galTrace K E (x a) = galTrace K E a. Proof. move=> Ea galEx; rewrite {2}/galTrace (reindex_inj (mulgI x)). by apply: eq_big => [b | b _]; rewrite ?groupMl // galM ?lfunE. Qed. Lemma galNorm_fixedField a : a \in E -> galNorm K E a \in fixedField 'Gal(E / K). Proof. move=> Ea; apply/fixedFieldP=> [|x galEx]. by apply: rpred_prod => x _; apply: memv_gal. rewrite {2}/galNorm (reindex_acts 'R _ galEx) ?astabsR //=. by rewrite rmorph_prod; apply: eq_bigr => y _; rewrite galM ?lfunE. Qed. Lemma galNorm_gal a x : a \in E -> x \in 'Gal(E / K) -> galNorm K E (x a) = galNorm K E a. Proof. move=> Ea galEx; rewrite {2}/galNorm (reindex_inj (mulgI x)). by apply: eq_big => [b | b _]; rewrite ?groupMl // galM ?lfunE. Qed. End TraceAndNormField. Definition normalField U V := [forall x in kAEndf U, x @: V == V]%VS. Lemma normalField_kAut K M E f : (K <= M <= E)%VS -> normalField K M -> kAut K E f -> kAut K M f. Proof. case/andP=> sKM sME nKM /kAut_to_gal[x galEx /(sub_in1 (subvP sME))Df]. have sKE := subv_trans sKM sME; rewrite gal_kHom // in galEx. rewrite (kAut_eq sKM Df) /kAut (kHomSr sME) //= (forall_inP nKM) // inE. by rewrite kAutfE; apply/kAHomP; apply: (kAHomP galEx). Qed. Lemma normalFieldP K E : reflect {in E, forall a, exists2 r, all (mem E) r & minPoly K a = \prod_(b <- r) ('X - b%:P)} (normalField K E). Proof. apply: (iffP eqfun_inP) => [nKE a Ea | nKE x]; last first. rewrite inE kAutfE => homKx; suffices: kAut K E x by case/andP=> _ /eqP. rewrite kAutE (kHomSr (subvf E)) //=; apply/subvP=> _ /memv_imgP[a Ea ->]. have [r /allP/=srE splitEa] := nKE a Ea. rewrite srE // -root_prod_XsubC -splitEa. by rewrite -(kHom_poly_id homKx (minPolyOver K a)) fmorph_root root_minPoly. have [r /eqP splitKa] := splitting_field_normal K a. exists r => //; apply/allP => b; rewrite -root_prod_XsubC -splitKa => pKa_b_0. pose y := kHomExtend K \1 a b; have [hom1K lf1p] := (kHom1 K K, lfun1_poly). have homKy: kHom K <> y by apply/kHomExtendP; rewrite ?lf1p. have [[g Dy] [_ idKy]] := (kHom_to_AEnd homKy, kHomP homKy). have <-: g a = b by rewrite -Dy ?memv_adjoin // (kHomExtend_val hom1K) ?lf1p. suffices /nKE <-: g \in kAEndf K by apply: memv_img. by rewrite inE kAutfE; apply/kAHomP=> c Kc; rewrite -Dy ?subvP_adjoin ?idKy. Qed. Lemma normalFieldf K : normalField K {:L}. Proof. apply/normalFieldP=> a _; have [r /eqP->] := splitting_field_normal K a. by exists r => //; apply/allP=> b; rewrite /= memvf. Qed. Lemma normalFieldS K M E : (K <= M)%VS -> normalField K E -> normalField M E. Proof. move=> sKM /normalFieldP nKE; apply/normalFieldP=> a Ea. have [r /allP Er splitKa] := nKE a Ea. have /dvdp_prod_XsubC[m splitMa]: minPoly M a %| \prod_(b <- r) ('X - b%:P). by rewrite -splitKa minPolyS. exists (mask m r); first by apply/allP=> b /mem_mask/Er. by apply/eqP; rewrite -eqp_monic ?monic_prod_XsubC ?monic_minPoly. Qed. Lemma splitting_normalField E K : (K <= E)%VS -> reflect (exists2 p, p \is a polyOver K & splittingFieldFor K p E) (normalField K E). Proof. move=> sKE; apply: (iffP idP) => [nKE| [p Kp [rs Dp defE]]]; last first. apply/forall_inP=> g; rewrite inE kAutE => /andP[homKg _]. rewrite -dimv_leqif_eq ?limg_dim_eq ?(eqP (AEnd_lker0 g)) ?capv0 //. rewrite -defE aimg_adjoin_seq; have [_ /fixedSpace_limg->] := andP homKg. apply/adjoin_seqSr=> _ /mapP[a rs_a ->]. rewrite -!root_prod_XsubC -!(eqp_root Dp) in rs_a *. by apply: kHom_root_id homKg Kp _ rs_a; rewrite ?subvf ?memvf. pose splitK a r := minPoly K a = \prod_(b <- r) ('X - b%:P). have{nKE} rK_ a: {r | a \in E -> all (mem E) r /\ splitK a r}. case Ea: (a \in E); last by exists [::]. by have /sig2_eqW[r] := normalFieldP _ _ nKE a Ea; exists r. have sXE := basis_mem (vbasisP E); set X : seq L := vbasis E in sXE. exists (\prod_(a <- X) minPoly K a). by apply: rpred_prod => a _; apply: minPolyOver. exists (flatten [seq (sval (rK_ a)) | a <- X]). move/allP: sXE; elim: X => [|a X IHX]; first by rewrite !big_nil eqpxx. rewrite big_cons /= big_cat /= => /andP[Ea sXE]. by case: (rK_ a) => /= r [] // _ <-; apply/eqp_mull/IHX. apply/eqP; rewrite eqEsubv; apply/andP; split. apply/Fadjoin_seqP; split=> // b /flatten_mapP[a /sXE Ea]. by apply/allP; case: rK_ => r /= []. rewrite -{1}(span_basis (vbasisP E)); apply/span_subvP=> a Xa. apply/seqv_sub_adjoin/flatten_mapP; exists a => //; rewrite -root_prod_XsubC. by case: rK_ => /= r [| _ <-]; rewrite ?sXE ?root_minPoly. Qed. Lemma kHom_to_gal K M E f : (K <= M <= E)%VS -> normalField K E -> kHom K M f -> {x | x \in 'Gal(E / K) & {in M, f =1 x}}. Proof. case/andP=> /subvP sKM /subvP sME nKE KhomMf. have [[g Df] [_ idKf]] := (kHom_to_AEnd KhomMf, kHomP KhomMf). suffices /kAut_to_gal[x galEx Dg]: kAut K E g. by exists x => //= a Ma; rewrite Df // Dg ?sME. have homKg: kHom K {:L} g by apply/kAHomP=> a Ka; rewrite -Df ?sKM ?idKf. by rewrite /kAut (kHomSr (subvf _)) // (forall_inP nKE) // inE kAutfE. Qed. Lemma normalField_root_minPoly K E a b : (K <= E)%VS -> normalField K E -> a \in E -> root (minPoly K a) b -> exists2 x, x \in 'Gal(E / K) & x a = b. Proof. move=> sKE nKE Ea pKa_b_0; pose f := kHomExtend K \1 a b. have homKa_f: kHom K <> f. by apply: kHomExtendP; rewrite ?kHom1 ?lfun1_poly. have sK_Ka_E: (K <= <> <= E)%VS. by rewrite subv_adjoin; apply/FadjoinP; rewrite sKE Ea. have [x galEx Df] := kHom_to_gal sK_Ka_E nKE homKa_f; exists x => //. by rewrite -Df ?memv_adjoin // (kHomExtend_val (kHom1 K K)) ?lfun1_poly. Qed. Arguments normalFieldP {K E}. Lemma normalField_factors K E : (K <= E)%VS -> reflect {in E, forall a, exists2 r : seq (gal_of E), r \subset 'Gal(E / K) & minPoly K a = \prod_(x <- r) ('X - (x a)%:P)} (normalField K E). Proof. move=> sKE; apply: (iffP idP) => [nKE a Ea | nKE]; last first. apply/normalFieldP=> a Ea; have [r _ ->] := nKE a Ea. exists [seq x a | x : gal_of E <- r]; last by rewrite big_map. by rewrite all_map; apply/allP=> b _; apply: memv_gal. have [r Er splitKa] := normalFieldP nKE a Ea. pose f b := [pick x in 'Gal(E / K) | x a == b]. exists (pmap f r). apply/subsetP=> x; rewrite mem_pmap /f => /mapP[b _]. by case: (pickP _) => // c /andP[galEc _] [->]. rewrite splitKa; have{splitKa}: all (root (minPoly K a)) r. by apply/allP => b; rewrite splitKa root_prod_XsubC. elim: r Er => /= [|b r IHr]; first by rewrite !big_nil. case/andP=> Eb Er /andP[pKa_b_0 /(IHr Er){Er}IHr]. have [x galE /eqP xa_b] := normalField_root_minPoly sKE nKE Ea pKa_b_0. rewrite /(f b); case: (pickP _) => [y /andP[_ /eqP<-]|/(_ x)/andP[]//]. by rewrite !big_cons IHr. Qed. Definition galois U V := [&& (U <= V)%VS, separable U V & normalField U V]. Lemma galoisS K M E : (K <= M <= E)%VS -> galois K E -> galois M E. Proof. case/andP=> sKM sME /and3P[_ sepUV nUV]. by rewrite /galois sME (separableSl sKM) ?(normalFieldS sKM). Qed. Lemma galois_dim K E : galois K E -> \dim_K E = #|'Gal(E / K)|. Proof. case/and3P=> sKE /eq_adjoin_separable_generator-> // nKE. set a := separable_generator K E in nKE *. have [r /allP/=Er splitKa] := normalFieldP nKE a (memv_adjoin K a). rewrite (dim_sup_field (subv_adjoin K a)) mulnK ?adim_gt0 //. apply/eqP; rewrite -eqSS -adjoin_degreeE -size_minPoly splitKa size_prod_XsubC. set n := size r; rewrite eqSS -[n]card_ord. have x_ (i : 'I_n): {x | x \in 'Gal(<> / K) & x a = r`_i}. apply/sig2_eqW/normalField_root_minPoly; rewrite ?subv_adjoin ?memv_adjoin //. by rewrite splitKa root_prod_XsubC mem_nth. have /card_image <-: injective (fun i => s2val (x_ i)). move=> i j /eqP; case: (x_ i) (x_ j) => y /= galEy Dya [z /= galEx Dza]. rewrite gal_adjoin_eq // Dya Dza nth_uniq // => [/(i =P j)//|]. by rewrite -separable_prod_XsubC -splitKa; apply: separable_generatorP. apply/eqP/eq_card=> x; apply/codomP/idP=> [[i ->] | galEx]; first by case: x_. have /(nthP 0) [i ltin Dxa]: x a \in r. rewrite -root_prod_XsubC -splitKa. by rewrite root_minPoly_gal ?memv_adjoin ?subv_adjoin. exists (Ordinal ltin); apply/esym/eqP. by case: x_ => y /= galEy /eqP; rewrite Dxa gal_adjoin_eq. Qed. Lemma galois_factors K E : (K <= E)%VS -> reflect {in E, forall a, exists r, let r_a := [seq x a | x : gal_of E <- r] in [/\ r \subset 'Gal(E / K), uniq r_a & minPoly K a = \prod_(b <- r_a) ('X - b%:P)]} (galois K E). Proof. move=> sKE; apply: (iffP and3P) => [[_ sepKE nKE] a Ea | galKE]. have [r galEr splitEa] := normalField_factors sKE nKE a Ea. exists r; rewrite /= -separable_prod_XsubC !big_map -splitEa. by split=> //; apply: separableP Ea. split=> //. apply/separableP => a /galKE[r [_ Ur_a splitKa]]. by rewrite /separable_element splitKa separable_prod_XsubC. apply/(normalField_factors sKE)=> a /galKE[r [galEr _ ->]]. by rewrite big_map; exists r. Qed. Lemma splitting_galoisField K E : reflect (exists p, [/\ p \is a polyOver K, separable_poly p & splittingFieldFor K p E]) (galois K E). Proof. apply: (iffP and3P) => [[sKE sepKE nKE]|[p [Kp sep_p [r Dp defE]]]]. rewrite (eq_adjoin_separable_generator sepKE) // in nKE *. set a := separable_generator K E in nKE *; exists (minPoly K a). split; first 1 [exact: minPolyOver | exact/separable_generatorP]. have [r /= /allP Er splitKa] := normalFieldP nKE a (memv_adjoin _ _). exists r; first by rewrite splitKa eqpxx. apply/eqP; rewrite eqEsubv; apply/andP; split. by apply/Fadjoin_seqP; split => //; apply: subv_adjoin. apply/FadjoinP; split; first exact: subv_adjoin_seq. by rewrite seqv_sub_adjoin // -root_prod_XsubC -splitKa root_minPoly. have sKE: (K <= E)%VS by rewrite -defE subv_adjoin_seq. split=> //; last by apply/splitting_normalField=> //; exists p; last exists r. rewrite -defE; apply/separable_Fadjoin_seq/allP=> a r_a. by apply/separable_elementP; exists p; rewrite (eqp_root Dp) root_prod_XsubC. Qed. Lemma galois_fixedField K E : reflect (fixedField 'Gal(E / K) = K) (galois K E). Proof. apply: (iffP idP) => [/and3P[sKE /separableP sepKE nKE] | fixedKE]. apply/eqP; rewrite eqEsubv galois_connection_subv ?andbT //. apply/subvP=> a /mem_fixedFieldP[Ea fixEa]; rewrite -adjoin_deg_eq1. have [r /allP Er splitKa] := normalFieldP nKE a Ea. rewrite -eqSS -size_minPoly splitKa size_prod_XsubC eqSS -/(size [:: a]). have Ur: uniq r by rewrite -separable_prod_XsubC -splitKa; apply: sepKE. rewrite -uniq_size_uniq {Ur}// => b; rewrite inE -root_prod_XsubC -splitKa. apply/eqP/idP=> [-> | pKa_b_0]; first exact: root_minPoly. by have [x /fixEa-> ->] := normalField_root_minPoly sKE nKE Ea pKa_b_0. have sKE: (K <= E)%VS by rewrite -fixedKE capvSl. apply/galois_factors=> // a Ea. pose r_pKa := [seq x a | x : gal_of E in 'Gal(E / K)]. have /fin_all_exists2[x_ galEx_ Dx_a] (b : seq_sub r_pKa) := imageP (valP b). exists (codom x_); rewrite -map_comp; set r := map _ _. have r_xa x: x \in 'Gal(E / K) -> x a \in r. move=> galEx; have r_pKa_xa: x a \in r_pKa by apply/imageP; exists x. by rewrite [x a](Dx_a (SeqSub r_pKa_xa)); apply: codom_f. have Ur: uniq r by apply/injectiveP=> b c /=; rewrite -!Dx_a => /val_inj. split=> //; first by apply/subsetP=> _ /codomP[b ->]. apply/eqP; rewrite -eqp_monic ?monic_minPoly ?monic_prod_XsubC //. apply/andP; split; last first. rewrite uniq_roots_dvdp ?uniq_rootsE // all_map. by apply/allP=> b _ /=; rewrite root_minPoly_gal. apply: minPoly_dvdp; last by rewrite root_prod_XsubC -(gal_id E a) r_xa ?group1. rewrite -fixedKE; apply/polyOverP => i; apply/fixedFieldP=> [|x galEx]. rewrite (polyOverP _) // big_map rpred_prod // => b _. by rewrite polyOverXsubC memv_gal. rewrite -coef_map rmorph_prod; congr (_ : {poly _})`_i. symmetry; rewrite (perm_big (map x r)) /= ?(big_map x). by apply: eq_bigr => b _; rewrite rmorphB /= map_polyX map_polyC. have Uxr: uniq (map x r) by rewrite map_inj_uniq //; apply: fmorph_inj. have /uniq_min_size: {subset map x r <= r}. by rewrite -map_comp => _ /codomP[b ->] /=; rewrite -galM // r_xa ?groupM. by rewrite (size_map x) perm_sym; case=> // _ /uniq_perm->. Qed. Lemma mem_galTrace K E a : galois K E -> a \in E -> galTrace K E a \in K. Proof. by move/galois_fixedField => {2}<- /galTrace_fixedField. Qed. Lemma mem_galNorm K E a : galois K E -> a \in E -> galNorm K E a \in K. Proof. by move/galois_fixedField=> {2}<- /galNorm_fixedField. Qed. Lemma gal_independent_contra E (P : pred (gal_of E)) (c_ : gal_of E -> L) x : P x -> c_ x != 0 -> exists2 a, a \in E & \sum_(y | P y) c_ y * y a != 0. Proof. have [n] := ubnP #|P|; elim: n c_ x P => // n IHn c_ x P lePn Px nz_cx. rewrite ltnS (cardD1x Px) in lePn; move/IHn: lePn => {n IHn}/=IH_P. have [/eqfun_inP c_Px'_0 | ] := boolP [forall (y | P y && (y != x)), c_ y == 0]. exists 1; rewrite ?mem1v // (bigD1 x Px) /= rmorph1 mulr1. by rewrite big1 ?addr0 // => y /c_Px'_0->; rewrite mul0r. case/forall_inPn => y Px'y nz_cy. have [Py /gal_eqP/eqlfun_inP/subvPn[a Ea]] := andP Px'y. rewrite memv_ker !lfun_simp => nz_yxa; pose d_ y := c_ y * (y a - x a). have /IH_P[//|b Eb nz_sumb]: d_ y != 0 by rewrite mulf_neq0. have [sumb_0|] := eqVneq (\sum_(z | P z) c_ z * z b) 0; last by exists b. exists (a * b); first exact: rpredM. rewrite -subr_eq0 -[z in _ - z](mulr0 (x a)) -[in z in _ - z]sumb_0. rewrite mulr_sumr -sumrB (bigD1 x Px) rmorphM /= mulrCA subrr add0r. congr (_ != 0): nz_sumb; apply: eq_bigr => z _. by rewrite mulrCA rmorphM -mulrBr -mulrBl mulrA. Qed. Lemma gal_independent E (P : pred (gal_of E)) (c_ : gal_of E -> L) : (forall a, a \in E -> \sum_(x | P x) c_ x * x a = 0) -> (forall x, P x -> c_ x = 0). Proof. move=> sum_cP_0 x Px; apply/eqP/idPn=> /(gal_independent_contra Px)[a Ea]. by rewrite sum_cP_0 ?eqxx. Qed. Lemma Hilbert's_theorem_90 K E x a : generator 'Gal(E / K) x -> a \in E -> reflect (exists2 b, b \in E /\ b != 0 & a = b / x b) (galNorm K E a == 1). Proof. move/(_ =P <[x]>)=> DgalE Ea. have galEx: x \in 'Gal(E / K) by rewrite DgalE cycle_id. apply: (iffP eqP) => [normEa1 | [b [Eb nzb] ->]]; last first. by rewrite galNormM galNormV galNorm_gal // mulfV // galNorm_eq0. have [x1 | ntx] := eqVneq x 1%g. exists 1; first by rewrite mem1v oner_neq0. by rewrite -{1}normEa1 /galNorm DgalE x1 cycle1 big_set1 !gal_id divr1. pose c_ y := \prod_(i < invm (injm_Zpm x) y) (x ^+ i)%g a. have nz_c1: c_ 1%g != 0 by rewrite /c_ morph1 big_ord0 oner_neq0. have [d] := @gal_independent_contra _ (mem 'Gal(E / K)) _ _ (group1 _) nz_c1. set b := \sum_(y in _) _ => Ed nz_b; exists b. split=> //; apply: rpred_sum => y galEy. by apply: rpredM; first apply: rpred_prod => i _; apply: memv_gal. apply: canRL (mulfK _) _; first by rewrite fmorph_eq0. rewrite rmorph_sum mulr_sumr [b](reindex_acts 'R _ galEx) ?astabsR //=. apply: eq_bigr => y galEy; rewrite galM // rmorphM mulrA; congr (_ * _). have /morphimP[/= i _ _ ->] /=: y \in Zpm @* Zp #[x] by rewrite im_Zpm -DgalE. have <-: Zpm (i + 1) = (Zpm i * x)%g by rewrite morphM ?mem_Zp ?order_gt1. rewrite /c_ !invmE ?mem_Zp ?order_gt1 //= addn1; set n := _.+2. transitivity (\prod_(j < i.+1) (x ^+ j)%g a). rewrite big_ord_recl gal_id rmorph_prod; congr (_ * _). by apply: eq_bigr => j _; rewrite expgSr galM ?lfunE. have [/modn_small->//||->] := ltngtP i.+1 n; first by rewrite ltnNge ltn_ord. rewrite modnn big_ord0; apply: etrans normEa1; rewrite /galNorm DgalE -im_Zpm. rewrite morphimEdom big_imset /=; last exact/injmP/injm_Zpm. by apply: eq_bigl => j /=; rewrite mem_Zp ?order_gt1. Qed. Section Matrix. Variable (E : {subfield L}) (A : {set gal_of E}). Let K := fixedField A. Lemma gal_matrix : {w : #|A|.-tuple L | {subset w <= E} /\ 0 \notin w & [/\ \matrix_(i, j < #|A|) enum_val i (tnth w j) \in unitmx, directv (\sum_i K * <[tnth w i]>) & group_set A -> (\sum_i K * <[tnth w i]>)%VS = E] }. Proof. pose nzE (w : #|A|.-tuple L) := {subset w <= E} /\ 0 \notin w. pose M w := \matrix_(i, j < #|A|) nth 1%g (enum A) i (tnth w j). have [w [Ew nzw] uM]: {w : #|A|.-tuple L | nzE w & M w \in unitmx}. rewrite {}/nzE {}/M cardE; have: uniq (enum A) := enum_uniq _. elim: (enum A) => [|x s IHs] Uxs. by exists [tuple]; rewrite // flatmx0 -(flatmx0 1%:M) unitmx1. have [s'x Us]: x \notin s /\ uniq s by apply/andP. have{IHs} [w [Ew nzw] uM] := IHs Us; set M := \matrix_(i, j) _ in uM. pose a := \row_i x (tnth w i) *m invmx M. pose c_ y := oapp (a 0) (-1) (insub (index y s)). have cx_n1 : c_ x = -1 by rewrite /c_ insubN ?index_mem. have nz_cx : c_ x != 0 by rewrite cx_n1 oppr_eq0 oner_neq0. have Px: [pred y in x :: s] x := mem_head x s. have{Px nz_cx} /sig2W[w0 Ew0 nzS] := gal_independent_contra Px nz_cx. exists [tuple of cons w0 w]. split; first by apply/allP; rewrite /= Ew0; apply/allP. rewrite inE negb_or (contraNneq _ nzS) // => <-. by rewrite big1 // => y _; rewrite rmorph0 mulr0. rewrite unitmxE -[\det _]mul1r; set M1 := \matrix_(i, j < 1 + size s) _. have <-: \det (block_mx 1 (- a) 0 1%:M) = 1 by rewrite det_ublock !det1 mulr1. rewrite -det_mulmx -[M1]submxK mulmx_block !mul0mx !mul1mx !add0r !mulNmx. have ->: drsubmx M1 = M by apply/matrixP => i j; rewrite !mxE !(tnth_nth 0). have ->: ursubmx M1 - a *m M = 0. by apply/rowP=> i; rewrite mulmxKV // !mxE !(tnth_nth 0) subrr. rewrite det_lblock unitrM andbC -unitmxE uM unitfE -oppr_eq0. congr (_ != 0): nzS; rewrite [_ - _]mx11_scalar det_scalar !mxE opprB /=. rewrite -big_uniq // big_cons /= cx_n1 mulN1r addrC; congr (_ + _). rewrite (big_nth 1%g) big_mkord; apply: eq_bigr => j _. by rewrite /c_ index_uniq // valK; congr (_ * _); rewrite !mxE. exists w => [//|]; split=> [||gA]. - by congr (_ \in unitmx): uM; apply/matrixP=> i j; rewrite !mxE -enum_val_nth. - apply/directv_sum_independent=> kw_ Kw_kw sum_kw_0 j _. have /fin_all_exists2[k_ Kk_ Dk_] i := memv_cosetP (Kw_kw i isT). pose kv := \col_i k_ i. transitivity (kv j 0 * tnth w j); first by rewrite !mxE. suffices{j}/(canRL (mulKmx uM))->: M w *m kv = 0 by rewrite mulmx0 mxE mul0r. apply/colP=> i; rewrite !mxE; pose Ai := nth 1%g (enum A) i. transitivity (Ai (\sum_j kw_ j)); last by rewrite sum_kw_0 rmorph0. rewrite rmorph_sum; apply: eq_bigr => j _; rewrite !mxE /= -/Ai. rewrite Dk_ mulrC rmorphM /=; congr (_ * _). by have /mem_fixedFieldP[_ -> //] := Kk_ j; rewrite -mem_enum mem_nth -?cardE. pose G := group gA; have G_1 := group1 G; pose iG := enum_rank_in G_1. apply/eqP; rewrite eqEsubv; apply/andP; split. apply/subv_sumP=> i _; apply: subv_trans (asubv _). by rewrite prodvS ?capvSl // -memvE Ew ?mem_tnth. apply/subvP=> w0 Ew0; apply/memv_sumP. pose wv := \col_(i < #|A|) enum_val i w0; pose v := invmx (M w) *m wv. exists (fun i => tnth w i * v i 0) => [i _|]; last first. transitivity (wv (iG 1%g) 0); first by rewrite mxE enum_rankK_in ?gal_id. rewrite -[wv](mulKVmx uM) -/v; rewrite mxE; apply: eq_bigr => i _. by congr (_ * _); rewrite !mxE -enum_val_nth enum_rankK_in ?gal_id. rewrite mulrC memv_mul ?memv_line //; apply/fixedFieldP=> [|x Gx]. rewrite mxE rpred_sum // => j _; rewrite !mxE rpredM //; last exact: memv_gal. have E_M k l: M w k l \in E by rewrite mxE memv_gal // Ew ?mem_tnth. have Edet n (N : 'M_n) (E_N : forall i j, N i j \in E): \det N \in E. by apply: rpred_sum => sigma _; rewrite rpredMsign rpred_prod. rewrite /invmx uM 2!mxE mulrC rpred_div ?Edet //. by rewrite rpredMsign Edet // => k l; rewrite 2!mxE. suffices{i} {2}<-: map_mx x v = v by rewrite [map_mx x v i 0]mxE. have uMx: map_mx x (M w) \in unitmx by rewrite map_unitmx. rewrite map_mxM map_invmx /=; apply: canLR {uMx}(mulKmx uMx) _. apply/colP=> i; rewrite !mxE; pose ix := iG (enum_val i * x)%g. have Dix b: b \in E -> enum_val ix b = x (enum_val i b). by move=> Eb; rewrite enum_rankK_in ?groupM ?enum_valP // galM ?lfunE. transitivity ((M w *m v) ix 0); first by rewrite mulKVmx // mxE Dix. rewrite mxE; apply: eq_bigr => j _; congr (_ * _). by rewrite !mxE -!enum_val_nth Dix // ?Ew ?mem_tnth. Qed. End Matrix. Lemma dim_fixedField E (G : {group gal_of E}) : #|G| = \dim_(fixedField G) E. Proof. have [w [_ nzw] [_ Edirect /(_ (groupP G))defE]] := gal_matrix G. set n := #|G|; set m := \dim (fixedField G); rewrite -defE (directvP Edirect). rewrite -[n]card_ord -(@mulnK #|'I_n| m) ?adim_gt0 //= -sum_nat_const. congr (_ %/ _)%N; apply: eq_bigr => i _. by rewrite dim_cosetv ?(memPn nzw) ?mem_tnth. Qed. Lemma dim_fixed_galois K E (G : {group gal_of E}) : galois K E -> G \subset 'Gal(E / K) -> \dim_K (fixedField G) = #|'Gal(E / K) : G|. Proof. move=> galE sGgal; have [sFE _ _] := and3P galE; apply/eqP. rewrite -divgS // eqn_div ?cardSg // dim_fixedField -galois_dim //. by rewrite mulnC muln_divA ?divnK ?field_dimS ?capvSl -?galois_connection. Qed. Lemma gal_fixedField E (G : {group gal_of E}): 'Gal(E / fixedField G) = G. Proof. apply/esym/eqP; rewrite eqEcard galois_connection_subset /= (dim_fixedField G). rewrite galois_dim //; apply/galois_fixedField/eqP. rewrite eqEsubv galois_connection_subv ?capvSl //. by rewrite fixedFieldS ?galois_connection_subset. Qed. Lemma gal_generated E (A : {set gal_of E}) : 'Gal(E / fixedField A) = <>. Proof. apply/eqP; rewrite eqEsubset gen_subG galois_connection_subset. by rewrite -[<>]gal_fixedField galS // fixedFieldS // subset_gen. Qed. Lemma fixedField_galois E (A : {set gal_of E}): galois (fixedField A) E. Proof. have: galois (fixedField <>) E. by apply/galois_fixedField; rewrite gal_fixedField. by apply: galoisS; rewrite capvSl fixedFieldS // subset_gen. Qed. Section FundamentalTheoremOfGaloisTheory. Variables E K : {subfield L}. Hypothesis galKE : galois K E. Section IntermediateField. Variable M : {subfield L}. Hypothesis (sKME : (K <= M <= E)%VS) (nKM : normalField K M). Lemma normalField_galois : galois K M. Proof. have [[sKM sME] [_ sepKE nKE]] := (andP sKME, and3P galKE). by rewrite /galois sKM (separableSr sME). Qed. Definition normalField_cast (x : gal_of E) : gal_of M := gal M x. Lemma normalField_cast_eq x : x \in 'Gal(E / K) -> {in M, normalField_cast x =1 x}. Proof. have [sKM sME] := andP sKME; have sKE := subv_trans sKM sME. rewrite gal_kAut // => /(normalField_kAut sKME nKM). by rewrite kAutE => /andP[_ /galK]. Qed. Lemma normalField_castM : {in 'Gal(E / K) &, {morph normalField_cast : x y / (x * y)%g}}. Proof. move=> x y galEx galEy /=; apply/eqP/gal_eqP => a Ma. have Ea: a \in E by have [_ /subvP->] := andP sKME. rewrite normalField_cast_eq ?groupM ?galM //=. by rewrite normalField_cast_eq ?memv_gal // normalField_cast_eq. Qed. Canonical normalField_cast_morphism := Morphism normalField_castM. Lemma normalField_ker : 'ker normalField_cast = 'Gal(E / M). Proof. have [sKM sME] := andP sKME. apply/setP=> x; apply/idP/idP=> [kerMx | galEMx]. rewrite gal_kHom //; apply/kAHomP=> a Ma. by rewrite -normalField_cast_eq ?(dom_ker kerMx) // (mker kerMx) gal_id. have galEM: x \in 'Gal(E / K) := subsetP (galS E sKM) x galEMx. apply/kerP=> //; apply/eqP/gal_eqP=> a Ma. by rewrite normalField_cast_eq // gal_id (fixed_gal sME). Qed. Lemma normalField_normal : 'Gal(E / M) <| 'Gal(E / K). Proof. by rewrite -normalField_ker ker_normal. Qed. Lemma normalField_img : normalField_cast @* 'Gal(E / K) = 'Gal(M / K). Proof. have [[sKM sME] [sKE _ nKE]] := (andP sKME, and3P galKE). apply/setP=> x; apply/idP/idP=> [/morphimP[{}x galEx _ ->] | galMx]. rewrite gal_kHom //; apply/kAHomP=> a Ka; have Ma := subvP sKM a Ka. by rewrite normalField_cast_eq // (fixed_gal sKE). have /(kHom_to_gal sKME nKE)[y galEy eq_xy]: kHom K M x by rewrite -gal_kHom. apply/morphimP; exists y => //; apply/eqP/gal_eqP => a Ha. by rewrite normalField_cast_eq // eq_xy. Qed. Lemma normalField_isom : {f : {morphism ('Gal(E / K) / 'Gal(E / M)) >-> gal_of M} | isom ('Gal(E / K) / 'Gal (E / M)) 'Gal(M / K) f & (forall A, f @* (A / 'Gal(E / M)) = normalField_cast @* A) /\ {in 'Gal(E / K) & M, forall x, f (coset 'Gal (E / M) x) =1 x} }%g. Proof. have:= first_isom normalField_cast_morphism; rewrite normalField_ker. case=> f injf Df; exists f; first by apply/isomP; rewrite Df normalField_img. split=> [//|x a galEx /normalField_cast_eq<- //]; congr ((_ : gal_of M) a). apply: set1_inj; rewrite -!morphim_set1 ?mem_quotient ?Df //. by rewrite (subsetP (normal_norm normalField_normal)). Qed. Lemma normalField_isog : 'Gal(E / K) / 'Gal(E / M) \isog 'Gal(M / K). Proof. by rewrite -normalField_ker -normalField_img first_isog. Qed. End IntermediateField. Section IntermediateGroup. Variable G : {group gal_of E}. Hypothesis nsGgalE : G <| 'Gal(E / K). Lemma normal_fixedField_galois : galois K (fixedField G). Proof. have [[sKE sepKE nKE] [sGgal nGgal]] := (and3P galKE, andP nsGgalE). rewrite /galois -(galois_connection _ sKE) sGgal. rewrite (separableSr _ sepKE) ?capvSl //; apply/forall_inP=> f autKf. rewrite eqEdim limg_dim_eq ?(eqP (AEnd_lker0 _)) ?capv0 // leqnn andbT. apply/subvP => _ /memv_imgP[a /mem_fixedFieldP[Ea cGa] ->]. have /kAut_to_gal[x galEx -> //]: kAut K E f. rewrite /kAut (forall_inP nKE) // andbT; apply/kAHomP. by move: autKf; rewrite inE kAutfE => /kHomP[]. apply/fixedFieldP=> [|y Gy]; first exact: memv_gal. by rewrite -galM // conjgCV galM //= cGa // memJ_norm ?groupV ?(subsetP nGgal). Qed. End IntermediateGroup. End FundamentalTheoremOfGaloisTheory. End GaloisTheory. Prenex Implicits gal_repr gal gal_reprK. Arguments gal_repr_inj {F L V} [x1 x2]. Notation "''Gal' ( V / U )" := (galoisG V U) : group_scope. Notation "''Gal' ( V / U )" := (galoisG_group V U) : Group_scope. Arguments fixedFieldP {F L E A a}. Arguments normalFieldP {F L K E}. Arguments splitting_galoisField {F L K E}. Arguments galois_fixedField {F L K E}. math-comp-mathcomp-1.12.0/mathcomp/field/separable.v000066400000000000000000001273571375767750300223510ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype tuple finfun bigop finset prime. From mathcomp Require Import binomial ssralg poly polydiv fingroup perm. From mathcomp Require Import morphism quotient gproduct finalg zmodp cyclic. From mathcomp Require Import matrix mxalgebra mxpoly polyXY vector falgebra. From mathcomp Require Import fieldext. (******************************************************************************) (* This file provides a theory of separable and inseparable field extensions. *) (* *) (* separable_poly p <=> p has no multiple roots in any field extension. *) (* separable_element K x <=> the minimal polynomial of x over K is separable. *) (* separable K E <=> every member of E is separable over K. *) (* separable_generator K E == some x \in E that generates the largest *) (* subfield K[x] that is separable over K. *) (* purely_inseparable_element K x <=> there is a [char L].-nat n such that *) (* x ^+ n \in K. *) (* purely_inseparable K E <=> every member of E is purely inseparable over K. *) (* *) (* Derivations are introduced to prove the adjoin_separableP Lemma: *) (* Derivation K D <=> the linear operator D satifies the Leibniz *) (* product rule inside K. *) (* extendDerivation x D K == given a derivation D on K and a separable *) (* element x over K, this function returns the *) (* unique extension of D to K(x). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GRing.Theory. Section SeparablePoly. Variable R : idomainType. Implicit Types p q d u v : {poly R}. Definition separable_poly p := coprimep p p^`(). Local Notation separable := separable_poly. Local Notation lcn_neq0 := (Pdiv.Idomain.lc_expn_scalp_neq0 _). Lemma separable_poly_neq0 p : separable p -> p != 0. Proof. by apply: contraTneq => ->; rewrite /separable deriv0 coprime0p eqp01. Qed. Lemma poly_square_freeP p : (forall u v, u * v %| p -> coprimep u v) <-> (forall u, size u != 1%N -> ~~ (u ^+ 2 %| p)). Proof. split=> [sq'p u | sq'p u v dvd_uv_p]. by apply: contra => /sq'p; rewrite coprimepp. rewrite coprimep_def (contraLR (sq'p _)) // (dvdp_trans _ dvd_uv_p) //. by rewrite dvdp_mul ?dvdp_gcdl ?dvdp_gcdr. Qed. Lemma separable_polyP {p} : reflect [/\ forall u v, u * v %| p -> coprimep u v & forall u, u %| p -> 1 < size u -> u^`() != 0] (separable p). Proof. apply: (iffP idP) => [sep_p | [sq'p nz_der1p]]. split=> [u v | u u_dv_p]; last first. apply: contraTneq => u'0; rewrite -leqNgt -(eqnP sep_p). rewrite dvdp_leq -?size_poly_eq0 ?(eqnP sep_p) // dvdp_gcd u_dv_p. have /dvdpZr <-: lead_coef u ^+ scalp p u != 0 by rewrite lcn_neq0. by rewrite -derivZ -Pdiv.Idomain.divpK //= derivM u'0 mulr0 addr0 dvdp_mull. rewrite Pdiv.Idomain.dvdp_eq mulrCA mulrA; set c := _ ^+ _ => /eqP Dcp. have nz_c: c != 0 by rewrite lcn_neq0. move: sep_p; rewrite coprimep_sym -[separable _](coprimepZl _ _ nz_c). rewrite -(coprimepZr _ _ nz_c) -derivZ Dcp derivM coprimepMl. by rewrite coprimep_addl_mul !coprimepMr -andbA => /and4P[]. rewrite /separable coprimep_def eqn_leq size_poly_gt0; set g := gcdp _ _. have nz_g: g != 0. rewrite -dvd0p dvdp_gcd -(mulr0 0); apply/nandP; left. by have /poly_square_freeP-> := sq'p; rewrite ?size_poly0. have [g_p]: g %| p /\ g %| p^`() by rewrite dvdp_gcdr ?dvdp_gcdl. pose c := lead_coef g ^+ scalp p g; have nz_c: c != 0 by rewrite lcn_neq0. have Dcp: c *: p = p %/ g * g by rewrite Pdiv.Idomain.divpK. rewrite nz_g andbT leqNgt -(dvdpZr _ _ nz_c) -derivZ Dcp derivM. rewrite dvdp_addr; last by rewrite dvdp_mull. rewrite Gauss_dvdpr; last by rewrite sq'p // mulrC -Dcp dvdpZl. by apply: contraL => /nz_der1p nz_g'; rewrite gtNdvdp ?nz_g' ?lt_size_deriv. Qed. Lemma separable_coprime p u v : separable p -> u * v %| p -> coprimep u v. Proof. by move=> /separable_polyP[sq'p _] /sq'p. Qed. Lemma separable_nosquare p u k : separable p -> 1 < k -> size u != 1%N -> (u ^+ k %| p) = false. Proof. move=> /separable_polyP[/poly_square_freeP sq'p _] /subnKC <- /sq'p. by apply: contraNF; apply: dvdp_trans; rewrite exprD dvdp_mulr. Qed. Lemma separable_deriv_eq0 p u : separable p -> u %| p -> 1 < size u -> (u^`() == 0) = false. Proof. by move=> /separable_polyP[_ nz_der1p] u_p /nz_der1p/negPf->. Qed. Lemma dvdp_separable p q : q %| p -> separable p -> separable q. Proof. move=> /(dvdp_trans _)q_dv_p /separable_polyP[sq'p nz_der1p]. by apply/separable_polyP; split=> [u v /q_dv_p/sq'p | u /q_dv_p/nz_der1p]. Qed. Lemma separable_mul p q : separable (p * q) = [&& separable p, separable q & coprimep p q]. Proof. apply/idP/and3P => [sep_pq | [sep_p seq_q co_pq]]. rewrite !(dvdp_separable _ sep_pq) ?dvdp_mulIr ?dvdp_mulIl //. by rewrite (separable_coprime sep_pq). rewrite /separable derivM coprimepMl {1}addrC mulrC !coprimep_addl_mul. by rewrite !coprimepMr (coprimep_sym q p) co_pq !andbT; apply/andP. Qed. Lemma eqp_separable p q : p %= q -> separable p = separable q. Proof. by case/andP=> p_q q_p; apply/idP/idP=> /dvdp_separable->. Qed. Lemma separable_root p x : separable (p * ('X - x%:P)) = separable p && ~~ root p x. Proof. rewrite separable_mul; apply: andb_id2l => seq_p. by rewrite /separable derivXsubC coprimep1 coprimep_XsubC. Qed. Lemma separable_prod_XsubC (r : seq R) : separable (\prod_(x <- r) ('X - x%:P)) = uniq r. Proof. elim: r => [|x r IH]; first by rewrite big_nil /separable_poly coprime1p. by rewrite big_cons mulrC separable_root IH root_prod_XsubC andbC. Qed. Lemma make_separable p : p != 0 -> separable (p %/ gcdp p p^`()). Proof. set g := gcdp p p^`() => nz_p; apply/separable_polyP. have max_dvd_u (u : {poly R}): 1 < size u -> exists k, ~~ (u ^+ k %| p). move=> u_gt1; exists (size p); rewrite gtNdvdp // polySpred //. by rewrite -(ltn_subRL 1) subn1 size_exp leq_pmull // -(subnKC u_gt1). split=> [|u u_pg u_gt1]; last first. apply/eqP=> u'0 /=; have [k /negP[]] := max_dvd_u u u_gt1. elim: k => [|k IHk]; first by rewrite dvd1p. suffices: u ^+ k.+1 %| (p %/ g) * g. by rewrite Pdiv.Idomain.divpK ?dvdp_gcdl // dvdpZr ?lcn_neq0. rewrite exprS dvdp_mul // dvdp_gcd IHk //=. suffices: u ^+ k %| (p %/ u ^+ k * u ^+ k)^`(). by rewrite Pdiv.Idomain.divpK // derivZ dvdpZr ?lcn_neq0. by rewrite !derivCE u'0 mul0r mul0rn mulr0 addr0 dvdp_mull. have pg_dv_p: p %/ g %| p by rewrite divp_dvd ?dvdp_gcdl. apply/poly_square_freeP=> u; rewrite neq_ltn ltnS leqn0 size_poly_eq0. case/predU1P=> [-> | /max_dvd_u[k]]. by apply: contra nz_p; rewrite expr0n -dvd0p => /dvdp_trans->. apply: contra => u2_dv_pg; case: k; [by rewrite dvd1p | elim=> [|n IHn]]. exact: dvdp_trans (dvdp_mulr _ _) (dvdp_trans u2_dv_pg pg_dv_p). suff: u ^+ n.+2 %| (p %/ g) * g. by rewrite Pdiv.Idomain.divpK ?dvdp_gcdl // dvdpZr ?lcn_neq0. rewrite -add2n exprD dvdp_mul // dvdp_gcd. rewrite (dvdp_trans _ IHn) ?exprS ?dvdp_mull //=. suff: u ^+ n %| ((p %/ u ^+ n.+1) * u ^+ n.+1)^`(). by rewrite Pdiv.Idomain.divpK // derivZ dvdpZr ?lcn_neq0. by rewrite !derivCE dvdp_add // -1?mulr_natl ?exprS !dvdp_mull. Qed. End SeparablePoly. Arguments separable_polyP {R p}. Lemma separable_map (F : fieldType) (R : idomainType) (f : {rmorphism F -> R}) (p : {poly F}) : separable_poly (map_poly f p) = separable_poly p. Proof. by rewrite /separable_poly deriv_map /coprimep -gcdp_map size_map_poly. Qed. Section InfinitePrimitiveElementTheorem. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Variables (F L : fieldType) (iota : {rmorphism F -> L}). Variables (x y : L) (p : {poly F}). Hypotheses (nz_p : p != 0) (px_0 : root (p ^ iota) x). Let inFz z w := exists q, (q ^ iota).[z] = w. Lemma large_field_PET q : root (q ^ iota) y -> separable_poly q -> exists2 r, r != 0 & forall t (z := iota t * y - x), ~~ root r (iota t) -> inFz z x /\ inFz z y. Proof. move=> qy_0 sep_q; have nz_q := separable_poly_neq0 sep_q. have /factor_theorem[q0 Dq] := qy_0. set p1 := p ^ iota \Po ('X + x%:P); set q1 := q0 \Po ('X + y%:P). have nz_p1: p1 != 0. apply: contraNneq nz_p => /(canRL (fun r => comp_polyXaddC_K r _))/eqP. by rewrite comp_poly0 map_poly_eq0. have{sep_q} nz_q10: q1.[0] != 0. move: sep_q; rewrite -(separable_map iota) Dq separable_root => /andP[_]. by rewrite horner_comp !hornerE. have nz_q1: q1 != 0 by apply: contraNneq nz_q10 => ->; rewrite horner0. pose p2 := p1 ^ polyC \Po ('X * 'Y); pose q2 := q1 ^ polyC. have /Bezout_coprimepP[[u v]]: coprimep p2 q2. rewrite coprimep_def eqn_leq leqNgt andbC size_poly_gt0 gcdp_eq0 poly_XmY_eq0. by rewrite map_polyC_eq0 (negPf nz_p1) -resultant_eq0 div_annihilant_neq0. rewrite -size_poly_eq1 => /size_poly1P[r nzr Dr]; exists r => {nzr}// t z nz_rt. have [r1 nz_r1 r1z_0]: algebraicOver iota z. apply/algebraic_sub; last by exists p. by apply: algebraic_mul; [apply: algebraic_id | exists q]. pose Fz := subFExtend iota z r1; pose kappa : Fz -> L := subfx_inj. pose kappa' := inj_subfx iota z r1. have /eq_map_poly Diota: kappa \o kappa' =1 iota. by move=> w; rewrite /kappa /= subfx_inj_eval // map_polyC hornerC. suffices [y3]: exists y3, y = kappa y3. have [q3 ->] := subfxE y3; rewrite /kappa subfx_inj_eval // => Dy. split; [exists (t *: q3 - 'X) | by exists q3]. by rewrite rmorphB linearZ /= map_polyX !hornerE -Dy opprB addrC addrNK. pose p0 := p ^ iota \Po (iota t *: 'X - z%:P). have co_p0_q0: coprimep p0 q0. pose at_t := horner_eval (iota t); have at_t0: at_t 0 = 0 by apply: rmorph0. have /map_polyK polyCK: cancel polyC at_t by move=> w; apply: hornerC. have ->: p0 = p2 ^ at_t \Po ('X - y%:P). rewrite map_comp_poly polyCK // rmorphM /= map_polyC map_polyX /=. rewrite horner_evalE hornerX. rewrite -!comp_polyA comp_polyM comp_polyD !comp_polyC !comp_polyX. by rewrite mulrC mulrBr mul_polyC addrAC -addrA -opprB -rmorphM -rmorphB. have ->: q0 = q2 ^ at_t \Po ('X - y%:P) by rewrite polyCK ?comp_polyXaddC_K. apply/coprimep_comp_poly/Bezout_coprimepP; exists (u ^ at_t, v ^ at_t). by rewrite -!rmorphM -rmorphD Dr /= map_polyC polyC_eqp1. have{co_p0_q0}: gcdp p0 (q ^ iota) %= 'X - y%:P. rewrite /eqp Dq (eqp_dvdl _ (Gauss_gcdpr _ _)) // dvdp_gcdr dvdp_gcd. rewrite dvdp_mull // -root_factor_theorem rootE horner_comp !hornerE. by rewrite opprB addrC subrK. have{p0} [p3 ->]: exists p3, p0 = p3 ^ kappa. exists (p ^ kappa' \Po (kappa' t *: 'X - (subfx_eval iota z r1 'X)%:P)). rewrite map_comp_poly rmorphB linearZ /= map_polyC map_polyX /=. rewrite !subfx_inj_eval // map_polyC hornerC map_polyX hornerX. by rewrite -map_poly_comp Diota. rewrite -Diota map_poly_comp -gcdp_map /= -/kappa. move: (gcdp _ _) => r3 /eqpf_eq[c nz_c Dr3]. exists (- (r3`_0 / r3`_1)); rewrite [kappa _]rmorphN fmorph_div -!coef_map Dr3. by rewrite !coefZ polyseqXsubC mulr1 mulrC mulKf ?opprK. Qed. Lemma char0_PET (q : {poly F}) : q != 0 -> root (q ^ iota) y -> [char F] =i pred0 -> exists n, let z := y *+ n - x in inFz z x /\ inFz z y. Proof. move=> nz_q qy_0 /charf0P charF0. without loss{nz_q} sep_q: q qy_0 / separable_poly q. move=> IHq; apply: IHq (make_separable nz_q). have /dvdpP[q1 Dq] := dvdp_gcdl q q^`(). rewrite {1}Dq mulpK ?gcdp_eq0; last by apply/nandP; left. have [n [r nz_ry Dr]] := multiplicity_XsubC (q ^ iota) y. rewrite map_poly_eq0 nz_q /= in nz_ry. case: n => [|n] in Dr; first by rewrite Dr mulr1 (negPf nz_ry) in qy_0. have: ('X - y%:P) ^+ n.+1 %| q ^ iota by rewrite Dr dvdp_mulIr. rewrite Dq rmorphM /= gcdp_map -(eqp_dvdr _ (gcdp_mul2l _ _ _)) -deriv_map Dr. rewrite dvdp_gcd derivM deriv_exp derivXsubC mul1r !mulrA dvdp_mulIr /=. rewrite mulrDr mulrA dvdp_addr ?dvdp_mulIr // exprS -scaler_nat -!scalerAr. rewrite dvdpZr -?(rmorph_nat iota) ?fmorph_eq0 ?charF0 //. rewrite mulrA dvdp_mul2r ?expf_neq0 ?polyXsubC_eq0 //. by rewrite Gauss_dvdpl ?dvdp_XsubCl // coprimep_sym coprimep_XsubC. have [r nz_r PETxy] := large_field_PET qy_0 sep_q. pose ts := mkseq (fun n => iota n%:R) (size r). have /(max_ring_poly_roots nz_r)/=/implyP: uniq_roots ts. rewrite uniq_rootsE mkseq_uniq // => m n eq_mn; apply/eqP; rewrite eqn_leq. wlog suffices: m n eq_mn / m <= n by move=> IHmn; rewrite !IHmn. move/fmorph_inj/eqP: eq_mn; rewrite -subr_eq0 leqNgt; apply: contraL => lt_mn. by rewrite -natrB ?(ltnW lt_mn) // charF0 -lt0n subn_gt0. rewrite size_mkseq ltnn implybF all_map => /allPn[n _ /= /PETxy]. by rewrite rmorph_nat mulr_natl; exists n. Qed. End InfinitePrimitiveElementTheorem. Section Separable. Variables (F : fieldType) (L : fieldExtType F). Implicit Types (U V W : {vspace L}) (E K M : {subfield L}) (D : 'End(L)). Section Derivation. Variables (K : {vspace L}) (D : 'End(L)). (* A deriviation only needs to be additive and satify Lebniz's law, but all *) (* the deriviations used here are going to be linear, so we only define *) (* the Derivation predicate for linear endomorphisms. *) Definition Derivation : bool := all2rel (fun u v => D (u * v) == D u * v + u * D v) (vbasis K). Hypothesis derD : Derivation. Lemma Derivation_mul : {in K &, forall u v, D (u * v) = D u * v + u * D v}. Proof. move=> u v /coord_vbasis-> /coord_vbasis->. rewrite !(mulr_sumr, linear_sum) -big_split; apply: eq_bigr => /= j _. rewrite !mulr_suml linear_sum -big_split; apply: eq_bigr => /= i _. rewrite !(=^~ scalerAl, linearZZ) -!scalerAr linearZZ -!scalerDr !scalerA /=. by congr (_ *: _); apply/eqP/(allrelP derD); exact: memt_nth. Qed. Lemma Derivation_mul_poly (Dp := map_poly D) : {in polyOver K &, forall p q, Dp (p * q) = Dp p * q + p * Dp q}. Proof. move=> p q Kp Kq; apply/polyP=> i; rewrite {}/Dp coefD coef_map /= !coefM. rewrite linear_sum -big_split; apply: eq_bigr => /= j _. by rewrite !{1}coef_map Derivation_mul ?(polyOverP _). Qed. End Derivation. Lemma DerivationS E K D : (K <= E)%VS -> Derivation E D -> Derivation K D. Proof. move/subvP=> sKE derD; apply/allrelP=> x y Kx Ky; apply/eqP. by rewrite (Derivation_mul derD) ?sKE // vbasis_mem. Qed. Section DerivationAlgebra. Variables (E : {subfield L}) (D : 'End(L)). Hypothesis derD : Derivation E D. Lemma Derivation1 : D 1 = 0. Proof. apply: (addIr (D (1 * 1))); rewrite add0r {1}mul1r. by rewrite (Derivation_mul derD) ?mem1v // mulr1 mul1r. Qed. Lemma Derivation_scalar x : x \in 1%VS -> D x = 0. Proof. by case/vlineP=> y ->; rewrite linearZ /= Derivation1 scaler0. Qed. Lemma Derivation_exp x m : x \in E -> D (x ^+ m) = x ^+ m.-1 *+ m * D x. Proof. move=> Ex; case: m; first by rewrite expr0 mulr0n mul0r Derivation1. elim=> [|m IHm]; first by rewrite mul1r. rewrite exprS (Derivation_mul derD) //; last by apply: rpredX. by rewrite mulrC IHm mulrA mulrnAr -exprS -mulrDl. Qed. Lemma Derivation_horner p x : p \is a polyOver E -> x \in E -> D p.[x] = (map_poly D p).[x] + p^`().[x] * D x. Proof. move=> Ep Ex; elim/poly_ind: p Ep => [|p c IHp] /polyOverP EpXc. by rewrite !(raddf0, horner0) mul0r add0r. have Ep: p \is a polyOver E. by apply/polyOverP=> i; have:= EpXc i.+1; rewrite coefD coefMX coefC addr0. have->: map_poly D (p * 'X + c%:P) = map_poly D p * 'X + (D c)%:P. apply/polyP=> i; rewrite !(coefD, coefMX, coef_map) /= linearD /= !coefC. by rewrite !(fun_if D) linear0. rewrite derivMXaddC !hornerE mulrDl mulrAC addrAC linearD /=; congr (_ + _). by rewrite addrCA -mulrDl -IHp // addrC (Derivation_mul derD) ?rpred_horner. Qed. End DerivationAlgebra. Definition separable_element U x := separable_poly (minPoly U x). Section SeparableElement. Variables (K : {subfield L}) (x : L). (* begin hide *) Let sKxK : (K <= <>)%VS := subv_adjoin K x. Let Kx_x : x \in <>%VS := memv_adjoin K x. (* end hide *) Lemma separable_elementP : reflect (exists f, [/\ f \is a polyOver K, root f x & separable_poly f]) (separable_element K x). Proof. apply: (iffP idP) => [sep_x | [f [Kf /(minPoly_dvdp Kf)/dvdpP[g ->]]]]. by exists (minPoly K x); rewrite minPolyOver root_minPoly. by rewrite separable_mul => /and3P[]. Qed. Lemma base_separable : x \in K -> separable_element K x. Proof. move=> Kx; apply/separable_elementP; exists ('X - x%:P). by rewrite polyOverXsubC root_XsubC /separable_poly !derivCE coprimep1. Qed. Lemma separable_nz_der : separable_element K x = ((minPoly K x)^`() != 0). Proof. rewrite /separable_element /separable_poly. apply/idP/idP=> [|nzPx']. by apply: contraTneq => ->; rewrite coprimep0 -size_poly_eq1 size_minPoly. have gcdK : gcdp (minPoly K x) (minPoly K x)^`() \in polyOver K. by rewrite gcdp_polyOver ?polyOver_deriv // minPolyOver. rewrite -gcdp_eqp1 -size_poly_eq1 -dvdp1. have /orP[/andP[_]|/andP[]//] := minPoly_irr gcdK (dvdp_gcdl _ _). rewrite dvdp_gcd dvdpp /= => /(dvdp_leq nzPx')/leq_trans/(_ (size_poly _ _)). by rewrite size_minPoly ltnn. Qed. Lemma separablePn : reflect (exists2 p, p \in [char L] & exists2 g, g \is a polyOver K & minPoly K x = g \Po 'X^p) (~~ separable_element K x). Proof. rewrite separable_nz_der negbK; set f := minPoly K x. apply: (iffP eqP) => [f'0 | [p Hp [g _ ->]]]; last first. by rewrite deriv_comp derivXn -scaler_nat (charf0 Hp) scale0r mulr0. pose n := adjoin_degree K x; have sz_f: size f = n.+1 := size_minPoly K x. have fn1: f`_n = 1 by rewrite -(monicP (monic_minPoly K x)) lead_coefE sz_f. have dimKx: (adjoin_degree K x)%:R == 0 :> L. by rewrite -(coef0 _ n.-1) -f'0 coef_deriv fn1. have /natf0_char[// | p charLp] := dimKx. have /dvdnP[r Dn]: (p %| n)%N by rewrite (dvdn_charf charLp). exists p => //; exists (\poly_(i < r.+1) f`_(i * p)). by apply: polyOver_poly => i _; rewrite (polyOverP _) ?minPolyOver. rewrite comp_polyE size_poly_eq -?Dn ?fn1 ?oner_eq0 //. have pr_p := charf_prime charLp; have p_gt0 := prime_gt0 pr_p. apply/polyP=> i; rewrite coef_sum. have [[{}i ->] | p'i] := altP (@dvdnP p i); last first. rewrite big1 => [|j _]; last first. rewrite coefZ -exprM coefXn [_ == _](contraNF _ p'i) ?mulr0 // => /eqP->. by rewrite dvdn_mulr. rewrite (dvdn_charf charLp) in p'i; apply: mulfI p'i _ _ _. by rewrite mulr0 mulr_natl; case: i => // i; rewrite -coef_deriv f'0 coef0. have [ltri | leir] := leqP r.+1 i. rewrite nth_default ?sz_f ?Dn ?ltn_pmul2r ?big1 // => j _. rewrite coefZ -exprM coefXn mulnC gtn_eqF ?mulr0 //. by rewrite ltn_pmul2l ?(leq_trans _ ltri). rewrite (bigD1 (Sub i _)) //= big1 ?addr0 => [|j i'j]; last first. by rewrite coefZ -exprM coefXn mulnC eqn_pmul2l // mulr_natr mulrb ifN_eqC. by rewrite coef_poly leir coefZ -exprM coefXn mulnC eqxx mulr1. Qed. Lemma separable_root_der : separable_element K x (+) root (minPoly K x)^`() x. Proof. have KpKx': _^`() \is a polyOver K := polyOver_deriv (minPolyOver K x). rewrite separable_nz_der addNb (root_small_adjoin_poly KpKx') ?addbb //. by rewrite (leq_trans (size_poly _ _)) ?size_minPoly. Qed. Lemma Derivation_separable D : Derivation <> D -> separable_element K x -> D x = - (map_poly D (minPoly K x)).[x] / (minPoly K x)^`().[x]. Proof. move=> derD sepKx; have:= separable_root_der; rewrite {}sepKx -sub0r => nzKx'x. apply: canRL (mulfK nzKx'x) (canRL (addrK _) _); rewrite mulrC addrC. rewrite -(Derivation_horner derD) ?minPolyxx ?linear0 //. exact: polyOverSv sKxK _ (minPolyOver _ _). Qed. Section ExtendDerivation. Variable D : 'End(L). Let Dx E := - (map_poly D (minPoly E x)).[x] / ((minPoly E x)^`()).[x]. Fact extendDerivation_subproof E (adjEx := Fadjoin_poly E x) : let body y (p := adjEx y) := (map_poly D p).[x] + p^`().[x] * Dx E in linear body. Proof. move: Dx => C /= a u v. rewrite /adjEx linearP /= -mul_polyC derivD derivM derivC mul0r add0r -/adjEx. rewrite !hornerE /= -scalerAl mul1r raddfD /=. have ->: map_poly D (a%:A%:P * adjEx u) = a%:A%:P * map_poly D (adjEx u). apply/polyP=> i; rewrite !mul_polyC !coef_map !coefZ !mulr_algl /= linearZ. by rewrite coef_map. rewrite !hornerE !mulr_algl mulrDl scalerDr -scalerAl -!addrA; congr (_ + _). by rewrite addrCA. Qed. Definition extendDerivation E : 'End(L) := linfun (Linear (extendDerivation_subproof E)). Hypothesis derD : Derivation K D. Lemma extendDerivation_id y : y \in K -> extendDerivation K y = D y. Proof. move=> yK; rewrite lfunE /= Fadjoin_polyC // derivC map_polyC hornerC. by rewrite horner0 mul0r addr0. Qed. Lemma extendDerivation_horner p : p \is a polyOver K -> separable_element K x -> extendDerivation K p.[x] = (map_poly D p).[x] + p^`().[x] * Dx K. Proof. move=> Kp sepKx; have:= separable_root_der; rewrite {}sepKx /= => nz_pKx'x. rewrite [in RHS](divp_eq p (minPoly K x)) lfunE /= Fadjoin_poly_mod ?raddfD //=. rewrite (Derivation_mul_poly derD) ?divp_polyOver ?minPolyOver //. rewrite derivM !{1}hornerD !{1}hornerM minPolyxx !{1}mulr0 !{1}add0r. rewrite mulrDl addrA [_ + (_ * _ * _)]addrC {2}/Dx -mulrA -/Dx. by rewrite [_ / _]mulrC (mulVKf nz_pKx'x) mulrN addKr. Qed. Lemma extendDerivationP : separable_element K x -> Derivation <> (extendDerivation K). Proof. move=> sep; apply/allrelP=> u v /vbasis_mem Hu /vbasis_mem Hv; apply/eqP. rewrite -(Fadjoin_poly_eq Hu) -(Fadjoin_poly_eq Hv) -hornerM. rewrite !{1}extendDerivation_horner ?{1}rpredM ?Fadjoin_polyOver //. rewrite (Derivation_mul_poly derD) ?Fadjoin_polyOver //. rewrite derivM !{1}hornerD !{1}hornerM !{1}mulrDl !{1}mulrDr -!addrA. congr (_ + _); rewrite [Dx K]lock -!{1}mulrA !{1}addrA; congr (_ + _). by rewrite addrC; congr (_ * _ + _); rewrite mulrC. Qed. End ExtendDerivation. (* Reference: http://www.math.uconn.edu/~kconrad/blurbs/galoistheory/separable2.pdf *) Lemma Derivation_separableP : reflect (forall D, Derivation <> D -> K <= lker D -> <> <= lker D)%VS (separable_element K x). Proof. apply: (iffP idP) => [sepKx D derD /subvP DK_0 | derKx_0]. have{} DK_0 q: q \is a polyOver K -> map_poly D q = 0. move=> /polyOverP Kq; apply/polyP=> i; apply/eqP. by rewrite coef0 coef_map -memv_ker DK_0. apply/subvP=> _ /Fadjoin_polyP[p Kp ->]; rewrite memv_ker. rewrite (Derivation_horner derD) ?(polyOverSv sKxK) //. rewrite (Derivation_separable derD sepKx) !DK_0 ?minPolyOver //. by rewrite horner0 oppr0 mul0r mulr0 addr0. apply: wlog_neg; rewrite {1}separable_nz_der negbK => /eqP pKx'_0. have Dlin: linear (fun y => (Fadjoin_poly K x y)^`().[x]). move=> a u v; rewrite linearP /= -mul_polyC derivD derivM derivC mul0r add0r. by rewrite hornerD hornerM hornerC -scalerAl mul1r. pose D := linfun (Linear Dlin); apply: base_separable. have DK_0: (K <= lker D)%VS. apply/subvP=> v Kv; rewrite memv_ker lfunE /= Fadjoin_polyC //. by rewrite derivC horner0. have Dder: Derivation <> D. apply/allrelP=> u v /vbasis_mem Kx_u /vbasis_mem Kx_v; apply/eqP. rewrite !lfunE /=; set Px := Fadjoin_poly K x. set Px_u := Px u; rewrite -(Fadjoin_poly_eq Kx_u) -/Px -/Px_u. set Px_v := Px v; rewrite -(Fadjoin_poly_eq Kx_v) -/Px -/Px_v. rewrite -!hornerM -hornerD -derivM. rewrite /Px Fadjoin_poly_mod ?rpredM ?Fadjoin_polyOver //. rewrite [in RHS](divp_eq (Px_u * Px_v) (minPoly K x)) derivD derivM. by rewrite pKx'_0 mulr0 addr0 hornerD hornerM minPolyxx mulr0 add0r. have{Dder DK_0}: x \in lker D by apply: subvP Kx_x; apply: derKx_0. apply: contraLR => K'x; rewrite memv_ker lfunE /= Fadjoin_polyX //. by rewrite derivX hornerC oner_eq0. Qed. End SeparableElement. Arguments separable_elementP {K x}. Lemma separable_elementS K E x : (K <= E)%VS -> separable_element K x -> separable_element E x. Proof. move=> sKE /separable_elementP[f [fK rootf sepf]]; apply/separable_elementP. by exists f; rewrite (polyOverSv sKE). Qed. Lemma adjoin_separableP {K x} : reflect (forall y, y \in <>%VS -> separable_element K y) (separable_element K x). Proof. apply: (iffP idP) => [sepKx | -> //]; last exact: memv_adjoin. move=> _ /Fadjoin_polyP[q Kq ->]; apply/Derivation_separableP=> D derD DK_0. apply/subvP=> _ /Fadjoin_polyP[p Kp ->]. rewrite memv_ker -(extendDerivation_id x D (mempx_Fadjoin _ Kp)). have sepFyx: (separable_element <> x). by apply: (separable_elementS (subv_adjoin _ _)). have KyxEqKx: (<< <>; x>> = <>)%VS. apply/eqP; rewrite eqEsubv andbC adjoinSl ?subv_adjoin //=. apply/FadjoinP/andP; rewrite memv_adjoin andbT. by apply/FadjoinP/andP; rewrite subv_adjoin mempx_Fadjoin. have:= extendDerivationP derD sepFyx; rewrite KyxEqKx => derDx. rewrite -horner_comp (Derivation_horner derDx) ?memv_adjoin //; last first. by apply: (polyOverSv (subv_adjoin _ _)); apply: polyOver_comp. set Dx_p := map_poly _; have Dx_p_0 t: t \is a polyOver K -> (Dx_p t).[x] = 0. move/polyOverP=> Kt; congr (_.[x] = 0): (horner0 x); apply/esym/polyP => i. have /eqP Dti_0: D t`_i == 0 by rewrite -memv_ker (subvP DK_0) ?Kt. by rewrite coef0 coef_map /= {1}extendDerivation_id ?subvP_adjoin. rewrite (Derivation_separable derDx sepKx) -/Dx_p Dx_p_0 ?polyOver_comp //. by rewrite add0r mulrCA Dx_p_0 ?minPolyOver ?oppr0 ?mul0r. Qed. Lemma separable_exponent K x : exists n, [char L].-nat n && separable_element K (x ^+ n). Proof. pose d := adjoin_degree K x; move: {2}d.+1 (ltnSn d) => n. elim: n => // n IHn in x @d *; rewrite ltnS => le_d_n. have [[p charLp]|] := altP (separablePn K x); last by rewrite negbK; exists 1%N. case=> g Kg defKx; have p_pr := charf_prime charLp. suffices /IHn[m /andP[charLm sepKxpm]]: adjoin_degree K (x ^+ p) < n. by exists (p * m)%N; rewrite pnatM pnatE // charLp charLm exprM. apply: leq_trans le_d_n; rewrite -ltnS -!size_minPoly. have nzKx: minPoly K x != 0 by rewrite monic_neq0 ?monic_minPoly. have nzg: g != 0 by apply: contra_eqN defKx => /eqP->; rewrite comp_poly0. apply: leq_ltn_trans (dvdp_leq nzg _) _. by rewrite minPoly_dvdp // rootE -hornerXn -horner_comp -defKx minPolyxx. rewrite (polySpred nzKx) ltnS defKx size_comp_poly size_polyXn /=. suffices g_gt1: 1 < size g by rewrite -(subnKC g_gt1) ltn_Pmulr ?prime_gt1. apply: contra_eqT (size_minPoly K x); rewrite defKx -leqNgt => /size1_polyC->. by rewrite comp_polyC size_polyC; case: (_ != 0). Qed. Lemma charf0_separable K : [char L] =i pred0 -> forall x, separable_element K x. Proof. move=> charL0 x; have [n /andP[charLn]] := separable_exponent K x. by rewrite (pnat_1 charLn (sub_in_pnat _ charLn)) // => p _; rewrite charL0. Qed. Lemma charf_p_separable K x e p : p \in [char L] -> separable_element K x = (x \in <>%VS). Proof. move=> charLp; apply/idP/idP=> [sepKx | /Fadjoin_poly_eq]; last first. set m := p ^ _; set f := Fadjoin_poly K _ x => Dx; apply/separable_elementP. have mL0: m%:R = 0 :> L by apply/eqP; rewrite -(dvdn_charf charLp) dvdn_exp. exists ('X - (f \Po 'X^m)); split. - by rewrite rpredB ?polyOver_comp ?rpredX ?polyOverX ?Fadjoin_polyOver. - by rewrite rootE !hornerE horner_comp hornerXn Dx subrr. rewrite /separable_poly !(derivE, deriv_comp) -mulr_natr -rmorphMn /= mL0. by rewrite !mulr0 subr0 coprimep1. without loss{e} ->: e x sepKx / e = 0%N. move=> IH; elim: {e}e.+1 => [|e]; [exact: memv_adjoin | apply: subvP]. apply/FadjoinP/andP; rewrite subv_adjoin expnSr exprM (IH 0%N) //. by have /adjoin_separableP-> := sepKx; rewrite ?rpredX ?memv_adjoin. set K' := <>%VS; have sKK': (K <= K')%VS := subv_adjoin _ _. pose q := minPoly K' x; pose g := 'X^p - (x ^+ p)%:P. have [K'g]: g \is a polyOver K' /\ q \is a polyOver K'. by rewrite minPolyOver rpredB ?rpredX ?polyOverX // polyOverC memv_adjoin. have /dvdpP[c Dq]: 'X - x%:P %| q by rewrite dvdp_XsubCl root_minPoly. have co_c_g: coprimep c g. have charPp: p \in [char {poly L}] := rmorph_char (polyC_rmorphism _) charLp. rewrite /g polyC_exp -!(Frobenius_autE charPp) -rmorphB coprimep_expr //. have: separable_poly q := separable_elementS sKK' sepKx. by rewrite Dq separable_mul => /and3P[]. have{g K'g co_c_g} /size_poly1P[a nz_a Dc]: size c == 1%N. suffices c_dv_g: c %| g by rewrite -(eqp_size (dvdp_gcd_idl c_dv_g)). have: q %| g by rewrite minPoly_dvdp // rootE !hornerE hornerXn subrr. by apply: dvdp_trans; rewrite Dq dvdp_mulIl. rewrite {q}Dq {c}Dc mulrBr -rmorphM -rmorphN -cons_poly_def qualifE. by rewrite polyseq_cons !polyseqC nz_a /= rpredN andbCA => /and3P[/fpredMl->]. Qed. Lemma charf_n_separable K x n : [char L].-nat n -> 1 < n -> separable_element K x = (x \in <>%VS). Proof. rewrite -pi_pdiv; set p := pdiv n => charLn pi_n_p. have charLp: p \in [char L] := pnatPpi charLn pi_n_p. have <-: (n`_p)%N = n by rewrite -(eq_partn n (charf_eq charLp)) part_pnat_id. by rewrite p_part lognE -mem_primes pi_n_p -charf_p_separable. Qed. Definition purely_inseparable_element U x := x ^+ ex_minn (separable_exponent <> x) \in U. Lemma purely_inseparable_elementP {K x} : reflect (exists2 n, [char L].-nat n & x ^+ n \in K) (purely_inseparable_element K x). Proof. rewrite /purely_inseparable_element. case: ex_minnP => n /andP[charLn /=]; rewrite subfield_closed => sepKxn min_xn. apply: (iffP idP) => [Kxn | [m charLm Kxm]]; first by exists n. have{min_xn}: n <= m by rewrite min_xn ?charLm ?base_separable. rewrite leq_eqVlt => /predU1P[-> // | ltnm]; pose p := pdiv m. have m_gt1: 1 < m by have [/leq_ltn_trans->] := andP charLn. have charLp: p \in [char L] by rewrite (pnatPpi charLm) ?pi_pdiv. have [/p_natP[em Dm] /p_natP[en Dn]]: p.-nat m /\ p.-nat n. by rewrite -!(eq_pnat _ (charf_eq charLp)). rewrite Dn Dm ltn_exp2l ?prime_gt1 ?pdiv_prime // in ltnm. rewrite -(Fadjoin_idP Kxm) Dm -(subnKC ltnm) addSnnS expnD exprM -Dn. by rewrite -charf_p_separable. Qed. Lemma separable_inseparable_element K x : separable_element K x && purely_inseparable_element K x = (x \in K). Proof. rewrite /purely_inseparable_element; case: ex_minnP => [[|m]] //=. rewrite subfield_closed; case: m => /= [-> //| m _ /(_ 1%N)/implyP/= insepKx]. by rewrite (negPf insepKx) (contraNF (@base_separable K x) insepKx). Qed. Lemma base_inseparable K x : x \in K -> purely_inseparable_element K x. Proof. by rewrite -separable_inseparable_element => /andP[]. Qed. Lemma sub_inseparable K E x : (K <= E)%VS -> purely_inseparable_element K x -> purely_inseparable_element E x. Proof. move/subvP=> sKE /purely_inseparable_elementP[n charLn /sKE Exn]. by apply/purely_inseparable_elementP; exists n. Qed. Section PrimitiveElementTheorem. Variables (K : {subfield L}) (x y : L). Section FiniteCase. Variable N : nat. Let K_is_large := exists s, [/\ uniq s, {subset s <= K} & N < size s]. Let cyclic_or_large (z : L) : z != 0 -> K_is_large \/ exists a, z ^+ a.+1 = 1. Proof. move=> nz_z; pose d := adjoin_degree K z. pose h0 (i : 'I_(N ^ d).+1) (j : 'I_d) := (Fadjoin_poly K z (z ^+ i))`_j. pose s := undup [seq h0 i j | i <- enum 'I_(N ^ d).+1, j <- enum 'I_d]. have s_h0 i j: h0 i j \in s. by rewrite mem_undup; apply/allpairsP; exists (i, j); rewrite !mem_enum. pose h i := [ffun j => Ordinal (etrans (index_mem _ _) (s_h0 i j))]. pose h' (f : {ffun 'I_d -> 'I_(size s)}) := \sum_(j < d) s`_(f j) * z ^+ j. have hK i: h' (h i) = z ^+ i. have Kz_zi: z ^+ i \in <>%VS by rewrite rpredX ?memv_adjoin. rewrite -(Fadjoin_poly_eq Kz_zi) (horner_coef_wide z (size_poly _ _)) -/d. by apply: eq_bigr => j _; rewrite ffunE /= nth_index. have [inj_h | ] := altP (@injectiveP _ _ h). left; exists s; split=> [|zi_j|]; rewrite ?undup_uniq ?mem_undup //=. by case/allpairsP=> ij [_ _ ->]; apply/polyOverP/Fadjoin_polyOver. rewrite -[size s]card_ord -(@ltn_exp2r _ _ d) // -{2}[d]card_ord -card_ffun. by rewrite -[_.+1]card_ord -(card_image inj_h) max_card. case/injectivePn=> i1 [i2 i1'2 /(congr1 h')]; rewrite !hK => eq_zi12; right. without loss{i1'2} lti12: i1 i2 eq_zi12 / i1 < i2. by move=> IH; move: i1'2; rewrite neq_ltn => /orP[]; apply: IH. by exists (i2 - i1.+1)%N; rewrite subnSK ?expfB // eq_zi12 divff ?expf_neq0. Qed. Lemma finite_PET : K_is_large \/ exists z, (<< <>; x>> = <>)%VS. Proof. have [-> | /cyclic_or_large[|[a Dxa]]] := eqVneq x 0; first 2 [by left]. by rewrite addv0 subfield_closed; right; exists y. have [-> | /cyclic_or_large[|[b Dyb]]] := eqVneq y 0; first 2 [by left]. by rewrite addv0 subfield_closed; right; exists x. pose h0 (ij : 'I_a.+1 * 'I_b.+1) := x ^+ ij.1 * y ^+ ij.2. pose H := <<[set ij | h0 ij == 1%R]>>%G; pose h (u : coset_of H) := h0 (repr u). have h0M: {morph h0: ij1 ij2 / (ij1 * ij2)%g >-> ij1 * ij2}. by rewrite /h0 => [] [i1 j1] [i2 j2] /=; rewrite mulrACA -!exprD !expr_mod. have memH ij: (ij \in H) = (h0 ij == 1). rewrite /= gen_set_id ?inE //; apply/group_setP; rewrite inE [h0 _]mulr1. by split=> // ? ?; rewrite !inE h0M => /eqP-> /eqP->; rewrite mulr1. have nH ij: ij \in 'N(H)%g. by apply/(subsetP (cent_sub _))/centP=> ij1 _; congr (_, _); rewrite Zp_mulgC. have hE ij: h (coset H ij) = h0 ij. rewrite /h val_coset //; case: repr_rcosetP => ij1. by rewrite memH h0M => /eqP->; rewrite mul1r. have h1: h 1%g = 1 by rewrite /h repr_coset1 [h0 _]mulr1. have hM: {morph h: u v / (u * v)%g >-> u * v}. by do 2![move=> u; have{u} [? _ ->] := cosetP u]; rewrite -morphM // !hE h0M. have /cyclicP[w defW]: cyclic [set: coset_of H]. apply: field_mul_group_cyclic (in2W hM) _ => u _; have [ij _ ->] := cosetP u. by split=> [/eqP | -> //]; rewrite hE -memH => /coset_id. have Kw_h ij t: h0 ij = t -> t \in <>%VS. have /cycleP[k Dk]: coset H ij \in <[w]>%g by rewrite -defW inE. rewrite -hE {}Dk => <-; elim: k => [|k IHk]; first by rewrite h1 rpred1. by rewrite expgS hM rpredM // memv_adjoin. right; exists (h w); apply/eqP; rewrite eqEsubv !(sameP FadjoinP andP). rewrite subv_adjoin (subv_trans (subv_adjoin K y)) ?subv_adjoin //=. rewrite (Kw_h (0, inZp 1)) 1?(Kw_h (inZp 1, 0)) /h0 ?mulr1 ?mul1r ?expr_mod //=. by rewrite rpredM ?rpredX ?memv_adjoin // subvP_adjoin ?memv_adjoin. Qed. End FiniteCase. Hypothesis sepKy : separable_element K y. Lemma Primitive_Element_Theorem : exists z, (<< <>; x>> = <>)%VS. Proof. have /polyOver_subvs[p Dp]: minPoly K x \is a polyOver K := minPolyOver K x. have nz_pKx: minPoly K x != 0 by rewrite monic_neq0 ?monic_minPoly. have{nz_pKx} nz_p: p != 0 by rewrite Dp map_poly_eq0 in nz_pKx. have{Dp} px0: root (map_poly vsval p) x by rewrite -Dp root_minPoly. have [q0 [Kq0 q0y0 sepKq0]] := separable_elementP sepKy. have /polyOver_subvs[q Dq]: minPoly K y \is a polyOver K := minPolyOver K y. have qy0: root (map_poly vsval q) y by rewrite -Dq root_minPoly. have sep_pKy: separable_poly (minPoly K y). by rewrite (dvdp_separable _ sepKq0) ?minPoly_dvdp. have{sep_pKy} sep_q: separable_poly q by rewrite Dq separable_map in sep_pKy. have [r nz_r PETr] := large_field_PET nz_p px0 qy0 sep_q. have [[s [Us Ks /ltnW leNs]] | //] := finite_PET (size r). have{s Us leNs} /allPn[t {}/Ks Kt nz_rt]: ~~ all (root r) s. by apply: contraTN leNs; rewrite -ltnNge => /max_poly_roots->. have{PETr} [/= [p1 Dx] [q1 Dy]] := PETr (Subvs Kt) nz_rt. set z := t * y - x in Dx Dy; exists z; apply/eqP. rewrite eqEsubv !(sameP FadjoinP andP) subv_adjoin. have Kz_p1z (r1 : {poly subvs_of K}): (map_poly vsval r1).[z] \in <>%VS. rewrite rpred_horner ?memv_adjoin ?(polyOverSv (subv_adjoin K z)) //. by apply/polyOver_subvs; exists r1. rewrite -{1}Dx -{1}Dy !{Dx Dy}Kz_p1z /=. rewrite (subv_trans (subv_adjoin K y)) ?subv_adjoin // rpredB ?memv_adjoin //. by rewrite subvP_adjoin // rpredM ?memv_adjoin ?subvP_adjoin. Qed. Lemma adjoin_separable : separable_element <> x -> separable_element K x. Proof. have /Derivation_separableP derKy := sepKy => /Derivation_separableP derKy_x. have [z defKz] := Primitive_Element_Theorem. suffices /adjoin_separableP: separable_element K z. by apply; rewrite -defKz memv_adjoin. apply/Derivation_separableP=> D; rewrite -defKz => derKxyD DK_0. suffices derKyD: Derivation <>%VS D by rewrite derKy_x // derKy. by apply: DerivationS derKxyD; apply: subv_adjoin. Qed. End PrimitiveElementTheorem. Lemma strong_Primitive_Element_Theorem K x y : separable_element <> y -> exists2 z : L, (<< <>; x>> = <>)%VS & separable_element K x -> separable_element K y. Proof. move=> sepKx_y; have [n /andP[charLn sepKyn]] := separable_exponent K y. have adjK_C z t: (<<<>; t>> = <<<>; z>>)%VS. by rewrite !agenv_add_id -!addvA (addvC <[_]>%VS). have [z defKz] := Primitive_Element_Theorem x sepKyn. exists z => [|/adjoin_separable->]; rewrite ?sepKx_y // -defKz. have [|n_gt1|-> //] := ltngtP n 1%N; first by case: (n) charLn. apply/eqP; rewrite !(adjK_C _ x) eqEsubv; apply/andP. split; apply/FadjoinP/andP; rewrite subv_adjoin ?rpredX ?memv_adjoin //=. by rewrite -charf_n_separable ?sepKx_y. Qed. Definition separable U W : bool := all (separable_element U) (vbasis W). Definition purely_inseparable U W : bool := all (purely_inseparable_element U) (vbasis W). Lemma separable_add K x y : separable_element K x -> separable_element K y -> separable_element K (x + y). Proof. move/(separable_elementS (subv_adjoin K y))=> sepKy_x sepKy. have [z defKz] := Primitive_Element_Theorem x sepKy. have /(adjoin_separableP _): x + y \in <>%VS. by rewrite -defKz rpredD ?memv_adjoin // subvP_adjoin ?memv_adjoin. apply; apply: adjoin_separable sepKy (adjoin_separable sepKy_x _). by rewrite defKz base_separable ?memv_adjoin. Qed. Lemma separable_sum I r (P : pred I) (v_ : I -> L) K : (forall i, P i -> separable_element K (v_ i)) -> separable_element K (\sum_(i <- r | P i) v_ i). Proof. move=> sepKi. by elim/big_ind: _; [apply/base_separable/mem0v | apply: separable_add |]. Qed. Lemma inseparable_add K x y : purely_inseparable_element K x -> purely_inseparable_element K y -> purely_inseparable_element K (x + y). Proof. have insepP := purely_inseparable_elementP. move=> /insepP[n charLn Kxn] /insepP[m charLm Kym]; apply/insepP. have charLnm: [char L].-nat (n * m)%N by rewrite pnatM charLn. by exists (n * m)%N; rewrite ?exprDn_char // {2}mulnC !exprM memvD // rpredX. Qed. Lemma inseparable_sum I r (P : pred I) (v_ : I -> L) K : (forall i, P i -> purely_inseparable_element K (v_ i)) -> purely_inseparable_element K (\sum_(i <- r | P i) v_ i). Proof. move=> insepKi. by elim/big_ind: _; [apply/base_inseparable/mem0v | apply: inseparable_add |]. Qed. Lemma separableP {K E} : reflect (forall y, y \in E -> separable_element K y) (separable K E). Proof. apply/(iffP idP)=> [/allP|] sepK_E; last by apply/allP=> x /vbasis_mem/sepK_E. move=> y /coord_vbasis->; apply/separable_sum=> i _. have: separable_element K (vbasis E)`_i by apply/sepK_E/memt_nth. by move/adjoin_separableP; apply; rewrite rpredZ ?memv_adjoin. Qed. Lemma purely_inseparableP {K E} : reflect (forall y, y \in E -> purely_inseparable_element K y) (purely_inseparable K E). Proof. apply/(iffP idP)=> [/allP|] sep'K_E; last by apply/allP=> x /vbasis_mem/sep'K_E. move=> y /coord_vbasis->; apply/inseparable_sum=> i _. have: purely_inseparable_element K (vbasis E)`_i by apply/sep'K_E/memt_nth. case/purely_inseparable_elementP=> n charLn K_Ein. by apply/purely_inseparable_elementP; exists n; rewrite // exprZn rpredZ. Qed. Lemma adjoin_separable_eq K x : separable_element K x = separable K <>%VS. Proof. exact: sameP adjoin_separableP separableP. Qed. Lemma separable_inseparable_decomposition E K : {x | x \in E /\ separable_element K x & purely_inseparable <> E}. Proof. without loss sKE: K / (K <= E)%VS. case/(_ _ (capvSr K E)) => x [Ex sepKEx] /purely_inseparableP sep'KExE. exists x; first by split; last exact/(separable_elementS _ sepKEx)/capvSl. apply/purely_inseparableP=> y /sep'KExE; apply: sub_inseparable. exact/adjoinSl/capvSl. pose E_ i := (vbasis E)`_i; pose fP i := separable_exponent K (E_ i). pose f i := E_ i ^+ ex_minn (fP i); pose s := mkseq f (\dim E). pose K' := <>%VS. have sepKs: all (separable_element K) s. by rewrite all_map /f; apply/allP=> i _ /=; case: ex_minnP => m /andP[]. have [x sepKx defKx]: {x | x \in E /\ separable_element K x & K' = <>%VS}. have: all (mem E) s. rewrite all_map; apply/allP=> i; rewrite mem_iota => ltis /=. by rewrite rpredX // vbasis_mem // memt_nth. rewrite {}/K'; elim/last_ind: s sepKs => [|s t IHs]. by exists 0; [rewrite base_separable mem0v | rewrite adjoin_nil addv0]. rewrite adjoin_rcons !all_rcons => /andP[sepKt sepKs] /andP[/= Et Es]. have{IHs sepKs Es} [y [Ey sepKy] ->{s}] := IHs sepKs Es. have /sig_eqW[x defKx] := Primitive_Element_Theorem t sepKy. exists x; [split | exact: defKx]. suffices: (<> <= E)%VS by case/FadjoinP. by rewrite -defKx !(sameP FadjoinP andP) sKE Ey Et. apply/adjoin_separableP=> z; rewrite -defKx => Kyt_z. apply: adjoin_separable sepKy _; apply: adjoin_separableP Kyt_z. exact: separable_elementS (subv_adjoin K y) sepKt. exists x; rewrite // -defKx; apply/(all_nthP 0)=> i; rewrite size_tuple => ltiE. apply/purely_inseparable_elementP. exists (ex_minn (fP i)); first by case: ex_minnP => n /andP[]. by apply/seqv_sub_adjoin/map_f; rewrite mem_iota. Qed. Definition separable_generator K E : L := s2val (locked (separable_inseparable_decomposition E K)). Lemma separable_generator_mem E K : separable_generator K E \in E. Proof. by rewrite /separable_generator; case: (locked _) => ? []. Qed. Lemma separable_generatorP E K : separable_element K (separable_generator K E). Proof. by rewrite /separable_generator; case: (locked _) => ? []. Qed. Lemma separable_generator_maximal E K : purely_inseparable <> E. Proof. by rewrite /separable_generator; case: (locked _). Qed. Lemma sub_adjoin_separable_generator E K : separable K E -> (E <= <>)%VS. Proof. move/separableP=> sepK_E; apply/subvP=> v Ev. rewrite -separable_inseparable_element. have /purely_inseparableP-> // := separable_generator_maximal E K. by rewrite (separable_elementS _ (sepK_E _ Ev)) // subv_adjoin. Qed. Lemma eq_adjoin_separable_generator E K : separable K E -> (K <= E)%VS -> E = <>%VS :> {vspace _}. Proof. move=> sepK_E sKE; apply/eqP; rewrite eqEsubv sub_adjoin_separable_generator //. by apply/FadjoinP/andP; rewrite sKE separable_generator_mem. Qed. Lemma separable_refl K : separable K K. Proof. exact/separableP/base_separable. Qed. Lemma separable_trans M K E : separable K M -> separable M E -> separable K E. Proof. move/sub_adjoin_separable_generator. set x := separable_generator K M => sMKx /separableP sepM_E. apply/separableP => w /sepM_E/(separable_elementS sMKx). case/strong_Primitive_Element_Theorem => _ _ -> //. exact: separable_generatorP. Qed. Lemma separableS K1 K2 E2 E1 : (K1 <= K2)%VS -> (E2 <= E1)%VS -> separable K1 E1 -> separable K2 E2. Proof. move=> sK12 /subvP sE21 /separableP sepK1_E1. by apply/separableP=> y /sE21/sepK1_E1/(separable_elementS sK12). Qed. Lemma separableSl K M E : (K <= M)%VS -> separable K E -> separable M E. Proof. by move/separableS; apply. Qed. Lemma separableSr K M E : (M <= E)%VS -> separable K E -> separable K M. Proof. exact: separableS. Qed. Lemma separable_Fadjoin_seq K rs : all (separable_element K) rs -> separable K <>. Proof. elim/last_ind: rs => [|s x IHs] in K *. by rewrite adjoin_nil subfield_closed separable_refl. rewrite all_rcons adjoin_rcons => /andP[sepKx /IHs/separable_trans-> //]. by rewrite -adjoin_separable_eq (separable_elementS _ sepKx) ?subv_adjoin_seq. Qed. Lemma purely_inseparable_refl K : purely_inseparable K K. Proof. by apply/purely_inseparableP; apply: base_inseparable. Qed. Lemma purely_inseparable_trans M K E : purely_inseparable K M -> purely_inseparable M E -> purely_inseparable K E. Proof. have insepP := purely_inseparableP => /insepP insepK_M /insepP insepM_E. have insepPe := purely_inseparable_elementP. apply/insepP=> x /insepM_E/insepPe[n charLn /insepK_M/insepPe[m charLm Kxnm]]. by apply/insepPe; exists (n * m)%N; rewrite ?exprM // pnatM charLn charLm. Qed. End Separable. Arguments separable_elementP {F L K x}. Arguments separablePn {F L K x}. Arguments Derivation_separableP {F L K x}. Arguments adjoin_separableP {F L K x}. Arguments purely_inseparable_elementP {F L K x}. Arguments separableP {F L K E}. Arguments purely_inseparableP {F L K E}. math-comp-mathcomp-1.12.0/mathcomp/fingroup/000077500000000000000000000000001375767750300207535ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/fingroup/AUTHORS000077700000000000000000000000001375767750300235142../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/fingroup/CeCILL-B000077700000000000000000000000001375767750300235662../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/fingroup/INSTALL.md000077700000000000000000000000001375767750300244542../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/fingroup/Make000066400000000000000000000005251375767750300215550ustar00rootroot00000000000000action.v all_fingroup.v automorphism.v fingroup.v gproduct.v morphism.v perm.v presentation.v quotient.v -R . mathcomp.fingroup -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scopemath-comp-mathcomp-1.12.0/mathcomp/fingroup/Makefile000066400000000000000000000002531375767750300224130ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory # -------------------------------------------------------------------- include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/fingroup/README.md000077700000000000000000000000001375767750300241322../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/fingroup/action.v000066400000000000000000003055121375767750300224250ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat div seq. From mathcomp Require Import fintype bigop finset fingroup morphism perm. From mathcomp Require Import automorphism quotient. (******************************************************************************) (* Group action: orbits, stabilisers, transitivity. *) (* is_action D to == the function to : T -> aT -> T defines an action *) (* of D : {set aT} on T. *) (* action D T == structure for a function defining an action of D. *) (* act_dom to == the domain D of to : action D rT. *) (* {action: aT &-> T} == structure for a total action. *) (* := action [set: aT] T *) (* TotalAction to1 toM == the constructor for total actions; to1 and toM *) (* are the proofs of the action identities for 1 and *) (* a * b, respectively. *) (* is_groupAction R to == to is a group action on range R: for all a in D, *) (* the permutation induced by to a is in Aut R. Thus *) (* the action of D must be trivial outside R. *) (* groupAction D R == the structure for group actions of D on R. This *) (* is a telescope on action D rT. *) (* gact_range to == the range R of to : groupAction D R. *) (* GroupAction toAut == constructs a groupAction for action to from *) (* toAut : actm to @* D \subset Aut R (actm to is *) (* the morphism to {perm rT} associated to 'to'). *) (* orbit to A x == the orbit of x under the action of A via to. *) (* orbit_transversal to A S == a transversal of the partition orbit to A @: S *) (* of S, provided A acts on S via to. *) (* amove to A x y == the set of a in A whose action sends x to y. *) (* 'C_A[x | to] == the stabiliser of x : rT in A :&: D. *) (* 'C_A(S | to) == the pointwise stabiliser of S : {set rT} in D :&: A. *) (* 'N_A(S | to) == the global stabiliser of S : {set rT} in D :&: A. *) (* 'Fix_(S | to)[a] == the set of fixpoints of a in S. *) (* 'Fix_(S | to)(A) == the set of fixpoints of A in S. *) (* In the first three _A can be omitted and defaults to the domain D of to; *) (* in the last two S can be omitted and defaults to [set: T], so 'Fix_to[a] *) (* is the set of all fixpoints of a. *) (* The domain restriction ensures that stabilisers have a canonical group *) (* structure, but note that 'Fix sets are generally not groups. Indeed, we *) (* provide alternative definitions when to is a group action on R: *) (* 'C_(G | to)(A) == the centraliser in R :&: G of the group action of *) (* D :&: A via to *) (* 'C_(G | to)[a] == the centraliser in R :&: G of a \in D, via to. *) (* These sets are groups when G is; G can be omitted: 'C(|to)(A) is the *) (* centraliser in R of the action of D :&: A via to. *) (* [acts A, on S | to] == A \subset D acts on the set S via to. *) (* {acts A, on S | to} == A acts on the set S (Prop statement). *) (* {acts A, on group G | to} == [acts A, on S | to] /\ G \subset R, i.e., *) (* A \subset D acts on G \subset R, via *) (* to : groupAction D R. *) (* [transitive A, on S | to] == A acts transitively on S. *) (* [faithful A, on S | to] == A acts faithfully on S. *) (* acts_irreducibly to A G == A acts irreducibly via the groupAction to *) (* on the nontrivial group G, i.e., A does *) (* not act on any nontrivial subgroup of G. *) (* Important caveat: the definitions of orbit, amove, 'Fix_(S | to)(A), *) (* transitive and faithful assume that A is a subset of the domain D. As most *) (* of the permutation actions we consider are total this is usually harmless. *) (* (Note that the theory of partial actions is only partially developed.) *) (* In all of the above, to is expected to be the actual action structure, *) (* not merely the function. There is a special scope %act for actions, and *) (* constructions and notations for many classical actions: *) (* 'P == natural action of a permutation group via aperm. *) (* 'J == internal group action (conjugation) via conjg (_ ^ _). *) (* 'R == regular group action (right translation) via mulg (_ * _). *) (* (However, to limit ambiguity, _ * _ is NOT a canonical action.) *) (* to^* == the action induced by to on {set rT} via to^* (== setact to). *) (* 'Js == the internal action on subsets via _ :^ _, equivalent to 'J^*. *) (* 'Rs == the regular action on subsets via rcoset, equivalent to 'R^*. *) (* 'JG == the conjugation action on {group rT} via (_ :^ _)%G. *) (* to / H == the action induced by to on coset_of H via qact to H, and *) (* restricted to (qact_dom to H) == 'N(rcosets H 'N(H) | to^* ). *) (* 'Q == the action induced to cosets by conjugation; the domain is *) (* qact_dom 'J H, which is provably equal to 'N(H). *) (* to %% A == the action of coset_of A via modact to A, with domain D / A *) (* and support restricted to 'C(D :&: A | to). *) (* to \ sAD == the action of A via ract to sAD == to, if sAD : A \subset D. *) (* [Aut G] == the permutation action restricted to Aut G, via autact G. *) (* <[nRA]> == the action of A on R via actby nRA == to in A and on R, and *) (* the trivial action elsewhere; here nRA : [acts A, on R | to] *) (* or nRA : {acts A, on group R | to}. *) (* to^? == the action induced by to on sT : @subType rT P, via subact to *) (* with domain subact_dom P to == 'N([set x | P x] | to). *) (* <> == the action of phi : D >-> {perm rT}, via mact phi. *) (* to \o f == the composite action (with domain f @*^-1 D) of the action to *) (* with f : {morphism G >-> aT}, via comp_act to f. Here f must *) (* be the actual morphism object (e.g., coset_morphism H), not *) (* the underlying function (e.g., coset H). *) (* The explicit application of an action to is usually written (to%act x a), *) (* but %act can be omitted if to is an abstract action or a set action to0^*. *) (* Note that this form will simplify and expose the acting function. *) (* There is a %gact scope for group actions; the notations above are *) (* recognised in %gact when they denote canonical group actions. *) (* Actions can be used to define morphisms: *) (* actperm to == the morphism D >-> {perm rT} induced by to. *) (* actm to a == if a \in D the function on D induced by the action to, else *) (* the identity function. If to is a group action with range R *) (* then actm to a is canonically a morphism on R. *) (* We also define here the restriction operation on permutations (the domain *) (* of this operations is a stabiliser), and local automorphism groups: *) (* restr_perm S p == if p acts on S, the permutation with support in S that *) (* coincides with p on S; else the identity. Note that *) (* restr_perm is a permutation group morphism that maps *) (* Aut G to Aut S when S is a subgroup of G. *) (* Aut_in A G == the local permutation group 'N_A(G | 'P) / 'C_A(G | 'P) *) (* Usually A is an automorphism group, and then Aut_in A G *) (* is isomorphic to a subgroup of Aut G, specifically *) (* restr_perm @* A. *) (* Finally, gproduct.v will provide a semi-direct group construction that *) (* maps an external group action to an internal one; the theory of morphisms *) (* between such products makes use of the following definition: *) (* morph_act to to' f fA <=> the action of to' on the images of f and fA is *) (* the image of the action of to, i.e., for all x and a we *) (* have f (to x a) = to' (f x) (fA a). Note that there is *) (* no mention of the domains of to and to'; if needed, this *) (* predicate should be restricted via the {in ...} notation *) (* and domain conditions should be added. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope action_scope. Declare Scope groupAction_scope. Import GroupScope. Section ActionDef. Variables (aT : finGroupType) (D : {set aT}) (rT : Type). Implicit Types a b : aT. Implicit Type x : rT. Definition act_morph to x := forall a b, to x (a * b) = to (to x a) b. Definition is_action to := left_injective to /\ forall x, {in D &, act_morph to x}. Record action := Action {act :> rT -> aT -> rT; _ : is_action act}. Definition clone_action to := let: Action _ toP := to return {type of Action for to} -> action in fun k => k toP. End ActionDef. (* Need to close the Section here to avoid re-declaring all Argument Scopes *) Delimit Scope action_scope with act. Bind Scope action_scope with action. Arguments act_morph {aT rT%type} to x%g. Arguments is_action {aT} D%g {rT} to. Arguments act {aT D%g rT%type} to%act x%g a%g : rename. Arguments clone_action [aT D%g rT%type to%act] _. Notation "{ 'action' aT &-> T }" := (action [set: aT] T) (at level 0, format "{ 'action' aT &-> T }") : type_scope. Notation "[ 'action' 'of' to ]" := (clone_action (@Action _ _ _ to)) (at level 0, format "[ 'action' 'of' to ]") : form_scope. Definition act_dom aT D rT of @action aT D rT := D. Section TotalAction. Variables (aT : finGroupType) (rT : Type) (to : rT -> aT -> rT). Hypotheses (to1 : to^~ 1 =1 id) (toM : forall x, act_morph to x). Lemma is_total_action : is_action setT to. Proof. split=> [a | x a b _ _] /=; last by rewrite toM. by apply: can_inj (to^~ a^-1) _ => x; rewrite -toM ?mulgV. Qed. Definition TotalAction := Action is_total_action. End TotalAction. Section ActionDefs. Variables (aT aT' : finGroupType) (D : {set aT}) (D' : {set aT'}). Definition morph_act rT rT' (to : action D rT) (to' : action D' rT') f fA := forall x a, f (to x a) = to' (f x) (fA a). Variable rT : finType. (* Most definitions require a finType structure on rT *) Implicit Type to : action D rT. Implicit Type A : {set aT}. Implicit Type S : {set rT}. Definition actm to a := if a \in D then to^~ a else id. Definition setact to S a := [set to x a | x in S]. Definition orbit to A x := to x @: A. Definition amove to A x y := [set a in A | to x a == y]. Definition afix to A := [set x | A \subset [set a | to x a == x]]. Definition astab S to := D :&: [set a | S \subset [set x | to x a == x]]. Definition astabs S to := D :&: [set a | S \subset to^~ a @^-1: S]. Definition acts_on A S to := {in A, forall a x, (to x a \in S) = (x \in S)}. Definition atrans A S to := S \in orbit to A @: S. Definition faithful A S to := A :&: astab S to \subset [1]. End ActionDefs. Arguments setact {aT D%g rT} to%act S%g a%g. Arguments orbit {aT D%g rT} to%act A%g x%g. Arguments amove {aT D%g rT} to%act A%g x%g y%g. Arguments afix {aT D%g rT} to%act A%g. Arguments astab {aT D%g rT} S%g to%act. Arguments astabs {aT D%g rT} S%g to%act. Arguments acts_on {aT D%g rT} A%g S%g to%act. Arguments atrans {aT D%g rT} A%g S%g to%act. Arguments faithful {aT D%g rT} A%g S%g to%act. Notation "to ^*" := (setact to) (at level 2, format "to ^*") : fun_scope. Prenex Implicits orbit amove. Notation "''Fix_' to ( A )" := (afix to A) (at level 8, to at level 2, format "''Fix_' to ( A )") : group_scope. (* camlp4 grammar factoring *) Notation "''Fix_' ( to ) ( A )" := 'Fix_to(A) (at level 8, only parsing) : group_scope. Notation "''Fix_' ( S | to ) ( A )" := (S :&: 'Fix_to(A)) (at level 8, format "''Fix_' ( S | to ) ( A )") : group_scope. Notation "''Fix_' to [ a ]" := ('Fix_to([set a])) (at level 8, to at level 2, format "''Fix_' to [ a ]") : group_scope. Notation "''Fix_' ( S | to ) [ a ]" := (S :&: 'Fix_to[a]) (at level 8, format "''Fix_' ( S | to ) [ a ]") : group_scope. Notation "''C' ( S | to )" := (astab S to) (at level 8, format "''C' ( S | to )") : group_scope. Notation "''C_' A ( S | to )" := (A :&: 'C(S | to)) (at level 8, A at level 2, format "''C_' A ( S | to )") : group_scope. Notation "''C_' ( A ) ( S | to )" := 'C_A(S | to) (at level 8, only parsing) : group_scope. Notation "''C' [ x | to ]" := ('C([set x] | to)) (at level 8, format "''C' [ x | to ]") : group_scope. Notation "''C_' A [ x | to ]" := (A :&: 'C[x | to]) (at level 8, A at level 2, format "''C_' A [ x | to ]") : group_scope. Notation "''C_' ( A ) [ x | to ]" := 'C_A[x | to] (at level 8, only parsing) : group_scope. Notation "''N' ( S | to )" := (astabs S to) (at level 8, format "''N' ( S | to )") : group_scope. Notation "''N_' A ( S | to )" := (A :&: 'N(S | to)) (at level 8, A at level 2, format "''N_' A ( S | to )") : group_scope. Notation "[ 'acts' A , 'on' S | to ]" := (A \subset pred_of_set 'N(S | to)) (at level 0, format "[ 'acts' A , 'on' S | to ]") : form_scope. Notation "{ 'acts' A , 'on' S | to }" := (acts_on A S to) (at level 0, format "{ 'acts' A , 'on' S | to }") : form_scope. Notation "[ 'transitive' A , 'on' S | to ]" := (atrans A S to) (at level 0, format "[ 'transitive' A , 'on' S | to ]") : form_scope. Notation "[ 'faithful' A , 'on' S | to ]" := (faithful A S to) (at level 0, format "[ 'faithful' A , 'on' S | to ]") : form_scope. Section RawAction. (* Lemmas that do not require the group structure on the action domain. *) (* Some lemmas like actMin would be actually be valid for arbitrary rT, *) (* e.g., for actions on a function type, but would be difficult to use *) (* as a view due to the confusion between parameters and assumptions. *) Variables (aT : finGroupType) (D : {set aT}) (rT : finType) (to : action D rT). Implicit Types (a : aT) (x y : rT) (A B : {set aT}) (S T : {set rT}). Lemma act_inj : left_injective to. Proof. by case: to => ? []. Qed. Arguments act_inj : clear implicits. Lemma actMin x : {in D &, act_morph to x}. Proof. by case: to => ? []. Qed. Lemma actmEfun a : a \in D -> actm to a = to^~ a. Proof. by rewrite /actm => ->. Qed. Lemma actmE a : a \in D -> actm to a =1 to^~ a. Proof. by move=> Da; rewrite actmEfun. Qed. Lemma setactE S a : to^* S a = [set to x a | x in S]. Proof. by []. Qed. Lemma mem_setact S a x : x \in S -> to x a \in to^* S a. Proof. exact: imset_f. Qed. Lemma card_setact S a : #|to^* S a| = #|S|. Proof. by apply: card_imset; apply: act_inj. Qed. Lemma setact_is_action : is_action D to^*. Proof. split=> [a R S eqRS | a b Da Db S]; last first. by rewrite /setact /= -imset_comp; apply: eq_imset => x; apply: actMin. apply/setP=> x; apply/idP/idP=> /(mem_setact a). by rewrite eqRS => /imsetP[y Sy /act_inj->]. by rewrite -eqRS => /imsetP[y Sy /act_inj->]. Qed. Canonical set_action := Action setact_is_action. Lemma orbitE A x : orbit to A x = to x @: A. Proof. by []. Qed. Lemma orbitP A x y : reflect (exists2 a, a \in A & to x a = y) (y \in orbit to A x). Proof. by apply: (iffP imsetP) => [] [a]; exists a. Qed. Lemma mem_orbit A x a : a \in A -> to x a \in orbit to A x. Proof. exact: imset_f. Qed. Lemma afixP A x : reflect (forall a, a \in A -> to x a = x) (x \in 'Fix_to(A)). Proof. rewrite inE; apply: (iffP subsetP) => [xfix a /xfix | xfix a Aa]. by rewrite inE => /eqP. by rewrite inE xfix. Qed. Lemma afixS A B : A \subset B -> 'Fix_to(B) \subset 'Fix_to(A). Proof. by move=> sAB; apply/subsetP=> u; rewrite !inE; apply: subset_trans. Qed. Lemma afixU A B : 'Fix_to(A :|: B) = 'Fix_to(A) :&: 'Fix_to(B). Proof. by apply/setP=> x; rewrite !inE subUset. Qed. Lemma afix1P a x : reflect (to x a = x) (x \in 'Fix_to[a]). Proof. by rewrite inE sub1set inE; apply: eqP. Qed. Lemma astabIdom S : 'C_D(S | to) = 'C(S | to). Proof. by rewrite setIA setIid. Qed. Lemma astab_dom S : {subset 'C(S | to) <= D}. Proof. by move=> a /setIP[]. Qed. Lemma astab_act S a x : a \in 'C(S | to) -> x \in S -> to x a = x. Proof. rewrite 2!inE => /andP[_ cSa] Sx; apply/eqP. by have:= subsetP cSa x Sx; rewrite inE. Qed. Lemma astabS S1 S2 : S1 \subset S2 -> 'C(S2 | to) \subset 'C(S1 | to). Proof. move=> sS12; apply/subsetP=> x; rewrite !inE => /andP[->]. exact: subset_trans. Qed. Lemma astabsIdom S : 'N_D(S | to) = 'N(S | to). Proof. by rewrite setIA setIid. Qed. Lemma astabs_dom S : {subset 'N(S | to) <= D}. Proof. by move=> a /setIdP[]. Qed. Lemma astabs_act S a x : a \in 'N(S | to) -> (to x a \in S) = (x \in S). Proof. rewrite 2!inE subEproper properEcard => /andP[_]. rewrite (card_preimset _ (act_inj _)) ltnn andbF orbF => /eqP{2}->. by rewrite inE. Qed. Lemma astab_sub S : 'C(S | to) \subset 'N(S | to). Proof. apply/subsetP=> a cSa; rewrite !inE (astab_dom cSa). by apply/subsetP=> x Sx; rewrite inE (astab_act cSa). Qed. Lemma astabsC S : 'N(~: S | to) = 'N(S | to). Proof. apply/setP=> a; apply/idP/idP=> nSa; rewrite !inE (astabs_dom nSa). by rewrite -setCS -preimsetC; apply/subsetP=> x; rewrite inE astabs_act. by rewrite preimsetC setCS; apply/subsetP=> x; rewrite inE astabs_act. Qed. Lemma astabsI S T : 'N(S | to) :&: 'N(T | to) \subset 'N(S :&: T | to). Proof. apply/subsetP=> a; rewrite !inE -!andbA preimsetI => /and4P[-> nSa _ nTa] /=. by rewrite setISS. Qed. Lemma astabs_setact S a : a \in 'N(S | to) -> to^* S a = S. Proof. move=> nSa; apply/eqP; rewrite eqEcard card_setact leqnn andbT. by apply/subsetP=> _ /imsetP[x Sx ->]; rewrite astabs_act. Qed. Lemma astab1_set S : 'C[S | set_action] = 'N(S | to). Proof. apply/setP=> a; apply/idP/idP=> nSa. case/setIdP: nSa => Da; rewrite !inE Da sub1set inE => /eqP defS. by apply/subsetP=> x Sx; rewrite inE -defS mem_setact. by rewrite !inE (astabs_dom nSa) sub1set inE /= astabs_setact. Qed. Lemma astabs_set1 x : 'N([set x] | to) = 'C[x | to]. Proof. apply/eqP; rewrite eqEsubset astab_sub andbC setIS //. by apply/subsetP=> a; rewrite ?(inE,sub1set). Qed. Lemma acts_dom A S : [acts A, on S | to] -> A \subset D. Proof. by move=> nSA; rewrite (subset_trans nSA) ?subsetIl. Qed. Lemma acts_act A S : [acts A, on S | to] -> {acts A, on S | to}. Proof. by move=> nAS a Aa x; rewrite astabs_act ?(subsetP nAS). Qed. Lemma astabCin A S : A \subset D -> (A \subset 'C(S | to)) = (S \subset 'Fix_to(A)). Proof. move=> sAD; apply/subsetP/subsetP=> [sAC x xS | sSF a aA]. by apply/afixP=> a aA; apply: astab_act (sAC _ aA) xS. rewrite !inE (subsetP sAD _ aA); apply/subsetP=> x xS. by move/afixP/(_ _ aA): (sSF _ xS); rewrite inE => ->. Qed. Section ActsSetop. Variables (A : {set aT}) (S T : {set rT}). Hypotheses (AactS : [acts A, on S | to]) (AactT : [acts A, on T | to]). Lemma astabU : 'C(S :|: T | to) = 'C(S | to) :&: 'C(T | to). Proof. by apply/setP=> a; rewrite !inE subUset; case: (a \in D). Qed. Lemma astabsU : 'N(S | to) :&: 'N(T | to) \subset 'N(S :|: T | to). Proof. by rewrite -(astabsC S) -(astabsC T) -(astabsC (S :|: T)) setCU astabsI. Qed. Lemma astabsD : 'N(S | to) :&: 'N(T | to) \subset 'N(S :\: T| to). Proof. by rewrite setDE -(astabsC T) astabsI. Qed. Lemma actsI : [acts A, on S :&: T | to]. Proof. by apply: subset_trans (astabsI S T); rewrite subsetI AactS. Qed. Lemma actsU : [acts A, on S :|: T | to]. Proof. by apply: subset_trans astabsU; rewrite subsetI AactS. Qed. Lemma actsD : [acts A, on S :\: T | to]. Proof. by apply: subset_trans astabsD; rewrite subsetI AactS. Qed. End ActsSetop. Lemma acts_in_orbit A S x y : [acts A, on S | to] -> y \in orbit to A x -> x \in S -> y \in S. Proof. by move=> nSA/imsetP[a Aa ->{y}] Sx; rewrite (astabs_act _ (subsetP nSA a Aa)). Qed. Lemma subset_faithful A B S : B \subset A -> [faithful A, on S | to] -> [faithful B, on S | to]. Proof. by move=> sAB; apply: subset_trans; apply: setSI. Qed. Section Reindex. Variables (vT : Type) (idx : vT) (op : Monoid.com_law idx) (S : {set rT}). Lemma reindex_astabs a F : a \in 'N(S | to) -> \big[op/idx]_(i in S) F i = \big[op/idx]_(i in S) F (to i a). Proof. move=> nSa; rewrite (reindex_inj (act_inj a)); apply: eq_bigl => x. exact: astabs_act. Qed. Lemma reindex_acts A a F : [acts A, on S | to] -> a \in A -> \big[op/idx]_(i in S) F i = \big[op/idx]_(i in S) F (to i a). Proof. by move=> nSA /(subsetP nSA); apply: reindex_astabs. Qed. End Reindex. End RawAction. Arguments act_inj {aT D rT} to a [x1 x2] : rename. Notation "to ^*" := (set_action to) : action_scope. Arguments orbitP {aT D rT to A x y}. Arguments afixP {aT D rT to A x}. Arguments afix1P {aT D rT to a x}. Arguments reindex_astabs [aT D rT] to [vT idx op S] a [F]. Arguments reindex_acts [aT D rT] to [vT idx op S A a F]. Section PartialAction. (* Lemmas that require a (partial) group domain. *) Variables (aT : finGroupType) (D : {group aT}) (rT : finType). Variable to : action D rT. Implicit Types a : aT. Implicit Types x y : rT. Implicit Types A B : {set aT}. Implicit Types G H : {group aT}. Implicit Types S : {set rT}. Lemma act1 x : to x 1 = x. Proof. by apply: (act_inj to 1); rewrite -actMin ?mulg1. Qed. Lemma actKin : {in D, right_loop invg to}. Proof. by move=> a Da /= x; rewrite -actMin ?groupV // mulgV act1. Qed. Lemma actKVin : {in D, rev_right_loop invg to}. Proof. by move=> a Da /= x; rewrite -{2}(invgK a) actKin ?groupV. Qed. Lemma setactVin S a : a \in D -> to^* S a^-1 = to^~ a @^-1: S. Proof. by move=> Da; apply: can2_imset_pre; [apply: actKVin | apply: actKin]. Qed. Lemma actXin x a i : a \in D -> to x (a ^+ i) = iter i (to^~ a) x. Proof. move=> Da; elim: i => /= [|i <-]; first by rewrite act1. by rewrite expgSr actMin ?groupX. Qed. Lemma afix1 : 'Fix_to(1) = setT. Proof. by apply/setP=> x; rewrite !inE sub1set inE act1 eqxx. Qed. Lemma afixD1 G : 'Fix_to(G^#) = 'Fix_to(G). Proof. by rewrite -{2}(setD1K (group1 G)) afixU afix1 setTI. Qed. Lemma orbit_refl G x : x \in orbit to G x. Proof. by rewrite -{1}[x]act1 mem_orbit. Qed. Local Notation orbit_rel A := (fun x y => x \in orbit to A y). Lemma contra_orbit G x y : x \notin orbit to G y -> x != y. Proof. by apply: contraNneq => ->; apply: orbit_refl. Qed. Lemma orbit_in_sym G : G \subset D -> symmetric (orbit_rel G). Proof. move=> sGD; apply: symmetric_from_pre => x y /imsetP[a Ga]. by move/(canLR (actKin (subsetP sGD a Ga))) <-; rewrite mem_orbit ?groupV. Qed. Lemma orbit_in_trans G : G \subset D -> transitive (orbit_rel G). Proof. move=> sGD _ _ z /imsetP[a Ga ->] /imsetP[b Gb ->]. by rewrite -actMin ?mem_orbit ?groupM // (subsetP sGD). Qed. Lemma orbit_in_eqP G x y : G \subset D -> reflect (orbit to G x = orbit to G y) (x \in orbit to G y). Proof. move=> sGD; apply: (iffP idP) => [yGx|<-]; last exact: orbit_refl. by apply/setP=> z; apply/idP/idP=> /orbit_in_trans-> //; rewrite orbit_in_sym. Qed. Lemma orbit_in_transl G x y z : G \subset D -> y \in orbit to G x -> (y \in orbit to G z) = (x \in orbit to G z). Proof. by move=> sGD Gxy; rewrite !(orbit_in_sym sGD _ z) (orbit_in_eqP y x sGD Gxy). Qed. Lemma orbit_act_in x a G : G \subset D -> a \in G -> orbit to G (to x a) = orbit to G x. Proof. by move=> sGD /mem_orbit/orbit_in_eqP->. Qed. Lemma orbit_actr_in x a G y : G \subset D -> a \in G -> (to y a \in orbit to G x) = (y \in orbit to G x). Proof. by move=> sGD /mem_orbit/orbit_in_transl->. Qed. Lemma orbit_inv_in A x y : A \subset D -> (y \in orbit to A^-1 x) = (x \in orbit to A y). Proof. move/subsetP=> sAD; apply/imsetP/imsetP=> [] [a Aa ->]. by exists a^-1; rewrite -?mem_invg ?actKin // -groupV sAD -?mem_invg. by exists a^-1; rewrite ?memV_invg ?actKin // sAD. Qed. Lemma orbit_lcoset_in A a x : A \subset D -> a \in D -> orbit to (a *: A) x = orbit to A (to x a). Proof. move/subsetP=> sAD Da; apply/setP=> y; apply/imsetP/imsetP=> [] [b Ab ->{y}]. by exists (a^-1 * b); rewrite -?actMin ?mulKVg // ?sAD -?mem_lcoset. by exists (a * b); rewrite ?mem_mulg ?set11 ?actMin // sAD. Qed. Lemma orbit_rcoset_in A a x y : A \subset D -> a \in D -> (to y a \in orbit to (A :* a) x) = (y \in orbit to A x). Proof. move=> sAD Da; rewrite -orbit_inv_in ?mul_subG ?sub1set // invMg. by rewrite invg_set1 orbit_lcoset_in ?inv_subG ?groupV ?actKin ?orbit_inv_in. Qed. Lemma orbit_conjsg_in A a x y : A \subset D -> a \in D -> (to y a \in orbit to (A :^ a) (to x a)) = (y \in orbit to A x). Proof. move=> sAD Da; rewrite conjsgE. by rewrite orbit_lcoset_in ?groupV ?mul_subG ?sub1set ?actKin ?orbit_rcoset_in. Qed. Lemma orbit1P G x : reflect (orbit to G x = [set x]) (x \in 'Fix_to(G)). Proof. apply: (iffP afixP) => [xfix | xfix a Ga]. apply/eqP; rewrite eq_sym eqEsubset sub1set -{1}[x]act1 imset_f //=. by apply/subsetP=> y; case/imsetP=> a Ga ->; rewrite inE xfix. by apply/set1P; rewrite -xfix imset_f. Qed. Lemma card_orbit1 G x : #|orbit to G x| = 1%N -> orbit to G x = [set x]. Proof. move=> orb1; apply/eqP; rewrite eq_sym eqEcard {}orb1 cards1. by rewrite sub1set orbit_refl. Qed. Lemma orbit_partition G S : [acts G, on S | to] -> partition (orbit to G @: S) S. Proof. move=> actsGS; have sGD := acts_dom actsGS. have eqiG: {in S & &, equivalence_rel [rel x y | y \in orbit to G x]}. by move=> x y z * /=; rewrite orbit_refl; split=> // /orbit_in_eqP->. congr (partition _ _): (equivalence_partitionP eqiG). apply: eq_in_imset => x Sx; apply/setP=> y. by rewrite inE /= andb_idl // => /acts_in_orbit->. Qed. Definition orbit_transversal A S := transversal (orbit to A @: S) S. Lemma orbit_transversalP G S (P := orbit to G @: S) (X := orbit_transversal G S) : [acts G, on S | to] -> [/\ is_transversal X P S, X \subset S, {in X &, forall x y, (y \in orbit to G x) = (x == y)} & forall x, x \in S -> exists2 a, a \in G & to x a \in X]. Proof. move/orbit_partition; rewrite -/P => partP. have [/eqP defS tiP _] := and3P partP. have trXP: is_transversal X P S := transversalP partP. have sXS: X \subset S := transversal_sub trXP. split=> // [x y Xx Xy /= | x Sx]. have Sx := subsetP sXS x Xx. rewrite -(inj_in_eq (pblock_inj trXP)) // eq_pblock ?defS //. by rewrite (def_pblock tiP (imset_f _ Sx)) ?orbit_refl. have /imsetP[y Xy defxG]: orbit to G x \in pblock P @: X. by rewrite (pblock_transversal trXP) ?imset_f. suffices /orbitP[a Ga def_y]: y \in orbit to G x by exists a; rewrite ?def_y. by rewrite defxG mem_pblock defS (subsetP sXS). Qed. Lemma group_set_astab S : group_set 'C(S | to). Proof. apply/group_setP; split=> [|a b cSa cSb]. by rewrite !inE group1; apply/subsetP=> x _; rewrite inE act1. rewrite !inE groupM ?(@astab_dom _ _ _ to S) //; apply/subsetP=> x Sx. by rewrite inE actMin ?(@astab_dom _ _ _ to S) ?(astab_act _ Sx). Qed. Canonical astab_group S := group (group_set_astab S). Lemma afix_gen_in A : A \subset D -> 'Fix_to(<>) = 'Fix_to(A). Proof. move=> sAD; apply/eqP; rewrite eqEsubset afixS ?sub_gen //=. by rewrite -astabCin gen_subG ?astabCin. Qed. Lemma afix_cycle_in a : a \in D -> 'Fix_to(<[a]>) = 'Fix_to[a]. Proof. by move=> Da; rewrite afix_gen_in ?sub1set. Qed. Lemma afixYin A B : A \subset D -> B \subset D -> 'Fix_to(A <*> B) = 'Fix_to(A) :&: 'Fix_to(B). Proof. by move=> sAD sBD; rewrite afix_gen_in ?afixU // subUset sAD. Qed. Lemma afixMin G H : G \subset D -> H \subset D -> 'Fix_to(G * H) = 'Fix_to(G) :&: 'Fix_to(H). Proof. by move=> sGD sHD; rewrite -afix_gen_in ?mul_subG // genM_join afixYin. Qed. Lemma sub_astab1_in A x : A \subset D -> (A \subset 'C[x | to]) = (x \in 'Fix_to(A)). Proof. by move=> sAD; rewrite astabCin ?sub1set. Qed. Lemma group_set_astabs S : group_set 'N(S | to). Proof. apply/group_setP; split=> [|a b cSa cSb]. by rewrite !inE group1; apply/subsetP=> x Sx; rewrite inE act1. rewrite !inE groupM ?(@astabs_dom _ _ _ to S) //; apply/subsetP=> x Sx. by rewrite inE actMin ?(@astabs_dom _ _ _ to S) ?astabs_act. Qed. Canonical astabs_group S := group (group_set_astabs S). Lemma astab_norm S : 'N(S | to) \subset 'N('C(S | to)). Proof. apply/subsetP=> a nSa; rewrite inE sub_conjg; apply/subsetP=> b cSb. have [Da Db] := (astabs_dom nSa, astab_dom cSb). rewrite mem_conjgV !inE groupJ //; apply/subsetP=> x Sx. rewrite inE !actMin ?groupM ?groupV //. by rewrite (astab_act cSb) ?actKVin ?astabs_act ?groupV. Qed. Lemma astab_normal S : 'C(S | to) <| 'N(S | to). Proof. by rewrite /normal astab_sub astab_norm. Qed. Lemma acts_sub_orbit G S x : [acts G, on S | to] -> (orbit to G x \subset S) = (x \in S). Proof. move/acts_act=> GactS. apply/subsetP/idP=> [| Sx y]; first by apply; apply: orbit_refl. by case/orbitP=> a Ga <-{y}; rewrite GactS. Qed. Lemma acts_orbit G x : G \subset D -> [acts G, on orbit to G x | to]. Proof. move/subsetP=> sGD; apply/subsetP=> a Ga; rewrite !inE sGD //. apply/subsetP=> _ /imsetP[b Gb ->]. by rewrite inE -actMin ?sGD // imset_f ?groupM. Qed. Lemma acts_subnorm_fix A : [acts 'N_D(A), on 'Fix_to(D :&: A) | to]. Proof. apply/subsetP=> a nAa; have [Da _] := setIP nAa; rewrite !inE Da. apply/subsetP=> x Cx; rewrite inE; apply/afixP=> b DAb. have [Db _]:= setIP DAb; rewrite -actMin // conjgCV actMin ?groupJ ?groupV //. by rewrite /= (afixP Cx) // memJ_norm // groupV (subsetP (normsGI _ _) _ nAa). Qed. Lemma atrans_orbit G x : [transitive G, on orbit to G x | to]. Proof. by apply: imset_f; apply: orbit_refl. Qed. Section OrbitStabilizer. Variables (G : {group aT}) (x : rT). Hypothesis sGD : G \subset D. Let ssGD := subsetP sGD. Lemma amove_act a : a \in G -> amove to G x (to x a) = 'C_G[x | to] :* a. Proof. move=> Ga; apply/setP=> b; have Da := ssGD Ga. rewrite mem_rcoset !(inE, sub1set) !groupMr ?groupV //. by case Gb: (b \in G); rewrite //= actMin ?groupV ?ssGD ?(canF_eq (actKVin Da)). Qed. Lemma amove_orbit : amove to G x @: orbit to G x = rcosets 'C_G[x | to] G. Proof. apply/setP => Ha; apply/imsetP/rcosetsP=> [[y] | [a Ga ->]]. by case/imsetP=> b Gb -> ->{Ha y}; exists b => //; rewrite amove_act. by rewrite -amove_act //; exists (to x a); first apply: mem_orbit. Qed. Lemma amoveK : {in orbit to G x, cancel (amove to G x) (fun Ca => to x (repr Ca))}. Proof. move=> _ /orbitP[a Ga <-]; rewrite amove_act //= -[G :&: _]/(gval _). case: repr_rcosetP => b; rewrite !(inE, sub1set)=> /and3P[Gb _ xbx]. by rewrite actMin ?ssGD ?(eqP xbx). Qed. Lemma orbit_stabilizer : orbit to G x = [set to x (repr Ca) | Ca in rcosets 'C_G[x | to] G]. Proof. rewrite -amove_orbit -imset_comp /=; apply/setP=> z. by apply/idP/imsetP=> [xGz | [y xGy ->]]; first exists z; rewrite /= ?amoveK. Qed. Lemma act_reprK : {in rcosets 'C_G[x | to] G, cancel (to x \o repr) (amove to G x)}. Proof. move=> _ /rcosetsP[a Ga ->] /=; rewrite amove_act ?rcoset_repr //. rewrite -[G :&: _]/(gval _); case: repr_rcosetP => b /setIP[Gb _]. exact: groupM. Qed. End OrbitStabilizer. Lemma card_orbit_in G x : G \subset D -> #|orbit to G x| = #|G : 'C_G[x | to]|. Proof. move=> sGD; rewrite orbit_stabilizer 1?card_in_imset //. exact: can_in_inj (act_reprK _). Qed. Lemma card_orbit_in_stab G x : G \subset D -> (#|orbit to G x| * #|'C_G[x | to]|)%N = #|G|. Proof. by move=> sGD; rewrite mulnC card_orbit_in ?Lagrange ?subsetIl. Qed. Lemma acts_sum_card_orbit G S : [acts G, on S | to] -> \sum_(T in orbit to G @: S) #|T| = #|S|. Proof. by move/orbit_partition/card_partition. Qed. Lemma astab_setact_in S a : a \in D -> 'C(to^* S a | to) = 'C(S | to) :^ a. Proof. move=> Da; apply/setP=> b; rewrite mem_conjg !inE -mem_conjg conjGid //. apply: andb_id2l => Db; rewrite sub_imset_pre; apply: eq_subset_r => x. by rewrite !inE !actMin ?groupM ?groupV // invgK (canF_eq (actKVin Da)). Qed. Lemma astab1_act_in x a : a \in D -> 'C[to x a | to] = 'C[x | to] :^ a. Proof. by move=> Da; rewrite -astab_setact_in // /setact imset_set1. Qed. Theorem Frobenius_Cauchy G S : [acts G, on S | to] -> \sum_(a in G) #|'Fix_(S | to)[a]| = (#|orbit to G @: S| * #|G|)%N. Proof. move=> GactS; have sGD := acts_dom GactS. transitivity (\sum_(a in G) \sum_(x in 'Fix_(S | to)[a]) 1%N). by apply: eq_bigr => a _; rewrite -sum1_card. rewrite (exchange_big_dep (mem S)) /= => [|a x _]; last by case/setIP. rewrite (set_partition_big _ (orbit_partition GactS)) -sum_nat_const /=. apply: eq_bigr => _ /imsetP[x Sx ->]. rewrite -(card_orbit_in_stab x sGD) -sum_nat_const. apply: eq_bigr => y; rewrite orbit_in_sym // => /imsetP[a Ga defx]. rewrite defx astab1_act_in ?(subsetP sGD) //. rewrite -{2}(conjGid Ga) -conjIg cardJg -sum1_card setIA (setIidPl sGD). by apply: eq_bigl => b; rewrite !(sub1set, inE) -(acts_act GactS Ga) -defx Sx. Qed. Lemma atrans_dvd_index_in G S : G \subset D -> [transitive G, on S | to] -> #|S| %| #|G : 'C_G(S | to)|. Proof. move=> sGD /imsetP[x Sx {1}->]; rewrite card_orbit_in //. by rewrite indexgS // setIS // astabS // sub1set. Qed. Lemma atrans_dvd_in G S : G \subset D -> [transitive G, on S | to] -> #|S| %| #|G|. Proof. move=> sGD transG; apply: dvdn_trans (atrans_dvd_index_in sGD transG) _. exact: dvdn_indexg. Qed. Lemma atransPin G S : G \subset D -> [transitive G, on S | to] -> forall x, x \in S -> orbit to G x = S. Proof. by move=> sGD /imsetP[y _ ->] x; apply/orbit_in_eqP. Qed. Lemma atransP2in G S : G \subset D -> [transitive G, on S | to] -> {in S &, forall x y, exists2 a, a \in G & y = to x a}. Proof. by move=> sGD transG x y /(atransPin sGD transG) <- /imsetP. Qed. Lemma atrans_acts_in G S : G \subset D -> [transitive G, on S | to] -> [acts G, on S | to]. Proof. move=> sGD transG; apply/subsetP=> a Ga; rewrite !inE (subsetP sGD) //. by apply/subsetP=> x /(atransPin sGD transG) <-; rewrite inE imset_f. Qed. Lemma subgroup_transitivePin G H S x : x \in S -> H \subset G -> G \subset D -> [transitive G, on S | to] -> reflect ('C_G[x | to] * H = G) [transitive H, on S | to]. Proof. move=> Sx sHG sGD trG; have sHD := subset_trans sHG sGD. apply: (iffP idP) => [trH | defG]. rewrite group_modr //; apply/setIidPl/subsetP=> a Ga. have Sxa: to x a \in S by rewrite (acts_act (atrans_acts_in sGD trG)). have [b Hb xab]:= atransP2in sHD trH Sxa Sx. have Da := subsetP sGD a Ga; have Db := subsetP sHD b Hb. rewrite -(mulgK b a) mem_mulg ?groupV // !inE groupM //= sub1set inE. by rewrite actMin -?xab. apply/imsetP; exists x => //; apply/setP=> y; rewrite -(atransPin sGD trG Sx). apply/imsetP/imsetP=> [] [a]; last by exists a; first apply: (subsetP sHG). rewrite -defG => /imset2P[c b /setIP[_ cxc] Hb ->] ->. exists b; rewrite ?actMin ?(astab_dom cxc) ?(subsetP sHD) //. by rewrite (astab_act cxc) ?inE. Qed. End PartialAction. Arguments orbit_transversal {aT D%g rT} to%act A%g S%g. Arguments orbit_in_eqP {aT D rT to G x y}. Arguments orbit1P {aT D rT to G x}. Arguments contra_orbit [aT D rT] to G [x y]. Notation "''C' ( S | to )" := (astab_group to S) : Group_scope. Notation "''C_' A ( S | to )" := (setI_group A 'C(S | to)) : Group_scope. Notation "''C_' ( A ) ( S | to )" := (setI_group A 'C(S | to)) (only parsing) : Group_scope. Notation "''C' [ x | to ]" := (astab_group to [set x%g]) : Group_scope. Notation "''C_' A [ x | to ]" := (setI_group A 'C[x | to]) : Group_scope. Notation "''C_' ( A ) [ x | to ]" := (setI_group A 'C[x | to]) (only parsing) : Group_scope. Notation "''N' ( S | to )" := (astabs_group to S) : Group_scope. Notation "''N_' A ( S | to )" := (setI_group A 'N(S | to)) : Group_scope. Section TotalActions. (* These lemmas are only established for total actions (domain = [set: rT]) *) Variable (aT : finGroupType) (rT : finType). Variable to : {action aT &-> rT}. Implicit Types (a b : aT) (x y z : rT) (A B : {set aT}) (G H : {group aT}). Implicit Type S : {set rT}. Lemma actM x a b : to x (a * b) = to (to x a) b. Proof. by rewrite actMin ?inE. Qed. Lemma actK : right_loop invg to. Proof. by move=> a; apply: actKin; rewrite inE. Qed. Lemma actKV : rev_right_loop invg to. Proof. by move=> a; apply: actKVin; rewrite inE. Qed. Lemma actX x a n : to x (a ^+ n) = iter n (to^~ a) x. Proof. by elim: n => [|n /= <-]; rewrite ?act1 // -actM expgSr. Qed. Lemma actCJ a b x : to (to x a) b = to (to x b) (a ^ b). Proof. by rewrite !actM actK. Qed. Lemma actCJV a b x : to (to x a) b = to (to x (b ^ a^-1)) a. Proof. by rewrite (actCJ _ a) conjgKV. Qed. Lemma orbit_sym G x y : (x \in orbit to G y) = (y \in orbit to G x). Proof. exact/orbit_in_sym/subsetT. Qed. Lemma orbit_trans G x y z : x \in orbit to G y -> y \in orbit to G z -> x \in orbit to G z. Proof. exact/orbit_in_trans/subsetT. Qed. Lemma orbit_eqP G x y : reflect (orbit to G x = orbit to G y) (x \in orbit to G y). Proof. exact/orbit_in_eqP/subsetT. Qed. Lemma orbit_transl G x y z : y \in orbit to G x -> (y \in orbit to G z) = (x \in orbit to G z). Proof. exact/orbit_in_transl/subsetT. Qed. Lemma orbit_act G a x: a \in G -> orbit to G (to x a) = orbit to G x. Proof. exact/orbit_act_in/subsetT. Qed. Lemma orbit_actr G a x y : a \in G -> (to y a \in orbit to G x) = (y \in orbit to G x). Proof. by move/mem_orbit/orbit_transl; apply. Qed. Lemma orbit_eq_mem G x y : (orbit to G x == orbit to G y) = (x \in orbit to G y). Proof. exact: sameP eqP (orbit_eqP G x y). Qed. Lemma orbit_inv A x y : (y \in orbit to A^-1 x) = (x \in orbit to A y). Proof. by rewrite orbit_inv_in ?subsetT. Qed. Lemma orbit_lcoset A a x : orbit to (a *: A) x = orbit to A (to x a). Proof. by rewrite orbit_lcoset_in ?subsetT ?inE. Qed. Lemma orbit_rcoset A a x y : (to y a \in orbit to (A :* a) x) = (y \in orbit to A x). Proof. by rewrite orbit_rcoset_in ?subsetT ?inE. Qed. Lemma orbit_conjsg A a x y : (to y a \in orbit to (A :^ a) (to x a)) = (y \in orbit to A x). Proof. by rewrite orbit_conjsg_in ?subsetT ?inE. Qed. Lemma astabP S a : reflect (forall x, x \in S -> to x a = x) (a \in 'C(S | to)). Proof. apply: (iffP idP) => [cSa x|cSa]; first exact: astab_act. by rewrite !inE; apply/subsetP=> x Sx; rewrite inE cSa. Qed. Lemma astab1P x a : reflect (to x a = x) (a \in 'C[x | to]). Proof. by rewrite !inE sub1set inE; apply: eqP. Qed. Lemma sub_astab1 A x : (A \subset 'C[x | to]) = (x \in 'Fix_to(A)). Proof. by rewrite sub_astab1_in ?subsetT. Qed. Lemma astabC A S : (A \subset 'C(S | to)) = (S \subset 'Fix_to(A)). Proof. by rewrite astabCin ?subsetT. Qed. Lemma afix_cycle a : 'Fix_to(<[a]>) = 'Fix_to[a]. Proof. by rewrite afix_cycle_in ?inE. Qed. Lemma afix_gen A : 'Fix_to(<>) = 'Fix_to(A). Proof. by rewrite afix_gen_in ?subsetT. Qed. Lemma afixM G H : 'Fix_to(G * H) = 'Fix_to(G) :&: 'Fix_to(H). Proof. by rewrite afixMin ?subsetT. Qed. Lemma astabsP S a : reflect (forall x, (to x a \in S) = (x \in S)) (a \in 'N(S | to)). Proof. apply: (iffP idP) => [nSa x|nSa]; first exact: astabs_act. by rewrite !inE; apply/subsetP=> x; rewrite inE nSa. Qed. Lemma card_orbit G x : #|orbit to G x| = #|G : 'C_G[x | to]|. Proof. by rewrite card_orbit_in ?subsetT. Qed. Lemma dvdn_orbit G x : #|orbit to G x| %| #|G|. Proof. by rewrite card_orbit dvdn_indexg. Qed. Lemma card_orbit_stab G x : (#|orbit to G x| * #|'C_G[x | to]|)%N = #|G|. Proof. by rewrite mulnC card_orbit Lagrange ?subsetIl. Qed. Lemma actsP A S : reflect {acts A, on S | to} [acts A, on S | to]. Proof. apply: (iffP idP) => [nSA x|nSA]; first exact: acts_act. by apply/subsetP=> a Aa; rewrite !inE; apply/subsetP=> x; rewrite inE nSA. Qed. Arguments actsP {A S}. Lemma setact_orbit A x b : to^* (orbit to A x) b = orbit to (A :^ b) (to x b). Proof. apply/setP=> y; apply/idP/idP=> /imsetP[_ /imsetP[a Aa ->] ->{y}]. by rewrite actCJ mem_orbit ?memJ_conjg. by rewrite -actCJ mem_setact ?mem_orbit. Qed. Lemma astab_setact S a : 'C(to^* S a | to) = 'C(S | to) :^ a. Proof. apply/setP=> b; rewrite mem_conjg. apply/astabP/astabP=> stab x => [Sx|]. by rewrite conjgE invgK !actM stab ?actK //; apply/imsetP; exists x. by case/imsetP=> y Sy ->{x}; rewrite -actM conjgCV actM stab. Qed. Lemma astab1_act x a : 'C[to x a | to] = 'C[x | to] :^ a. Proof. by rewrite -astab_setact /setact imset_set1. Qed. Lemma atransP G S : [transitive G, on S | to] -> forall x, x \in S -> orbit to G x = S. Proof. by case/imsetP=> x _ -> y; apply/orbit_eqP. Qed. Lemma atransP2 G S : [transitive G, on S | to] -> {in S &, forall x y, exists2 a, a \in G & y = to x a}. Proof. by move=> GtrS x y /(atransP GtrS) <- /imsetP. Qed. Lemma atrans_acts G S : [transitive G, on S | to] -> [acts G, on S | to]. Proof. move=> GtrS; apply/subsetP=> a Ga; rewrite !inE. by apply/subsetP=> x /(atransP GtrS) <-; rewrite inE imset_f. Qed. Lemma atrans_supgroup G H S : G \subset H -> [transitive G, on S | to] -> [transitive H, on S | to] = [acts H, on S | to]. Proof. move=> sGH trG; apply/idP/idP=> [|actH]; first exact: atrans_acts. case/imsetP: trG => x Sx defS; apply/imsetP; exists x => //. by apply/eqP; rewrite eqEsubset acts_sub_orbit ?Sx // defS imsetS. Qed. Lemma atrans_acts_card G S : [transitive G, on S | to] = [acts G, on S | to] && (#|orbit to G @: S| == 1%N). Proof. apply/idP/andP=> [GtrS | [nSG]]. split; first exact: atrans_acts. rewrite ((_ @: S =P [set S]) _) ?cards1 // eqEsubset sub1set. apply/andP; split=> //; apply/subsetP=> _ /imsetP[x Sx ->]. by rewrite inE (atransP GtrS). rewrite eqn_leq andbC lt0n => /andP[/existsP[X /imsetP[x Sx X_Gx]]]. rewrite (cardD1 X) {X}X_Gx imset_f // ltnS leqn0 => /eqP GtrS. apply/imsetP; exists x => //; apply/eqP. rewrite eqEsubset acts_sub_orbit // Sx andbT. apply/subsetP=> y Sy; have:= card0_eq GtrS (orbit to G y). by rewrite !inE /= imset_f // andbT => /eqP <-; apply: orbit_refl. Qed. Lemma atrans_dvd G S : [transitive G, on S | to] -> #|S| %| #|G|. Proof. by case/imsetP=> x _ ->; apply: dvdn_orbit. Qed. (* This is Aschbacher (5.2) *) Lemma acts_fix_norm A B : A \subset 'N(B) -> [acts A, on 'Fix_to(B) | to]. Proof. move=> nAB; have:= acts_subnorm_fix to B; rewrite !setTI. exact: subset_trans. Qed. Lemma faithfulP A S : reflect (forall a, a \in A -> {in S, to^~ a =1 id} -> a = 1) [faithful A, on S | to]. Proof. apply: (iffP subsetP) => [Cto1 a Aa Ca | Cto1 a]. by apply/set1P; rewrite Cto1 // inE Aa; apply/astabP. by case/setIP=> Aa /astabP Ca; apply/set1P; apply: Cto1. Qed. (* This is the first part of Aschbacher (5.7) *) Lemma astab_trans_gcore G S u : [transitive G, on S | to] -> u \in S -> 'C(S | to) = gcore 'C[u | to] G. Proof. move=> transG Su; apply/eqP; rewrite eqEsubset. rewrite gcore_max ?astabS ?sub1set //=; last first. exact: subset_trans (atrans_acts transG) (astab_norm _ _). apply/subsetP=> x cSx; apply/astabP=> uy. case/(atransP2 transG Su) => y Gy ->{uy}. by apply/astab1P; rewrite astab1_act (bigcapP cSx). Qed. (* This is Aschbacher (5.20) *) Theorem subgroup_transitiveP G H S x : x \in S -> H \subset G -> [transitive G, on S | to] -> reflect ('C_G[x | to] * H = G) [transitive H, on S | to]. Proof. by move=> Sx sHG; apply: subgroup_transitivePin (subsetT G). Qed. (* This is Aschbacher (5.21) *) Lemma trans_subnorm_fixP x G H S : let C := 'C_G[x | to] in let T := 'Fix_(S | to)(H) in [transitive G, on S | to] -> x \in S -> H \subset C -> reflect ((H :^: G) ::&: C = H :^: C) [transitive 'N_G(H), on T | to]. Proof. move=> C T trGS Sx sHC; have actGS := acts_act (atrans_acts trGS). have:= sHC; rewrite subsetI sub_astab1 => /andP[sHG cHx]. have Tx: x \in T by rewrite inE Sx. apply: (iffP idP) => [trN | trC]. apply/setP=> Ha; apply/setIdP/imsetP=> [[]|[a Ca ->{Ha}]]; last first. by rewrite conj_subG //; case/setIP: Ca => Ga _; rewrite imset_f. case/imsetP=> a Ga ->{Ha}; rewrite subsetI !sub_conjg => /andP[_ sHCa]. have Txa: to x a^-1 \in T. by rewrite inE -sub_astab1 astab1_act actGS ?Sx ?groupV. have [b] := atransP2 trN Tx Txa; case/setIP=> Gb nHb cxba. exists (b * a); last by rewrite conjsgM (normP nHb). by rewrite inE groupM //; apply/astab1P; rewrite actM -cxba actKV. apply/imsetP; exists x => //; apply/setP=> y; apply/idP/idP=> [Ty|]. have [Sy cHy]:= setIP Ty; have [a Ga defy] := atransP2 trGS Sx Sy. have: H :^ a^-1 \in H :^: C. rewrite -trC inE subsetI imset_f 1?conj_subG ?groupV // sub_conjgV. by rewrite -astab1_act -defy sub_astab1. case/imsetP=> b /setIP[Gb /astab1P cxb] defHb. rewrite defy -{1}cxb -actM mem_orbit // inE groupM //. by apply/normP; rewrite conjsgM -defHb conjsgKV. case/imsetP=> a /setIP[Ga nHa] ->{y}. by rewrite inE actGS // Sx (acts_act (acts_fix_norm _) nHa). Qed. End TotalActions. Arguments astabP {aT rT to S a}. Arguments orbit_eqP {aT rT to G x y}. Arguments astab1P {aT rT to x a}. Arguments astabsP {aT rT to S a}. Arguments atransP {aT rT to G S}. Arguments actsP {aT rT to A S}. Arguments faithfulP {aT rT to A S}. Section Restrict. Variables (aT : finGroupType) (D : {set aT}) (rT : Type). Variables (to : action D rT) (A : {set aT}). Definition ract of A \subset D := act to. Variable sAD : A \subset D. Lemma ract_is_action : is_action A (ract sAD). Proof. rewrite /ract; case: to => f [injf fM]. by split=> // x; apply: (sub_in2 (subsetP sAD)). Qed. Canonical raction := Action ract_is_action. Lemma ractE : raction =1 to. Proof. by []. Qed. (* Other properties of raction need rT : finType; we defer them *) (* until after the definition of actperm. *) End Restrict. Notation "to \ sAD" := (raction to sAD) (at level 50) : action_scope. Section ActBy. Variables (aT : finGroupType) (D : {set aT}) (rT : finType). Definition actby_cond (A : {set aT}) R (to : action D rT) : Prop := [acts A, on R | to]. Definition actby A R to of actby_cond A R to := fun x a => if (x \in R) && (a \in A) then to x a else x. Variables (A : {group aT}) (R : {set rT}) (to : action D rT). Hypothesis nRA : actby_cond A R to. Lemma actby_is_action : is_action A (actby nRA). Proof. rewrite /actby; split=> [a x y | x a b Aa Ab /=]; last first. rewrite Aa Ab groupM // !andbT actMin ?(subsetP (acts_dom nRA)) //. by case Rx: (x \in R); rewrite ?(acts_act nRA) ?Rx. case Aa: (a \in A); rewrite ?andbF ?andbT //. case Rx: (x \in R); case Ry: (y \in R) => // eqxy; first exact: act_inj eqxy. by rewrite -eqxy (acts_act nRA Aa) Rx in Ry. by rewrite eqxy (acts_act nRA Aa) Ry in Rx. Qed. Canonical action_by := Action actby_is_action. Local Notation "<[nRA]>" := action_by : action_scope. Lemma actbyE x a : x \in R -> a \in A -> <[nRA]>%act x a = to x a. Proof. by rewrite /= /actby => -> ->. Qed. Lemma afix_actby B : 'Fix_<[nRA]>(B) = ~: R :|: 'Fix_to(A :&: B). Proof. apply/setP=> x; rewrite !inE /= /actby. case: (x \in R); last by apply/subsetP=> a _; rewrite !inE. apply/subsetP/subsetP=> [cBx a | cABx a Ba]; rewrite !inE. by case/andP=> Aa /cBx; rewrite inE Aa. by case: ifP => //= Aa; have:= cABx a; rewrite !inE Aa => ->. Qed. Lemma astab_actby S : 'C(S | <[nRA]>) = 'C_A(R :&: S | to). Proof. apply/setP=> a; rewrite setIA (setIidPl (acts_dom nRA)) !inE. case Aa: (a \in A) => //=; apply/subsetP/subsetP=> cRSa x => [|Sx]. by case/setIP=> Rx /cRSa; rewrite !inE actbyE. by have:= cRSa x; rewrite !inE /= /actby Aa Sx; case: (x \in R) => //; apply. Qed. Lemma astabs_actby S : 'N(S | <[nRA]>) = 'N_A(R :&: S | to). Proof. apply/setP=> a; rewrite setIA (setIidPl (acts_dom nRA)) !inE. case Aa: (a \in A) => //=; apply/subsetP/subsetP=> nRSa x => [|Sx]. by case/setIP=> Rx /nRSa; rewrite !inE actbyE ?(acts_act nRA) ?Rx. have:= nRSa x; rewrite !inE /= /actby Aa Sx ?(acts_act nRA) //. by case: (x \in R) => //; apply. Qed. Lemma acts_actby (B : {set aT}) S : [acts B, on S | <[nRA]>] = (B \subset A) && [acts B, on R :&: S | to]. Proof. by rewrite astabs_actby subsetI. Qed. End ActBy. Notation "<[ nRA ] >" := (action_by nRA) : action_scope. Section SubAction. Variables (aT : finGroupType) (D : {group aT}). Variables (rT : finType) (sP : pred rT) (sT : subFinType sP) (to : action D rT). Implicit Type A : {set aT}. Implicit Type u : sT. Implicit Type S : {set sT}. Definition subact_dom := 'N([set x | sP x] | to). Canonical subact_dom_group := [group of subact_dom]. Implicit Type Na : {a | a \in subact_dom}. Lemma sub_act_proof u Na : sP (to (val u) (val Na)). Proof. by case: Na => a /= /(astabs_act (val u)); rewrite !inE valP. Qed. Definition subact u a := if insub a is Some Na then Sub _ (sub_act_proof u Na) else u. Lemma val_subact u a : val (subact u a) = if a \in subact_dom then to (val u) a else val u. Proof. by rewrite /subact -if_neg; case: insubP => [Na|] -> //=; rewrite SubK => ->. Qed. Lemma subact_is_action : is_action subact_dom subact. Proof. split=> [a u v eq_uv | u a b Na Nb]; apply: val_inj. move/(congr1 val): eq_uv; rewrite !val_subact. by case: (a \in _); first move/act_inj. have Da := astabs_dom Na; have Db := astabs_dom Nb. by rewrite !val_subact Na Nb groupM ?actMin. Qed. Canonical subaction := Action subact_is_action. Lemma astab_subact S : 'C(S | subaction) = subact_dom :&: 'C(val @: S | to). Proof. apply/setP=> a; rewrite inE in_setI; apply: andb_id2l => sDa. have [Da _] := setIP sDa; rewrite !inE Da. apply/subsetP/subsetP=> [cSa _ /imsetP[x Sx ->] | cSa x Sx]; rewrite !inE. by have:= cSa x Sx; rewrite inE -val_eqE val_subact sDa. by have:= cSa _ (imset_f val Sx); rewrite inE -val_eqE val_subact sDa. Qed. Lemma astabs_subact S : 'N(S | subaction) = subact_dom :&: 'N(val @: S | to). Proof. apply/setP=> a; rewrite inE in_setI; apply: andb_id2l => sDa. have [Da _] := setIP sDa; rewrite !inE Da. apply/subsetP/subsetP=> [nSa _ /imsetP[x Sx ->] | nSa x Sx]; rewrite !inE. by have:= nSa x Sx; rewrite inE => /(imset_f val); rewrite val_subact sDa. have:= nSa _ (imset_f val Sx); rewrite inE => /imsetP[y Sy def_y]. by rewrite ((_ a =P y) _) // -val_eqE val_subact sDa def_y. Qed. Lemma afix_subact A : A \subset subact_dom -> 'Fix_subaction(A) = val @^-1: 'Fix_to(A). Proof. move/subsetP=> sAD; apply/setP=> u. rewrite !inE !(sameP setIidPl eqP); congr (_ == A). apply/setP=> a; rewrite !inE; apply: andb_id2l => Aa. by rewrite -val_eqE val_subact sAD. Qed. End SubAction. Notation "to ^?" := (subaction _ to) (at level 2, format "to ^?") : action_scope. Section QuotientAction. Variables (aT : finGroupType) (D : {group aT}) (rT : finGroupType). Variables (to : action D rT) (H : {group rT}). Definition qact_dom := 'N(rcosets H 'N(H) | to^*). Canonical qact_dom_group := [group of qact_dom]. Local Notation subdom := (subact_dom (coset_range H) to^*). Fact qact_subdomE : subdom = qact_dom. Proof. by congr 'N(_|_); apply/setP=> Hx; rewrite !inE genGid. Qed. Lemma qact_proof : qact_dom \subset subdom. Proof. by rewrite qact_subdomE. Qed. Definition qact : coset_of H -> aT -> coset_of H := act (to^*^? \ qact_proof). Canonical quotient_action := [action of qact]. Lemma acts_qact_dom : [acts qact_dom, on 'N(H) | to]. Proof. apply/subsetP=> a nNa; rewrite !inE (astabs_dom nNa); apply/subsetP=> x Nx. have: H :* x \in rcosets H 'N(H) by rewrite -rcosetE imset_f. rewrite inE -(astabs_act _ nNa) => /rcosetsP[y Ny defHy]. have: to x a \in H :* y by rewrite -defHy (imset_f (to^~a)) ?rcoset_refl. by apply: subsetP; rewrite mul_subG ?sub1set ?normG. Qed. Lemma qactEcond x a : x \in 'N(H) -> quotient_action (coset H x) a = coset H (if a \in qact_dom then to x a else x). Proof. move=> Nx; apply: val_inj; rewrite val_subact //= qact_subdomE. have: H :* x \in rcosets H 'N(H) by rewrite -rcosetE imset_f. case nNa: (a \in _); rewrite // -(astabs_act _ nNa). rewrite !val_coset ?(acts_act acts_qact_dom nNa) //=. case/rcosetsP=> y Ny defHy; rewrite defHy; apply: rcoset_eqP. by rewrite rcoset_sym -defHy (imset_f (_^~_)) ?rcoset_refl. Qed. Lemma qactE x a : x \in 'N(H) -> a \in qact_dom -> quotient_action (coset H x) a = coset H (to x a). Proof. by move=> Nx nNa; rewrite qactEcond ?nNa. Qed. Lemma acts_quotient (A : {set aT}) (B : {set rT}) : A \subset 'N_qact_dom(B | to) -> [acts A, on B / H | quotient_action]. Proof. move=> nBA; apply: subset_trans {A}nBA _; apply/subsetP=> a /setIP[dHa nBa]. rewrite inE dHa inE; apply/subsetP=> _ /morphimP[x nHx Bx ->]. rewrite inE /= qactE //. by rewrite mem_morphim ?(acts_act acts_qact_dom) ?(astabs_act _ nBa). Qed. Lemma astabs_quotient (G : {group rT}) : H <| G -> 'N(G / H | quotient_action) = 'N_qact_dom(G | to). Proof. move=> nsHG; have [_ nHG] := andP nsHG. apply/eqP; rewrite eqEsubset acts_quotient // andbT. apply/subsetP=> a nGa; have dHa := astabs_dom nGa; have [Da _]:= setIdP dHa. rewrite inE dHa 2!inE Da; apply/subsetP=> x Gx; have nHx := subsetP nHG x Gx. rewrite -(quotientGK nsHG) 2!inE (acts_act acts_qact_dom) ?nHx //= inE. by rewrite -qactE // (astabs_act _ nGa) mem_morphim. Qed. End QuotientAction. Notation "to / H" := (quotient_action to H) : action_scope. Section ModAction. Variables (aT : finGroupType) (D : {group aT}) (rT : finType). Variable to : action D rT. Implicit Types (G : {group aT}) (S : {set rT}). Section GenericMod. Variable H : {group aT}. Local Notation dom := 'N_D(H). Local Notation range := 'Fix_to(D :&: H). Let acts_dom : {acts dom, on range | to} := acts_act (acts_subnorm_fix to H). Definition modact x (Ha : coset_of H) := if x \in range then to x (repr (D :&: Ha)) else x. Lemma modactEcond x a : a \in dom -> modact x (coset H a) = (if x \in range then to x a else x). Proof. case/setIP=> Da Na; case: ifP => Cx; rewrite /modact Cx //. rewrite val_coset // -group_modr ?sub1set //. case: (repr _) / (repr_rcosetP (D :&: H) a) => a' Ha'. by rewrite actMin ?(afixP Cx _ Ha') //; case/setIP: Ha'. Qed. Lemma modactE x a : a \in D -> a \in 'N(H) -> x \in range -> modact x (coset H a) = to x a. Proof. by move=> Da Na Rx; rewrite modactEcond ?Rx // inE Da. Qed. Lemma modact_is_action : is_action (D / H) modact. Proof. split=> [Ha x y | x Ha Hb]; last first. case/morphimP=> a Na Da ->{Ha}; case/morphimP=> b Nb Db ->{Hb}. rewrite -morphM //= !modactEcond // ?groupM ?(introT setIP _) //. by case: ifP => Cx; rewrite ?(acts_dom, Cx, actMin, introT setIP _). case: (set_0Vmem (D :&: Ha)) => [Da0 | [a /setIP[Da NHa]]]. by rewrite /modact Da0 repr_set0 !act1 !if_same. have Na := subsetP (coset_norm _) _ NHa. have NDa: a \in 'N_D(H) by rewrite inE Da. rewrite -(coset_mem NHa) !modactEcond //. do 2![case: ifP]=> Cy Cx // eqxy; first exact: act_inj eqxy. by rewrite -eqxy acts_dom ?Cx in Cy. by rewrite eqxy acts_dom ?Cy in Cx. Qed. Canonical mod_action := Action modact_is_action. Section Stabilizers. Variable S : {set rT}. Hypothesis cSH : H \subset 'C(S | to). Let fixSH : S \subset 'Fix_to(D :&: H). Proof. by rewrite -astabCin ?subsetIl // subIset ?cSH ?orbT. Qed. Lemma astabs_mod : 'N(S | mod_action) = 'N(S | to) / H. Proof. apply/setP=> Ha; apply/idP/morphimP=> [nSa | [a nHa nSa ->]]. case/morphimP: (astabs_dom nSa) => a nHa Da defHa. exists a => //; rewrite !inE Da; apply/subsetP=> x Sx; rewrite !inE. by have:= Sx; rewrite -(astabs_act x nSa) defHa /= modactE ?(subsetP fixSH). have Da := astabs_dom nSa; rewrite !inE mem_quotient //; apply/subsetP=> x Sx. by rewrite !inE /= modactE ?(astabs_act x nSa) ?(subsetP fixSH). Qed. Lemma astab_mod : 'C(S | mod_action) = 'C(S | to) / H. Proof. apply/setP=> Ha; apply/idP/morphimP=> [cSa | [a nHa cSa ->]]. case/morphimP: (astab_dom cSa) => a nHa Da defHa. exists a => //; rewrite !inE Da; apply/subsetP=> x Sx; rewrite !inE. by rewrite -{2}[x](astab_act cSa) // defHa /= modactE ?(subsetP fixSH). have Da := astab_dom cSa; rewrite !inE mem_quotient //; apply/subsetP=> x Sx. by rewrite !inE /= modactE ?(astab_act cSa) ?(subsetP fixSH). Qed. End Stabilizers. Lemma afix_mod G S : H \subset 'C(S | to) -> G \subset 'N_D(H) -> 'Fix_(S | mod_action)(G / H) = 'Fix_(S | to)(G). Proof. move=> cSH /subsetIP[sGD nHG]. apply/eqP; rewrite eqEsubset !subsetI !subsetIl /= -!astabCin ?quotientS //. have cfixH F: H \subset 'C(S :&: F | to). by rewrite (subset_trans cSH) // astabS ?subsetIl. rewrite andbC astab_mod ?quotientS //=; last by rewrite astabCin ?subsetIr. by rewrite -(quotientSGK nHG) //= -astab_mod // astabCin ?quotientS ?subsetIr. Qed. End GenericMod. Lemma modact_faithful G S : [faithful G / 'C_G(S | to), on S | mod_action 'C_G(S | to)]. Proof. rewrite /faithful astab_mod ?subsetIr //=. by rewrite -quotientIG ?subsetIr ?trivg_quotient. Qed. End ModAction. Notation "to %% H" := (mod_action to H) : action_scope. Section ActPerm. (* Morphism to permutations induced by an action. *) Variables (aT : finGroupType) (D : {set aT}) (rT : finType). Variable to : action D rT. Definition actperm a := perm (act_inj to a). Lemma actpermM : {in D &, {morph actperm : a b / a * b}}. Proof. by move=> a b Da Db; apply/permP=> x; rewrite permM !permE actMin. Qed. Canonical actperm_morphism := Morphism actpermM. Lemma actpermE a x : actperm a x = to x a. Proof. by rewrite permE. Qed. Lemma actpermK x a : aperm x (actperm a) = to x a. Proof. exact: actpermE. Qed. Lemma ker_actperm : 'ker actperm = 'C(setT | to). Proof. congr (_ :&: _); apply/setP=> a; rewrite !inE /=. apply/eqP/subsetP=> [a1 x _ | a1]; first by rewrite inE -actpermE a1 perm1. by apply/permP=> x; apply/eqP; have:= a1 x; rewrite !inE actpermE perm1 => ->. Qed. End ActPerm. Section RestrictActionTheory. Variables (aT : finGroupType) (D : {set aT}) (rT : finType). Variables (to : action D rT). Lemma faithful_isom (A : {group aT}) S (nSA : actby_cond A S to) : [faithful A, on S | to] -> isom A (actperm <[nSA]> @* A) (actperm <[nSA]>). Proof. by move=> ffulAS; apply/isomP; rewrite ker_actperm astab_actby setIT. Qed. Variables (A : {set aT}) (sAD : A \subset D). Lemma ractpermE : actperm (to \ sAD) =1 actperm to. Proof. by move=> a; apply/permP=> x; rewrite !permE. Qed. Lemma afix_ract B : 'Fix_(to \ sAD)(B) = 'Fix_to(B). Proof. by []. Qed. Lemma astab_ract S : 'C(S | to \ sAD) = 'C_A(S | to). Proof. by rewrite setIA (setIidPl sAD). Qed. Lemma astabs_ract S : 'N(S | to \ sAD) = 'N_A(S | to). Proof. by rewrite setIA (setIidPl sAD). Qed. Lemma acts_ract (B : {set aT}) S : [acts B, on S | to \ sAD] = (B \subset A) && [acts B, on S | to]. Proof. by rewrite astabs_ract subsetI. Qed. End RestrictActionTheory. Section MorphAct. (* Action induced by a morphism to permutations. *) Variables (aT : finGroupType) (D : {group aT}) (rT : finType). Variable phi : {morphism D >-> {perm rT}}. Definition mact x a := phi a x. Lemma mact_is_action : is_action D mact. Proof. split=> [a x y | x a b Da Db]; first exact: perm_inj. by rewrite /mact morphM //= permM. Qed. Canonical morph_action := Action mact_is_action. Lemma mactE x a : morph_action x a = phi a x. Proof. by []. Qed. Lemma injm_faithful : 'injm phi -> [faithful D, on setT | morph_action]. Proof. move/injmP=> phi_inj; apply/subsetP=> a /setIP[Da /astab_act a1]. apply/set1P/phi_inj => //; apply/permP=> x. by rewrite morph1 perm1 -mactE a1 ?inE. Qed. Lemma perm_mact a : actperm morph_action a = phi a. Proof. by apply/permP=> x; rewrite permE. Qed. End MorphAct. Notation "<< phi >>" := (morph_action phi) : action_scope. Section CompAct. Variables (gT aT : finGroupType) (rT : finType). Variables (D : {set aT}) (to : action D rT). Variables (B : {set gT}) (f : {morphism B >-> aT}). Definition comp_act x e := to x (f e). Lemma comp_is_action : is_action (f @*^-1 D) comp_act. Proof. split=> [e | x e1 e2]; first exact: act_inj. case/morphpreP=> Be1 Dfe1; case/morphpreP=> Be2 Dfe2. by rewrite /comp_act morphM ?actMin. Qed. Canonical comp_action := Action comp_is_action. Lemma comp_actE x e : comp_action x e = to x (f e). Proof. by []. Qed. Lemma afix_comp (A : {set gT}) : A \subset B -> 'Fix_comp_action(A) = 'Fix_to(f @* A). Proof. move=> sAB; apply/setP=> x; rewrite !inE /morphim (setIidPr sAB). apply/subsetP/subsetP=> [cAx _ /imsetP[a Aa ->] | cfAx a Aa]. by move/cAx: Aa; rewrite !inE. by rewrite inE; move/(_ (f a)): cfAx; rewrite inE imset_f // => ->. Qed. Lemma astab_comp S : 'C(S | comp_action) = f @*^-1 'C(S | to). Proof. by apply/setP=> x; rewrite !inE -andbA. Qed. Lemma astabs_comp S : 'N(S | comp_action) = f @*^-1 'N(S | to). Proof. by apply/setP=> x; rewrite !inE -andbA. Qed. End CompAct. Notation "to \o f" := (comp_action to f) : action_scope. Section PermAction. (* Natural action of permutation groups. *) Variable rT : finType. Local Notation gT := {perm rT}. Implicit Types a b c : gT. Lemma aperm_is_action : is_action setT (@aperm rT). Proof. by apply: is_total_action => [x|x a b]; rewrite apermE (perm1, permM). Qed. Canonical perm_action := Action aperm_is_action. Lemma porbitE a : porbit a = orbit perm_action <[a]>%g. Proof. by []. Qed. Lemma perm_act1P a : reflect (forall x, aperm x a = x) (a == 1). Proof. apply: (iffP eqP) => [-> x | a1]; first exact: act1. by apply/permP=> x; rewrite -apermE a1 perm1. Qed. Lemma perm_faithful A : [faithful A, on setT | perm_action]. Proof. apply/subsetP=> a /setIP[Da crTa]. by apply/set1P; apply/permP=> x; rewrite -apermE perm1 (astabP crTa) ?inE. Qed. Lemma actperm_id p : actperm perm_action p = p. Proof. by apply/permP=> x; rewrite permE. Qed. End PermAction. Arguments perm_act1P {rT a}. Notation "'P" := (perm_action _) (at level 8) : action_scope. Section ActpermOrbits. Variables (aT : finGroupType) (D : {group aT}) (rT : finType). Variable to : action D rT. Lemma orbit_morphim_actperm (A : {set aT}) : A \subset D -> orbit 'P (actperm to @* A) =1 orbit to A. Proof. move=> sAD x; rewrite morphimEsub // /orbit -imset_comp. by apply: eq_imset => a //=; rewrite actpermK. Qed. Lemma porbit_actperm (a : aT) : a \in D -> porbit (actperm to a) =1 orbit to <[a]>. Proof. move=> Da x. by rewrite porbitE -orbit_morphim_actperm ?cycle_subG ?morphim_cycle. Qed. End ActpermOrbits. Section RestrictPerm. Variables (T : finType) (S : {set T}). Definition restr_perm := actperm (<[subxx 'N(S | 'P)]>). Canonical restr_perm_morphism := [morphism of restr_perm]. Lemma restr_perm_on p : perm_on S (restr_perm p). Proof. apply/subsetP=> x; apply: contraR => notSx. by rewrite permE /= /actby (negPf notSx). Qed. Lemma triv_restr_perm p : p \notin 'N(S | 'P) -> restr_perm p = 1. Proof. move=> not_nSp; apply/permP=> x. by rewrite !permE /= /actby (negPf not_nSp) andbF. Qed. Lemma restr_permE : {in 'N(S | 'P) & S, forall p, restr_perm p =1 p}. Proof. by move=> y x nSp Sx; rewrite /= actpermE actbyE. Qed. Lemma ker_restr_perm : 'ker restr_perm = 'C(S | 'P). Proof. by rewrite ker_actperm astab_actby setIT (setIidPr (astab_sub _ _)). Qed. Lemma im_restr_perm p : restr_perm p @: S = S. Proof. exact: im_perm_on (restr_perm_on p). Qed. Lemma restr_perm_commute s : commute (restr_perm s) s. Proof. have [sC|/triv_restr_perm->] := boolP (s \in 'N(S | 'P)); last first. exact: (commute_sym (commute1 _)). apply/permP => x; have /= xsS := astabsP sC x; rewrite !permM. have [xS|xNS] := boolP (x \in S); first by rewrite ?(restr_permE) ?xsS. by rewrite !(out_perm (restr_perm_on _)) ?xsS. Qed. End RestrictPerm. Section Symmetry. Variables (T : finType) (S : {set T}). Lemma SymE : Sym S = 'C(~: S | 'P). Proof. apply/setP => s; rewrite inE; apply/idP/astabP => [sS x|/= S_id]. by rewrite inE /= apermE => /out_perm->. by apply/subsetP => x; move=> /(contra_neqN (S_id _)); rewrite inE negbK. Qed. End Symmetry. Section AutIn. Variable gT : finGroupType. Definition Aut_in A (B : {set gT}) := 'N_A(B | 'P) / 'C_A(B | 'P). Variables G H : {group gT}. Hypothesis sHG: H \subset G. Lemma Aut_restr_perm a : a \in Aut G -> restr_perm H a \in Aut H. Proof. move=> AutGa. case nHa: (a \in 'N(H | 'P)); last by rewrite triv_restr_perm ?nHa ?group1. rewrite inE restr_perm_on; apply/morphicP=> x y Hx Hy /=. by rewrite !restr_permE ?groupM // -(autmE AutGa) morphM ?(subsetP sHG). Qed. Lemma restr_perm_Aut : restr_perm H @* Aut G \subset Aut H. Proof. by apply/subsetP=> a'; case/morphimP=> a _ AutGa ->{a'}; apply: Aut_restr_perm. Qed. Lemma Aut_in_isog : Aut_in (Aut G) H \isog restr_perm H @* Aut G. Proof. rewrite /Aut_in -ker_restr_perm kerE -morphpreIdom -morphimIdom -kerE /=. by rewrite setIA (setIC _ (Aut G)) first_isog_loc ?subsetIr. Qed. Lemma Aut_sub_fullP : reflect (forall h : {morphism H >-> gT}, 'injm h -> h @* H = H -> exists g : {morphism G >-> gT}, [/\ 'injm g, g @* G = G & {in H, g =1 h}]) (Aut_in (Aut G) H \isog Aut H). Proof. rewrite (isog_transl _ Aut_in_isog) /=; set rG := _ @* _. apply: (iffP idP) => [iso_rG h injh hH| AutHinG]. have: aut injh hH \in rG; last case/morphimP=> g nHg AutGg def_g. suffices ->: rG = Aut H by apply: Aut_aut. by apply/eqP; rewrite eqEcard restr_perm_Aut /= (card_isog iso_rG). exists (autm_morphism AutGg); rewrite injm_autm im_autm; split=> // x Hx. by rewrite -(autE injh hH Hx) def_g actpermE actbyE. suffices ->: rG = Aut H by apply: isog_refl. apply/eqP; rewrite eqEsubset restr_perm_Aut /=. apply/subsetP=> h AutHh; have hH := im_autm AutHh. have [g [injg gG eq_gh]] := AutHinG _ (injm_autm AutHh) hH. have [Ng AutGg]: aut injg gG \in 'N(H | 'P) /\ aut injg gG \in Aut G. rewrite Aut_aut !inE; split=> //; apply/subsetP=> x Hx. by rewrite inE /= /aperm autE ?(subsetP sHG) // -hH eq_gh ?mem_morphim. apply/morphimP; exists (aut injg gG) => //; apply: (eq_Aut AutHh) => [|x Hx]. by rewrite (subsetP restr_perm_Aut) // mem_morphim. by rewrite restr_permE //= /aperm autE ?eq_gh ?(subsetP sHG). Qed. End AutIn. Arguments Aut_in {gT} A%g B%g. Section InjmAutIn. Variables (gT rT : finGroupType) (D G H : {group gT}) (f : {morphism D >-> rT}). Hypotheses (injf : 'injm f) (sGD : G \subset D) (sHG : H \subset G). Let sHD := subset_trans sHG sGD. Local Notation fGisom := (Aut_isom injf sGD). Local Notation fHisom := (Aut_isom injf sHD). Local Notation inH := (restr_perm H). Local Notation infH := (restr_perm (f @* H)). Lemma astabs_Aut_isom a : a \in Aut G -> (fGisom a \in 'N(f @* H | 'P)) = (a \in 'N(H | 'P)). Proof. move=> AutGa; rewrite !inE sub_morphim_pre // subsetI sHD /= /aperm. rewrite !(sameP setIidPl eqP) !eqEsubset !subsetIl; apply: eq_subset_r => x. rewrite !inE; apply: andb_id2l => Hx; have Gx: x \in G := subsetP sHG x Hx. have Dax: a x \in D by rewrite (subsetP sGD) // Aut_closed. by rewrite Aut_isomE // -!sub1set -morphim_set1 // injmSK ?sub1set. Qed. Lemma isom_restr_perm a : a \in Aut G -> fHisom (inH a) = infH (fGisom a). Proof. move=> AutGa; case nHa: (a \in 'N(H | 'P)); last first. by rewrite !triv_restr_perm ?astabs_Aut_isom ?nHa ?morph1. apply: (eq_Aut (Aut_Aut_isom injf sHD _)) => [|fx Hfx /=]. by rewrite (Aut_restr_perm (morphimS f sHG)) ?Aut_Aut_isom. have [x Dx Hx def_fx] := morphimP Hfx; have Gx := subsetP sHG x Hx. rewrite {1}def_fx Aut_isomE ?(Aut_restr_perm sHG) //. by rewrite !restr_permE ?astabs_Aut_isom // def_fx Aut_isomE. Qed. Lemma restr_perm_isom : isom (inH @* Aut G) (infH @* Aut (f @* G)) fHisom. Proof. apply: sub_isom; rewrite ?restr_perm_Aut ?injm_Aut_isom //=. rewrite -(im_Aut_isom injf sGD) -!morphim_comp. apply: eq_in_morphim; last exact: isom_restr_perm. apply/setP=> a; rewrite 2!in_setI; apply: andb_id2r => AutGa. rewrite /= inE andbC inE (Aut_restr_perm sHG) //=. by symmetry; rewrite inE AutGa inE astabs_Aut_isom. Qed. Lemma injm_Aut_sub : Aut_in (Aut (f @* G)) (f @* H) \isog Aut_in (Aut G) H. Proof. do 2!rewrite isog_sym (isog_transl _ (Aut_in_isog _ _)). by rewrite isog_sym (isom_isog _ _ restr_perm_isom) // restr_perm_Aut. Qed. Lemma injm_Aut_full : (Aut_in (Aut (f @* G)) (f @* H) \isog Aut (f @* H)) = (Aut_in (Aut G) H \isog Aut H). Proof. by rewrite (isog_transl _ injm_Aut_sub) (isog_transr _ (injm_Aut injf sHD)). Qed. End InjmAutIn. Section GroupAction. Variables (aT rT : finGroupType) (D : {set aT}) (R : {set rT}). Local Notation actT := (action D rT). Definition is_groupAction (to : actT) := {in D, forall a, actperm to a \in Aut R}. Structure groupAction := GroupAction {gact :> actT; _ : is_groupAction gact}. Definition clone_groupAction to := let: GroupAction _ toA := to return {type of GroupAction for to} -> _ in fun k => k toA : groupAction. End GroupAction. Delimit Scope groupAction_scope with gact. Bind Scope groupAction_scope with groupAction. Arguments is_groupAction {aT rT D%g} R%g to%act. Arguments groupAction {aT rT} D%g R%g. Arguments gact {aT rT D%g R%g} to%gact : rename. Notation "[ 'groupAction' 'of' to ]" := (clone_groupAction (@GroupAction _ _ _ _ to)) (at level 0, format "[ 'groupAction' 'of' to ]") : form_scope. Section GroupActionDefs. Variables (aT rT : finGroupType) (D : {set aT}) (R : {set rT}). Implicit Type A : {set aT}. Implicit Type S : {set rT}. Implicit Type to : groupAction D R. Definition gact_range of groupAction D R := R. Definition gacent to A := 'Fix_(R | to)(D :&: A). Definition acts_on_group A S to := [acts A, on S | to] /\ S \subset R. Coercion actby_cond_group A S to : acts_on_group A S to -> actby_cond A S to := @proj1 _ _. Definition acts_irreducibly A S to := [min S of G | G :!=: 1 & [acts A, on G | to]]. End GroupActionDefs. Arguments gacent {aT rT D%g R%g} to%gact A%g. Arguments acts_on_group {aT rT D%g R%g} A%g S%g to%gact. Arguments acts_irreducibly {aT rT D%g R%g} A%g S%g to%gact. Notation "''C_' ( | to ) ( A )" := (gacent to A) (at level 8, format "''C_' ( | to ) ( A )") : group_scope. Notation "''C_' ( G | to ) ( A )" := (G :&: 'C_(|to)(A)) (at level 8, format "''C_' ( G | to ) ( A )") : group_scope. Notation "''C_' ( | to ) [ a ]" := 'C_(|to)([set a]) (at level 8, format "''C_' ( | to ) [ a ]") : group_scope. Notation "''C_' ( G | to ) [ a ]" := 'C_(G | to)([set a]) (at level 8, format "''C_' ( G | to ) [ a ]") : group_scope. Notation "{ 'acts' A , 'on' 'group' G | to }" := (acts_on_group A G to) (at level 0, format "{ 'acts' A , 'on' 'group' G | to }") : form_scope. Section RawGroupAction. Variables (aT rT : finGroupType) (D : {set aT}) (R : {set rT}). Variable to : groupAction D R. Lemma actperm_Aut : is_groupAction R to. Proof. by case: to. Qed. Lemma im_actperm_Aut : actperm to @* D \subset Aut R. Proof. by apply/subsetP=> _ /morphimP[a _ Da ->]; apply: actperm_Aut. Qed. Lemma gact_out x a : a \in D -> x \notin R -> to x a = x. Proof. by move=> Da Rx; rewrite -actpermE (out_Aut _ Rx) ?actperm_Aut. Qed. Lemma gactM : {in D, forall a, {in R &, {morph to^~ a : x y / x * y}}}. Proof. move=> a Da /= x y; rewrite -!(actpermE to); apply: morphicP x y. by rewrite Aut_morphic ?actperm_Aut. Qed. Lemma actmM a : {in R &, {morph actm to a : x y / x * y}}. Proof. by rewrite /actm; case: ifP => //; apply: gactM. Qed. Canonical act_morphism a := Morphism (actmM a). Lemma morphim_actm : {in D, forall a (S : {set rT}), S \subset R -> actm to a @* S = to^* S a}. Proof. by move=> a Da /= S sSR; rewrite /morphim /= actmEfun ?(setIidPr _). Qed. Variables (a : aT) (A B : {set aT}) (S : {set rT}). Lemma gacentIdom : 'C_(|to)(D :&: A) = 'C_(|to)(A). Proof. by rewrite /gacent setIA setIid. Qed. Lemma gacentIim : 'C_(R | to)(A) = 'C_(|to)(A). Proof. by rewrite setIA setIid. Qed. Lemma gacentS : A \subset B -> 'C_(|to)(B) \subset 'C_(|to)(A). Proof. by move=> sAB; rewrite !(setIS, afixS). Qed. Lemma gacentU : 'C_(|to)(A :|: B) = 'C_(|to)(A) :&: 'C_(|to)(B). Proof. by rewrite -setIIr -afixU -setIUr. Qed. Hypotheses (Da : a \in D) (sAD : A \subset D) (sSR : S \subset R). Lemma gacentE : 'C_(|to)(A) = 'Fix_(R | to)(A). Proof. by rewrite -{2}(setIidPr sAD). Qed. Lemma gacent1E : 'C_(|to)[a] = 'Fix_(R | to)[a]. Proof. by rewrite /gacent [D :&: _](setIidPr _) ?sub1set. Qed. Lemma subgacentE : 'C_(S | to)(A) = 'Fix_(S | to)(A). Proof. by rewrite gacentE setIA (setIidPl sSR). Qed. Lemma subgacent1E : 'C_(S | to)[a] = 'Fix_(S | to)[a]. Proof. by rewrite gacent1E setIA (setIidPl sSR). Qed. End RawGroupAction. Section GroupActionTheory. Variables aT rT : finGroupType. Variables (D : {group aT}) (R : {group rT}) (to : groupAction D R). Implicit Type A B : {set aT}. Implicit Types G H : {group aT}. Implicit Type S : {set rT}. Implicit Types M N : {group rT}. Lemma gact1 : {in D, forall a, to 1 a = 1}. Proof. by move=> a Da; rewrite /= -actmE ?morph1. Qed. Lemma gactV : {in D, forall a, {in R, {morph to^~ a : x / x^-1}}}. Proof. by move=> a Da /= x Rx; move; rewrite -!actmE ?morphV. Qed. Lemma gactX : {in D, forall a n, {in R, {morph to^~ a : x / x ^+ n}}}. Proof. by move=> a Da /= n x Rx; rewrite -!actmE // morphX. Qed. Lemma gactJ : {in D, forall a, {in R &, {morph to^~ a : x y / x ^ y}}}. Proof. by move=> a Da /= x Rx y Ry; rewrite -!actmE // morphJ. Qed. Lemma gactR : {in D, forall a, {in R &, {morph to^~ a : x y / [~ x, y]}}}. Proof. by move=> a Da /= x Rx y Ry; rewrite -!actmE // morphR. Qed. Lemma gact_stable : {acts D, on R | to}. Proof. apply: acts_act; apply/subsetP=> a Da; rewrite !inE Da. apply/subsetP=> x; rewrite inE; apply: contraLR => R'xa. by rewrite -(actKin to Da x) gact_out ?groupV. Qed. Lemma group_set_gacent A : group_set 'C_(|to)(A). Proof. apply/group_setP; split=> [|x y]. by rewrite !inE group1; apply/subsetP=> a /setIP[Da _]; rewrite inE gact1. case/setIP=> Rx /afixP cAx /setIP[Ry /afixP cAy]. rewrite inE groupM //; apply/afixP=> a Aa. by rewrite gactM ?cAx ?cAy //; case/setIP: Aa. Qed. Canonical gacent_group A := Group (group_set_gacent A). Lemma gacent1 : 'C_(|to)(1) = R. Proof. by rewrite /gacent (setIidPr (sub1G _)) afix1 setIT. Qed. Lemma gacent_gen A : A \subset D -> 'C_(|to)(<>) = 'C_(|to)(A). Proof. by move=> sAD; rewrite /gacent ![D :&: _](setIidPr _) ?gen_subG ?afix_gen_in. Qed. Lemma gacentD1 A : 'C_(|to)(A^#) = 'C_(|to)(A). Proof. rewrite -gacentIdom -gacent_gen ?subsetIl // setIDA genD1 ?group1 //. by rewrite gacent_gen ?subsetIl // gacentIdom. Qed. Lemma gacent_cycle a : a \in D -> 'C_(|to)(<[a]>) = 'C_(|to)[a]. Proof. by move=> Da; rewrite gacent_gen ?sub1set. Qed. Lemma gacentY A B : A \subset D -> B \subset D -> 'C_(|to)(A <*> B) = 'C_(|to)(A) :&: 'C_(|to)(B). Proof. by move=> sAD sBD; rewrite gacent_gen ?gacentU // subUset sAD. Qed. Lemma gacentM G H : G \subset D -> H \subset D -> 'C_(|to)(G * H) = 'C_(|to)(G) :&: 'C_(|to)(H). Proof. by move=> sGD sHB; rewrite -gacent_gen ?mul_subG // genM_join gacentY. Qed. Lemma astab1 : 'C(1 | to) = D. Proof. by apply/setP=> x; rewrite ?(inE, sub1set) andb_idr //; move/gact1=> ->. Qed. Lemma astab_range : 'C(R | to) = 'C(setT | to). Proof. apply/eqP; rewrite eqEsubset andbC astabS ?subsetT //=. apply/subsetP=> a cRa; have Da := astab_dom cRa; rewrite !inE Da. apply/subsetP=> x; rewrite -(setUCr R) !inE. by case/orP=> ?; [rewrite (astab_act cRa) | rewrite gact_out]. Qed. Lemma gacentC A S : A \subset D -> S \subset R -> (S \subset 'C_(|to)(A)) = (A \subset 'C(S | to)). Proof. by move=> sAD sSR; rewrite subsetI sSR astabCin // (setIidPr sAD). Qed. Lemma astab_gen S : S \subset R -> 'C(<> | to) = 'C(S | to). Proof. move=> sSR; apply/setP=> a; case Da: (a \in D); last by rewrite !inE Da. by rewrite -!sub1set -!gacentC ?sub1set ?gen_subG. Qed. Lemma astabM M N : M \subset R -> N \subset R -> 'C(M * N | to) = 'C(M | to) :&: 'C(N | to). Proof. move=> sMR sNR; rewrite -astabU -astab_gen ?mul_subG // genM_join. by rewrite astab_gen // subUset sMR. Qed. Lemma astabs1 : 'N(1 | to) = D. Proof. by rewrite astabs_set1 astab1. Qed. Lemma astabs_range : 'N(R | to) = D. Proof. apply/setIidPl; apply/subsetP=> a Da; rewrite inE. by apply/subsetP=> x Rx; rewrite inE gact_stable. Qed. Lemma astabsD1 S : 'N(S^# | to) = 'N(S | to). Proof. case S1: (1 \in S); last first. by rewrite (setDidPl _) // disjoint_sym disjoints_subset sub1set inE S1. apply/eqP; rewrite eqEsubset andbC -{1}astabsIdom -{1}astabs1 setIC astabsD /=. by rewrite -{2}(setD1K S1) -astabsIdom -{1}astabs1 astabsU. Qed. Lemma gacts_range A : A \subset D -> {acts A, on group R | to}. Proof. by move=> sAD; split; rewrite ?astabs_range. Qed. Lemma acts_subnorm_gacent A : A \subset D -> [acts 'N_D(A), on 'C_(| to)(A) | to]. Proof. move=> sAD; rewrite gacentE // actsI ?astabs_range ?subsetIl //. by rewrite -{2}(setIidPr sAD) acts_subnorm_fix. Qed. Lemma acts_subnorm_subgacent A B S : A \subset D -> [acts B, on S | to] -> [acts 'N_B(A), on 'C_(S | to)(A) | to]. Proof. move=> sAD actsB; rewrite actsI //; first by rewrite subIset ?actsB. by rewrite (subset_trans _ (acts_subnorm_gacent sAD)) ?setSI ?(acts_dom actsB). Qed. Lemma acts_gen A S : S \subset R -> [acts A, on S | to] -> [acts A, on <> | to]. Proof. move=> sSR actsA; apply: {A}subset_trans actsA _. apply/subsetP=> a nSa; have Da := astabs_dom nSa; rewrite !inE Da. apply: subset_trans (_ : <> \subset actm to a @*^-1 <>) _. rewrite gen_subG subsetI sSR; apply/subsetP=> x Sx. by rewrite inE /= actmE ?mem_gen // astabs_act. by apply/subsetP=> x; rewrite !inE; case/andP=> Rx; rewrite /= actmE. Qed. Lemma acts_joing A M N : M \subset R -> N \subset R -> [acts A, on M | to] -> [acts A, on N | to] -> [acts A, on M <*> N | to]. Proof. by move=> sMR sNR nMA nNA; rewrite acts_gen ?actsU // subUset sMR. Qed. Lemma injm_actm a : 'injm (actm to a). Proof. apply/injmP=> x y Rx Ry; rewrite /= /actm; case: ifP => Da //. exact: act_inj. Qed. Lemma im_actm a : actm to a @* R = R. Proof. apply/eqP; rewrite eqEcard (card_injm (injm_actm a)) // leqnn andbT. apply/subsetP=> _ /morphimP[x Rx _ ->] /=. by rewrite /actm; case: ifP => // Da; rewrite gact_stable. Qed. Lemma acts_char G M : G \subset D -> M \char R -> [acts G, on M | to]. Proof. move=> sGD /charP[sMR charM]. apply/subsetP=> a Ga; have Da := subsetP sGD a Ga; rewrite !inE Da. apply/subsetP=> x Mx; have Rx := subsetP sMR x Mx. by rewrite inE -(charM _ (injm_actm a) (im_actm a)) -actmE // mem_morphim. Qed. Lemma gacts_char G M : G \subset D -> M \char R -> {acts G, on group M | to}. Proof. by move=> sGD charM; split; rewrite (acts_char, char_sub). Qed. Section Restrict. Variables (A : {group aT}) (sAD : A \subset D). Lemma ract_is_groupAction : is_groupAction R (to \ sAD). Proof. by move=> a Aa /=; rewrite ractpermE actperm_Aut ?(subsetP sAD). Qed. Canonical ract_groupAction := GroupAction ract_is_groupAction. Lemma gacent_ract B : 'C_(|ract_groupAction)(B) = 'C_(|to)(A :&: B). Proof. by rewrite /gacent afix_ract setIA (setIidPr sAD). Qed. End Restrict. Section ActBy. Variables (A : {group aT}) (G : {group rT}) (nGAg : {acts A, on group G | to}). Lemma actby_is_groupAction : is_groupAction G <[nGAg]>. Proof. move=> a Aa; rewrite /= inE; apply/andP; split. apply/subsetP=> x; apply: contraR => Gx. by rewrite actpermE /= /actby (negbTE Gx). apply/morphicP=> x y Gx Gy; rewrite !actpermE /= /actby Aa groupM ?Gx ?Gy //=. by case nGAg; move/acts_dom; do 2!move/subsetP=> ?; rewrite gactM; auto. Qed. Canonical actby_groupAction := GroupAction actby_is_groupAction. Lemma gacent_actby B : 'C_(|actby_groupAction)(B) = 'C_(G | to)(A :&: B). Proof. rewrite /gacent afix_actby !setIA setIid setIUr setICr set0U. by have [nAG sGR] := nGAg; rewrite (setIidPr (acts_dom nAG)) (setIidPl sGR). Qed. End ActBy. Section Quotient. Variable H : {group rT}. Lemma acts_qact_dom_norm : {acts qact_dom to H, on 'N(H) | to}. Proof. move=> a HDa /= x; rewrite {2}(('N(H) =P to^~ a @^-1: 'N(H)) _) ?inE {x}//. rewrite eqEcard (card_preimset _ (act_inj _ _)) leqnn andbT. apply/subsetP=> x Nx; rewrite inE; move/(astabs_act (H :* x)): HDa. rewrite mem_rcosets mulSGid ?normG // Nx => /rcosetsP[y Ny defHy]. suffices: to x a \in H :* y by apply: subsetP; rewrite mul_subG ?sub1set ?normG. by rewrite -defHy; apply: imset_f; apply: rcoset_refl. Qed. Lemma qact_is_groupAction : is_groupAction (R / H) (to / H). Proof. move=> a HDa /=; have Da := astabs_dom HDa. rewrite inE; apply/andP; split. apply/subsetP=> Hx /=; case: (cosetP Hx) => x Nx ->{Hx}. apply: contraR => R'Hx; rewrite actpermE qactE // gact_out //. by apply: contra R'Hx; apply: mem_morphim. apply/morphicP=> Hx Hy; rewrite !actpermE. case/morphimP=> x Nx Gx ->{Hx}; case/morphimP=> y Ny Gy ->{Hy}. by rewrite -morphM ?qactE ?groupM ?gactM // morphM ?acts_qact_dom_norm. Qed. Canonical quotient_groupAction := GroupAction qact_is_groupAction. Lemma qact_domE : H \subset R -> qact_dom to H = 'N(H | to). Proof. move=> sHR; apply/setP=> a; apply/idP/idP=> nHa; have Da := astabs_dom nHa. rewrite !inE Da; apply/subsetP=> x Hx; rewrite inE -(rcoset1 H). have /rcosetsP[y Ny defHy]: to^~ a @: H \in rcosets H 'N(H). by rewrite (astabs_act _ nHa); apply/rcosetsP; exists 1; rewrite ?mulg1. by rewrite (rcoset_eqP (_ : 1 \in H :* y)) -defHy -1?(gact1 Da) mem_setact. rewrite !inE Da; apply/subsetP=> Hx; rewrite inE => /rcosetsP[x Nx ->{Hx}]. apply/imsetP; exists (to x a). case Rx: (x \in R); last by rewrite gact_out ?Rx. rewrite inE; apply/subsetP=> _ /imsetP[y Hy ->]. rewrite -(actKVin to Da y) -gactJ // ?(subsetP sHR, astabs_act, groupV) //. by rewrite memJ_norm // astabs_act ?groupV. apply/eqP; rewrite rcosetE eqEcard. rewrite (card_imset _ (act_inj _ _)) !card_rcoset leqnn andbT. apply/subsetP=> _ /imsetP[y Hxy ->]; rewrite !mem_rcoset in Hxy *. have Rxy := subsetP sHR _ Hxy; rewrite -(mulgKV x y). case Rx: (x \in R); last by rewrite !gact_out ?mulgK // 1?groupMl ?Rx. by rewrite -gactV // -gactM 1?groupMr ?groupV // mulgK astabs_act. Qed. End Quotient. Section Mod. Variable H : {group aT}. Lemma modact_is_groupAction : is_groupAction 'C_(|to)(H) (to %% H). Proof. move=> Ha /morphimP[a Na Da ->]; have NDa: a \in 'N_D(H) by apply/setIP. rewrite inE; apply/andP; split. apply/subsetP=> x; rewrite 2!inE andbC actpermE /= modactEcond //. by apply: contraR; case: ifP => // E Rx; rewrite gact_out. apply/morphicP=> x y /setIP[Rx cHx] /setIP[Ry cHy]. rewrite /= !actpermE /= !modactE ?gactM //. suffices: x * y \in 'C_(|to)(H) by case/setIP. by rewrite groupM //; apply/setIP. Qed. Canonical mod_groupAction := GroupAction modact_is_groupAction. Lemma modgactE x a : H \subset 'C(R | to) -> a \in 'N_D(H) -> (to %% H)%act x (coset H a) = to x a. Proof. move=> cRH NDa /=; have [Da Na] := setIP NDa. have [Rx | notRx] := boolP (x \in R). by rewrite modactE //; apply/afixP=> b /setIP[_ /(subsetP cRH)/astab_act->]. rewrite gact_out //= /modact; case: ifP => // _; rewrite gact_out //. suffices: a \in D :&: coset H a by case/mem_repr/setIP. by rewrite inE Da val_coset // rcoset_refl. Qed. Lemma gacent_mod G M : H \subset 'C(M | to) -> G \subset 'N(H) -> 'C_(M | mod_groupAction)(G / H) = 'C_(M | to)(G). Proof. move=> cMH nHG; rewrite -gacentIdom gacentE ?subsetIl // setICA. have sHD: H \subset D by rewrite (subset_trans cMH) ?subsetIl. rewrite -quotientGI // afix_mod ?setIS // setICA -gacentIim (setIC R) -setIA. rewrite -gacentE ?subsetIl // gacentIdom setICA (setIidPr _) //. by rewrite gacentC // ?(subset_trans cMH) ?astabS ?subsetIl // setICA subsetIl. Qed. Lemma acts_irr_mod G M : H \subset 'C(M | to) -> G \subset 'N(H) -> acts_irreducibly G M to -> acts_irreducibly (G / H) M mod_groupAction. Proof. move=> cMH nHG /mingroupP[/andP[ntM nMG] minM]. apply/mingroupP; rewrite ntM astabs_mod ?quotientS //; split=> // L modL ntL. have cLH: H \subset 'C(L | to) by rewrite (subset_trans cMH) ?astabS //. apply: minM => //; case/andP: modL => ->; rewrite astabs_mod ?quotientSGK //. by rewrite (subset_trans cLH) ?astab_sub. Qed. End Mod. Lemma modact_coset_astab x a : a \in D -> (to %% 'C(R | to))%act x (coset _ a) = to x a. Proof. move=> Da; apply: modgactE => {x}//. rewrite !inE Da; apply/subsetP=> _ /imsetP[c Cc ->]. have Dc := astab_dom Cc; rewrite !inE groupJ //. apply/subsetP=> x Rx; rewrite inE conjgE !actMin ?groupM ?groupV //. by rewrite (astab_act Cc) ?actKVin // gact_stable ?groupV. Qed. Lemma acts_irr_mod_astab G M : acts_irreducibly G M to -> acts_irreducibly (G / 'C_G(M | to)) M (mod_groupAction _). Proof. move=> irrG; have /andP[_ nMG] := mingroupp irrG. apply: acts_irr_mod irrG; first exact: subsetIr. by rewrite normsI ?normG // (subset_trans nMG) // astab_norm. Qed. Section CompAct. Variables (gT : finGroupType) (G : {group gT}) (f : {morphism G >-> aT}). Lemma comp_is_groupAction : is_groupAction R (comp_action to f). Proof. move=> a /morphpreP[Ba Dfa]; apply: etrans (actperm_Aut to Dfa). by congr (_ \in Aut R); apply/permP=> x; rewrite !actpermE. Qed. Canonical comp_groupAction := GroupAction comp_is_groupAction. Lemma gacent_comp U : 'C_(|comp_groupAction)(U) = 'C_(|to)(f @* U). Proof. rewrite /gacent afix_comp ?subIset ?subxx //. by rewrite -(setIC U) (setIC D) morphim_setIpre. Qed. End CompAct. End GroupActionTheory. Notation "''C_' ( | to ) ( A )" := (gacent_group to A) : Group_scope. Notation "''C_' ( G | to ) ( A )" := (setI_group G 'C_(|to)(A)) : Group_scope. Notation "''C_' ( | to ) [ a ]" := (gacent_group to [set a%g]) : Group_scope. Notation "''C_' ( G | to ) [ a ]" := (setI_group G 'C_(|to)[a]) : Group_scope. Notation "to \ sAD" := (ract_groupAction to sAD) : groupAction_scope. Notation "<[ nGA ] >" := (actby_groupAction nGA) : groupAction_scope. Notation "to / H" := (quotient_groupAction to H) : groupAction_scope. Notation "to %% H" := (mod_groupAction to H) : groupAction_scope. Notation "to \o f" := (comp_groupAction to f) : groupAction_scope. (* Operator group isomorphism. *) Section MorphAction. Variables (aT1 aT2 : finGroupType) (rT1 rT2 : finType). Variables (D1 : {group aT1}) (D2 : {group aT2}). Variables (to1 : action D1 rT1) (to2 : action D2 rT2). Variables (A : {set aT1}) (R S : {set rT1}). Variables (h : rT1 -> rT2) (f : {morphism D1 >-> aT2}). Hypotheses (actsDR : {acts D1, on R | to1}) (injh : {in R &, injective h}). Hypothesis defD2 : f @* D1 = D2. Hypotheses (sSR : S \subset R) (sAD1 : A \subset D1). Hypothesis hfJ : {in S & D1, morph_act to1 to2 h f}. Lemma morph_astabs : f @* 'N(S | to1) = 'N(h @: S | to2). Proof. apply/setP=> fx; apply/morphimP/idP=> [[x D1x nSx ->] | nSx]. rewrite 2!inE -{1}defD2 mem_morphim //=; apply/subsetP=> _ /imsetP[u Su ->]. by rewrite inE -hfJ ?imset_f // (astabs_act _ nSx). have [|x D1x _ def_fx] := morphimP (_ : fx \in f @* D1). by rewrite defD2 (astabs_dom nSx). exists x => //; rewrite !inE D1x; apply/subsetP=> u Su. have /imsetP[u' Su' /injh def_u']: h (to1 u x) \in h @: S. by rewrite hfJ // -def_fx (astabs_act _ nSx) imset_f. by rewrite inE def_u' ?actsDR ?(subsetP sSR). Qed. Lemma morph_astab : f @* 'C(S | to1) = 'C(h @: S | to2). Proof. apply/setP=> fx; apply/morphimP/idP=> [[x D1x cSx ->] | cSx]. rewrite 2!inE -{1}defD2 mem_morphim //=; apply/subsetP=> _ /imsetP[u Su ->]. by rewrite inE -hfJ // (astab_act cSx). have [|x D1x _ def_fx] := morphimP (_ : fx \in f @* D1). by rewrite defD2 (astab_dom cSx). exists x => //; rewrite !inE D1x; apply/subsetP=> u Su. rewrite inE -(inj_in_eq injh) ?actsDR ?(subsetP sSR) ?hfJ //. by rewrite -def_fx (astab_act cSx) ?imset_f. Qed. Lemma morph_afix : h @: 'Fix_(S | to1)(A) = 'Fix_(h @: S | to2)(f @* A). Proof. apply/setP=> hu; apply/imsetP/setIP=> [[u /setIP[Su cAu] ->]|]. split; first by rewrite imset_f. by apply/afixP=> _ /morphimP[x D1x Ax ->]; rewrite -hfJ ?(afixP cAu). case=> /imsetP[u Su ->] /afixP c_hu_fA; exists u; rewrite // inE Su. apply/afixP=> x Ax; have Dx := subsetP sAD1 x Ax. by apply: injh; rewrite ?actsDR ?(subsetP sSR) ?hfJ // c_hu_fA ?mem_morphim. Qed. End MorphAction. Section MorphGroupAction. Variables (aT1 aT2 rT1 rT2 : finGroupType). Variables (D1 : {group aT1}) (D2 : {group aT2}). Variables (R1 : {group rT1}) (R2 : {group rT2}). Variables (to1 : groupAction D1 R1) (to2 : groupAction D2 R2). Variables (h : {morphism R1 >-> rT2}) (f : {morphism D1 >-> aT2}). Hypotheses (iso_h : isom R1 R2 h) (iso_f : isom D1 D2 f). Hypothesis hfJ : {in R1 & D1, morph_act to1 to2 h f}. Implicit Types (A : {set aT1}) (S : {set rT1}) (M : {group rT1}). Lemma morph_gastabs S : S \subset R1 -> f @* 'N(S | to1) = 'N(h @* S | to2). Proof. have [[_ defD2] [injh _]] := (isomP iso_f, isomP iso_h). move=> sSR1; rewrite (morphimEsub _ sSR1). apply: (morph_astabs (gact_stable to1) (injmP injh)) => // u x. by move/(subsetP sSR1); apply: hfJ. Qed. Lemma morph_gastab S : S \subset R1 -> f @* 'C(S | to1) = 'C(h @* S | to2). Proof. have [[_ defD2] [injh _]] := (isomP iso_f, isomP iso_h). move=> sSR1; rewrite (morphimEsub _ sSR1). apply: (morph_astab (gact_stable to1) (injmP injh)) => // u x. by move/(subsetP sSR1); apply: hfJ. Qed. Lemma morph_gacent A : A \subset D1 -> h @* 'C_(|to1)(A) = 'C_(|to2)(f @* A). Proof. have [[_ defD2] [injh defR2]] := (isomP iso_f, isomP iso_h). move=> sAD1; rewrite !gacentE //; last by rewrite -defD2 morphimS. rewrite morphimEsub ?subsetIl // -{1}defR2 morphimEdom. exact: (morph_afix (gact_stable to1) (injmP injh)). Qed. Lemma morph_gact_irr A M : A \subset D1 -> M \subset R1 -> acts_irreducibly (f @* A) (h @* M) to2 = acts_irreducibly A M to1. Proof. move=> sAD1 sMR1. have [[injf defD2] [injh defR2]] := (isomP iso_f, isomP iso_h). have h_eq1 := morphim_injm_eq1 injh. apply/mingroupP/mingroupP=> [] [/andP[ntM actAM] minM]. split=> [|U]; first by rewrite -h_eq1 // ntM -(injmSK injf) ?morph_gastabs. case/andP=> ntU acts_fAU sUM; have sUR1 := subset_trans sUM sMR1. apply: (injm_morphim_inj injh) => //; apply: minM; last exact: morphimS. by rewrite h_eq1 // ntU -morph_gastabs ?morphimS. split=> [|U]; first by rewrite h_eq1 // ntM -morph_gastabs ?morphimS. case/andP=> ntU acts_fAU sUhM. have sUhR1 := subset_trans sUhM (morphimS h sMR1). have sU'M: h @*^-1 U \subset M by rewrite sub_morphpre_injm. rewrite /= -(minM _ _ sU'M) ?morphpreK // -h_eq1 ?subsetIl // -(injmSK injf) //. by rewrite morph_gastabs ?(subset_trans sU'M) // morphpreK ?ntU. Qed. End MorphGroupAction. (* Conjugation and right translation actions. *) Section InternalActionDefs. Variable gT : finGroupType. Implicit Type A : {set gT}. Implicit Type G : {group gT}. (* This is not a Canonical action because it is seldom used, and it would *) (* cause too many spurious matches (any group product would be viewed as an *) (* action!). *) Definition mulgr_action := TotalAction (@mulg1 gT) (@mulgA gT). Canonical conjg_action := TotalAction (@conjg1 gT) (@conjgM gT). Lemma conjg_is_groupAction : is_groupAction setT conjg_action. Proof. move=> a _; rewrite /= inE; apply/andP; split. by apply/subsetP=> x _; rewrite inE. by apply/morphicP=> x y _ _; rewrite !actpermE /= conjMg. Qed. Canonical conjg_groupAction := GroupAction conjg_is_groupAction. Lemma rcoset_is_action : is_action setT (@rcoset gT). Proof. by apply: is_total_action => [A|A x y]; rewrite !rcosetE (mulg1, rcosetM). Qed. Canonical rcoset_action := Action rcoset_is_action. Canonical conjsg_action := TotalAction (@conjsg1 gT) (@conjsgM gT). Lemma conjG_is_action : is_action setT (@conjG_group gT). Proof. apply: is_total_action => [G | G x y]; apply: val_inj; rewrite /= ?act1 //. exact: actM. Qed. Definition conjG_action := Action conjG_is_action. End InternalActionDefs. Notation "'R" := (@mulgr_action _) (at level 8) : action_scope. Notation "'Rs" := (@rcoset_action _) (at level 8) : action_scope. Notation "'J" := (@conjg_action _) (at level 8) : action_scope. Notation "'J" := (@conjg_groupAction _) (at level 8) : groupAction_scope. Notation "'Js" := (@conjsg_action _) (at level 8) : action_scope. Notation "'JG" := (@conjG_action _) (at level 8) : action_scope. Notation "'Q" := ('J / _)%act (at level 8) : action_scope. Notation "'Q" := ('J / _)%gact (at level 8) : groupAction_scope. Section InternalGroupAction. Variable gT : finGroupType. Implicit Types A B : {set gT}. Implicit Types G H : {group gT}. Implicit Type x : gT. (* Various identities for actions on groups. *) Lemma orbitR G x : orbit 'R G x = x *: G. Proof. by rewrite -lcosetE. Qed. Lemma astab1R x : 'C[x | 'R] = 1. Proof. apply/trivgP/subsetP=> y cxy. by rewrite -(mulKg x y) [x * y](astab1P cxy) mulVg set11. Qed. Lemma astabR G : 'C(G | 'R) = 1. Proof. apply/trivgP/subsetP=> x cGx. by rewrite -(mul1g x) [1 * x](astabP cGx) group1. Qed. Lemma astabsR G : 'N(G | 'R) = G. Proof. apply/setP=> x; rewrite !inE -setactVin ?inE //=. by rewrite -groupV -{1 3}(mulg1 G) rcoset_sym -sub1set -mulGS -!rcosetE. Qed. Lemma atransR G : [transitive G, on G | 'R]. Proof. by rewrite /atrans -{1}(mul1g G) -orbitR imset_f. Qed. Lemma faithfulR G : [faithful G, on G | 'R]. Proof. by rewrite /faithful astabR subsetIr. Qed. Definition Cayley_repr G := actperm <[atrans_acts (atransR G)]>. Theorem Cayley_isom G : isom G (Cayley_repr G @* G) (Cayley_repr G). Proof. exact: faithful_isom (faithfulR G). Qed. Theorem Cayley_isog G : G \isog Cayley_repr G @* G. Proof. exact: isom_isog (Cayley_isom G). Qed. Lemma orbitJ G x : orbit 'J G x = x ^: G. Proof. by []. Qed. Lemma afixJ A : 'Fix_('J)(A) = 'C(A). Proof. apply/setP=> x; apply/afixP/centP=> cAx y Ay /=. by rewrite /commute conjgC cAx. by rewrite conjgE cAx ?mulKg. Qed. Lemma astabJ A : 'C(A |'J) = 'C(A). Proof. apply/setP=> x; apply/astabP/centP=> cAx y Ay /=. by apply: esym; rewrite conjgC cAx. by rewrite conjgE -cAx ?mulKg. Qed. Lemma astab1J x : 'C[x |'J] = 'C[x]. Proof. by rewrite astabJ cent_set1. Qed. Lemma astabsJ A : 'N(A | 'J) = 'N(A). Proof. by apply/setP=> x; rewrite -2!groupV !inE -conjg_preim -sub_conjg. Qed. Lemma setactJ A x : 'J^*%act A x = A :^ x. Proof. by []. Qed. Lemma gacentJ A : 'C_(|'J)(A) = 'C(A). Proof. by rewrite gacentE ?setTI ?subsetT ?afixJ. Qed. Lemma orbitRs G A : orbit 'Rs G A = rcosets A G. Proof. by []. Qed. Lemma sub_afixRs_norms G x A : (G :* x \in 'Fix_('Rs)(A)) = (A \subset G :^ x). Proof. rewrite inE /=; apply: eq_subset_r => a. rewrite inE rcosetE -(can2_eq (rcosetKV x) (rcosetK x)) -!rcosetM. rewrite eqEcard card_rcoset leqnn andbT mulgA (conjgCV x) mulgK. by rewrite -{2 3}(mulGid G) mulGS sub1set -mem_conjg. Qed. Lemma sub_afixRs_norm G x : (G :* x \in 'Fix_('Rs)(G)) = (x \in 'N(G)). Proof. by rewrite sub_afixRs_norms -groupV inE sub_conjgV. Qed. Lemma afixRs_rcosets A G : 'Fix_(rcosets G A | 'Rs)(G) = rcosets G 'N_A(G). Proof. apply/setP=> Gx; apply/setIP/rcosetsP=> [[/rcosetsP[x Ax ->]]|[x]]. by rewrite sub_afixRs_norm => Nx; exists x; rewrite // inE Ax. by case/setIP=> Ax Nx ->; rewrite -{1}rcosetE imset_f // sub_afixRs_norm. Qed. Lemma astab1Rs G : 'C[G : {set gT} | 'Rs] = G. Proof. apply/setP=> x. by apply/astab1P/idP=> /= [<- | Gx]; rewrite rcosetE ?rcoset_refl ?rcoset_id. Qed. Lemma actsRs_rcosets H G : [acts G, on rcosets H G | 'Rs]. Proof. by rewrite -orbitRs acts_orbit ?subsetT. Qed. Lemma transRs_rcosets H G : [transitive G, on rcosets H G | 'Rs]. Proof. by rewrite -orbitRs atrans_orbit. Qed. (* This is the second part of Aschbacher (5.7) *) Lemma astabRs_rcosets H G : 'C(rcosets H G | 'Rs) = gcore H G. Proof. have transGH := transRs_rcosets H G. by rewrite (astab_trans_gcore transGH (orbit_refl _ G _)) astab1Rs. Qed. Lemma orbitJs G A : orbit 'Js G A = A :^: G. Proof. by []. Qed. Lemma astab1Js A : 'C[A | 'Js] = 'N(A). Proof. by apply/setP=> x; apply/astab1P/normP. Qed. Lemma card_conjugates A G : #|A :^: G| = #|G : 'N_G(A)|. Proof. by rewrite card_orbit astab1Js. Qed. Lemma afixJG G A : (G \in 'Fix_('JG)(A)) = (A \subset 'N(G)). Proof. by apply/afixP/normsP=> nG x Ax; apply/eqP; move/eqP: (nG x Ax). Qed. Lemma astab1JG G : 'C[G | 'JG] = 'N(G). Proof. by apply/setP=> x; apply/astab1P/normP=> [/congr_group | /group_inj]. Qed. Lemma dom_qactJ H : qact_dom 'J H = 'N(H). Proof. by rewrite qact_domE ?subsetT ?astabsJ. Qed. Lemma qactJ H (Hy : coset_of H) x : 'Q%act Hy x = if x \in 'N(H) then Hy ^ coset H x else Hy. Proof. case: (cosetP Hy) => y Ny ->{Hy}. by rewrite qactEcond // dom_qactJ; case Nx: (x \in 'N(H)); rewrite ?morphJ. Qed. Lemma actsQ A B H : A \subset 'N(H) -> A \subset 'N(B) -> [acts A, on B / H | 'Q]. Proof. by move=> nHA nBA; rewrite acts_quotient // subsetI dom_qactJ nHA astabsJ. Qed. Lemma astabsQ G H : H <| G -> 'N(G / H | 'Q) = 'N(H) :&: 'N(G). Proof. by move=> nsHG; rewrite astabs_quotient // dom_qactJ astabsJ. Qed. Lemma astabQ H Abar : 'C(Abar |'Q) = coset H @*^-1 'C(Abar). Proof. apply/setP=> x; rewrite inE /= dom_qactJ morphpreE in_setI /=. apply: andb_id2l => Nx; rewrite !inE -sub1set centsC cent_set1. apply: eq_subset_r => {Abar} Hy; rewrite inE qactJ Nx (sameP eqP conjg_fixP). by rewrite (sameP cent1P eqP) (sameP commgP eqP). Qed. Lemma sub_astabQ A H Bbar : (A \subset 'C(Bbar | 'Q)) = (A \subset 'N(H)) && (A / H \subset 'C(Bbar)). Proof. rewrite astabQ -morphpreIdom subsetI; apply: andb_id2l => nHA. by rewrite -sub_quotient_pre. Qed. Lemma sub_astabQR A B H : A \subset 'N(H) -> B \subset 'N(H) -> (A \subset 'C(B / H | 'Q)) = ([~: A, B] \subset H). Proof. move=> nHA nHB; rewrite sub_astabQ nHA /= (sameP commG1P eqP). by rewrite eqEsubset sub1G andbT -quotientR // quotient_sub1 // comm_subG. Qed. Lemma astabQR A H : A \subset 'N(H) -> 'C(A / H | 'Q) = [set x in 'N(H) | [~: [set x], A] \subset H]. Proof. move=> nHA; apply/setP=> x; rewrite astabQ -morphpreIdom 2!inE -astabQ. by case nHx: (x \in _); rewrite //= -sub1set sub_astabQR ?sub1set. Qed. Lemma quotient_astabQ H Abar : 'C(Abar | 'Q) / H = 'C(Abar). Proof. by rewrite astabQ cosetpreK. Qed. Lemma conj_astabQ A H x : x \in 'N(H) -> 'C(A / H | 'Q) :^ x = 'C(A :^ x / H | 'Q). Proof. move=> nHx; apply/setP=> y; rewrite !astabQ mem_conjg !in_setI -mem_conjg. rewrite -normJ (normP nHx) quotientJ //; apply/andb_id2l => nHy. by rewrite !inE centJ morphJ ?groupV ?morphV // -mem_conjg. Qed. Section CardClass. Variable G : {group gT}. Lemma index_cent1 x : #|G : 'C_G[x]| = #|x ^: G|. Proof. by rewrite -astab1J -card_orbit. Qed. Lemma classes_partition : partition (classes G) G. Proof. by apply: orbit_partition; apply/actsP=> x Gx y; apply: groupJr. Qed. Lemma sum_card_class : \sum_(C in classes G) #|C| = #|G|. Proof. by apply: acts_sum_card_orbit; apply/actsP=> x Gx y; apply: groupJr. Qed. Lemma class_formula : \sum_(C in classes G) #|G : 'C_G[repr C]| = #|G|. Proof. rewrite -sum_card_class; apply: eq_bigr => _ /imsetP[x Gx ->]. have: x \in x ^: G by rewrite -{1}(conjg1 x) imset_f. by case/mem_repr/imsetP=> y Gy ->; rewrite index_cent1 classGidl. Qed. Lemma abelian_classP : reflect {in G, forall x, x ^: G = [set x]} (abelian G). Proof. rewrite /abelian -astabJ astabC. by apply: (iffP subsetP) => cGG x Gx; apply/orbit1P; apply: cGG. Qed. Lemma card_classes_abelian : abelian G = (#|classes G| == #|G|). Proof. have cGgt0 C: C \in classes G -> 1 <= #|C| ?= iff (#|C| == 1)%N. by case/imsetP=> x _ ->; rewrite eq_sym -index_cent1. rewrite -sum_card_class -sum1_card (leqif_sum cGgt0). apply/abelian_classP/forall_inP=> [cGG _ /imsetP[x Gx ->]| cGG x Gx]. by rewrite cGG ?cards1. apply/esym/eqP; rewrite eqEcard sub1set cards1 class_refl leq_eqVlt cGG //. exact: imset_f. Qed. End CardClass. End InternalGroupAction. Lemma gacentQ (gT : finGroupType) (H : {group gT}) (A : {set gT}) : 'C_(|'Q)(A) = 'C(A / H). Proof. apply/setP=> Hx; case: (cosetP Hx) => x Nx ->{Hx}. rewrite -sub_cent1 -astab1J astabC sub1set -(quotientInorm H A). have defD: qact_dom 'J H = 'N(H) by rewrite qact_domE ?subsetT ?astabsJ. rewrite !(inE, mem_quotient) //= defD setIC. apply/subsetP/subsetP=> [cAx _ /morphimP[a Na Aa ->] | cAx a Aa]. by move/cAx: Aa; rewrite !inE qactE ?defD ?morphJ. have [_ Na] := setIP Aa; move/implyP: (cAx (coset H a)); rewrite mem_morphim //. by rewrite !inE qactE ?defD ?morphJ. Qed. Section AutAct. Variable (gT : finGroupType) (G : {set gT}). Definition autact := act ('P \ subsetT (Aut G)). Canonical aut_action := [action of autact]. Lemma autactK a : actperm aut_action a = a. Proof. by apply/permP=> x; rewrite permE. Qed. Lemma autact_is_groupAction : is_groupAction G aut_action. Proof. by move=> a Aa /=; rewrite autactK. Qed. Canonical aut_groupAction := GroupAction autact_is_groupAction. End AutAct. Arguments autact {gT} G%g. Arguments aut_action {gT} G%g. Arguments aut_groupAction {gT} G%g. Notation "[ 'Aut' G ]" := (aut_action G) : action_scope. Notation "[ 'Aut' G ]" := (aut_groupAction G) : groupAction_scope. Notation pcycleE := (deprecate pcycleE porbitE _) (only parsing). Notation pcycle_actperm := (deprecate pcycle_actperm porbit_actperm _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/fingroup/all_fingroup.v000066400000000000000000000003131375767750300236200ustar00rootroot00000000000000Require Export action. Require Export automorphism. Require Export fingroup. Require Export gproduct. Require Export morphism. Require Export perm. Require Export presentation. Require Export quotient. math-comp-mathcomp-1.12.0/mathcomp/fingroup/automorphism.v000066400000000000000000000406601375767750300236770ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat fintype. From mathcomp Require Import finset fingroup perm morphism. (******************************************************************************) (* Group automorphisms and characteristic subgroups. *) (* Unlike morphisms on a group G, which are functions of type gT -> rT, with *) (* a canonical structure of dependent type {morphim G >-> rT}, automorphisms *) (* are permutations of type {perm gT} contained in Aut G : {set {perm gT}}. *) (* This lets us use the finGroupType of {perm gT}. Note also that while *) (* morphisms on G are undefined outside G, automorphisms have their support *) (* in G, i.e., they are the identity outside G. *) (* Definitions: *) (* Aut G (or [Aut G]) == the automorphism group of G. *) (* [Aut G]%G == the group structure for Aut G. *) (* autm AutGa == the morphism on G induced by a, given *) (* AutGa : a \in Aut G. *) (* perm_in injf fA == the permutation with support B in induced by f, *) (* given injf : {in A &, injective f} and *) (* fA : f @: A \subset A. *) (* aut injf fG == the automorphism of G induced by the morphism f, *) (* given injf : 'injm f and fG : f @* G \subset G. *) (* Aut_isom injf sDom == the injective homomorphism that maps Aut G to *) (* Aut (f @* G), with f : {morphism D >-> rT} and *) (* given injf: 'injm f and sDom : G \subset D. *) (* conjgm G == the conjugation automorphism on G. *) (* H \char G == H is a characteristic subgroup of G. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. (***********************************************************************) (* A group automorphism, defined as a permutation on a subset of a *) (* finGroupType that respects the morphism law. *) (* Here perm_on is used as a closure rule for the set A. *) (***********************************************************************) Section Automorphism. Variable gT : finGroupType. Implicit Type A : {set gT}. Implicit Types a b : {perm gT}. Definition Aut A := [set a | perm_on A a & morphic A a]. Lemma Aut_morphic A a : a \in Aut A -> morphic A a. Proof. by case/setIdP. Qed. Lemma out_Aut A a x : a \in Aut A -> x \notin A -> a x = x. Proof. by case/setIdP=> Aa _; apply: out_perm. Qed. Lemma eq_Aut A : {in Aut A &, forall a b, {in A, a =1 b} -> a = b}. Proof. move=> a g Aa Ag /= eqag; apply/permP=> x. by have [/eqag // | /out_Aut out] := boolP (x \in A); rewrite !out. Qed. (* The morphism that is represented by a given element of Aut A. *) Definition autm A a (AutAa : a \in Aut A) := morphm (Aut_morphic AutAa). Lemma autmE A a (AutAa : a \in Aut A) : autm AutAa = a. Proof. by []. Qed. Canonical autm_morphism A a aM := Eval hnf in [morphism of @autm A a aM]. Section AutGroup. Variable G : {group gT}. Lemma Aut_group_set : group_set (Aut G). Proof. apply/group_setP; split=> [|a b]. by rewrite inE perm_on1; apply/morphicP=> ? *; rewrite !permE. rewrite !inE => /andP[Ga aM] /andP[Gb bM]; rewrite perm_onM //=. apply/morphicP=> x y Gx Gy; rewrite !permM (morphicP aM) //. by rewrite (morphicP bM) ?perm_closed. Qed. Canonical Aut_group := group Aut_group_set. Variable (a : {perm gT}) (AutGa : a \in Aut G). Notation f := (autm AutGa). Notation fE := (autmE AutGa). Lemma injm_autm : 'injm f. Proof. by apply/injmP; apply: in2W; apply: perm_inj. Qed. Lemma ker_autm : 'ker f = 1. Proof. by move/trivgP: injm_autm. Qed. Lemma im_autm : f @* G = G. Proof. apply/setP=> x; rewrite morphimEdom (can_imset_pre _ (permK a)) inE. by have:= AutGa; rewrite inE => /andP[/perm_closed <-]; rewrite permKV. Qed. Lemma Aut_closed x : x \in G -> a x \in G. Proof. by move=> Gx; rewrite -im_autm; apply: mem_morphim. Qed. End AutGroup. Lemma Aut1 : Aut 1 = 1. Proof. apply/trivgP/subsetP=> a /= AutGa; apply/set1P. apply: eq_Aut (AutGa) (group1 _) _ => _ /set1P->. by rewrite -(autmE AutGa) morph1 perm1. Qed. End Automorphism. Arguments Aut _ _%g. Notation "[ 'Aut' G ]" := (Aut_group G) (at level 0, format "[ 'Aut' G ]") : Group_scope. Notation "[ 'Aut' G ]" := (Aut G) (at level 0, only parsing) : group_scope. Prenex Implicits Aut autm. (* The permutation function (total on the underlying groupType) that is the *) (* representant of a given morphism f with domain A in (Aut A). *) Section PermIn. Variables (T : finType) (A : {set T}) (f : T -> T). Hypotheses (injf : {in A &, injective f}) (sBf : f @: A \subset A). Lemma perm_in_inj : injective (fun x => if x \in A then f x else x). Proof. move=> x y /=; wlog Ay: x y / y \in A. by move=> IH eqfxy; case: ifP (eqfxy); [symmetry | case: ifP => //]; auto. rewrite Ay; case: ifP => [Ax | nAx def_x]; first exact: injf. by case/negP: nAx; rewrite def_x (subsetP sBf) ?imset_f. Qed. Definition perm_in := perm perm_in_inj. Lemma perm_in_on : perm_on A perm_in. Proof. by apply/subsetP=> x; rewrite inE /= permE; case: ifP => // _; case/eqP. Qed. Lemma perm_inE : {in A, perm_in =1 f}. Proof. by move=> x Ax; rewrite /= permE Ax. Qed. End PermIn. (* properties of injective endomorphisms *) Section MakeAut. Variables (gT : finGroupType) (G : {group gT}) (f : {morphism G >-> gT}). Implicit Type A : {set gT}. Hypothesis injf : 'injm f. Lemma morphim_fixP A : A \subset G -> reflect (f @* A = A) (f @* A \subset A). Proof. rewrite /morphim => sAG; have:= eqEcard (f @: A) A. rewrite (setIidPr sAG) card_in_imset ?leqnn ?andbT => [<-|]; first exact: eqP. by move/injmP: injf; apply: sub_in2; apply/subsetP. Qed. Hypothesis Gf : f @* G = G. Lemma aut_closed : f @: G \subset G. Proof. by rewrite -morphimEdom; apply/morphim_fixP. Qed. Definition aut := perm_in (injmP injf) aut_closed. Lemma autE : {in G, aut =1 f}. Proof. exact: perm_inE. Qed. Lemma morphic_aut : morphic G aut. Proof. by apply/morphicP=> x y Gx Gy /=; rewrite !autE ?groupM // morphM. Qed. Lemma Aut_aut : aut \in Aut G. Proof. by rewrite inE morphic_aut perm_in_on. Qed. Lemma imset_autE A : A \subset G -> aut @: A = f @* A. Proof. move=> sAG; rewrite /morphim (setIidPr sAG). by apply: eq_in_imset; apply: sub_in1 autE; apply/subsetP. Qed. Lemma preim_autE A : A \subset G -> aut @^-1: A = f @*^-1 A. Proof. move=> sAG; apply/setP=> x; rewrite !inE permE /=. by case Gx: (x \in G) => //; apply/negP=> Ax; rewrite (subsetP sAG) in Gx. Qed. End MakeAut. Arguments morphim_fixP {gT G f}. Prenex Implicits aut. Section AutIsom. Variables (gT rT : finGroupType) (G D : {group gT}) (f : {morphism D >-> rT}). Hypotheses (injf : 'injm f) (sGD : G \subset D). Let domG := subsetP sGD. Lemma Aut_isom_subproof a : {a' | a' \in Aut (f @* G) & a \in Aut G -> {in G, a' \o f =1 f \o a}}. Proof. set Aut_a := autm (subgP (subg [Aut G] a)). have aDom: 'dom (f \o Aut_a \o invm injf) = f @* G. rewrite /dom /= morphpre_invm -morphpreIim; congr (f @* _). by rewrite [_ :&: D](setIidPl _) ?injmK ?injm_autm ?im_autm. have [af [def_af ker_af _ im_af]] := domP _ aDom. have inj_a': 'injm af by rewrite ker_af !injm_comp ?injm_autm ?injm_invm. have im_a': af @* (f @* G) = f @* G. by rewrite im_af !morphim_comp morphim_invm // im_autm. pose a' := aut inj_a' im_a'; exists a' => [|AutGa x Gx]; first exact: Aut_aut. have Dx := domG Gx; rewrite /= [a' _]autE ?mem_morphim //. by rewrite def_af /= invmE // autmE subgK. Qed. Definition Aut_isom a := s2val (Aut_isom_subproof a). Lemma Aut_Aut_isom a : Aut_isom a \in Aut (f @* G). Proof. by rewrite /Aut_isom; case: (Aut_isom_subproof a). Qed. Lemma Aut_isomE a : a \in Aut G -> {in G, forall x, Aut_isom a (f x) = f (a x)}. Proof. by rewrite /Aut_isom; case: (Aut_isom_subproof a). Qed. Lemma Aut_isomM : {in Aut G &, {morph Aut_isom: x y / x * y}}. Proof. move=> a b AutGa AutGb. apply: (eq_Aut (Aut_Aut_isom _)); rewrite ?groupM ?Aut_Aut_isom // => fx. case/morphimP=> x Dx Gx ->{fx}. by rewrite permM !Aut_isomE ?groupM /= ?permM ?Aut_closed. Qed. Canonical Aut_isom_morphism := Morphism Aut_isomM. Lemma injm_Aut_isom : 'injm Aut_isom. Proof. apply/injmP=> a b AutGa AutGb eq_ab'; apply: (eq_Aut AutGa AutGb) => x Gx. by apply: (injmP injf); rewrite ?domG ?Aut_closed // -!Aut_isomE //= eq_ab'. Qed. End AutIsom. Section InjmAut. Variables (gT rT : finGroupType) (G D : {group gT}) (f : {morphism D >-> rT}). Hypotheses (injf : 'injm f) (sGD : G \subset D). Let domG := subsetP sGD. Lemma im_Aut_isom : Aut_isom injf sGD @* Aut G = Aut (f @* G). Proof. apply/eqP; rewrite eqEcard; apply/andP; split. by apply/subsetP=> _ /morphimP[a _ AutGa ->]; apply: Aut_Aut_isom. have inj_isom' := injm_Aut_isom (injm_invm injf) (morphimS _ sGD). rewrite card_injm ?injm_Aut_isom // -(card_injm inj_isom') ?subset_leq_card //. apply/subsetP=> a /morphimP[a' _ AutfGa' def_a]. by rewrite -(morphim_invm injf sGD) def_a Aut_Aut_isom. Qed. Lemma Aut_isomP : isom (Aut G) (Aut (f @* G)) (Aut_isom injf sGD). Proof. by apply/isomP; split; [apply: injm_Aut_isom | apply: im_Aut_isom]. Qed. Lemma injm_Aut : Aut (f @* G) \isog Aut G. Proof. by rewrite isog_sym (isom_isog _ _ Aut_isomP). Qed. End InjmAut. (* conjugation automorphism *) Section ConjugationMorphism. Variable gT : finGroupType. Implicit Type A : {set gT}. Definition conjgm of {set gT} := fun x y : gT => y ^ x. Lemma conjgmE A x y : conjgm A x y = y ^ x. Proof. by []. Qed. Canonical conjgm_morphism A x := @Morphism _ _ A (conjgm A x) (in2W (fun y z => conjMg y z x)). Lemma morphim_conj A x B : conjgm A x @* B = (A :&: B) :^ x. Proof. by []. Qed. Variable G : {group gT}. Lemma injm_conj x : 'injm (conjgm G x). Proof. by apply/injmP; apply: in2W; apply: conjg_inj. Qed. Lemma conj_isom x : isom G (G :^ x) (conjgm G x). Proof. by apply/isomP; rewrite morphim_conj setIid injm_conj. Qed. Lemma conj_isog x : G \isog G :^ x. Proof. exact: isom_isog (conj_isom x). Qed. Lemma norm_conjg_im x : x \in 'N(G) -> conjgm G x @* G = G. Proof. by rewrite morphimEdom; apply: normP. Qed. Lemma norm_conj_isom x : x \in 'N(G) -> isom G G (conjgm G x). Proof. by move/norm_conjg_im/restr_isom_to/(_ (conj_isom x))->. Qed. Definition conj_aut x := aut (injm_conj _) (norm_conjg_im (subgP (subg _ x))). Lemma norm_conj_autE : {in 'N(G) & G, forall x y, conj_aut x y = y ^ x}. Proof. by move=> x y nGx Gy; rewrite /= autE //= subgK. Qed. Lemma conj_autE : {in G &, forall x y, conj_aut x y = y ^ x}. Proof. by apply: sub_in11 norm_conj_autE => //; apply: subsetP (normG G). Qed. Lemma conj_aut_morphM : {in 'N(G) &, {morph conj_aut : x y / x * y}}. Proof. move=> x y nGx nGy; apply/permP=> z /=; rewrite permM. case Gz: (z \in G); last by rewrite !permE /= !Gz. by rewrite !norm_conj_autE // (conjgM, memJ_norm, groupM). Qed. Canonical conj_aut_morphism := Morphism conj_aut_morphM. Lemma ker_conj_aut : 'ker conj_aut = 'C(G). Proof. apply/setP=> x; rewrite inE; case nGx: (x \in 'N(G)); last first. by symmetry; apply/idP=> cGx; rewrite (subsetP (cent_sub G)) in nGx. rewrite 2!inE /=; apply/eqP/centP=> [cx1 y Gy | cGx]. by rewrite /commute (conjgC y) -norm_conj_autE // cx1 perm1. apply/permP=> y; case Gy: (y \in G); last by rewrite !permE Gy. by rewrite perm1 norm_conj_autE // conjgE -cGx ?mulKg. Qed. Lemma Aut_conj_aut A : conj_aut @* A \subset Aut G. Proof. by apply/subsetP=> _ /imsetP[x _ ->]; apply: Aut_aut. Qed. End ConjugationMorphism. Arguments conjgm _ _%g. Prenex Implicits conjgm conj_aut. Reserved Notation "G \char H" (at level 70). (* Characteristic subgroup *) Section Characteristicity. Variable gT : finGroupType. Implicit Types A B : {set gT}. Implicit Types G H K L : {group gT}. Definition characteristic A B := (A \subset B) && [forall f in Aut B, f @: A \subset A]. Infix "\char" := characteristic. Lemma charP H G : let fixH (f : {morphism G >-> gT}) := 'injm f -> f @* G = G -> f @* H = H in reflect [/\ H \subset G & forall f, fixH f] (H \char G). Proof. do [apply: (iffP andP) => -[sHG chHG]; split] => // [f injf Gf|]. by apply/morphim_fixP; rewrite // -imset_autE ?(forall_inP chHG) ?Aut_aut. apply/forall_inP=> f Af; rewrite -(autmE Af) -morphimEsub //. by rewrite chHG ?injm_autm ?im_autm. Qed. (* Characteristic subgroup properties : composition, relational properties *) Lemma char1 G : 1 \char G. Proof. by apply/charP; split=> [|f _ _]; rewrite (sub1G, morphim1). Qed. Lemma char_refl G : G \char G. Proof. exact/charP. Qed. Lemma char_trans H G K : K \char H -> H \char G -> K \char G. Proof. case/charP=> sKH chKH; case/charP=> sHG chHG. apply/charP; split=> [|f injf Gf]; first exact: subset_trans sHG. rewrite -{1}(setIidPr sKH) -(morphim_restrm sHG) chKH //. by rewrite ker_restrm; move/trivgP: injf => ->; apply: subsetIr. by rewrite morphim_restrm setIid chHG. Qed. Lemma char_norms H G : H \char G -> 'N(G) \subset 'N(H). Proof. case/charP=> sHG chHG; apply/normsP=> x /normP-Nx. have:= chHG [morphism of conjgm G x] => /=. by rewrite !morphimEsub //=; apply; rewrite // injm_conj. Qed. Lemma char_sub A B : A \char B -> A \subset B. Proof. by case/andP. Qed. Lemma char_norm_trans H G A : H \char G -> A \subset 'N(G) -> A \subset 'N(H). Proof. by move/char_norms=> nHnG nGA; apply: subset_trans nHnG. Qed. Lemma char_normal_trans H G K : K \char H -> H <| G -> K <| G. Proof. move=> chKH /andP[sHG nHG]. by rewrite /normal (subset_trans (char_sub chKH)) // (char_norm_trans chKH). Qed. Lemma char_normal H G : H \char G -> H <| G. Proof. by move/char_normal_trans; apply; apply/andP; rewrite normG. Qed. Lemma char_norm H G : H \char G -> G \subset 'N(H). Proof. by case/char_normal/andP. Qed. Lemma charI G H K : H \char G -> K \char G -> H :&: K \char G. Proof. case/charP=> sHG chHG; case/charP=> _ chKG. apply/charP; split=> [|f injf Gf]; first by rewrite subIset // sHG. by rewrite morphimGI ?(chHG, chKG) //; apply: subset_trans (sub1G H). Qed. Lemma charY G H K : H \char G -> K \char G -> H <*> K \char G. Proof. case/charP=> sHG chHG; case/charP=> sKG chKG. apply/charP; split=> [|f injf Gf]; first by rewrite gen_subG subUset sHG. by rewrite morphim_gen ?(morphimU, subUset, sHG, chHG, chKG). Qed. Lemma charM G H K : H \char G -> K \char G -> H * K \char G. Proof. move=> chHG chKG; rewrite -norm_joinEl ?charY //. exact: subset_trans (char_sub chHG) (char_norm chKG). Qed. Lemma lone_subgroup_char G H : H \subset G -> (forall K, K \subset G -> K \isog H -> K \subset H) -> H \char G. Proof. move=> sHG Huniq; apply/charP; split=> // f injf Gf; apply/eqP. have{} injf: {in H &, injective f}. by move/injmP: injf; apply: sub_in2; apply/subsetP. have fH: f @* H = f @: H by rewrite /morphim (setIidPr sHG). rewrite eqEcard {2}fH card_in_imset ?{}Huniq //=. by rewrite -{3}Gf morphimS. rewrite isog_sym; apply/isogP. exists [morphism of restrm sHG f] => //=; first exact/injmP. by rewrite morphimEdom fH. Qed. End Characteristicity. Arguments characteristic _ _%g _%g. Notation "H \char G" := (characteristic H G) : group_scope. Hint Resolve char_refl : core. Section InjmChar. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Hypothesis injf : 'injm f. Lemma injm_char (G H : {group aT}) : G \subset D -> H \char G -> f @* H \char f @* G. Proof. move=> sGD /charP[sHG charH]. apply/charP; split=> [|g injg gfG]; first exact: morphimS. have /domP[h [_ ker_h _ im_h]]: 'dom (invm injf \o g \o f) = G. by rewrite /dom /= -(morphpreIim g) (setIidPl _) ?injmK // gfG morphimS. have hH: h @* H = H. apply: charH; first by rewrite ker_h !injm_comp ?injm_invm. by rewrite im_h !morphim_comp gfG morphim_invm. rewrite /= -{2}hH im_h !morphim_comp morphim_invmE morphpreK //. by rewrite (subset_trans _ (morphimS f sGD)) //= -{3}gfG !morphimS. Qed. End InjmChar. Section CharInjm. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Hypothesis injf : 'injm f. Lemma char_injm (G H : {group aT}) : G \subset D -> H \subset D -> (f @* H \char f @* G) = (H \char G). Proof. move=> sGD sHD; apply/idP/idP; last exact: injm_char. by move/(injm_char (injm_invm injf)); rewrite !morphim_invm ?morphimS // => ->. Qed. End CharInjm. Unset Implicit Arguments. math-comp-mathcomp-1.12.0/mathcomp/fingroup/fingroup.v000066400000000000000000003347061375767750300230100ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import fintype div path tuple bigop prime finset. (******************************************************************************) (* This file defines the main interface for finite groups : *) (* finGroupType == the structure for finite types with a group law. *) (* {group gT} == type of groups with elements of type gT. *) (* baseFinGroupType == the structure for finite types with a monoid law *) (* and an involutive antimorphism; finGroupType is *) (* derived from baseFinGroupType (via a telescope). *) (* FinGroupType mulVg == the finGroupType structure for an existing *) (* baseFinGroupType structure, built from a proof of *) (* the left inverse group axiom for that structure's *) (* operations. *) (* BaseFinGroupType bgm == the baseFingroupType structure built by packaging *) (* bgm : FinGroup.mixin_of T for a type T with an *) (* existing finType structure. *) (* FinGroup.BaseMixin mulA mul1x invK invM == *) (* the mixin for a baseFinGroupType structure, built *) (* from proofs of the baseFinGroupType axioms. *) (* FinGroup.Mixin mulA mul1x mulVg == *) (* the mixin for a baseFinGroupType structure, built *) (* from proofs of the group axioms. *) (* [baseFinGroupType of T] == a clone of an existing baseFinGroupType *) (* structure on T, for T (the existing structure *) (* might be for some delta-expansion of T). *) (* [finGroupType of T] == a clone of an existing finGroupType structure on *) (* T, for the canonical baseFinGroupType structure *) (* of T (the existing structure might be for the *) (* baseFinGroupType of some delta-expansion of T). *) (* [group of G] == a clone for an existing {group gT} structure on *) (* G : {set gT} (the existing structure might be for *) (* some delta-expansion of G). *) (* If gT implements finGroupType, then we can form {set gT}, the type of *) (* finite sets with elements of type gT (as finGroupType extends finType). *) (* The group law extends pointwise to {set gT}, which thus implements a sub- *) (* interface baseFinGroupType of finGroupType. To be consistent with the *) (* predType interface, this is done by coercion to FinGroup.arg_sort, an *) (* alias for FinGroup.sort. Accordingly, all pointwise group operations below *) (* have arguments of type (FinGroup.arg_sort) gT and return results of type *) (* FinGroup.sort gT. *) (* The notations below are declared in two scopes: *) (* group_scope (delimiter %g) for point operations and set constructs. *) (* Group_scope (delimiter %G) for explicit {group gT} structures. *) (* These scopes should not be opened globally, although group_scope is often *) (* opened locally in group-theory files (via Import GroupScope). *) (* As {group gT} is both a subtype and an interface structure for {set gT}, *) (* the fact that a given G : {set gT} is a group can (and usually should) be *) (* inferred by type inference with canonical structures. This means that all *) (* `group' constructions (e.g., the normaliser 'N_G(H)) actually define sets *) (* with a canonical {group gT} structure; the %G delimiter can be used to *) (* specify the actual {group gT} structure (e.g., 'N_G(H)%G). *) (* Operations on elements of a group: *) (* x * y == the group product of x and y. *) (* x ^+ n == the nth power of x, i.e., x * ... * x (n times). *) (* x^-1 == the group inverse of x. *) (* x ^- n == the inverse of x ^+ n (notation for (x ^+ n)^-1). *) (* 1 == the unit element. *) (* x ^ y == the conjugate of x by y (i.e., y^-1 * (x * y)). *) (* [~ x, y] == the commutator of x and y (i.e., x^-1 * x ^ y). *) (* [~ x1, ..., xn] == the commutator of x1, ..., xn (associating left). *) (* \prod_(i ...) x i == the product of the x i (order-sensitive). *) (* commute x y <-> x and y commute. *) (* centralises x A <-> x centralises A. *) (* 'C[x] == the set of elements that commute with x. *) (* 'C_G[x] == the set of elements of G that commute with x. *) (* <[x]> == the cyclic subgroup generated by the element x. *) (* #[x] == the order of the element x, i.e., #|<[x]>|. *) (* Operations on subsets/subgroups of a finite group: *) (* H * G == {xy | x \in H, y \in G}. *) (* 1 or [1] or [1 gT] == the unit group. *) (* [set: gT]%G == the group of all x : gT (in Group_scope). *) (* group_set G == G contains 1 and is closed under binary product; *) (* this is the characteristic property of the *) (* {group gT} subtype of {set gT}. *) (* [subg G] == the subtype, set, or group of all x \in G: this *) (* notation is defined simultaneously in %type, %g *) (* and %G scopes, and G must denote a {group gT} *) (* structure (G is in the %G scope). *) (* subg, sgval == the projection into and injection from [subg G]. *) (* H^# == the set H minus the unit element. *) (* repr H == some element of H if 1 \notin H != set0, else 1. *) (* (repr is defined over sets of a baseFinGroupType, *) (* so it can be used, e.g., to pick right cosets.) *) (* x *: H == left coset of H by x. *) (* lcosets H G == the set of the left cosets of H by elements of G. *) (* H :* x == right coset of H by x. *) (* rcosets H G == the set of the right cosets of H by elements of G. *) (* #|G : H| == the index of H in G, i.e., #|rcosets G H|. *) (* H :^ x == the conjugate of H by x. *) (* x ^: H == the conjugate class of x in H. *) (* classes G == the set of all conjugate classes of G. *) (* G :^: H == {G :^ x | x \in H}. *) (* class_support G H == {x ^ y | x \in G, y \in H}. *) (* commg_set G H == {[~ x, y] | x \in G, y \in H}; NOT the commutator! *) (* <> == the subgroup generated by the set H. *) (* [~: G, H] == the commmutator subgroup of G and H, i.e., *) (* <>>. *) (* [~: H1, ..., Hn] == commutator subgroup of H1, ..., Hn (left assoc.). *) (* H <*> G == the subgroup generated by sets H and G (H join G). *) (* (H * G)%G == the join of G H : {group gT} (convertible, but not *) (* identical to (G <*> H)%G). *) (* (\prod_(i ...) H i)%G == the group generated by the H i. *) (* {in G, centralised H} <-> G centralises H. *) (* {in G, normalised H} <-> G normalises H. *) (* <-> forall x, x \in G -> H :^ x = H. *) (* 'N(H) == the normaliser of H. *) (* 'N_G(H) == the normaliser of H in G. *) (* H <| G <=> H is a normal subgroup of G. *) (* 'C(H) == the centraliser of H. *) (* 'C_G(H) == the centraliser of H in G. *) (* gcore H G == the largest subgroup of H normalised by G. *) (* If H is a subgroup of G, this is the largest *) (* normal subgroup of G contained in H). *) (* abelian H <=> H is abelian. *) (* subgroups G == the set of subgroups of G, i.e., the set of all *) (* H : {group gT} such that H \subset G. *) (* In the notation below G is a variable that is bound in P. *) (* [max G | P] <=> G is the largest group such that P holds. *) (* [max H of G | P] <=> H is the largest group G such that P holds. *) (* [max G | P & Q] := [max G | P && Q], likewise [max H of G | P & Q]. *) (* [min G | P] <=> G is the smallest group such that P holds. *) (* [min G | P & Q] := [min G | P && Q], likewise [min H of G | P & Q]. *) (* [min H of G | P] <=> H is the smallest group G such that P holds. *) (* In addition to the generic suffixes described in ssrbool.v and finset.v, *) (* we associate the following suffixes to group operations: *) (* 1 - identity element, as in group1 : 1 \in G. *) (* M - multiplication, as is invMg : (x * y)^-1 = y^-1 * x^-1. *) (* Also nat multiplication, for expgM : x ^+ (m * n) = x ^+ m ^+ n. *) (* D - (nat) addition, for expgD : x ^+ (m + n) = x ^+ m * x ^+ n. *) (* V - inverse, as in mulgV : x * x^-1 = 1. *) (* X - exponentiation, as in conjXg : (x ^+ n) ^ y = (x ^ y) ^+ n. *) (* J - conjugation, as in orderJ : #[x ^ y] = #[x]. *) (* R - commutator, as in conjRg : [~ x, y] ^ z = [~ x ^ z, y ^ z]. *) (* Y - join, as in centY : 'C(G <*> H) = 'C(G) :&: 'C(H). *) (* We sometimes prefix these with an `s' to indicate a set-lifted operation, *) (* e.g., conjsMg : (A * B) :^ x = A :^ x * B :^ x. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope group_scope. Declare Scope Group_scope. Delimit Scope group_scope with g. Delimit Scope Group_scope with G. (* This module can be imported to open the scope for group element *) (* operations locally to a file, without exporting the Open to *) (* clients of that file (as Open would do). *) Module GroupScope. Open Scope group_scope. End GroupScope. Import GroupScope. (* These are the operation notations introduced by this file. *) Reserved Notation "[ ~ x1 , x2 , .. , xn ]" (at level 0, format "'[ ' [ ~ x1 , '/' x2 , '/' .. , '/' xn ] ']'"). Reserved Notation "[ 1 gT ]" (at level 0, format "[ 1 gT ]"). Reserved Notation "[ 1 ]" (at level 0, format "[ 1 ]"). Reserved Notation "[ 'subg' G ]" (at level 0, format "[ 'subg' G ]"). Reserved Notation "A ^#" (at level 2, format "A ^#"). Reserved Notation "A :^ x" (at level 35, right associativity). Reserved Notation "x ^: B" (at level 35, right associativity). Reserved Notation "A :^: B" (at level 35, right associativity). Reserved Notation "#| B : A |" (at level 0, B, A at level 99, format "#| B : A |"). Reserved Notation "''N' ( A )" (at level 8, format "''N' ( A )"). Reserved Notation "''N_' G ( A )" (at level 8, G at level 2, format "''N_' G ( A )"). Reserved Notation "A <| B" (at level 70, no associativity). Reserved Notation "A <*> B" (at level 40, left associativity). Reserved Notation "[ ~: A1 , A2 , .. , An ]" (at level 0, format "[ ~: '[' A1 , '/' A2 , '/' .. , '/' An ']' ]"). Reserved Notation "[ 'max' A 'of' G | gP ]" (at level 0, format "[ '[hv' 'max' A 'of' G '/ ' | gP ']' ]"). Reserved Notation "[ 'max' G | gP ]" (at level 0, format "[ '[hv' 'max' G '/ ' | gP ']' ]"). Reserved Notation "[ 'max' A 'of' G | gP & gQ ]" (at level 0, format "[ '[hv' 'max' A 'of' G '/ ' | gP '/ ' & gQ ']' ]"). Reserved Notation "[ 'max' G | gP & gQ ]" (at level 0, format "[ '[hv' 'max' G '/ ' | gP '/ ' & gQ ']' ]"). Reserved Notation "[ 'min' A 'of' G | gP ]" (at level 0, format "[ '[hv' 'min' A 'of' G '/ ' | gP ']' ]"). Reserved Notation "[ 'min' G | gP ]" (at level 0, format "[ '[hv' 'min' G '/ ' | gP ']' ]"). Reserved Notation "[ 'min' A 'of' G | gP & gQ ]" (at level 0, format "[ '[hv' 'min' A 'of' G '/ ' | gP '/ ' & gQ ']' ]"). Reserved Notation "[ 'min' G | gP & gQ ]" (at level 0, format "[ '[hv' 'min' G '/ ' | gP '/ ' & gQ ']' ]"). Module FinGroup. (* We split the group axiomatisation in two. We define a *) (* class of "base groups", which are basically monoids *) (* with an involutive antimorphism, from which we derive *) (* the class of groups proper. This allows use to reuse *) (* much of the group notation and algebraic axioms for *) (* group subsets, by defining a base group class on them. *) (* We use class/mixins here rather than telescopes to *) (* be able to interoperate with the type coercions. *) (* Another potential benefit (not exploited here) would *) (* be to define a class for infinite groups, which could *) (* share all of the algebraic laws. *) Record mixin_of (T : Type) : Type := BaseMixin { mul : T -> T -> T; one : T; inv : T -> T; _ : associative mul; _ : left_id one mul; _ : involutive inv; _ : {morph inv : x y / mul x y >-> mul y x} }. Structure base_type : Type := PackBase { sort : Type; _ : mixin_of sort; _ : Finite.class_of sort }. (* We want to use sort as a coercion class, both to infer *) (* argument scopes properly, and to allow groups and cosets to *) (* coerce to the base group of group subsets. *) (* However, the return type of group operations should NOT be a *) (* coercion class, since this would trump the real (head-normal) *) (* coercion class for concrete group types, thus spoiling the *) (* coercion of A * B to pred_sort in x \in A * B, or rho * tau to *) (* ffun and Funclass in (rho * tau) x, when rho tau : perm T. *) (* Therefore we define an alias of sort for argument types, and *) (* make it the default coercion FinGroup.base_type >-> Sortclass *) (* so that arguments of a functions whose parameters are of type, *) (* say, gT : finGroupType, can be coerced to the coercion class *) (* of arg_sort. Care should be taken, however, to declare the *) (* return type of functions and operators as FinGroup.sort gT *) (* rather than gT, e.g., mulg : gT -> gT -> FinGroup.sort gT. *) (* Note that since we do this here and in quotient.v for all the *) (* basic functions, the inferred return type should generally be *) (* correct. *) Definition arg_sort := sort. Definition mixin T := let: PackBase _ m _ := T return mixin_of (sort T) in m. Definition finClass T := let: PackBase _ _ m := T return Finite.class_of (sort T) in m. Structure type : Type := Pack { base : base_type; _ : left_inverse (one (mixin base)) (inv (mixin base)) (mul (mixin base)) }. (* We only need three axioms to make a true group. *) Section Mixin. Variables (T : Type) (one : T) (mul : T -> T -> T) (inv : T -> T). Hypothesis mulA : associative mul. Hypothesis mul1 : left_id one mul. Hypothesis mulV : left_inverse one inv mul. Notation "1" := one. Infix "*" := mul. Notation "x ^-1" := (inv x). Lemma mk_invgK : involutive inv. Proof. have mulV21 x: x^-1^-1 * 1 = x by rewrite -(mulV x) mulA mulV mul1. by move=> x; rewrite -[_ ^-1]mulV21 -(mul1 1) mulA !mulV21. Qed. Lemma mk_invMg : {morph inv : x y / x * y >-> y * x}. Proof. have mulxV x: x * x^-1 = 1 by rewrite -{1}[x]mk_invgK mulV. move=> x y /=; rewrite -[y^-1 * _]mul1 -(mulV (x * y)) -2!mulA (mulA y). by rewrite mulxV mul1 mulxV -(mulxV (x * y)) mulA mulV mul1. Qed. Definition Mixin := BaseMixin mulA mul1 mk_invgK mk_invMg. End Mixin. Definition pack_base T m := fun c cT & phant_id (Finite.class cT) c => @PackBase T m c. Definition clone_base T := fun bT & sort bT -> T => fun m c (bT' := @PackBase T m c) & phant_id bT' bT => bT'. Definition clone T := fun bT gT & sort bT * sort (base gT) -> T * T => fun m (gT' := @Pack bT m) & phant_id gT' gT => gT'. Section InheritedClasses. Variable bT : base_type. Local Notation T := (arg_sort bT). Local Notation rT := (sort bT). Local Notation class := (finClass bT). Canonical eqType := Equality.Pack class. Canonical choiceType := Choice.Pack class. Canonical countType := Countable.Pack class. Canonical finType := Finite.Pack class. Definition arg_eqType := Eval hnf in [eqType of T]. Definition arg_choiceType := Eval hnf in [choiceType of T]. Definition arg_countType := Eval hnf in [countType of T]. Definition arg_finType := Eval hnf in [finType of T]. End InheritedClasses. Module Import Exports. (* Declaring sort as a Coercion is clearly redundant; it only *) (* serves the purpose of eliding FinGroup.sort in the display of *) (* return types. The warning could be eliminated by using the *) (* functor trick to replace Sortclass by a dummy target. *) Coercion arg_sort : base_type >-> Sortclass. Coercion sort : base_type >-> Sortclass. Coercion mixin : base_type >-> mixin_of. Coercion base : type >-> base_type. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Coercion arg_eqType : base_type >-> Equality.type. Canonical arg_eqType. Coercion arg_choiceType : base_type >-> Choice.type. Canonical arg_choiceType. Coercion arg_countType : base_type >-> Countable.type. Canonical arg_countType. Coercion arg_finType : base_type >-> Finite.type. Canonical arg_finType. Bind Scope group_scope with sort. Bind Scope group_scope with arg_sort. Notation baseFinGroupType := base_type. Notation finGroupType := type. Notation BaseFinGroupType T m := (@pack_base T m _ _ id). Notation FinGroupType := Pack. Notation "[ 'baseFinGroupType' 'of' T ]" := (@clone_base T _ id _ _ id) (at level 0, format "[ 'baseFinGroupType' 'of' T ]") : form_scope. Notation "[ 'finGroupType' 'of' T ]" := (@clone T _ _ id _ id) (at level 0, format "[ 'finGroupType' 'of' T ]") : form_scope. End Exports. End FinGroup. Export FinGroup.Exports. Section ElementOps. Variable T : baseFinGroupType. Notation rT := (FinGroup.sort T). Definition oneg : rT := FinGroup.one T. Definition mulg : T -> T -> rT := FinGroup.mul T. Definition invg : T -> rT := FinGroup.inv T. Definition expgn_rec (x : T) n : rT := iterop n mulg x oneg. End ElementOps. Definition expgn := nosimpl expgn_rec. Notation "1" := (oneg _) : group_scope. Notation "x1 * x2" := (mulg x1 x2) : group_scope. Notation "x ^-1" := (invg x) : group_scope. Notation "x ^+ n" := (expgn x n) : group_scope. Notation "x ^- n" := (x ^+ n)^-1 : group_scope. (* Arguments of conjg are restricted to true groups to avoid an *) (* improper interpretation of A ^ B with A and B sets, namely: *) (* {x^-1 * (y * z) | y \in A, x, z \in B} *) Definition conjg (T : finGroupType) (x y : T) := y^-1 * (x * y). Notation "x1 ^ x2" := (conjg x1 x2) : group_scope. Definition commg (T : finGroupType) (x y : T) := x^-1 * x ^ y. Notation "[ ~ x1 , x2 , .. , xn ]" := (commg .. (commg x1 x2) .. xn) : group_scope. Prenex Implicits mulg invg expgn conjg commg. Notation "\prod_ ( i <- r | P ) F" := (\big[mulg/1]_(i <- r | P%B) F%g) : group_scope. Notation "\prod_ ( i <- r ) F" := (\big[mulg/1]_(i <- r) F%g) : group_scope. Notation "\prod_ ( m <= i < n | P ) F" := (\big[mulg/1]_(m <= i < n | P%B) F%g) : group_scope. Notation "\prod_ ( m <= i < n ) F" := (\big[mulg/1]_(m <= i < n) F%g) : group_scope. Notation "\prod_ ( i | P ) F" := (\big[mulg/1]_(i | P%B) F%g) : group_scope. Notation "\prod_ i F" := (\big[mulg/1]_i F%g) : group_scope. Notation "\prod_ ( i : t | P ) F" := (\big[mulg/1]_(i : t | P%B) F%g) (only parsing) : group_scope. Notation "\prod_ ( i : t ) F" := (\big[mulg/1]_(i : t) F%g) (only parsing) : group_scope. Notation "\prod_ ( i < n | P ) F" := (\big[mulg/1]_(i < n | P%B) F%g) : group_scope. Notation "\prod_ ( i < n ) F" := (\big[mulg/1]_(i < n) F%g) : group_scope. Notation "\prod_ ( i 'in' A | P ) F" := (\big[mulg/1]_(i in A | P%B) F%g) : group_scope. Notation "\prod_ ( i 'in' A ) F" := (\big[mulg/1]_(i in A) F%g) : group_scope. Section PreGroupIdentities. Variable T : baseFinGroupType. Implicit Types x y z : T. Local Notation mulgT := (@mulg T). Lemma mulgA : associative mulgT. Proof. by case: T => ? []. Qed. Lemma mul1g : left_id 1 mulgT. Proof. by case: T => ? []. Qed. Lemma invgK : @involutive T invg. Proof. by case: T => ? []. Qed. Lemma invMg x y : (x * y)^-1 = y^-1 * x^-1. Proof. by case: T x y => ? []. Qed. Lemma invg_inj : @injective T T invg. Proof. exact: can_inj invgK. Qed. Lemma eq_invg_sym x y : (x^-1 == y) = (x == y^-1). Proof. by apply: (inv_eq invgK). Qed. Lemma invg1 : 1^-1 = 1 :> T. Proof. by apply: invg_inj; rewrite -{1}[1^-1]mul1g invMg invgK mul1g. Qed. Lemma eq_invg1 x : (x^-1 == 1) = (x == 1). Proof. by rewrite eq_invg_sym invg1. Qed. Lemma mulg1 : right_id 1 mulgT. Proof. by move=> x; apply: invg_inj; rewrite invMg invg1 mul1g. Qed. Canonical finGroup_law := Monoid.Law mulgA mul1g mulg1. Lemma expgnE x n : x ^+ n = expgn_rec x n. Proof. by []. Qed. Lemma expg0 x : x ^+ 0 = 1. Proof. by []. Qed. Lemma expg1 x : x ^+ 1 = x. Proof. by []. Qed. Lemma expgS x n : x ^+ n.+1 = x * x ^+ n. Proof. by case: n => //; rewrite mulg1. Qed. Lemma expg1n n : 1 ^+ n = 1 :> T. Proof. by elim: n => // n IHn; rewrite expgS mul1g. Qed. Lemma expgD x n m : x ^+ (n + m) = x ^+ n * x ^+ m. Proof. by elim: n => [|n IHn]; rewrite ?mul1g // !expgS IHn mulgA. Qed. Lemma expgSr x n : x ^+ n.+1 = x ^+ n * x. Proof. by rewrite -addn1 expgD expg1. Qed. Lemma expgM x n m : x ^+ (n * m) = x ^+ n ^+ m. Proof. elim: m => [|m IHm]; first by rewrite muln0 expg0. by rewrite mulnS expgD IHm expgS. Qed. Lemma expgAC x m n : x ^+ m ^+ n = x ^+ n ^+ m. Proof. by rewrite -!expgM mulnC. Qed. Definition commute x y := x * y = y * x. Lemma commute_refl x : commute x x. Proof. by []. Qed. Lemma commute_sym x y : commute x y -> commute y x. Proof. by []. Qed. Lemma commute1 x : commute x 1. Proof. by rewrite /commute mulg1 mul1g. Qed. Lemma commuteM x y z : commute x y -> commute x z -> commute x (y * z). Proof. by move=> cxy cxz; rewrite /commute -mulgA -cxz !mulgA cxy. Qed. Lemma commuteX x y n : commute x y -> commute x (y ^+ n). Proof. by move=> cxy; case: n; [apply: commute1 | elim=> // n; apply: commuteM]. Qed. Lemma commuteX2 x y m n : commute x y -> commute (x ^+ m) (y ^+ n). Proof. by move=> cxy; apply/commuteX/commute_sym/commuteX. Qed. Lemma expgVn x n : x^-1 ^+ n = x ^- n. Proof. by elim: n => [|n IHn]; rewrite ?invg1 // expgSr expgS invMg IHn. Qed. Lemma expgMn x y n : commute x y -> (x * y) ^+ n = x ^+ n * y ^+ n. Proof. move=> cxy; elim: n => [|n IHn]; first by rewrite mulg1. by rewrite !expgS IHn -mulgA (mulgA y) (commuteX _ (commute_sym cxy)) !mulgA. Qed. End PreGroupIdentities. Hint Resolve commute1 : core. Arguments invg_inj {T} [x1 x2]. Prenex Implicits commute invgK. Section GroupIdentities. Variable T : finGroupType. Implicit Types x y z : T. Local Notation mulgT := (@mulg T). Lemma mulVg : left_inverse 1 invg mulgT. Proof. by case T. Qed. Lemma mulgV : right_inverse 1 invg mulgT. Proof. by move=> x; rewrite -{1}(invgK x) mulVg. Qed. Lemma mulKg : left_loop invg mulgT. Proof. by move=> x y; rewrite mulgA mulVg mul1g. Qed. Lemma mulKVg : rev_left_loop invg mulgT. Proof. by move=> x y; rewrite mulgA mulgV mul1g. Qed. Lemma mulgI : right_injective mulgT. Proof. by move=> x; apply: can_inj (mulKg x). Qed. Lemma mulgK : right_loop invg mulgT. Proof. by move=> x y; rewrite -mulgA mulgV mulg1. Qed. Lemma mulgKV : rev_right_loop invg mulgT. Proof. by move=> x y; rewrite -mulgA mulVg mulg1. Qed. Lemma mulIg : left_injective mulgT. Proof. by move=> x; apply: can_inj (mulgK x). Qed. Lemma eq_invg_mul x y : (x^-1 == y :> T) = (x * y == 1 :> T). Proof. by rewrite -(inj_eq (@mulgI x)) mulgV eq_sym. Qed. Lemma eq_mulgV1 x y : (x == y) = (x * y^-1 == 1 :> T). Proof. by rewrite -(inj_eq invg_inj) eq_invg_mul. Qed. Lemma eq_mulVg1 x y : (x == y) = (x^-1 * y == 1 :> T). Proof. by rewrite -eq_invg_mul invgK. Qed. Lemma commuteV x y : commute x y -> commute x y^-1. Proof. by move=> cxy; apply: (@mulIg y); rewrite mulgKV -mulgA cxy mulKg. Qed. Lemma conjgE x y : x ^ y = y^-1 * (x * y). Proof. by []. Qed. Lemma conjgC x y : x * y = y * x ^ y. Proof. by rewrite mulKVg. Qed. Lemma conjgCV x y : x * y = y ^ x^-1 * x. Proof. by rewrite -mulgA mulgKV invgK. Qed. Lemma conjg1 x : x ^ 1 = x. Proof. by rewrite conjgE commute1 mulKg. Qed. Lemma conj1g x : 1 ^ x = 1. Proof. by rewrite conjgE mul1g mulVg. Qed. Lemma conjMg x y z : (x * y) ^ z = x ^ z * y ^ z. Proof. by rewrite !conjgE !mulgA mulgK. Qed. Lemma conjgM x y z : x ^ (y * z) = (x ^ y) ^ z. Proof. by rewrite !conjgE invMg !mulgA. Qed. Lemma conjVg x y : x^-1 ^ y = (x ^ y)^-1. Proof. by rewrite !conjgE !invMg invgK mulgA. Qed. Lemma conjJg x y z : (x ^ y) ^ z = (x ^ z) ^ y ^ z. Proof. by rewrite 2!conjMg conjVg. Qed. Lemma conjXg x y n : (x ^+ n) ^ y = (x ^ y) ^+ n. Proof. by elim: n => [|n IHn]; rewrite ?conj1g // !expgS conjMg IHn. Qed. Lemma conjgK : @right_loop T T invg conjg. Proof. by move=> y x; rewrite -conjgM mulgV conjg1. Qed. Lemma conjgKV : @rev_right_loop T T invg conjg. Proof. by move=> y x; rewrite -conjgM mulVg conjg1. Qed. Lemma conjg_inj : @left_injective T T T conjg. Proof. by move=> y; apply: can_inj (conjgK y). Qed. Lemma conjg_eq1 x y : (x ^ y == 1) = (x == 1). Proof. by rewrite (canF_eq (conjgK _)) conj1g. Qed. Lemma conjg_prod I r (P : pred I) F z : (\prod_(i <- r | P i) F i) ^ z = \prod_(i <- r | P i) (F i ^ z). Proof. by apply: (big_morph (conjg^~ z)) => [x y|]; rewrite ?conj1g ?conjMg. Qed. Lemma commgEl x y : [~ x, y] = x^-1 * x ^ y. Proof. by []. Qed. Lemma commgEr x y : [~ x, y] = y^-1 ^ x * y. Proof. by rewrite -!mulgA. Qed. Lemma commgC x y : x * y = y * x * [~ x, y]. Proof. by rewrite -mulgA !mulKVg. Qed. Lemma commgCV x y : x * y = [~ x^-1, y^-1] * (y * x). Proof. by rewrite commgEl !mulgA !invgK !mulgKV. Qed. Lemma conjRg x y z : [~ x, y] ^ z = [~ x ^ z, y ^ z]. Proof. by rewrite !conjMg !conjVg. Qed. Lemma invg_comm x y : [~ x, y]^-1 = [~ y, x]. Proof. by rewrite commgEr conjVg invMg invgK. Qed. Lemma commgP x y : reflect (commute x y) ([~ x, y] == 1 :> T). Proof. by rewrite [[~ x, y]]mulgA -invMg -eq_mulVg1 eq_sym; apply: eqP. Qed. Lemma conjg_fixP x y : reflect (x ^ y = x) ([~ x, y] == 1 :> T). Proof. by rewrite -eq_mulVg1 eq_sym; apply: eqP. Qed. Lemma commg1_sym x y : ([~ x, y] == 1 :> T) = ([~ y, x] == 1 :> T). Proof. by rewrite -invg_comm (inv_eq invgK) invg1. Qed. Lemma commg1 x : [~ x, 1] = 1. Proof. exact/eqP/commgP. Qed. Lemma comm1g x : [~ 1, x] = 1. Proof. by rewrite -invg_comm commg1 invg1. Qed. Lemma commgg x : [~ x, x] = 1. Proof. exact/eqP/commgP. Qed. Lemma commgXg x n : [~ x, x ^+ n] = 1. Proof. exact/eqP/commgP/commuteX. Qed. Lemma commgVg x : [~ x, x^-1] = 1. Proof. exact/eqP/commgP/commuteV. Qed. Lemma commgXVg x n : [~ x, x ^- n] = 1. Proof. exact/eqP/commgP/commuteV/commuteX. Qed. (* Other commg identities should slot in here. *) End GroupIdentities. Hint Rewrite mulg1 mul1g invg1 mulVg mulgV (@invgK) mulgK mulgKV invMg mulgA : gsimpl. Ltac gsimpl := autorewrite with gsimpl; try done. Definition gsimp := (mulg1 , mul1g, (invg1, @invgK), (mulgV, mulVg)). Definition gnorm := (gsimp, (mulgK, mulgKV, (mulgA, invMg))). Arguments mulgI [T]. Arguments mulIg [T]. Arguments conjg_inj {T} x [x1 x2]. Arguments commgP {T x y}. Arguments conjg_fixP {T x y}. Section Repr. (* Plucking a set representative. *) Variable gT : baseFinGroupType. Implicit Type A : {set gT}. Definition repr A := if 1 \in A then 1 else odflt 1 [pick x in A]. Lemma mem_repr A x : x \in A -> repr A \in A. Proof. by rewrite /repr; case: ifP => // _; case: pickP => // A0; rewrite [x \in A]A0. Qed. Lemma card_mem_repr A : #|A| > 0 -> repr A \in A. Proof. by rewrite lt0n => /existsP[x]; apply: mem_repr. Qed. Lemma repr_set1 x : repr [set x] = x. Proof. by apply/set1P/card_mem_repr; rewrite cards1. Qed. Lemma repr_set0 : repr set0 = 1. Proof. by rewrite /repr; case: pickP => [x|_]; rewrite !inE. Qed. End Repr. Arguments mem_repr [gT A]. Section BaseSetMulDef. (* We only assume a baseFinGroupType to allow this construct to be iterated. *) Variable gT : baseFinGroupType. Implicit Types A B : {set gT}. (* Set-lifted group operations. *) Definition set_mulg A B := mulg @2: (A, B). Definition set_invg A := invg @^-1: A. (* The pre-group structure of group subsets. *) Lemma set_mul1g : left_id [set 1] set_mulg. Proof. move=> A; apply/setP=> y; apply/imset2P/idP=> [[_ x /set1P-> Ax ->] | Ay]. by rewrite mul1g. by exists (1 : gT) y; rewrite ?(set11, mul1g). Qed. Lemma set_mulgA : associative set_mulg. Proof. move=> A B C; apply/setP=> y. apply/imset2P/imset2P=> [[x1 z Ax1 /imset2P[x2 x3 Bx2 Cx3 ->] ->]| [z x3]]. by exists (x1 * x2) x3; rewrite ?mulgA //; apply/imset2P; exists x1 x2. case/imset2P=> x1 x2 Ax1 Bx2 -> Cx3 ->. by exists x1 (x2 * x3); rewrite ?mulgA //; apply/imset2P; exists x2 x3. Qed. Lemma set_invgK : involutive set_invg. Proof. by move=> A; apply/setP=> x; rewrite !inE invgK. Qed. Lemma set_invgM : {morph set_invg : A B / set_mulg A B >-> set_mulg B A}. Proof. move=> A B; apply/setP=> z; rewrite inE. apply/imset2P/imset2P=> [[x y Ax By /(canRL invgK)->] | [y x]]. by exists y^-1 x^-1; rewrite ?invMg // inE invgK. by rewrite !inE => By1 Ax1 ->; exists x^-1 y^-1; rewrite ?invMg. Qed. Definition group_set_baseGroupMixin : FinGroup.mixin_of (set_type gT) := FinGroup.BaseMixin set_mulgA set_mul1g set_invgK set_invgM. Canonical group_set_baseGroupType := Eval hnf in BaseFinGroupType (set_type gT) group_set_baseGroupMixin. Canonical group_set_of_baseGroupType := Eval hnf in [baseFinGroupType of {set gT}]. End BaseSetMulDef. (* Time to open the bag of dirty tricks. When we define groups down below *) (* as a subtype of {set gT}, we need them to be able to coerce to sets in *) (* both set-style contexts (x \in G) and monoid-style contexts (G * H), *) (* and we need the coercion function to be EXACTLY the structure *) (* projection in BOTH cases -- otherwise the canonical unification breaks.*) (* Alas, Coq doesn't let us use the same coercion function twice, even *) (* when the targets are convertible. Our workaround (ab)uses the module *) (* system to declare two different identity coercions on an alias class. *) Module GroupSet. Definition sort (gT : baseFinGroupType) := {set gT}. End GroupSet. Identity Coercion GroupSet_of_sort : GroupSet.sort >-> set_of. Module Type GroupSetBaseGroupSig. Definition sort gT := group_set_of_baseGroupType gT : Type. End GroupSetBaseGroupSig. Module MakeGroupSetBaseGroup (Gset_base : GroupSetBaseGroupSig). Identity Coercion of_sort : Gset_base.sort >-> FinGroup.arg_sort. End MakeGroupSetBaseGroup. Module Export GroupSetBaseGroup := MakeGroupSetBaseGroup GroupSet. Canonical group_set_eqType gT := Eval hnf in [eqType of GroupSet.sort gT]. Canonical group_set_choiceType gT := Eval hnf in [choiceType of GroupSet.sort gT]. Canonical group_set_countType gT := Eval hnf in [countType of GroupSet.sort gT]. Canonical group_set_finType gT := Eval hnf in [finType of GroupSet.sort gT]. Section GroupSetMulDef. (* Some of these constructs could be defined on a baseFinGroupType. *) (* We restrict them to proper finGroupType because we only develop *) (* the theory for that case. *) Variable gT : finGroupType. Implicit Types A B : {set gT}. Implicit Type x y : gT. Definition lcoset A x := mulg x @: A. Definition rcoset A x := mulg^~ x @: A. Definition lcosets A B := lcoset A @: B. Definition rcosets A B := rcoset A @: B. Definition indexg B A := #|rcosets A B|. Definition conjugate A x := conjg^~ x @: A. Definition conjugates A B := conjugate A @: B. Definition class x B := conjg x @: B. Definition classes A := class^~ A @: A. Definition class_support A B := conjg @2: (A, B). Definition commg_set A B := commg @2: (A, B). (* These will only be used later, but are defined here so that we can *) (* keep all the Notation together. *) Definition normaliser A := [set x | conjugate A x \subset A]. Definition centraliser A := \bigcap_(x in A) normaliser [set x]. Definition abelian A := A \subset centraliser A. Definition normal A B := (A \subset B) && (B \subset normaliser A). (* "normalised" and "centralise[s|d]" are intended to be used with *) (* the {in ...} form, as in abelian below. *) Definition normalised A := forall x, conjugate A x = A. Definition centralises x A := forall y, y \in A -> commute x y. Definition centralised A := forall x, centralises x A. End GroupSetMulDef. Arguments lcoset _ _%g _%g. Arguments rcoset _ _%g _%g. Arguments rcosets _ _%g _%g. Arguments lcosets _ _%g _%g. Arguments indexg _ _%g _%g. Arguments conjugate _ _%g _%g. Arguments conjugates _ _%g _%g. Arguments class _ _%g _%g. Arguments classes _ _%g. Arguments class_support _ _%g _%g. Arguments commg_set _ _%g _%g. Arguments normaliser _ _%g. Arguments centraliser _ _%g. Arguments abelian _ _%g. Arguments normal _ _%g _%g. Arguments normalised _ _%g. Arguments centralises _ _%g _%g. Arguments centralised _ _%g. Notation "[ 1 gT ]" := (1 : {set gT}) : group_scope. Notation "[ 1 ]" := [1 FinGroup.sort _] : group_scope. Notation "A ^#" := (A :\ 1) : group_scope. Notation "x *: A" := ([set x%g] * A) : group_scope. Notation "A :* x" := (A * [set x%g]) : group_scope. Notation "A :^ x" := (conjugate A x) : group_scope. Notation "x ^: B" := (class x B) : group_scope. Notation "A :^: B" := (conjugates A B) : group_scope. Notation "#| B : A |" := (indexg B A) : group_scope. (* No notation for lcoset and rcoset, which are to be used mostly *) (* in curried form; x *: B and A :* 1 denote singleton products, *) (* so we can use mulgA, mulg1, etc, on, say, A :* 1 * B :* x. *) (* No notation for the set commutator generator set commg_set. *) Notation "''N' ( A )" := (normaliser A) : group_scope. Notation "''N_' G ( A )" := (G%g :&: 'N(A)) : group_scope. Notation "A <| B" := (normal A B) : group_scope. Notation "''C' ( A )" := (centraliser A) : group_scope. Notation "''C_' G ( A )" := (G%g :&: 'C(A)) : group_scope. Notation "''C_' ( G ) ( A )" := 'C_G(A) (only parsing) : group_scope. Notation "''C' [ x ]" := 'N([set x%g]) : group_scope. Notation "''C_' G [ x ]" := 'N_G([set x%g]) : group_scope. Notation "''C_' ( G ) [ x ]" := 'C_G[x] (only parsing) : group_scope. Prenex Implicits repr lcoset rcoset lcosets rcosets normal. Prenex Implicits conjugate conjugates class classes class_support. Prenex Implicits commg_set normalised centralised abelian. Section BaseSetMulProp. (* Properties of the purely multiplicative structure. *) Variable gT : baseFinGroupType. Implicit Types A B C D : {set gT}. Implicit Type x y z : gT. (* Set product. We already have all the pregroup identities, so we *) (* only need to add the monotonicity rules. *) Lemma mulsgP A B x : reflect (imset2_spec mulg (mem A) (fun _ => mem B) x) (x \in A * B). Proof. exact: imset2P. Qed. Lemma mem_mulg A B x y : x \in A -> y \in B -> x * y \in A * B. Proof. by move=> Ax By; apply/mulsgP; exists x y. Qed. Lemma prodsgP (I : finType) (P : pred I) (A : I -> {set gT}) x : reflect (exists2 c, forall i, P i -> c i \in A i & x = \prod_(i | P i) c i) (x \in \prod_(i | P i) A i). Proof. have [r big_r [Ur mem_r] _] := big_enumP P. pose inA c := all (fun i => c i \in A i); rewrite -big_r; set piAx := x \in _. suffices{big_r} IHr: reflect (exists2 c, inA c r & x = \prod_(i <- r) c i) piAx. apply: (iffP IHr) => -[c inAc ->]; do [exists c; last by rewrite big_r]. by move=> i Pi; rewrite (allP inAc) ?mem_r. by apply/allP=> i; rewrite mem_r => /inAc. elim: {P mem_r}r x @piAx Ur => /= [x _ | i r IHr x /andP[r'i /IHr{}IHr]]. by rewrite unlock; apply: (iffP set1P) => [-> | [] //]; exists (fun=> x). rewrite big_cons; apply: (iffP idP) => [|[c /andP[Aci Ac] ->]]; last first. by rewrite big_cons mem_mulg //; apply/IHr=> //; exists c. case/mulsgP=> c_i _ Ac_i /IHr[c /allP-inAcr ->] ->{x}. exists [eta c with i |-> c_i]; rewrite /= ?big_cons eqxx ?Ac_i. by apply/allP=> j rj; rewrite /= ifN ?(memPn r'i) ?inAcr. by congr (_ * _); apply: eq_big_seq => j rj; rewrite ifN ?(memPn r'i). Qed. Lemma mem_prodg (I : finType) (P : pred I) (A : I -> {set gT}) c : (forall i, P i -> c i \in A i) -> \prod_(i | P i) c i \in \prod_(i | P i) A i. Proof. by move=> Ac; apply/prodsgP; exists c. Qed. Lemma mulSg A B C : A \subset B -> A * C \subset B * C. Proof. exact: imset2Sl. Qed. Lemma mulgS A B C : B \subset C -> A * B \subset A * C. Proof. exact: imset2Sr. Qed. Lemma mulgSS A B C D : A \subset B -> C \subset D -> A * C \subset B * D. Proof. exact: imset2S. Qed. Lemma mulg_subl A B : 1 \in B -> A \subset A * B. Proof. by move=> B1; rewrite -{1}(mulg1 A) mulgS ?sub1set. Qed. Lemma mulg_subr A B : 1 \in A -> B \subset A * B. Proof. by move=> A1; rewrite -{1}(mul1g B) mulSg ?sub1set. Qed. Lemma mulUg A B C : (A :|: B) * C = (A * C) :|: (B * C). Proof. exact: imset2Ul. Qed. Lemma mulgU A B C : A * (B :|: C) = (A * B) :|: (A * C). Proof. exact: imset2Ur. Qed. (* Set (pointwise) inverse. *) Lemma invUg A B : (A :|: B)^-1 = A^-1 :|: B^-1. Proof. exact: preimsetU. Qed. Lemma invIg A B : (A :&: B)^-1 = A^-1 :&: B^-1. Proof. exact: preimsetI. Qed. Lemma invDg A B : (A :\: B)^-1 = A^-1 :\: B^-1. Proof. exact: preimsetD. Qed. Lemma invCg A : (~: A)^-1 = ~: A^-1. Proof. exact: preimsetC. Qed. Lemma invSg A B : (A^-1 \subset B^-1) = (A \subset B). Proof. by rewrite !(sameP setIidPl eqP) -invIg (inj_eq invg_inj). Qed. Lemma mem_invg x A : (x \in A^-1) = (x^-1 \in A). Proof. by rewrite inE. Qed. Lemma memV_invg x A : (x^-1 \in A^-1) = (x \in A). Proof. by rewrite inE invgK. Qed. Lemma card_invg A : #|A^-1| = #|A|. Proof. exact/card_preimset/invg_inj. Qed. (* Product with singletons. *) Lemma set1gE : 1 = [set 1] :> {set gT}. Proof. by []. Qed. Lemma set1gP x : reflect (x = 1) (x \in [1]). Proof. exact: set1P. Qed. Lemma mulg_set1 x y : [set x] :* y = [set x * y]. Proof. by rewrite [_ * _]imset2_set1l imset_set1. Qed. Lemma invg_set1 x : [set x]^-1 = [set x^-1]. Proof. by apply/setP=> y; rewrite !inE inv_eq //; apply: invgK. Qed. End BaseSetMulProp. Arguments set1gP {gT x}. Arguments mulsgP {gT A B x}. Arguments prodsgP {gT I P A x}. Section GroupSetMulProp. (* Constructs that need a finGroupType *) Variable gT : finGroupType. Implicit Types A B C D : {set gT}. Implicit Type x y z : gT. (* Left cosets. *) Lemma lcosetE A x : lcoset A x = x *: A. Proof. by rewrite [_ * _]imset2_set1l. Qed. Lemma card_lcoset A x : #|x *: A| = #|A|. Proof. by rewrite -lcosetE (card_imset _ (mulgI _)). Qed. Lemma mem_lcoset A x y : (y \in x *: A) = (x^-1 * y \in A). Proof. by rewrite -lcosetE [_ x](can_imset_pre _ (mulKg _)) inE. Qed. Lemma lcosetP A x y : reflect (exists2 a, a \in A & y = x * a) (y \in x *: A). Proof. by rewrite -lcosetE; apply: imsetP. Qed. Lemma lcosetsP A B C : reflect (exists2 x, x \in B & C = x *: A) (C \in lcosets A B). Proof. by apply: (iffP imsetP) => [] [x Bx ->]; exists x; rewrite ?lcosetE. Qed. Lemma lcosetM A x y : (x * y) *: A = x *: (y *: A). Proof. by rewrite -mulg_set1 mulgA. Qed. Lemma lcoset1 A : 1 *: A = A. Proof. exact: mul1g. Qed. Lemma lcosetK : left_loop invg (fun x A => x *: A). Proof. by move=> x A; rewrite -lcosetM mulVg mul1g. Qed. Lemma lcosetKV : rev_left_loop invg (fun x A => x *: A). Proof. by move=> x A; rewrite -lcosetM mulgV mul1g. Qed. Lemma lcoset_inj : right_injective (fun x A => x *: A). Proof. by move=> x; apply: can_inj (lcosetK x). Qed. Lemma lcosetS x A B : (x *: A \subset x *: B) = (A \subset B). Proof. apply/idP/idP=> sAB; last exact: mulgS. by rewrite -(lcosetK x A) -(lcosetK x B) mulgS. Qed. Lemma sub_lcoset x A B : (A \subset x *: B) = (x^-1 *: A \subset B). Proof. by rewrite -(lcosetS x^-1) lcosetK. Qed. Lemma sub_lcosetV x A B : (A \subset x^-1 *: B) = (x *: A \subset B). Proof. by rewrite sub_lcoset invgK. Qed. (* Right cosets. *) Lemma rcosetE A x : rcoset A x = A :* x. Proof. by rewrite [_ * _]imset2_set1r. Qed. Lemma card_rcoset A x : #|A :* x| = #|A|. Proof. by rewrite -rcosetE (card_imset _ (mulIg _)). Qed. Lemma mem_rcoset A x y : (y \in A :* x) = (y * x^-1 \in A). Proof. by rewrite -rcosetE [_ x](can_imset_pre A (mulgK _)) inE. Qed. Lemma rcosetP A x y : reflect (exists2 a, a \in A & y = a * x) (y \in A :* x). Proof. by rewrite -rcosetE; apply: imsetP. Qed. Lemma rcosetsP A B C : reflect (exists2 x, x \in B & C = A :* x) (C \in rcosets A B). Proof. by apply: (iffP imsetP) => [] [x Bx ->]; exists x; rewrite ?rcosetE. Qed. Lemma rcosetM A x y : A :* (x * y) = A :* x :* y. Proof. by rewrite -mulg_set1 mulgA. Qed. Lemma rcoset1 A : A :* 1 = A. Proof. exact: mulg1. Qed. Lemma rcosetK : right_loop invg (fun A x => A :* x). Proof. by move=> x A; rewrite -rcosetM mulgV mulg1. Qed. Lemma rcosetKV : rev_right_loop invg (fun A x => A :* x). Proof. by move=> x A; rewrite -rcosetM mulVg mulg1. Qed. Lemma rcoset_inj : left_injective (fun A x => A :* x). Proof. by move=> x; apply: can_inj (rcosetK x). Qed. Lemma rcosetS x A B : (A :* x \subset B :* x) = (A \subset B). Proof. apply/idP/idP=> sAB; last exact: mulSg. by rewrite -(rcosetK x A) -(rcosetK x B) mulSg. Qed. Lemma sub_rcoset x A B : (A \subset B :* x) = (A :* x ^-1 \subset B). Proof. by rewrite -(rcosetS x^-1) rcosetK. Qed. Lemma sub_rcosetV x A B : (A \subset B :* x^-1) = (A :* x \subset B). Proof. by rewrite sub_rcoset invgK. Qed. (* Inverse maps lcosets to rcosets *) Lemma invg_lcosets A B : (lcosets A B)^-1 = rcosets A^-1 B^-1. Proof. rewrite /A^-1/= -![_^-1](can_imset_pre _ invgK) -[RHS]imset_comp -imset_comp. by apply: eq_imset => x /=; rewrite lcosetE rcosetE invMg invg_set1. Qed. (* Conjugates. *) Lemma conjg_preim A x : A :^ x = (conjg^~ x^-1) @^-1: A. Proof. exact: can_imset_pre (conjgK _). Qed. Lemma mem_conjg A x y : (y \in A :^ x) = (y ^ x^-1 \in A). Proof. by rewrite conjg_preim inE. Qed. Lemma mem_conjgV A x y : (y \in A :^ x^-1) = (y ^ x \in A). Proof. by rewrite mem_conjg invgK. Qed. Lemma memJ_conjg A x y : (y ^ x \in A :^ x) = (y \in A). Proof. by rewrite mem_conjg conjgK. Qed. Lemma conjsgE A x : A :^ x = x^-1 *: (A :* x). Proof. by apply/setP=> y; rewrite mem_lcoset mem_rcoset -mulgA mem_conjg. Qed. Lemma conjsg1 A : A :^ 1 = A. Proof. by rewrite conjsgE invg1 mul1g mulg1. Qed. Lemma conjsgM A x y : A :^ (x * y) = (A :^ x) :^ y. Proof. by rewrite !conjsgE invMg -!mulg_set1 !mulgA. Qed. Lemma conjsgK : @right_loop _ gT invg conjugate. Proof. by move=> x A; rewrite -conjsgM mulgV conjsg1. Qed. Lemma conjsgKV : @rev_right_loop _ gT invg conjugate. Proof. by move=> x A; rewrite -conjsgM mulVg conjsg1. Qed. Lemma conjsg_inj : @left_injective _ gT _ conjugate. Proof. by move=> x; apply: can_inj (conjsgK x). Qed. Lemma cardJg A x : #|A :^ x| = #|A|. Proof. by rewrite (card_imset _ (conjg_inj x)). Qed. Lemma conjSg A B x : (A :^ x \subset B :^ x) = (A \subset B). Proof. by rewrite !conjsgE lcosetS rcosetS. Qed. Lemma properJ A B x : (A :^ x \proper B :^ x) = (A \proper B). Proof. by rewrite /proper !conjSg. Qed. Lemma sub_conjg A B x : (A :^ x \subset B) = (A \subset B :^ x^-1). Proof. by rewrite -(conjSg A _ x) conjsgKV. Qed. Lemma sub_conjgV A B x : (A :^ x^-1 \subset B) = (A \subset B :^ x). Proof. by rewrite -(conjSg _ B x) conjsgKV. Qed. Lemma conjg_set1 x y : [set x] :^ y = [set x ^ y]. Proof. by rewrite [_ :^ _]imset_set1. Qed. Lemma conjs1g x : 1 :^ x = 1. Proof. by rewrite conjg_set1 conj1g. Qed. Lemma conjsg_eq1 A x : (A :^ x == 1%g) = (A == 1%g). Proof. by rewrite (canF_eq (conjsgK x)) conjs1g. Qed. Lemma conjsMg A B x : (A * B) :^ x = A :^ x * B :^ x. Proof. by rewrite !conjsgE !mulgA rcosetK. Qed. Lemma conjIg A B x : (A :&: B) :^ x = A :^ x :&: B :^ x. Proof. by rewrite !conjg_preim preimsetI. Qed. Lemma conj0g x : set0 :^ x = set0. Proof. exact: imset0. Qed. Lemma conjTg x : [set: gT] :^ x = [set: gT]. Proof. by rewrite conjg_preim preimsetT. Qed. Lemma bigcapJ I r (P : pred I) (B : I -> {set gT}) x : \bigcap_(i <- r | P i) (B i :^ x) = (\bigcap_(i <- r | P i) B i) :^ x. Proof. by rewrite (big_endo (conjugate^~ x)) => // [B1 B2|]; rewrite (conjTg, conjIg). Qed. Lemma conjUg A B x : (A :|: B) :^ x = A :^ x :|: B :^ x. Proof. by rewrite !conjg_preim preimsetU. Qed. Lemma bigcupJ I r (P : pred I) (B : I -> {set gT}) x : \bigcup_(i <- r | P i) (B i :^ x) = (\bigcup_(i <- r | P i) B i) :^ x. Proof. rewrite (big_endo (conjugate^~ x)) => // [B1 B2|]; first by rewrite conjUg. exact: imset0. Qed. Lemma conjCg A x : (~: A) :^ x = ~: A :^ x. Proof. by rewrite !conjg_preim preimsetC. Qed. Lemma conjDg A B x : (A :\: B) :^ x = A :^ x :\: B :^ x. Proof. by rewrite !setDE !(conjCg, conjIg). Qed. Lemma conjD1g A x : A^# :^ x = (A :^ x)^#. Proof. by rewrite conjDg conjs1g. Qed. (* Classes; not much for now. *) Lemma memJ_class x y A : y \in A -> x ^ y \in x ^: A. Proof. exact: imset_f. Qed. Lemma classS x A B : A \subset B -> x ^: A \subset x ^: B. Proof. exact: imsetS. Qed. Lemma class_set1 x y : x ^: [set y] = [set x ^ y]. Proof. exact: imset_set1. Qed. Lemma class1g x A : x \in A -> 1 ^: A = 1. Proof. move=> Ax; apply/setP=> y. by apply/imsetP/set1P=> [[a Aa]|] ->; last exists x; rewrite ?conj1g. Qed. Lemma classVg x A : x^-1 ^: A = (x ^: A)^-1. Proof. apply/setP=> xy; rewrite inE; apply/imsetP/imsetP=> [] [y Ay def_xy]. by rewrite def_xy conjVg invgK; exists y. by rewrite -[xy]invgK def_xy -conjVg; exists y. Qed. Lemma mem_classes x A : x \in A -> x ^: A \in classes A. Proof. exact: imset_f. Qed. Lemma memJ_class_support A B x y : x \in A -> y \in B -> x ^ y \in class_support A B. Proof. by move=> Ax By; apply: imset2_f. Qed. Lemma class_supportM A B C : class_support A (B * C) = class_support (class_support A B) C. Proof. apply/setP=> x; apply/imset2P/imset2P=> [[a y Aa] | [y c]]. case/mulsgP=> b c Bb Cc -> ->{x y}. by exists (a ^ b) c; rewrite ?(imset2_f, conjgM). case/imset2P=> a b Aa Bb -> Cc ->{x y}. by exists a (b * c); rewrite ?(mem_mulg, conjgM). Qed. Lemma class_support_set1l A x : class_support [set x] A = x ^: A. Proof. exact: imset2_set1l. Qed. Lemma class_support_set1r A x : class_support A [set x] = A :^ x. Proof. exact: imset2_set1r. Qed. Lemma classM x A B : x ^: (A * B) = class_support (x ^: A) B. Proof. by rewrite -!class_support_set1l class_supportM. Qed. Lemma class_lcoset x y A : x ^: (y *: A) = (x ^ y) ^: A. Proof. by rewrite classM class_set1 class_support_set1l. Qed. Lemma class_rcoset x A y : x ^: (A :* y) = (x ^: A) :^ y. Proof. by rewrite -class_support_set1r classM. Qed. (* Conjugate set. *) Lemma conjugatesS A B C : B \subset C -> A :^: B \subset A :^: C. Proof. exact: imsetS. Qed. Lemma conjugates_set1 A x : A :^: [set x] = [set A :^ x]. Proof. exact: imset_set1. Qed. Lemma conjugates_conj A x B : (A :^ x) :^: B = A :^: (x *: B). Proof. rewrite /conjugates [x *: B]imset2_set1l -imset_comp. by apply: eq_imset => y /=; rewrite conjsgM. Qed. (* Class support. *) Lemma class_supportEl A B : class_support A B = \bigcup_(x in A) x ^: B. Proof. exact: curry_imset2l. Qed. Lemma class_supportEr A B : class_support A B = \bigcup_(x in B) A :^ x. Proof. exact: curry_imset2r. Qed. (* Groups (at last!) *) Definition group_set A := (1 \in A) && (A * A \subset A). Lemma group_setP A : reflect (1 \in A /\ {in A & A, forall x y, x * y \in A}) (group_set A). Proof. apply: (iffP andP) => [] [A1 AM]; split=> {A1}//. by move=> x y Ax Ay; apply: (subsetP AM); rewrite mem_mulg. by apply/subsetP=> _ /mulsgP[x y Ax Ay ->]; apply: AM. Qed. Structure group_type : Type := Group { gval :> GroupSet.sort gT; _ : group_set gval }. Definition group_of of phant gT : predArgType := group_type. Local Notation groupT := (group_of (Phant gT)). Identity Coercion type_of_group : group_of >-> group_type. Canonical group_subType := Eval hnf in [subType for gval]. Definition group_eqMixin := Eval hnf in [eqMixin of group_type by <:]. Canonical group_eqType := Eval hnf in EqType group_type group_eqMixin. Definition group_choiceMixin := [choiceMixin of group_type by <:]. Canonical group_choiceType := Eval hnf in ChoiceType group_type group_choiceMixin. Definition group_countMixin := [countMixin of group_type by <:]. Canonical group_countType := Eval hnf in CountType group_type group_countMixin. Canonical group_subCountType := Eval hnf in [subCountType of group_type]. Definition group_finMixin := [finMixin of group_type by <:]. Canonical group_finType := Eval hnf in FinType group_type group_finMixin. Canonical group_subFinType := Eval hnf in [subFinType of group_type]. (* No predType or baseFinGroupType structures, as these would hide the *) (* group-to-set coercion and thus spoil unification. *) Canonical group_of_subType := Eval hnf in [subType of groupT]. Canonical group_of_eqType := Eval hnf in [eqType of groupT]. Canonical group_of_choiceType := Eval hnf in [choiceType of groupT]. Canonical group_of_countType := Eval hnf in [countType of groupT]. Canonical group_of_subCountType := Eval hnf in [subCountType of groupT]. Canonical group_of_finType := Eval hnf in [finType of groupT]. Canonical group_of_subFinType := Eval hnf in [subFinType of groupT]. Definition group (A : {set gT}) gA : groupT := @Group A gA. Definition clone_group G := let: Group _ gP := G return {type of Group for G} -> groupT in fun k => k gP. Lemma group_inj : injective gval. Proof. exact: val_inj. Qed. Lemma groupP (G : groupT) : group_set G. Proof. by case: G. Qed. Lemma congr_group (H K : groupT) : H = K -> H :=: K. Proof. exact: congr1. Qed. Lemma isgroupP A : reflect (exists G : groupT, A = G) (group_set A). Proof. by apply: (iffP idP) => [gA | [[B gB] -> //]]; exists (Group gA). Qed. Lemma group_set_one : group_set 1. Proof. by rewrite /group_set set11 mulg1 subxx. Qed. Canonical one_group := group group_set_one. Canonical set1_group := @group [set 1] group_set_one. Lemma group_setT (phT : phant gT) : group_set (setTfor phT). Proof. by apply/group_setP; split=> [|x y _ _]; rewrite inE. Qed. Canonical setT_group phT := group (group_setT phT). (* These definitions come early so we can establish the Notation. *) Definition generated A := \bigcap_(G : groupT | A \subset G) G. Definition gcore A B := \bigcap_(x in B) A :^ x. Definition joing A B := generated (A :|: B). Definition commutator A B := generated (commg_set A B). Definition cycle x := generated [set x]. Definition order x := #|cycle x|. End GroupSetMulProp. Arguments lcosetP {gT A x y}. Arguments lcosetsP {gT A B C}. Arguments rcosetP {gT A x y}. Arguments rcosetsP {gT A B C}. Arguments group_setP {gT A}. Prenex Implicits group_set mulsgP set1gP. Arguments commutator _ _%g _%g. Arguments joing _ _%g _%g. Arguments generated _ _%g. Notation "{ 'group' gT }" := (group_of (Phant gT)) (at level 0, format "{ 'group' gT }") : type_scope. Notation "[ 'group' 'of' G ]" := (clone_group (@group _ G)) (at level 0, format "[ 'group' 'of' G ]") : form_scope. Bind Scope Group_scope with group_type. Bind Scope Group_scope with group_of. Notation "1" := (one_group _) : Group_scope. Notation "[ 1 gT ]" := (1%G : {group gT}) : Group_scope. Notation "[ 'set' : gT ]" := (setT_group (Phant gT)) : Group_scope. (* Helper notation for defining new groups that need a bespoke finGroupType. *) (* The actual group for such a type (say, my_gT) will be the full group, *) (* i.e., [set: my_gT] or [set: my_gT]%G, but Coq will not recognize *) (* specific notation for these because of the coercions inserted during type *) (* inference, unless they are defined as [set: gsort my_gT] using the *) (* Notation below. *) Notation gsort gT := (FinGroup.arg_sort (FinGroup.base gT%type)) (only parsing). Notation "<< A >>" := (generated A) : group_scope. Notation "<[ x ] >" := (cycle x) : group_scope. Notation "#[ x ]" := (order x) : group_scope. Notation "A <*> B" := (joing A B) : group_scope. Notation "[ ~: A1 , A2 , .. , An ]" := (commutator .. (commutator A1 A2) .. An) : group_scope. Prenex Implicits order cycle gcore. Section GroupProp. Variable gT : finGroupType. Notation sT := {set gT}. Implicit Types A B C D : sT. Implicit Types x y z : gT. Implicit Types G H K : {group gT}. Section OneGroup. Variable G : {group gT}. Lemma valG : val G = G. Proof. by []. Qed. (* Non-triviality. *) Lemma group1 : 1 \in G. Proof. by case/group_setP: (valP G). Qed. Hint Resolve group1 : core. Lemma group1_contra x : x \notin G -> x != 1. Proof. by apply: contraNneq => ->. Qed. Lemma sub1G : [1 gT] \subset G. Proof. by rewrite sub1set. Qed. Lemma subG1 : (G \subset [1]) = (G :==: 1). Proof. by rewrite eqEsubset sub1G andbT. Qed. Lemma setI1g : 1 :&: G = 1. Proof. exact: (setIidPl sub1G). Qed. Lemma setIg1 : G :&: 1 = 1. Proof. exact: (setIidPr sub1G). Qed. Lemma subG1_contra H : G \subset H -> G :!=: 1 -> H :!=: 1. Proof. by move=> sGH; rewrite -subG1; apply: contraNneq => <-. Qed. Lemma repr_group : repr G = 1. Proof. by rewrite /repr group1. Qed. Lemma cardG_gt0 : 0 < #|G|. Proof. by rewrite lt0n; apply/existsP; exists (1 : gT). Qed. Lemma indexg_gt0 A : 0 < #|G : A|. Proof. rewrite lt0n; apply/existsP; exists A. by rewrite -{2}[A]mulg1 -rcosetE; apply: imset_f. Qed. Lemma trivgP : reflect (G :=: 1) (G \subset [1]). Proof. by rewrite subG1; apply: eqP. Qed. Lemma trivGP : reflect (G = 1%G) (G \subset [1]). Proof. by rewrite subG1; apply: eqP. Qed. Lemma proper1G : ([1] \proper G) = (G :!=: 1). Proof. by rewrite properEneq sub1G andbT eq_sym. Qed. Lemma trivgPn : reflect (exists2 x, x \in G & x != 1) (G :!=: 1). Proof. rewrite -subG1. by apply: (iffP subsetPn) => [] [x Gx x1]; exists x; rewrite ?inE in x1 *. Qed. Lemma trivg_card_le1 : (G :==: 1) = (#|G| <= 1). Proof. by rewrite eq_sym eqEcard cards1 sub1G. Qed. Lemma trivg_card1 : (G :==: 1) = (#|G| == 1%N). Proof. by rewrite trivg_card_le1 eqn_leq cardG_gt0 andbT. Qed. Lemma cardG_gt1 : (#|G| > 1) = (G :!=: 1). Proof. by rewrite trivg_card_le1 ltnNge. Qed. Lemma card_le1_trivg : #|G| <= 1 -> G :=: 1. Proof. by rewrite -trivg_card_le1; move/eqP. Qed. Lemma card1_trivg : #|G| = 1%N -> G :=: 1. Proof. by move=> G1; rewrite card_le1_trivg ?G1. Qed. (* Inclusion and product. *) Lemma mulG_subl A : A \subset A * G. Proof. exact: mulg_subl group1. Qed. Lemma mulG_subr A : A \subset G * A. Proof. exact: mulg_subr group1. Qed. Lemma mulGid : G * G = G. Proof. by apply/eqP; rewrite eqEsubset mulG_subr andbT; case/andP: (valP G). Qed. Lemma mulGS A B : (G * A \subset G * B) = (A \subset G * B). Proof. apply/idP/idP; first exact: subset_trans (mulG_subr A). by move/(mulgS G); rewrite mulgA mulGid. Qed. Lemma mulSG A B : (A * G \subset B * G) = (A \subset B * G). Proof. apply/idP/idP; first exact: subset_trans (mulG_subl A). by move/(mulSg G); rewrite -mulgA mulGid. Qed. Lemma mul_subG A B : A \subset G -> B \subset G -> A * B \subset G. Proof. by move=> sAG sBG; rewrite -mulGid mulgSS. Qed. (* Membership lemmas *) Lemma groupM x y : x \in G -> y \in G -> x * y \in G. Proof. by case/group_setP: (valP G) x y. Qed. Lemma groupX x n : x \in G -> x ^+ n \in G. Proof. by move=> Gx; elim: n => [|n IHn]; rewrite ?group1 // expgS groupM. Qed. Lemma groupVr x : x \in G -> x^-1 \in G. Proof. move=> Gx; rewrite -(mul1g x^-1) -mem_rcoset ((G :* x =P G) _) //. by rewrite eqEcard card_rcoset leqnn mul_subG ?sub1set. Qed. Lemma groupVl x : x^-1 \in G -> x \in G. Proof. by move/groupVr; rewrite invgK. Qed. Lemma groupV x : (x^-1 \in G) = (x \in G). Proof. by apply/idP/idP; [apply: groupVl | apply: groupVr]. Qed. Lemma groupMl x y : x \in G -> (x * y \in G) = (y \in G). Proof. move=> Gx; apply/idP/idP=> [Gxy|]; last exact: groupM. by rewrite -(mulKg x y) groupM ?groupVr. Qed. Lemma groupMr x y : x \in G -> (y * x \in G) = (y \in G). Proof. by move=> Gx; rewrite -[_ \in G]groupV invMg groupMl groupV. Qed. Definition in_group := (group1, groupV, (groupMl, groupX)). Lemma groupJ x y : x \in G -> y \in G -> x ^ y \in G. Proof. by move=> Gx Gy; rewrite !in_group. Qed. Lemma groupJr x y : y \in G -> (x ^ y \in G) = (x \in G). Proof. by move=> Gy; rewrite groupMl (groupMr, groupV). Qed. Lemma groupR x y : x \in G -> y \in G -> [~ x, y] \in G. Proof. by move=> Gx Gy; rewrite !in_group. Qed. Lemma group_prod I r (P : pred I) F : (forall i, P i -> F i \in G) -> \prod_(i <- r | P i) F i \in G. Proof. by move=> G_P; elim/big_ind: _ => //; apply: groupM. Qed. (* Inverse is an anti-morphism. *) Lemma invGid : G^-1 = G. Proof. by apply/setP=> x; rewrite inE groupV. Qed. Lemma inv_subG A : (A^-1 \subset G) = (A \subset G). Proof. by rewrite -{1}invGid invSg. Qed. Lemma invg_lcoset x : (x *: G)^-1 = G :* x^-1. Proof. by rewrite invMg invGid invg_set1. Qed. Lemma invg_rcoset x : (G :* x)^-1 = x^-1 *: G. Proof. by rewrite invMg invGid invg_set1. Qed. Lemma memV_lcosetV x y : (y^-1 \in x^-1 *: G) = (y \in G :* x). Proof. by rewrite -invg_rcoset memV_invg. Qed. Lemma memV_rcosetV x y : (y^-1 \in G :* x^-1) = (y \in x *: G). Proof. by rewrite -invg_lcoset memV_invg. Qed. (* Product idempotence *) Lemma mulSgGid A x : x \in A -> A \subset G -> A * G = G. Proof. move=> Ax sAG; apply/eqP; rewrite eqEsubset -{2}mulGid mulSg //=. apply/subsetP=> y Gy; rewrite -(mulKVg x y) mem_mulg // groupMr // groupV. exact: (subsetP sAG). Qed. Lemma mulGSgid A x : x \in A -> A \subset G -> G * A = G. Proof. rewrite -memV_invg -invSg invGid => Ax sAG. by apply: invg_inj; rewrite invMg invGid (mulSgGid Ax). Qed. (* Left cosets *) Lemma lcoset_refl x : x \in x *: G. Proof. by rewrite mem_lcoset mulVg group1. Qed. Lemma lcoset_sym x y : (x \in y *: G) = (y \in x *: G). Proof. by rewrite !mem_lcoset -groupV invMg invgK. Qed. Lemma lcoset_eqP {x y} : reflect (x *: G = y *: G) (x \in y *: G). Proof. suffices <-: (x *: G == y *: G) = (x \in y *: G) by apply: eqP. by rewrite eqEsubset !mulSG !sub1set lcoset_sym andbb. Qed. Lemma lcoset_transl x y z : x \in y *: G -> (x \in z *: G) = (y \in z *: G). Proof. by move=> Gyx; rewrite -2!(lcoset_sym z) (lcoset_eqP Gyx). Qed. Lemma lcoset_trans x y z : x \in y *: G -> y \in z *: G -> x \in z *: G. Proof. by move/lcoset_transl->. Qed. Lemma lcoset_id x : x \in G -> x *: G = G. Proof. by move=> Gx; rewrite (lcoset_eqP (_ : x \in 1 *: G)) mul1g. Qed. (* Right cosets, with an elimination form for repr. *) Lemma rcoset_refl x : x \in G :* x. Proof. by rewrite mem_rcoset mulgV group1. Qed. Lemma rcoset_sym x y : (x \in G :* y) = (y \in G :* x). Proof. by rewrite -!memV_lcosetV lcoset_sym. Qed. Lemma rcoset_eqP {x y} : reflect (G :* x = G :* y) (x \in G :* y). Proof. suffices <-: (G :* x == G :* y) = (x \in G :* y) by apply: eqP. by rewrite eqEsubset !mulGS !sub1set rcoset_sym andbb. Qed. Lemma rcoset_transl x y z : x \in G :* y -> (x \in G :* z) = (y \in G :* z). Proof. by move=> Gyx; rewrite -2!(rcoset_sym z) (rcoset_eqP Gyx). Qed. Lemma rcoset_trans x y z : x \in G :* y -> y \in G :* z -> x \in G :* z. Proof. by move/rcoset_transl->. Qed. Lemma rcoset_id x : x \in G -> G :* x = G. Proof. by move=> Gx; rewrite (rcoset_eqP (_ : x \in G :* 1)) mulg1. Qed. (* Elimination form. *) Variant rcoset_repr_spec x : gT -> Type := RcosetReprSpec g : g \in G -> rcoset_repr_spec x (g * x). Lemma mem_repr_rcoset x : repr (G :* x) \in G :* x. Proof. exact: mem_repr (rcoset_refl x). Qed. (* This form sometimes fails because ssreflect 1.1 delegates matching to the *) (* (weaker) primitive Coq algorithm for general (co)inductive type families. *) Lemma repr_rcosetP x : rcoset_repr_spec x (repr (G :* x)). Proof. by rewrite -[repr _](mulgKV x); split; rewrite -mem_rcoset mem_repr_rcoset. Qed. Lemma rcoset_repr x : G :* (repr (G :* x)) = G :* x. Proof. exact/rcoset_eqP/mem_repr_rcoset. Qed. (* Coset spaces. *) Lemma mem_rcosets A x : (G :* x \in rcosets G A) = (x \in G * A). Proof. apply/rcosetsP/mulsgP=> [[a Aa /rcoset_eqP/rcosetP[g]] | ]; first by exists g a. by case=> g a Gg Aa ->{x}; exists a; rewrite // rcosetM rcoset_id. Qed. Lemma mem_lcosets A x : (x *: G \in lcosets G A) = (x \in A * G). Proof. rewrite -[LHS]memV_invg invg_lcoset invg_lcosets. by rewrite -[RHS]memV_invg invMg invGid mem_rcosets. Qed. (* Conjugates. *) Lemma group_setJ A x : group_set (A :^ x) = group_set A. Proof. by rewrite /group_set mem_conjg conj1g -conjsMg conjSg. Qed. Lemma group_set_conjG x : group_set (G :^ x). Proof. by rewrite group_setJ groupP. Qed. Canonical conjG_group x := group (group_set_conjG x). Lemma conjGid : {in G, normalised G}. Proof. by move=> x Gx; apply/setP=> y; rewrite mem_conjg groupJr ?groupV. Qed. Lemma conj_subG x A : x \in G -> A \subset G -> A :^ x \subset G. Proof. by move=> Gx sAG; rewrite -(conjGid Gx) conjSg. Qed. (* Classes *) Lemma class1G : 1 ^: G = 1. Proof. exact: class1g group1. Qed. Lemma classes1 : [1] \in classes G. Proof. by rewrite -class1G mem_classes. Qed. Lemma classGidl x y : y \in G -> (x ^ y) ^: G = x ^: G. Proof. by move=> Gy; rewrite -class_lcoset lcoset_id. Qed. Lemma classGidr x : {in G, normalised (x ^: G)}. Proof. by move=> y Gy /=; rewrite -class_rcoset rcoset_id. Qed. Lemma class_refl x : x \in x ^: G. Proof. by apply/imsetP; exists 1; rewrite ?conjg1. Qed. Hint Resolve class_refl : core. Lemma class_eqP x y : reflect (x ^: G = y ^: G) (x \in y ^: G). Proof. by apply: (iffP idP) => [/imsetP[z Gz ->] | <-]; rewrite ?class_refl ?classGidl. Qed. Lemma class_sym x y : (x \in y ^: G) = (y \in x ^: G). Proof. by apply/idP/idP=> /class_eqP->. Qed. Lemma class_transl x y z : x \in y ^: G -> (x \in z ^: G) = (y \in z ^: G). Proof. by rewrite -!(class_sym z) => /class_eqP->. Qed. Lemma class_trans x y z : x \in y ^: G -> y \in z ^: G -> x \in z ^: G. Proof. by move/class_transl->. Qed. Lemma repr_class x : {y | y \in G & repr (x ^: G) = x ^ y}. Proof. set z := repr _; have: #|[set y in G | z == x ^ y]| > 0. have: z \in x ^: G by apply: (mem_repr x). by case/imsetP=> y Gy ->; rewrite (cardD1 y) inE Gy eqxx. by move/card_mem_repr; move: (repr _) => y /setIdP[Gy /eqP]; exists y. Qed. Lemma classG_eq1 x : (x ^: G == 1) = (x == 1). Proof. apply/eqP/eqP=> [xG1 | ->]; last exact: class1G. by have:= class_refl x; rewrite xG1 => /set1P. Qed. Lemma class_subG x A : x \in G -> A \subset G -> x ^: A \subset G. Proof. move=> Gx sAG; apply/subsetP=> _ /imsetP[y Ay ->]. by rewrite groupJ // (subsetP sAG). Qed. Lemma repr_classesP xG : reflect (repr xG \in G /\ xG = repr xG ^: G) (xG \in classes G). Proof. apply: (iffP imsetP) => [[x Gx ->] | []]; last by exists (repr xG). by have [y Gy ->] := repr_class x; rewrite classGidl ?groupJ. Qed. Lemma mem_repr_classes xG : xG \in classes G -> repr xG \in xG. Proof. by case/repr_classesP=> _ {2}->; apply: class_refl. Qed. Lemma classes_gt0 : 0 < #|classes G|. Proof. by rewrite (cardsD1 1) classes1. Qed. Lemma classes_gt1 : (#|classes G| > 1) = (G :!=: 1). Proof. rewrite (cardsD1 1) classes1 ltnS lt0n cards_eq0. apply/set0Pn/trivgPn=> [[xG /setD1P[nt_xG]] | [x Gx ntx]]. by case/imsetP=> x Gx def_xG; rewrite def_xG classG_eq1 in nt_xG; exists x. by exists (x ^: G); rewrite !inE classG_eq1 ntx; apply: imset_f. Qed. Lemma mem_class_support A x : x \in A -> x \in class_support A G. Proof. by move=> Ax; rewrite -[x]conjg1 memJ_class_support. Qed. Lemma class_supportGidl A x : x \in G -> class_support (A :^ x) G = class_support A G. Proof. by move=> Gx; rewrite -class_support_set1r -class_supportM lcoset_id. Qed. Lemma class_supportGidr A : {in G, normalised (class_support A G)}. Proof. by move=> x Gx /=; rewrite -class_support_set1r -class_supportM rcoset_id. Qed. Lemma class_support_subG A : A \subset G -> class_support A G \subset G. Proof. by move=> sAG; rewrite class_supportEr; apply/bigcupsP=> x Gx; apply: conj_subG. Qed. Lemma sub_class_support A : A \subset class_support A G. Proof. by rewrite class_supportEr (bigcup_max 1) ?conjsg1. Qed. Lemma class_support_id : class_support G G = G. Proof. by apply/eqP; rewrite eqEsubset sub_class_support class_support_subG. Qed. Lemma class_supportD1 A : (class_support A G)^# = cover (A^# :^: G). Proof. rewrite cover_imset class_supportEr setDE big_distrl /=. by apply: eq_bigr => x _; rewrite -setDE conjD1g. Qed. (* Subgroup Type construction. *) (* We only expect to use this for abstract groups, so we don't project *) (* the argument to a set. *) Inductive subg_of : predArgType := Subg x & x \in G. Definition sgval u := let: Subg x _ := u in x. Canonical subg_subType := Eval hnf in [subType for sgval]. Definition subg_eqMixin := Eval hnf in [eqMixin of subg_of by <:]. Canonical subg_eqType := Eval hnf in EqType subg_of subg_eqMixin. Definition subg_choiceMixin := [choiceMixin of subg_of by <:]. Canonical subg_choiceType := Eval hnf in ChoiceType subg_of subg_choiceMixin. Definition subg_countMixin := [countMixin of subg_of by <:]. Canonical subg_countType := Eval hnf in CountType subg_of subg_countMixin. Canonical subg_subCountType := Eval hnf in [subCountType of subg_of]. Definition subg_finMixin := [finMixin of subg_of by <:]. Canonical subg_finType := Eval hnf in FinType subg_of subg_finMixin. Canonical subg_subFinType := Eval hnf in [subFinType of subg_of]. Lemma subgP u : sgval u \in G. Proof. exact: valP. Qed. Lemma subg_inj : injective sgval. Proof. exact: val_inj. Qed. Lemma congr_subg u v : u = v -> sgval u = sgval v. Proof. exact: congr1. Qed. Definition subg_one := Subg group1. Definition subg_inv u := Subg (groupVr (subgP u)). Definition subg_mul u v := Subg (groupM (subgP u) (subgP v)). Lemma subg_oneP : left_id subg_one subg_mul. Proof. by move=> u; apply: val_inj; apply: mul1g. Qed. Lemma subg_invP : left_inverse subg_one subg_inv subg_mul. Proof. by move=> u; apply: val_inj; apply: mulVg. Qed. Lemma subg_mulP : associative subg_mul. Proof. by move=> u v w; apply: val_inj; apply: mulgA. Qed. Definition subFinGroupMixin := FinGroup.Mixin subg_mulP subg_oneP subg_invP. Canonical subBaseFinGroupType := Eval hnf in BaseFinGroupType subg_of subFinGroupMixin. Canonical subFinGroupType := FinGroupType subg_invP. Lemma sgvalM : {in setT &, {morph sgval : x y / x * y}}. Proof. by []. Qed. Lemma valgM : {in setT &, {morph val : x y / (x : subg_of) * y >-> x * y}}. Proof. by []. Qed. Definition subg : gT -> subg_of := insubd (1 : subg_of). Lemma subgK x : x \in G -> val (subg x) = x. Proof. by move=> Gx; rewrite insubdK. Qed. Lemma sgvalK : cancel sgval subg. Proof. by case=> x Gx; apply: val_inj; apply: subgK. Qed. Lemma subg_default x : (x \in G) = false -> val (subg x) = 1. Proof. by move=> Gx; rewrite val_insubd Gx. Qed. Lemma subgM : {in G &, {morph subg : x y / x * y}}. Proof. by move=> x y Gx Gy; apply: val_inj; rewrite /= !subgK ?groupM. Qed. End OneGroup. Hint Resolve group1 : core. Lemma groupD1_inj G H : G^# = H^# -> G :=: H. Proof. by move/(congr1 (setU 1)); rewrite !setD1K. Qed. Lemma invMG G H : (G * H)^-1 = H * G. Proof. by rewrite invMg !invGid. Qed. Lemma mulSGid G H : H \subset G -> H * G = G. Proof. exact: mulSgGid (group1 H). Qed. Lemma mulGSid G H : H \subset G -> G * H = G. Proof. exact: mulGSgid (group1 H). Qed. Lemma mulGidPl G H : reflect (G * H = G) (H \subset G). Proof. by apply: (iffP idP) => [|<-]; [apply: mulGSid | apply: mulG_subr]. Qed. Lemma mulGidPr G H : reflect (G * H = H) (G \subset H). Proof. by apply: (iffP idP) => [|<-]; [apply: mulSGid | apply: mulG_subl]. Qed. Lemma comm_group_setP G H : reflect (commute G H) (group_set (G * H)). Proof. rewrite /group_set (subsetP (mulG_subl _ _)) ?group1 // andbC. have <-: #|G * H| <= #|H * G| by rewrite -invMG card_invg. by rewrite -mulgA mulGS mulgA mulSG -eqEcard eq_sym; apply: eqP. Qed. Lemma card_lcosets G H : #|lcosets H G| = #|G : H|. Proof. by rewrite -card_invg invg_lcosets !invGid. Qed. (* Group Modularity equations *) Lemma group_modl A B G : A \subset G -> A * (B :&: G) = A * B :&: G. Proof. move=> sAG; apply/eqP; rewrite eqEsubset subsetI mulgS ?subsetIl //. rewrite -{2}mulGid mulgSS ?subsetIr //. apply/subsetP => _ /setIP[/mulsgP[a b Aa Bb ->] Gab]. by rewrite mem_mulg // inE Bb -(groupMl _ (subsetP sAG _ Aa)). Qed. Lemma group_modr A B G : B \subset G -> (G :&: A) * B = G :&: A * B. Proof. move=> sBG; apply: invg_inj; rewrite !(invMg, invIg) invGid !(setIC G). by rewrite group_modl // -invGid invSg. Qed. End GroupProp. Hint Extern 0 (is_true (1%g \in _)) => apply: group1 : core. Hint Extern 0 (is_true (0 < #|_|)) => apply: cardG_gt0 : core. Hint Extern 0 (is_true (0 < #|_ : _|)) => apply: indexg_gt0 : core. Notation "G :^ x" := (conjG_group G x) : Group_scope. Notation "[ 'subg' G ]" := (subg_of G) : type_scope. Notation "[ 'subg' G ]" := [set: subg_of G] : group_scope. Notation "[ 'subg' G ]" := [set: subg_of G]%G : Group_scope. Prenex Implicits subg sgval subg_of. Bind Scope group_scope with subg_of. Arguments subgK {gT G}. Arguments sgvalK {gT G}. Arguments subg_inj {gT G} [u1 u2] eq_u12 : rename. Arguments trivgP {gT G}. Arguments trivGP {gT G}. Arguments lcoset_eqP {gT G x y}. Arguments rcoset_eqP {gT G x y}. Arguments mulGidPl {gT G H}. Arguments mulGidPr {gT G H}. Arguments comm_group_setP {gT G H}. Arguments class_eqP {gT G x y}. Arguments repr_classesP {gT G xG}. Section GroupInter. Variable gT : finGroupType. Implicit Types A B : {set gT}. Implicit Types G H : {group gT}. Lemma group_setI G H : group_set (G :&: H). Proof. apply/group_setP; split=> [|x y]; rewrite !inE ?group1 //. by case/andP=> Gx Hx; rewrite !groupMl. Qed. Canonical setI_group G H := group (group_setI G H). Section Nary. Variables (I : finType) (P : pred I) (F : I -> {group gT}). Lemma group_set_bigcap : group_set (\bigcap_(i | P i) F i). Proof. by elim/big_rec: _ => [|i G _ gG]; rewrite -1?(insubdK 1%G gG) groupP. Qed. Canonical bigcap_group := group group_set_bigcap. End Nary. Canonical generated_group A : {group _} := Eval hnf in [group of <>]. Canonical gcore_group G A : {group _} := Eval hnf in [group of gcore G A]. Canonical commutator_group A B : {group _} := Eval hnf in [group of [~: A, B]]. Canonical joing_group A B : {group _} := Eval hnf in [group of A <*> B]. Canonical cycle_group x : {group _} := Eval hnf in [group of <[x]>]. Definition joinG G H := joing_group G H. Definition subgroups A := [set G : {group gT} | G \subset A]. Lemma order_gt0 (x : gT) : 0 < #[x]. Proof. exact: cardG_gt0. Qed. End GroupInter. Hint Resolve order_gt0 : core. Arguments generated_group _ _%g. Arguments joing_group _ _%g _%g. Arguments subgroups _ _%g. Notation "G :&: H" := (setI_group G H) : Group_scope. Notation "<< A >>" := (generated_group A) : Group_scope. Notation "<[ x ] >" := (cycle_group x) : Group_scope. Notation "[ ~: A1 , A2 , .. , An ]" := (commutator_group .. (commutator_group A1 A2) .. An) : Group_scope. Notation "A <*> B" := (joing_group A B) : Group_scope. Notation "G * H" := (joinG G H) : Group_scope. Prenex Implicits joinG subgroups. Notation "\prod_ ( i <- r | P ) F" := (\big[joinG/1%G]_(i <- r | P%B) F%G) : Group_scope. Notation "\prod_ ( i <- r ) F" := (\big[joinG/1%G]_(i <- r) F%G) : Group_scope. Notation "\prod_ ( m <= i < n | P ) F" := (\big[joinG/1%G]_(m <= i < n | P%B) F%G) : Group_scope. Notation "\prod_ ( m <= i < n ) F" := (\big[joinG/1%G]_(m <= i < n) F%G) : Group_scope. Notation "\prod_ ( i | P ) F" := (\big[joinG/1%G]_(i | P%B) F%G) : Group_scope. Notation "\prod_ i F" := (\big[joinG/1%G]_i F%G) : Group_scope. Notation "\prod_ ( i : t | P ) F" := (\big[joinG/1%G]_(i : t | P%B) F%G) (only parsing) : Group_scope. Notation "\prod_ ( i : t ) F" := (\big[joinG/1%G]_(i : t) F%G) (only parsing) : Group_scope. Notation "\prod_ ( i < n | P ) F" := (\big[joinG/1%G]_(i < n | P%B) F%G) : Group_scope. Notation "\prod_ ( i < n ) F" := (\big[joinG/1%G]_(i < n) F%G) : Group_scope. Notation "\prod_ ( i 'in' A | P ) F" := (\big[joinG/1%G]_(i in A | P%B) F%G) : Group_scope. Notation "\prod_ ( i 'in' A ) F" := (\big[joinG/1%G]_(i in A) F%G) : Group_scope. Section Lagrange. Variable gT : finGroupType. Implicit Types G H K : {group gT}. Lemma LagrangeI G H : (#|G :&: H| * #|G : H|)%N = #|G|. Proof. rewrite -[#|G|]sum1_card (partition_big_imset (rcoset H)) /=. rewrite mulnC -sum_nat_const; apply: eq_bigr => _ /rcosetsP[x Gx ->]. rewrite -(card_rcoset _ x) -sum1_card; apply: eq_bigl => y. by rewrite rcosetE (sameP eqP rcoset_eqP) group_modr (sub1set, inE). Qed. Lemma divgI G H : #|G| %/ #|G :&: H| = #|G : H|. Proof. by rewrite -(LagrangeI G H) mulKn ?cardG_gt0. Qed. Lemma divg_index G H : #|G| %/ #|G : H| = #|G :&: H|. Proof. by rewrite -(LagrangeI G H) mulnK. Qed. Lemma dvdn_indexg G H : #|G : H| %| #|G|. Proof. by rewrite -(LagrangeI G H) dvdn_mull. Qed. Theorem Lagrange G H : H \subset G -> (#|H| * #|G : H|)%N = #|G|. Proof. by move/setIidPr=> sHG; rewrite -{1}sHG LagrangeI. Qed. Lemma cardSg G H : H \subset G -> #|H| %| #|G|. Proof. by move/Lagrange <-; rewrite dvdn_mulr. Qed. Lemma lognSg p G H : G \subset H -> logn p #|G| <= logn p #|H|. Proof. by move=> sGH; rewrite dvdn_leq_log ?cardSg. Qed. Lemma piSg G H : G \subset H -> {subset \pi(gval G) <= \pi(gval H)}. Proof. move=> sGH p; rewrite !mem_primes !cardG_gt0 => /and3P[-> _ pG]. exact: dvdn_trans (cardSg sGH). Qed. Lemma divgS G H : H \subset G -> #|G| %/ #|H| = #|G : H|. Proof. by move/Lagrange <-; rewrite mulKn. Qed. Lemma divg_indexS G H : H \subset G -> #|G| %/ #|G : H| = #|H|. Proof. by move/Lagrange <-; rewrite mulnK. Qed. Lemma coprimeSg G H p : H \subset G -> coprime #|G| p -> coprime #|H| p. Proof. by move=> sHG; apply: coprime_dvdl (cardSg sHG). Qed. Lemma coprimegS G H p : H \subset G -> coprime p #|G| -> coprime p #|H|. Proof. by move=> sHG; apply: coprime_dvdr (cardSg sHG). Qed. Lemma indexJg G H x : #|G :^ x : H :^ x| = #|G : H|. Proof. by rewrite -!divgI -conjIg !cardJg. Qed. Lemma indexgg G : #|G : G| = 1%N. Proof. by rewrite -divgS // divnn cardG_gt0. Qed. Lemma rcosets_id G : rcosets G G = [set G : {set gT}]. Proof. apply/esym/eqP; rewrite eqEcard sub1set [#|_|]indexgg cards1 andbT. by apply/rcosetsP; exists 1; rewrite ?mulg1. Qed. Lemma Lagrange_index G H K : H \subset G -> K \subset H -> (#|G : H| * #|H : K|)%N = #|G : K|. Proof. move=> sHG sKH; apply/eqP; rewrite mulnC -(eqn_pmul2l (cardG_gt0 K)). by rewrite mulnA !Lagrange // (subset_trans sKH). Qed. Lemma indexgI G H : #|G : G :&: H| = #|G : H|. Proof. by rewrite -divgI divgS ?subsetIl. Qed. Lemma indexgS G H K : H \subset K -> #|G : K| %| #|G : H|. Proof. move=> sHK; rewrite -(@dvdn_pmul2l #|G :&: K|) ?cardG_gt0 // LagrangeI. by rewrite -(Lagrange (setIS G sHK)) mulnAC LagrangeI dvdn_mulr. Qed. Lemma indexSg G H K : H \subset K -> K \subset G -> #|K : H| %| #|G : H|. Proof. move=> sHK sKG; rewrite -(@dvdn_pmul2l #|H|) ?cardG_gt0 //. by rewrite !Lagrange ?(cardSg, subset_trans sHK). Qed. Lemma indexg_eq1 G H : (#|G : H| == 1%N) = (G \subset H). Proof. rewrite eqn_leq -(leq_pmul2l (cardG_gt0 (G :&: H))) LagrangeI muln1. by rewrite indexg_gt0 andbT (sameP setIidPl eqP) eqEcard subsetIl. Qed. Lemma indexg_gt1 G H : (#|G : H| > 1) = ~~ (G \subset H). Proof. by rewrite -indexg_eq1 eqn_leq indexg_gt0 andbT -ltnNge. Qed. Lemma index1g G H : H \subset G -> #|G : H| = 1%N -> H :=: G. Proof. by move=> sHG iHG; apply/eqP; rewrite eqEsubset sHG -indexg_eq1 iHG. Qed. Lemma indexg1 G : #|G : 1| = #|G|. Proof. by rewrite -divgS ?sub1G // cards1 divn1. Qed. Lemma indexMg G A : #|G * A : G| = #|A : G|. Proof. apply/eq_card/setP/eqP; rewrite eqEsubset andbC imsetS ?mulG_subr //. by apply/subsetP=> _ /rcosetsP[x GAx ->]; rewrite mem_rcosets. Qed. Lemma rcosets_partition_mul G H : partition (rcosets H G) (H * G). Proof. set HG := H * G; have sGHG: {subset G <= HG} by apply/subsetP/mulG_subr. have defHx x: x \in HG -> [set y in HG | rcoset H x == rcoset H y] = H :* x. move=> HGx; apply/setP=> y; rewrite inE !rcosetE (sameP eqP rcoset_eqP). by rewrite rcoset_sym; apply/andb_idl/subsetP; rewrite mulGS sub1set. have:= preim_partitionP (rcoset H) HG; congr (partition _ _); apply/setP=> Hx. apply/imsetP/idP=> [[x HGx ->] | ]; first by rewrite defHx // mem_rcosets. by case/rcosetsP=> x /sGHG-HGx ->; exists x; rewrite ?defHx. Qed. Lemma rcosets_partition G H : H \subset G -> partition (rcosets H G) G. Proof. by move=> sHG; have:= rcosets_partition_mul G H; rewrite mulSGid. Qed. Lemma LagrangeMl G H : (#|G| * #|H : G|)%N = #|G * H|. Proof. rewrite mulnC -(card_uniform_partition _ (rcosets_partition_mul H G)) //. by move=> _ /rcosetsP[x Hx ->]; rewrite card_rcoset. Qed. Lemma LagrangeMr G H : (#|G : H| * #|H|)%N = #|G * H|. Proof. by rewrite mulnC LagrangeMl -card_invg invMg !invGid. Qed. Lemma mul_cardG G H : (#|G| * #|H| = #|G * H|%g * #|G :&: H|)%N. Proof. by rewrite -LagrangeMr -(LagrangeI G H) -mulnA mulnC. Qed. Lemma dvdn_cardMg G H : #|G * H| %| #|G| * #|H|. Proof. by rewrite mul_cardG dvdn_mulr. Qed. Lemma cardMg_divn G H : #|G * H| = (#|G| * #|H|) %/ #|G :&: H|. Proof. by rewrite mul_cardG mulnK ?cardG_gt0. Qed. Lemma cardIg_divn G H : #|G :&: H| = (#|G| * #|H|) %/ #|G * H|. Proof. by rewrite mul_cardG mulKn // (cardD1 (1 * 1)) mem_mulg. Qed. Lemma TI_cardMg G H : G :&: H = 1 -> #|G * H| = (#|G| * #|H|)%N. Proof. by move=> tiGH; rewrite mul_cardG tiGH cards1 muln1. Qed. Lemma cardMg_TI G H : #|G| * #|H| <= #|G * H| -> G :&: H = 1. Proof. move=> leGH; apply: card_le1_trivg. rewrite -(@leq_pmul2l #|G * H|); first by rewrite -mul_cardG muln1. by apply: leq_trans leGH; rewrite muln_gt0 !cardG_gt0. Qed. Lemma coprime_TIg G H : coprime #|G| #|H| -> G :&: H = 1. Proof. move=> coGH; apply/eqP; rewrite trivg_card1 -dvdn1 -{}(eqnP coGH). by rewrite dvdn_gcd /= {2}setIC !cardSg ?subsetIl. Qed. Lemma prime_TIg G H : prime #|G| -> ~~ (G \subset H) -> G :&: H = 1. Proof. case/primeP=> _ /(_ _ (cardSg (subsetIl G H))). rewrite (sameP setIidPl eqP) eqEcard subsetIl => /pred2P[/card1_trivg|] //= ->. by case/negP. Qed. Lemma prime_meetG G H : prime #|G| -> G :&: H != 1 -> G \subset H. Proof. by move=> prG; apply: contraR; move/prime_TIg->. Qed. Lemma coprime_cardMg G H : coprime #|G| #|H| -> #|G * H| = (#|G| * #|H|)%N. Proof. by move=> coGH; rewrite TI_cardMg ?coprime_TIg. Qed. Lemma coprime_index_mulG G H K : H \subset G -> K \subset G -> coprime #|G : H| #|G : K| -> H * K = G. Proof. move=> sHG sKG co_iG_HK; apply/eqP; rewrite eqEcard mul_subG //=. rewrite -(@leq_pmul2r #|H :&: K|) ?cardG_gt0 // -mul_cardG. rewrite -(Lagrange sHG) -(LagrangeI K H) mulnAC setIC -mulnA. rewrite !leq_pmul2l ?cardG_gt0 // dvdn_leq // -(Gauss_dvdr _ co_iG_HK). by rewrite -(indexgI K) Lagrange_index ?indexgS ?subsetIl ?subsetIr. Qed. End Lagrange. Section GeneratedGroup. Variable gT : finGroupType. Implicit Types x y z : gT. Implicit Types A B C D : {set gT}. Implicit Types G H K : {group gT}. Lemma subset_gen A : A \subset <>. Proof. exact/bigcapsP. Qed. Lemma sub_gen A B : A \subset B -> A \subset <>. Proof. by move/subset_trans=> -> //; apply: subset_gen. Qed. Lemma mem_gen x A : x \in A -> x \in <>. Proof. exact: subsetP (subset_gen A) x. Qed. Lemma generatedP x A : reflect (forall G, A \subset G -> x \in G) (x \in <>). Proof. exact: bigcapP. Qed. Lemma gen_subG A G : (<> \subset G) = (A \subset G). Proof. apply/idP/idP=> [|sAG]; first exact: subset_trans (subset_gen A). by apply/subsetP=> x /generatedP; apply. Qed. Lemma genGid G : <> = G. Proof. by apply/eqP; rewrite eqEsubset gen_subG subset_gen andbT. Qed. Lemma genGidG G : <>%G = G. Proof. by apply: val_inj; apply: genGid. Qed. Lemma gen_set_id A : group_set A -> <> = A. Proof. by move=> gA; apply: (genGid (group gA)). Qed. Lemma genS A B : A \subset B -> <> \subset <>. Proof. by move=> sAB; rewrite gen_subG sub_gen. Qed. Lemma gen0 : <> = 1 :> {set gT}. Proof. by apply/eqP; rewrite eqEsubset sub1G gen_subG sub0set. Qed. Lemma gen_expgs A : {n | <> = (1 |: A) ^+ n}. Proof. set B := (1 |: A); pose N := #|gT|. have BsubG n : B ^+ n \subset <>. by elim: n => [|n IHn]; rewrite ?expgS ?mul_subG ?subUset ?sub1G ?subset_gen. have B_1 n : 1 \in B ^+ n. by elim: n => [|n IHn]; rewrite ?set11 // expgS mulUg mul1g inE IHn. case: (pickP (fun i : 'I_N => B ^+ i.+1 \subset B ^+ i)) => [n fixBn | no_fix]. exists n; apply/eqP; rewrite eqEsubset BsubG andbT. rewrite -[B ^+ n]gen_set_id ?genS ?subsetUr //. by apply: subset_trans fixBn; rewrite expgS mulUg subsetU ?mulg_subl ?orbT. rewrite /group_set B_1 /=. elim: {2}(n : nat) => [|m IHm]; first by rewrite mulg1. by apply: subset_trans fixBn; rewrite !expgSr mulgA mulSg. suffices: N < #|B ^+ N| by rewrite ltnNge max_card. have [] := ubnPgeq N; elim=> [|n IHn] lt_nN; first by rewrite cards1. apply: leq_ltn_trans (IHn (ltnW lt_nN)) (proper_card _). by rewrite /proper (no_fix (Ordinal lt_nN)) expgS mulUg mul1g subsetUl. Qed. Lemma gen_prodgP A x : reflect (exists n, exists2 c, forall i : 'I_n, c i \in A & x = \prod_i c i) (x \in <>). Proof. apply: (iffP idP) => [|[n [c Ac ->]]]; last first. by apply: group_prod => i _; rewrite mem_gen ?Ac. have [n ->] := gen_expgs A; rewrite /expgn /expgn_rec Monoid.iteropE /=. rewrite -[n]card_ord -big_const => /prodsgP[/= c Ac def_x]. have{Ac def_x} ->: x = \prod_(i | c i \in A) c i. rewrite big_mkcond {x}def_x; apply: eq_bigr => i _. by case/setU1P: (Ac i isT) => -> //; rewrite if_same. have [e <- [_ /= mem_e] _] := big_enumP [preim c of A]. pose t := in_tuple e; rewrite -[e]/(val t) big_tuple. by exists (size e), (c \o tnth t) => // i; rewrite -mem_e mem_tnth. Qed. Lemma genD A B : A \subset <> -> <> = <>. Proof. by move=> sAB; apply/eqP; rewrite eqEsubset genS (subsetDl, gen_subG). Qed. Lemma genV A : <> = <>. Proof. apply/eqP; rewrite eqEsubset !gen_subG -!(invSg _ <<_>>) invgK. by rewrite !invGid !subset_gen. Qed. Lemma genJ A z : <> = <> :^ z. Proof. by apply/eqP; rewrite eqEsubset sub_conjg !gen_subG conjSg -?sub_conjg !sub_gen. Qed. Lemma conjYg A B z : (A <*> B) :^z = A :^ z <*> B :^ z. Proof. by rewrite -genJ conjUg. Qed. Lemma genD1 A x : x \in <> -> <> = <>. Proof. move=> gA'x; apply/eqP; rewrite eqEsubset genS; last by rewrite subsetDl. rewrite gen_subG; apply/subsetP=> y Ay. by case: (y =P x) => [-> //|]; move/eqP=> nyx; rewrite mem_gen // !inE nyx. Qed. Lemma genD1id A : <> = <>. Proof. by rewrite genD1 ?group1. Qed. Notation joingT := (@joing gT) (only parsing). Notation joinGT := (@joinG gT) (only parsing). Lemma joingE A B : A <*> B = <>. Proof. by []. Qed. Lemma joinGE G H : (G * H)%G = (G <*> H)%G. Proof. by []. Qed. Lemma joingC : commutative joingT. Proof. by move=> A B; rewrite /joing setUC. Qed. Lemma joing_idr A B : A <*> <> = A <*> B. Proof. apply/eqP; rewrite eqEsubset gen_subG subUset gen_subG /=. by rewrite -subUset subset_gen genS // setUS // subset_gen. Qed. Lemma joing_idl A B : <> <*> B = A <*> B. Proof. by rewrite -!(joingC B) joing_idr. Qed. Lemma joing_subl A B : A \subset A <*> B. Proof. by rewrite sub_gen ?subsetUl. Qed. Lemma joing_subr A B : B \subset A <*> B. Proof. by rewrite sub_gen ?subsetUr. Qed. Lemma join_subG A B G : (A <*> B \subset G) = (A \subset G) && (B \subset G). Proof. by rewrite gen_subG subUset. Qed. Lemma joing_idPl G A : reflect (G <*> A = G) (A \subset G). Proof. apply: (iffP idP) => [sHG | <-]; last by rewrite joing_subr. by rewrite joingE (setUidPl sHG) genGid. Qed. Lemma joing_idPr A G : reflect (A <*> G = G) (A \subset G). Proof. by rewrite joingC; apply: joing_idPl. Qed. Lemma joing_subP A B G : reflect (A \subset G /\ B \subset G) (A <*> B \subset G). Proof. by rewrite join_subG; apply: andP. Qed. Lemma joing_sub A B C : A <*> B = C -> A \subset C /\ B \subset C. Proof. by move <-; apply/joing_subP. Qed. Lemma genDU A B C : A \subset C -> <> = <> -> <> = <>. Proof. move=> sAC; rewrite -joingE -joing_idr => <- {B}; rewrite joing_idr. by congr <<_>>; rewrite setDE setUIr setUCr setIT; apply/setUidPr. Qed. Lemma joingA : associative joingT. Proof. by move=> A B C; rewrite joing_idl joing_idr /joing setUA. Qed. Lemma joing1G G : 1 <*> G = G. Proof. by rewrite -gen0 joing_idl /joing set0U genGid. Qed. Lemma joingG1 G : G <*> 1 = G. Proof. by rewrite joingC joing1G. Qed. Lemma genM_join G H : <> = G <*> H. Proof. apply/eqP; rewrite eqEsubset gen_subG /= -{1}[G <*> H]mulGid. rewrite genS; last by rewrite subUset mulG_subl mulG_subr. by rewrite mulgSS ?(sub_gen, subsetUl, subsetUr). Qed. Lemma mulG_subG G H K : (G * H \subset K) = (G \subset K) && (H \subset K). Proof. by rewrite -gen_subG genM_join join_subG. Qed. Lemma mulGsubP K H G : reflect (K \subset G /\ H \subset G) (K * H \subset G). Proof. by rewrite mulG_subG; apply: andP. Qed. Lemma mulG_sub K H A : K * H = A -> K \subset A /\ H \subset A. Proof. by move <-; rewrite mulG_subl mulG_subr. Qed. Lemma trivMg G H : (G * H == 1) = (G :==: 1) && (H :==: 1). Proof. by rewrite !eqEsubset -{2}[1]mulGid mulgSS ?sub1G // !andbT mulG_subG. Qed. Lemma comm_joingE G H : commute G H -> G <*> H = G * H. Proof. by move/comm_group_setP=> gGH; rewrite -genM_join; apply: (genGid (group gGH)). Qed. Lemma joinGC : commutative joinGT. Proof. by move=> G H; apply: val_inj; apply: joingC. Qed. Lemma joinGA : associative joinGT. Proof. by move=> G H K; apply: val_inj; apply: joingA. Qed. Lemma join1G : left_id 1%G joinGT. Proof. by move=> G; apply: val_inj; apply: joing1G. Qed. Lemma joinG1 : right_id 1%G joinGT. Proof. by move=> G; apply: val_inj; apply: joingG1. Qed. Canonical joinG_law := Monoid.Law joinGA join1G joinG1. Canonical joinG_abelaw := Monoid.ComLaw joinGC. Lemma bigprodGEgen I r (P : pred I) (F : I -> {set gT}) : (\prod_(i <- r | P i) <>)%G :=: << \bigcup_(i <- r | P i) F i >>. Proof. elim/big_rec2: _ => /= [|i A _ _ ->]; first by rewrite gen0. by rewrite joing_idl joing_idr. Qed. Lemma bigprodGE I r (P : pred I) (F : I -> {group gT}) : (\prod_(i <- r | P i) F i)%G :=: << \bigcup_(i <- r | P i) F i >>. Proof. rewrite -bigprodGEgen /=; apply: congr_group. by apply: eq_bigr => i _; rewrite genGidG. Qed. Lemma mem_commg A B x y : x \in A -> y \in B -> [~ x, y] \in [~: A, B]. Proof. by move=> Ax By; rewrite mem_gen ?imset2_f. Qed. Lemma commSg A B C : A \subset B -> [~: A, C] \subset [~: B, C]. Proof. by move=> sAC; rewrite genS ?imset2S. Qed. Lemma commgS A B C : B \subset C -> [~: A, B] \subset [~: A, C]. Proof. by move=> sBC; rewrite genS ?imset2S. Qed. Lemma commgSS A B C D : A \subset B -> C \subset D -> [~: A, C] \subset [~: B, D]. Proof. by move=> sAB sCD; rewrite genS ?imset2S. Qed. Lemma der1_subG G : [~: G, G] \subset G. Proof. by rewrite gen_subG; apply/subsetP=> _ /imset2P[x y Gx Gy ->]; apply: groupR. Qed. Lemma comm_subG A B G : A \subset G -> B \subset G -> [~: A, B] \subset G. Proof. by move=> sAG sBG; apply: subset_trans (der1_subG G); apply: commgSS. Qed. Lemma commGC A B : [~: A, B] = [~: B, A]. Proof. rewrite -[[~: A, B]]genV; congr <<_>>; apply/setP=> z; rewrite inE. by apply/imset2P/imset2P=> [] [x y Ax Ay]; last rewrite -{1}(invgK z); rewrite -invg_comm => /invg_inj->; exists y x. Qed. Lemma conjsRg A B x : [~: A, B] :^ x = [~: A :^ x, B :^ x]. Proof. wlog suffices: A B x / [~: A, B] :^ x \subset [~: A :^ x, B :^ x]. move=> subJ; apply/eqP; rewrite eqEsubset subJ /= -sub_conjgV. by rewrite -{2}(conjsgK x A) -{2}(conjsgK x B). rewrite -genJ gen_subG; apply/subsetP=> _ /imsetP[_ /imset2P[y z Ay Bz ->] ->]. by rewrite conjRg mem_commg ?memJ_conjg. Qed. End GeneratedGroup. Arguments gen_prodgP {gT A x}. Arguments joing_idPl {gT G A}. Arguments joing_idPr {gT A G}. Arguments mulGsubP {gT K H G}. Arguments joing_subP {gT A B G}. Section Cycles. (* Elementary properties of cycles and order, needed in perm.v. *) (* More advanced results on the structure of cyclic groups will *) (* be given in cyclic.v. *) Variable gT : finGroupType. Implicit Types x y : gT. Implicit Types G : {group gT}. Import Monoid.Theory. Lemma cycle1 : <[1]> = [1 gT]. Proof. exact: genGid. Qed. Lemma order1 : #[1 : gT] = 1%N. Proof. by rewrite /order cycle1 cards1. Qed. Lemma cycle_id x : x \in <[x]>. Proof. by rewrite mem_gen // set11. Qed. Lemma mem_cycle x i : x ^+ i \in <[x]>. Proof. by rewrite groupX // cycle_id. Qed. Lemma cycle_subG x G : (<[x]> \subset G) = (x \in G). Proof. by rewrite gen_subG sub1set. Qed. Lemma cycle_eq1 x : (<[x]> == 1) = (x == 1). Proof. by rewrite eqEsubset sub1G andbT cycle_subG inE. Qed. Lemma orderE x : #[x] = #|<[x]>|. Proof. by []. Qed. Lemma order_eq1 x : (#[x] == 1%N) = (x == 1). Proof. by rewrite -trivg_card1 cycle_eq1. Qed. Lemma order_gt1 x : (#[x] > 1) = (x != 1). Proof. by rewrite ltnNge -trivg_card_le1 cycle_eq1. Qed. Lemma cycle_traject x : <[x]> =i traject (mulg x) 1 #[x]. Proof. set t := _ 1; apply: fsym; apply/subset_cardP; last first. by apply/subsetP=> _ /trajectP[i _ ->]; rewrite -iteropE mem_cycle. rewrite (card_uniqP _) ?size_traject //; case def_n: #[_] => // [n]. rewrite looping_uniq; apply: contraL (card_size (t n)) => /loopingP t_xi. rewrite -ltnNge size_traject -def_n ?subset_leq_card //. rewrite -(eq_subset_r (in_set _)) {}/t; set G := finset _. rewrite -[x]mulg1 -[G]gen_set_id ?genS ?sub1set ?inE ?(t_xi 1%N)//. apply/group_setP; split=> [|y z]; rewrite !inE ?(t_xi 0) //. by do 2!case/trajectP=> ? _ ->; rewrite -!iteropE -expgD [x ^+ _]iteropE. Qed. Lemma cycle2g x : #[x] = 2 -> <[x]> = [set 1; x]. Proof. by move=> ox; apply/setP=> y; rewrite cycle_traject ox !inE mulg1. Qed. Lemma cyclePmin x y : y \in <[x]> -> {i | i < #[x] & y = x ^+ i}. Proof. rewrite cycle_traject; set tx := traject _ _ #[x] => tx_y; pose i := index y tx. have lt_i_x : i < #[x] by rewrite -index_mem size_traject in tx_y. by exists i; rewrite // [x ^+ i]iteropE /= -(nth_traject _ lt_i_x) nth_index. Qed. Lemma cycleP x y : reflect (exists i, y = x ^+ i) (y \in <[x]>). Proof. by apply: (iffP idP) => [/cyclePmin[i _]|[i ->]]; [exists i | apply: mem_cycle]. Qed. Lemma expg_order x : x ^+ #[x] = 1. Proof. have: uniq (traject (mulg x) 1 #[x]). by apply/card_uniqP; rewrite size_traject -(eq_card (cycle_traject x)). case/cyclePmin: (mem_cycle x #[x]) => [] [//|i] ltix. rewrite -(subnKC ltix) addSnnS /= expgD; move: (_ - _) => j x_j1. case/andP=> /trajectP[]; exists j; first exact: leq_addl. by apply: (mulgI (x ^+ i.+1)); rewrite -iterSr iterS -iteropE -expgS mulg1. Qed. Lemma expg_mod p k x : x ^+ p = 1 -> x ^+ (k %% p) = x ^+ k. Proof. move=> xp. by rewrite {2}(divn_eq k p) expgD mulnC expgM xp expg1n mul1g. Qed. Lemma expg_mod_order x i : x ^+ (i %% #[x]) = x ^+ i. Proof. by rewrite expg_mod // expg_order. Qed. Lemma invg_expg x : x^-1 = x ^+ #[x].-1. Proof. by apply/eqP; rewrite eq_invg_mul -expgS prednK ?expg_order. Qed. Lemma invg2id x : #[x] = 2 -> x^-1 = x. Proof. by move=> ox; rewrite invg_expg ox. Qed. Lemma cycleX x i : <[x ^+ i]> \subset <[x]>. Proof. by rewrite cycle_subG; apply: mem_cycle. Qed. Lemma cycleV x : <[x^-1]> = <[x]>. Proof. by apply/eqP; rewrite eq_sym eqEsubset !cycle_subG groupV -groupV !cycle_id. Qed. Lemma orderV x : #[x^-1] = #[x]. Proof. by rewrite /order cycleV. Qed. Lemma cycleJ x y : <[x ^ y]> = <[x]> :^ y. Proof. by rewrite -genJ conjg_set1. Qed. Lemma orderJ x y : #[x ^ y] = #[x]. Proof. by rewrite /order cycleJ cardJg. Qed. End Cycles. Section Normaliser. Variable gT : finGroupType. Implicit Types x y z : gT. Implicit Types A B C D : {set gT}. Implicit Type G H K : {group gT}. Lemma normP x A : reflect (A :^ x = A) (x \in 'N(A)). Proof. suffices ->: (x \in 'N(A)) = (A :^ x == A) by apply: eqP. by rewrite eqEcard cardJg leqnn andbT inE. Qed. Arguments normP {x A}. Lemma group_set_normaliser A : group_set 'N(A). Proof. apply/group_setP; split=> [|x y Nx Ny]; rewrite inE ?conjsg1 //. by rewrite conjsgM !(normP _). Qed. Canonical normaliser_group A := group (group_set_normaliser A). Lemma normsP A B : reflect {in A, normalised B} (A \subset 'N(B)). Proof. apply: (iffP subsetP) => nBA x Ax; last by rewrite inE nBA //. by apply/normP; apply: nBA. Qed. Arguments normsP {A B}. Lemma memJ_norm x y A : x \in 'N(A) -> (y ^ x \in A) = (y \in A). Proof. by move=> Nx; rewrite -{1}(normP Nx) memJ_conjg. Qed. Lemma norms_cycle x y : (<[y]> \subset 'N(<[x]>)) = (x ^ y \in <[x]>). Proof. by rewrite cycle_subG inE -cycleJ cycle_subG. Qed. Lemma norm1 : 'N(1) = setT :> {set gT}. Proof. by apply/setP=> x; rewrite !inE conjs1g subxx. Qed. Lemma norms1 A : A \subset 'N(1). Proof. by rewrite norm1 subsetT. Qed. Lemma normCs A : 'N(~: A) = 'N(A). Proof. by apply/setP=> x; rewrite -groupV !inE conjCg setCS sub_conjg. Qed. Lemma normG G : G \subset 'N(G). Proof. by apply/normsP; apply: conjGid. Qed. Lemma normT : 'N([set: gT]) = [set: gT]. Proof. by apply/eqP; rewrite -subTset normG. Qed. Lemma normsG A G : A \subset G -> A \subset 'N(G). Proof. by move=> sAG; apply: subset_trans (normG G). Qed. Lemma normC A B : A \subset 'N(B) -> commute A B. Proof. move/subsetP=> nBA; apply/setP=> u. apply/mulsgP/mulsgP=> [[x y Ax By] | [y x By Ax]] -> {u}. by exists (y ^ x^-1) x; rewrite -?conjgCV // memJ_norm // groupV nBA. by exists x (y ^ x); rewrite -?conjgC // memJ_norm // nBA. Qed. Lemma norm_joinEl G H : G \subset 'N(H) -> G <*> H = G * H. Proof. by move/normC/comm_joingE. Qed. Lemma norm_joinEr G H : H \subset 'N(G) -> G <*> H = G * H. Proof. by move/normC=> cHG; apply: comm_joingE. Qed. Lemma norm_rlcoset G x : x \in 'N(G) -> G :* x = x *: G. Proof. by rewrite -sub1set => /normC. Qed. Lemma rcoset_mul G x y : x \in 'N(G) -> (G :* x) * (G :* y) = G :* (x * y). Proof. move/norm_rlcoset=> GxxG. by rewrite mulgA -(mulgA _ _ G) -GxxG mulgA mulGid -mulgA mulg_set1. Qed. Lemma normJ A x : 'N(A :^ x) = 'N(A) :^ x. Proof. by apply/setP=> y; rewrite mem_conjg !inE -conjsgM conjgCV conjsgM conjSg. Qed. Lemma norm_conj_norm x A B : x \in 'N(A) -> (A \subset 'N(B :^ x)) = (A \subset 'N(B)). Proof. by move=> Nx; rewrite normJ -sub_conjgV (normP _) ?groupV. Qed. Lemma norm_gen A : 'N(A) \subset 'N(<>). Proof. by apply/normsP=> x Nx; rewrite -genJ (normP Nx). Qed. Lemma class_norm x G : G \subset 'N(x ^: G). Proof. by apply/normsP=> y; apply: classGidr. Qed. Lemma class_normal x G : x \in G -> x ^: G <| G. Proof. by move=> Gx; rewrite /normal class_norm class_subG. Qed. Lemma class_sub_norm G A x : G \subset 'N(A) -> (x ^: G \subset A) = (x \in A). Proof. move=> nAG; apply/subsetP/idP=> [-> // | Ax xy]; first exact: class_refl. by case/imsetP=> y Gy ->; rewrite memJ_norm ?(subsetP nAG). Qed. Lemma class_support_norm A G : G \subset 'N(class_support A G). Proof. by apply/normsP; apply: class_supportGidr. Qed. Lemma class_support_sub_norm A B G : A \subset G -> B \subset 'N(G) -> class_support A B \subset G. Proof. move=> sAG nGB; rewrite class_supportEr. by apply/bigcupsP=> x Bx; rewrite -(normsP nGB x Bx) conjSg. Qed. Section norm_trans. Variables (A B C D : {set gT}). Hypotheses (nBA : A \subset 'N(B)) (nCA : A \subset 'N(C)). Lemma norms_gen : A \subset 'N(<>). Proof. exact: subset_trans nBA (norm_gen B). Qed. Lemma norms_norm : A \subset 'N('N(B)). Proof. by apply/normsP=> x Ax; rewrite -normJ (normsP nBA). Qed. Lemma normsI : A \subset 'N(B :&: C). Proof. by apply/normsP=> x Ax; rewrite conjIg !(normsP _ x Ax). Qed. Lemma normsU : A \subset 'N(B :|: C). Proof. by apply/normsP=> x Ax; rewrite conjUg !(normsP _ x Ax). Qed. Lemma normsIs : B \subset 'N(D) -> A :&: B \subset 'N(C :&: D). Proof. move/normsP=> nDB; apply/normsP=> x; case/setIP=> Ax Bx. by rewrite conjIg (normsP nCA) ?nDB. Qed. Lemma normsD : A \subset 'N(B :\: C). Proof. by apply/normsP=> x Ax; rewrite conjDg !(normsP _ x Ax). Qed. Lemma normsM : A \subset 'N(B * C). Proof. by apply/normsP=> x Ax; rewrite conjsMg !(normsP _ x Ax). Qed. Lemma normsY : A \subset 'N(B <*> C). Proof. by apply/normsP=> x Ax; rewrite -genJ conjUg !(normsP _ x Ax). Qed. Lemma normsR : A \subset 'N([~: B, C]). Proof. by apply/normsP=> x Ax; rewrite conjsRg !(normsP _ x Ax). Qed. Lemma norms_class_support : A \subset 'N(class_support B C). Proof. apply/subsetP=> x Ax; rewrite inE sub_conjg class_supportEr. apply/bigcupsP=> y Cy; rewrite -sub_conjg -conjsgM conjgC conjsgM. by rewrite (normsP nBA) // bigcup_sup ?memJ_norm ?(subsetP nCA). Qed. End norm_trans. Lemma normsIG A B G : A \subset 'N(B) -> A :&: G \subset 'N(B :&: G). Proof. by move/normsIs->; rewrite ?normG. Qed. Lemma normsGI A B G : A \subset 'N(B) -> G :&: A \subset 'N(G :&: B). Proof. by move=> nBA; rewrite !(setIC G) normsIG. Qed. Lemma norms_bigcap I r (P : pred I) A (B_ : I -> {set gT}) : A \subset \bigcap_(i <- r | P i) 'N(B_ i) -> A \subset 'N(\bigcap_(i <- r | P i) B_ i). Proof. elim/big_rec2: _ => [|i B N _ IH /subsetIP[nBiA /IH]]; last exact: normsI. by rewrite normT. Qed. Lemma norms_bigcup I r (P : pred I) A (B_ : I -> {set gT}) : A \subset \bigcap_(i <- r | P i) 'N(B_ i) -> A \subset 'N(\bigcup_(i <- r | P i) B_ i). Proof. move=> nBA; rewrite -normCs setC_bigcup norms_bigcap //. by rewrite (eq_bigr _ (fun _ _ => normCs _)). Qed. Lemma normsD1 A B : A \subset 'N(B) -> A \subset 'N(B^#). Proof. by move/normsD->; rewrite ?norms1. Qed. Lemma normD1 A : 'N(A^#) = 'N(A). Proof. apply/eqP; rewrite eqEsubset normsD1 //. rewrite -{2}(setID A 1) setIC normsU //; apply/normsP=> x _; apply/setP=> y. by rewrite conjIg conjs1g !inE mem_conjg; case: eqP => // ->; rewrite conj1g. Qed. Lemma normalP A B : reflect (A \subset B /\ {in B, normalised A}) (A <| B). Proof. by apply: (iffP andP)=> [] [sAB]; move/normsP. Qed. Lemma normal_sub A B : A <| B -> A \subset B. Proof. by case/andP. Qed. Lemma normal_norm A B : A <| B -> B \subset 'N(A). Proof. by case/andP. Qed. Lemma normalS G H K : K \subset H -> H \subset G -> K <| G -> K <| H. Proof. by move=> sKH sHG /andP[_ nKG]; rewrite /(K <| _) sKH (subset_trans sHG). Qed. Lemma normal1 G : 1 <| G. Proof. by rewrite /normal sub1set group1 norms1. Qed. Lemma normal_refl G : G <| G. Proof. by rewrite /(G <| _) normG subxx. Qed. Lemma normalG G : G <| 'N(G). Proof. by rewrite /(G <| _) normG subxx. Qed. Lemma normalSG G H : H \subset G -> H <| 'N_G(H). Proof. by move=> sHG; rewrite /normal subsetI sHG normG subsetIr. Qed. Lemma normalJ A B x : (A :^ x <| B :^ x) = (A <| B). Proof. by rewrite /normal normJ !conjSg. Qed. Lemma normalM G A B : A <| G -> B <| G -> A * B <| G. Proof. by case/andP=> sAG nAG /andP[sBG nBG]; rewrite /normal mul_subG ?normsM. Qed. Lemma normalY G A B : A <| G -> B <| G -> A <*> B <| G. Proof. by case/andP=> sAG ? /andP[sBG ?]; rewrite /normal join_subG sAG sBG ?normsY. Qed. Lemma normalYl G H : (H <| H <*> G) = (G \subset 'N(H)). Proof. by rewrite /normal joing_subl join_subG normG. Qed. Lemma normalYr G H : (H <| G <*> H) = (G \subset 'N(H)). Proof. by rewrite joingC normalYl. Qed. Lemma normalI G A B : A <| G -> B <| G -> A :&: B <| G. Proof. by case/andP=> sAG nAG /andP[_ nBG]; rewrite /normal subIset ?sAG // normsI. Qed. Lemma norm_normalI G A : G \subset 'N(A) -> G :&: A <| G. Proof. by move=> nAG; rewrite /normal subsetIl normsI ?normG. Qed. Lemma normalGI G H A : H \subset G -> A <| G -> H :&: A <| H. Proof. by move=> sHG /andP[_ nAG]; apply: norm_normalI (subset_trans sHG nAG). Qed. Lemma normal_subnorm G H : (H <| 'N_G(H)) = (H \subset G). Proof. by rewrite /normal subsetIr subsetI normG !andbT. Qed. Lemma normalD1 A G : (A^# <| G) = (A <| G). Proof. by rewrite /normal normD1 subDset (setUidPr (sub1G G)). Qed. Lemma gcore_sub A G : gcore A G \subset A. Proof. by rewrite (bigcap_min 1) ?conjsg1. Qed. Lemma gcore_norm A G : G \subset 'N(gcore A G). Proof. apply/subsetP=> x Gx; rewrite inE; apply/bigcapsP=> y Gy. by rewrite sub_conjg -conjsgM bigcap_inf ?groupM ?groupV. Qed. Lemma gcore_normal A G : A \subset G -> gcore A G <| G. Proof. by move=> sAG; rewrite /normal gcore_norm (subset_trans (gcore_sub A G)). Qed. Lemma gcore_max A B G : B \subset A -> G \subset 'N(B) -> B \subset gcore A G. Proof. move=> sBA nBG; apply/bigcapsP=> y Gy. by rewrite -sub_conjgV (normsP nBG) ?groupV. Qed. Lemma sub_gcore A B G : G \subset 'N(B) -> (B \subset gcore A G) = (B \subset A). Proof. move=> nBG; apply/idP/idP=> [sBAG | sBA]; last exact: gcore_max. exact: subset_trans (gcore_sub A G). Qed. (* An elementary proof that subgroups of index 2 are normal; it is almost as *) (* short as the "advanced" proof using group actions; besides, the fact that *) (* the coset is equal to the complement is used in extremal.v. *) Lemma rcoset_index2 G H x : H \subset G -> #|G : H| = 2 -> x \in G :\: H -> H :* x = G :\: H. Proof. move=> sHG indexHG => /setDP[Gx notHx]; apply/eqP. rewrite eqEcard -(leq_add2l #|G :&: H|) cardsID -(LagrangeI G H) indexHG muln2. rewrite (setIidPr sHG) card_rcoset addnn leqnn andbT. apply/subsetP=> _ /rcosetP[y Hy ->]; apply/setDP. by rewrite !groupMl // (subsetP sHG). Qed. Lemma index2_normal G H : H \subset G -> #|G : H| = 2 -> H <| G. Proof. move=> sHG indexHG; rewrite /normal sHG; apply/subsetP=> x Gx. case Hx: (x \in H); first by rewrite inE conjGid. rewrite inE conjsgE mulgA -sub_rcosetV -invg_rcoset. by rewrite !(rcoset_index2 sHG) ?inE ?groupV ?Hx // invDg !invGid. Qed. Lemma cent1P x y : reflect (commute x y) (x \in 'C[y]). Proof. rewrite inE conjg_set1 sub1set inE (sameP eqP conjg_fixP)commg1_sym. exact: commgP. Qed. Lemma cent1id x : x \in 'C[x]. Proof. exact/cent1P. Qed. Lemma cent1E x y : (x \in 'C[y]) = (x * y == y * x). Proof. by rewrite (sameP (cent1P x y) eqP). Qed. Lemma cent1C x y : (x \in 'C[y]) = (y \in 'C[x]). Proof. by rewrite !cent1E eq_sym. Qed. Canonical centraliser_group A : {group _} := Eval hnf in [group of 'C(A)]. Lemma cent_set1 x : 'C([set x]) = 'C[x]. Proof. by apply: big_pred1 => y /=; rewrite inE. Qed. Lemma cent1J x y : 'C[x ^ y] = 'C[x] :^ y. Proof. by rewrite -conjg_set1 normJ. Qed. Lemma centP A x : reflect (centralises x A) (x \in 'C(A)). Proof. by apply: (iffP bigcapP) => cxA y /cxA/cent1P. Qed. Lemma centsP A B : reflect {in A, centralised B} (A \subset 'C(B)). Proof. by apply: (iffP subsetP) => cAB x /cAB/centP. Qed. Lemma centsC A B : (A \subset 'C(B)) = (B \subset 'C(A)). Proof. by apply/centsP/centsP=> cAB x ? y ?; rewrite /commute -cAB. Qed. Lemma cents1 A : A \subset 'C(1). Proof. by rewrite centsC sub1G. Qed. Lemma cent1T : 'C(1) = setT :> {set gT}. Proof. by apply/eqP; rewrite -subTset cents1. Qed. Lemma cent11T : 'C[1] = setT :> {set gT}. Proof. by rewrite -cent_set1 cent1T. Qed. Lemma cent_sub A : 'C(A) \subset 'N(A). Proof. apply/subsetP=> x /centP cAx; rewrite inE. by apply/subsetP=> _ /imsetP[y Ay ->]; rewrite /conjg -cAx ?mulKg. Qed. Lemma cents_norm A B : A \subset 'C(B) -> A \subset 'N(B). Proof. by move=> cAB; apply: subset_trans (cent_sub B). Qed. Lemma centC A B : A \subset 'C(B) -> commute A B. Proof. by move=> cAB; apply: normC (cents_norm cAB). Qed. Lemma cent_joinEl G H : G \subset 'C(H) -> G <*> H = G * H. Proof. by move=> cGH; apply: norm_joinEl (cents_norm cGH). Qed. Lemma cent_joinEr G H : H \subset 'C(G) -> G <*> H = G * H. Proof. by move=> cGH; apply: norm_joinEr (cents_norm cGH). Qed. Lemma centJ A x : 'C(A :^ x) = 'C(A) :^ x. Proof. apply/setP=> y; rewrite mem_conjg; apply/centP/centP=> cAy z Az. by apply: (conjg_inj x); rewrite 2!conjMg conjgKV cAy ?memJ_conjg. by apply: (conjg_inj x^-1); rewrite 2!conjMg cAy -?mem_conjg. Qed. Lemma cent_norm A : 'N(A) \subset 'N('C(A)). Proof. by apply/normsP=> x nCx; rewrite -centJ (normP nCx). Qed. Lemma norms_cent A B : A \subset 'N(B) -> A \subset 'N('C(B)). Proof. by move=> nBA; apply: subset_trans nBA (cent_norm B). Qed. Lemma cent_normal A : 'C(A) <| 'N(A). Proof. by rewrite /(_ <| _) cent_sub cent_norm. Qed. Lemma centS A B : B \subset A -> 'C(A) \subset 'C(B). Proof. by move=> sAB; rewrite centsC (subset_trans sAB) 1?centsC. Qed. Lemma centsS A B C : A \subset B -> C \subset 'C(B) -> C \subset 'C(A). Proof. by move=> sAB cCB; apply: subset_trans cCB (centS sAB). Qed. Lemma centSS A B C D : A \subset C -> B \subset D -> C \subset 'C(D) -> A \subset 'C(B). Proof. by move=> sAC sBD cCD; apply: subset_trans (centsS sBD cCD). Qed. Lemma centI A B : 'C(A) <*> 'C(B) \subset 'C(A :&: B). Proof. by rewrite gen_subG subUset !centS ?(subsetIl, subsetIr). Qed. Lemma centU A B : 'C(A :|: B) = 'C(A) :&: 'C(B). Proof. apply/eqP; rewrite eqEsubset subsetI 2?centS ?(subsetUl, subsetUr) //=. by rewrite centsC subUset -centsC subsetIl -centsC subsetIr. Qed. Lemma cent_gen A : 'C(<>) = 'C(A). Proof. by apply/setP=> x; rewrite -!sub1set centsC gen_subG centsC. Qed. Lemma cent_cycle x : 'C(<[x]>) = 'C[x]. Proof. by rewrite cent_gen cent_set1. Qed. Lemma sub_cent1 A x : (A \subset 'C[x]) = (x \in 'C(A)). Proof. by rewrite -cent_cycle centsC cycle_subG. Qed. Lemma cents_cycle x y : commute x y -> <[x]> \subset 'C(<[y]>). Proof. by move=> cxy; rewrite cent_cycle cycle_subG; apply/cent1P. Qed. Lemma cycle_abelian x : abelian <[x]>. Proof. exact: cents_cycle. Qed. Lemma centY A B : 'C(A <*> B) = 'C(A) :&: 'C(B). Proof. by rewrite cent_gen centU. Qed. Lemma centM G H : 'C(G * H) = 'C(G) :&: 'C(H). Proof. by rewrite -cent_gen genM_join centY. Qed. Lemma cent_classP x G : reflect (x ^: G = [set x]) (x \in 'C(G)). Proof. apply: (iffP (centP _ _)) => [Cx | Cx1 y Gy]. apply/eqP; rewrite eqEsubset sub1set class_refl andbT. by apply/subsetP=> _ /imsetP[y Gy ->]; rewrite inE conjgE Cx ?mulKg. by apply/commgP/conjg_fixP/set1P; rewrite -Cx1; apply/imsetP; exists y. Qed. Lemma commG1P A B : reflect ([~: A, B] = 1) (A \subset 'C(B)). Proof. apply: (iffP (centsP A B)) => [cAB | cAB1 x Ax y By]. apply/trivgP; rewrite gen_subG; apply/subsetP=> _ /imset2P[x y Ax Ay ->]. by rewrite inE; apply/commgP; apply: cAB. by apply/commgP; rewrite -in_set1 -[[set 1]]cAB1 mem_commg. Qed. Lemma abelianE A : abelian A = (A \subset 'C(A)). Proof. by []. Qed. Lemma abelian1 : abelian [1 gT]. Proof. exact: sub1G. Qed. Lemma abelianS A B : A \subset B -> abelian B -> abelian A. Proof. by move=> sAB; apply: centSS. Qed. Lemma abelianJ A x : abelian (A :^ x) = abelian A. Proof. by rewrite /abelian centJ conjSg. Qed. Lemma abelian_gen A : abelian <> = abelian A. Proof. by rewrite /abelian cent_gen gen_subG. Qed. Lemma abelianY A B : abelian (A <*> B) = [&& abelian A, abelian B & B \subset 'C(A)]. Proof. rewrite /abelian join_subG /= centY !subsetI -!andbA; congr (_ && _). by rewrite centsC andbA andbb andbC. Qed. Lemma abelianM G H : abelian (G * H) = [&& abelian G, abelian H & H \subset 'C(G)]. Proof. by rewrite -abelian_gen genM_join abelianY. Qed. Section SubAbelian. Variable A B C : {set gT}. Hypothesis cAA : abelian A. Lemma sub_abelian_cent : C \subset A -> A \subset 'C(C). Proof. by move=> sCA; rewrite centsC (subset_trans sCA). Qed. Lemma sub_abelian_cent2 : B \subset A -> C \subset A -> B \subset 'C(C). Proof. by move=> sBA; move/sub_abelian_cent; apply: subset_trans. Qed. Lemma sub_abelian_norm : C \subset A -> A \subset 'N(C). Proof. by move=> sCA; rewrite cents_norm ?sub_abelian_cent. Qed. Lemma sub_abelian_normal : (C \subset A) = (C <| A). Proof. by rewrite /normal; case sHG: (C \subset A); rewrite // sub_abelian_norm. Qed. End SubAbelian. End Normaliser. Arguments normP {gT x A}. Arguments centP {gT A x}. Arguments normsP {gT A B}. Arguments cent1P {gT x y}. Arguments normalP {gT A B}. Arguments centsP {gT A B}. Arguments commG1P {gT A B}. Arguments normaliser_group _ _%g. Arguments centraliser_group _ _%g. Notation "''N' ( A )" := (normaliser_group A) : Group_scope. Notation "''C' ( A )" := (centraliser_group A) : Group_scope. Notation "''C' [ x ]" := (normaliser_group [set x%g]) : Group_scope. Notation "''N_' G ( A )" := (setI_group G 'N(A)) : Group_scope. Notation "''C_' G ( A )" := (setI_group G 'C(A)) : Group_scope. Notation "''C_' ( G ) ( A )" := (setI_group G 'C(A)) (only parsing) : Group_scope. Notation "''C_' G [ x ]" := (setI_group G 'C[x]) : Group_scope. Notation "''C_' ( G ) [ x ]" := (setI_group G 'C[x]) (only parsing) : Group_scope. Hint Extern 0 (is_true (_ \subset _)) => apply: normG : core. Hint Extern 0 (is_true (_ <| _)) => apply: normal_refl : core. Section MinMaxGroup. Variable gT : finGroupType. Implicit Types gP : pred {group gT}. Definition maxgroup A gP := maxset (fun A => group_set A && gP <>%G) A. Definition mingroup A gP := minset (fun A => group_set A && gP <>%G) A. Variable gP : pred {group gT}. Arguments gP G%G. Lemma ex_maxgroup : (exists G, gP G) -> {G : {group gT} | maxgroup G gP}. Proof. move=> exP; have [A maxA]: {A | maxgroup A gP}. apply: ex_maxset; case: exP => G gPG. by exists (G : {set gT}); rewrite groupP genGidG. by exists <>%G; rewrite /= gen_set_id; case/andP: (maxsetp maxA). Qed. Lemma ex_mingroup : (exists G, gP G) -> {G : {group gT} | mingroup G gP}. Proof. move=> exP; have [A minA]: {A | mingroup A gP}. apply: ex_minset; case: exP => G gPG. by exists (G : {set gT}); rewrite groupP genGidG. by exists <>%G; rewrite /= gen_set_id; case/andP: (minsetp minA). Qed. Variable G : {group gT}. Lemma mingroupP : reflect (gP G /\ forall H, gP H -> H \subset G -> H :=: G) (mingroup G gP). Proof. apply: (iffP minsetP); rewrite /= groupP genGidG /= => [] [-> minG]. by split=> // H gPH sGH; apply: minG; rewrite // groupP genGidG. by split=> // A; case/andP=> gA gPA; rewrite -(gen_set_id gA); apply: minG. Qed. Lemma maxgroupP : reflect (gP G /\ forall H, gP H -> G \subset H -> H :=: G) (maxgroup G gP). Proof. apply: (iffP maxsetP); rewrite /= groupP genGidG /= => [] [-> maxG]. by split=> // H gPH sGH; apply: maxG; rewrite // groupP genGidG. by split=> // A; case/andP=> gA gPA; rewrite -(gen_set_id gA); apply: maxG. Qed. Lemma maxgroupp : maxgroup G gP -> gP G. Proof. by case/maxgroupP. Qed. Lemma mingroupp : mingroup G gP -> gP G. Proof. by case/mingroupP. Qed. Hypothesis gPG : gP G. Lemma maxgroup_exists : {H : {group gT} | maxgroup H gP & G \subset H}. Proof. have [A maxA sGA]: {A | maxgroup A gP & G \subset A}. by apply: maxset_exists; rewrite groupP genGidG. by exists <>%G; rewrite /= gen_set_id; case/andP: (maxsetp maxA). Qed. Lemma mingroup_exists : {H : {group gT} | mingroup H gP & H \subset G}. Proof. have [A maxA sGA]: {A | mingroup A gP & A \subset G}. by apply: minset_exists; rewrite groupP genGidG. by exists <>%G; rewrite /= gen_set_id; case/andP: (minsetp maxA). Qed. End MinMaxGroup. Arguments mingroup {gT} A%g gP. Arguments maxgroup {gT} A%g gP. Arguments mingroupP {gT gP G}. Arguments maxgroupP {gT gP G}. Notation "[ 'max' A 'of' G | gP ]" := (maxgroup A (fun G : {group _} => gP)) : group_scope. Notation "[ 'max' G | gP ]" := [max gval G of G | gP] : group_scope. Notation "[ 'max' A 'of' G | gP & gQ ]" := [max A of G | gP && gQ] : group_scope. Notation "[ 'max' G | gP & gQ ]" := [max G | gP && gQ] : group_scope. Notation "[ 'min' A 'of' G | gP ]" := (mingroup A (fun G : {group _} => gP)) : group_scope. Notation "[ 'min' G | gP ]" := [min gval G of G | gP] : group_scope. Notation "[ 'min' A 'of' G | gP & gQ ]" := [min A of G | gP && gQ] : group_scope. Notation "[ 'min' G | gP & gQ ]" := [min G | gP && gQ] : group_scope. math-comp-mathcomp-1.12.0/mathcomp/fingroup/gproduct.v000066400000000000000000001736551375767750300230120ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype bigop finset fingroup morphism. From mathcomp Require Import quotient action. (******************************************************************************) (* Partial, semidirect, central, and direct products. *) (* ++ Internal products, with A, B : {set gT}, are partial operations : *) (* partial_product A B == A * B if A is a group normalised by the group B, *) (* and the empty set otherwise. *) (* A ><| B == A * B if this is a semi-direct product (i.e., if A *) (* is normalised by B and intersects it trivially). *) (* A \* B == A * B if this is a central product ([A, B] = 1). *) (* A \x B == A * B if this is a direct product. *) (* [complements to K in G] == set of groups H s.t. K * H = G and K :&: H = 1. *) (* [splits G, over K] == [complements to K in G] is not empty. *) (* remgr A B x == the right remainder in B of x mod A, i.e., *) (* some element of (A :* x) :&: B. *) (* divgr A B x == the "division" in B of x by A: for all x, *) (* x = divgr A B x * remgr A B x. *) (* ++ External products : *) (* pairg1, pair1g == the isomorphisms aT1 -> aT1 * aT2, aT2 -> aT1 * aT2. *) (* (aT1 * aT2 has a direct product group structure.) *) (* sdprod_by to == the semidirect product defined by to : groupAction H K. *) (* This is a finGroupType; the actual semidirect product is *) (* the total set [set: sdprod_by to] on that type. *) (* sdpair[12] to == the isomorphisms injecting K and H into *) (* sdprod_by to = sdpair1 to @* K ><| sdpair2 to @* H. *) (* External central products (with identified centers) will be defined later *) (* in file center.v. *) (* ++ Morphisms on product groups: *) (* pprodm nAB fJ fAB == the morphism extending fA and fB on A <*> B when *) (* nAB : B \subset 'N(A), *) (* fJ : {in A & B, morph_actj fA fB}, and *) (* fAB : {in A :&: B, fA =1 fB}. *) (* sdprodm defG fJ == the morphism extending fA and fB on G, given *) (* defG : A ><| B = G and *) (* fJ : {in A & B, morph_act 'J 'J fA fB}. *) (* xsdprodm fHKact == the total morphism on sdprod_by to induced by *) (* fH : {morphism H >-> rT}, fK : {morphism K >-> rT}, *) (* with to : groupAction K H, *) (* given fHKact : morph_act to 'J fH fK. *) (* cprodm defG cAB fAB == the morphism extending fA and fB on G, when *) (* defG : A \* B = G, *) (* cAB : fB @* B \subset 'C(fB @* A), *) (* and fAB : {in A :&: B, fA =1 fB}. *) (* dprodm defG cAB == the morphism extending fA and fB on G, when *) (* defG : A \x B = G and *) (* cAB : fA @* B \subset 'C(fA @* A) *) (* mulgm (x, y) == x * y; mulgm is an isomorphism from setX A B to G *) (* iff A \x B = G . *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Defs. Variables gT : finGroupType. Implicit Types A B C : {set gT}. Definition partial_product A B := if A == 1 then B else if B == 1 then A else if [&& group_set A, group_set B & B \subset 'N(A)] then A * B else set0. Definition semidirect_product A B := if A :&: B \subset 1%G then partial_product A B else set0. Definition central_product A B := if B \subset 'C(A) then partial_product A B else set0. Definition direct_product A B := if A :&: B \subset 1%G then central_product A B else set0. Definition complements_to_in A B := [set K : {group gT} | A :&: K == 1 & A * K == B]. Definition splits_over B A := complements_to_in A B != set0. (* Product remainder functions -- right variant only. *) Definition remgr A B x := repr (A :* x :&: B). Definition divgr A B x := x * (remgr A B x)^-1. End Defs. Arguments partial_product _ _%g _%g : clear implicits. Arguments semidirect_product _ _%g _%g : clear implicits. Arguments central_product _ _%g _%g : clear implicits. Arguments complements_to_in _ _%g _%g. Arguments splits_over _ _%g _%g. Arguments remgr _ _%g _%g _%g. Arguments divgr _ _%g _%g _%g. Arguments direct_product : clear implicits. Notation pprod := (partial_product _). Notation sdprod := (semidirect_product _). Notation cprod := (central_product _). Notation dprod := (direct_product _). Notation "G ><| H" := (sdprod G H)%g (at level 40, left associativity). Notation "G \* H" := (cprod G H)%g (at level 40, left associativity). Notation "G \x H" := (dprod G H)%g (at level 40, left associativity). Notation "[ 'complements' 'to' A 'in' B ]" := (complements_to_in A B) (at level 0, format "[ 'complements' 'to' A 'in' B ]") : group_scope. Notation "[ 'splits' B , 'over' A ]" := (splits_over B A) (at level 0, format "[ 'splits' B , 'over' A ]") : group_scope. (* Prenex Implicits remgl divgl. *) Prenex Implicits remgr divgr. Section InternalProd. Variable gT : finGroupType. Implicit Types A B C : {set gT}. Implicit Types G H K L M : {group gT}. Local Notation pprod := (partial_product gT). Local Notation sdprod := (semidirect_product gT) (only parsing). Local Notation cprod := (central_product gT) (only parsing). Local Notation dprod := (direct_product gT) (only parsing). Lemma pprod1g : left_id 1 pprod. Proof. by move=> A; rewrite /pprod eqxx. Qed. Lemma pprodg1 : right_id 1 pprod. Proof. by move=> A; rewrite /pprod eqxx; case: eqP. Qed. Variant are_groups A B : Prop := AreGroups K H of A = K & B = H. Lemma group_not0 G : set0 <> G. Proof. by move/setP/(_ 1); rewrite inE group1. Qed. Lemma mulg0 : right_zero (@set0 gT) mulg. Proof. by move=> A; apply/setP=> x; rewrite inE; apply/imset2P=> [[y z]]; rewrite inE. Qed. Lemma mul0g : left_zero (@set0 gT) mulg. Proof. by move=> A; apply/setP=> x; rewrite inE; apply/imset2P=> [[y z]]; rewrite inE. Qed. Lemma pprodP A B G : pprod A B = G -> [/\ are_groups A B, A * B = G & B \subset 'N(A)]. Proof. have Gnot0 := @group_not0 G; rewrite /pprod; do 2?case: eqP => [-> ->| _]. - by rewrite mul1g norms1; split; first exists 1%G G. - by rewrite mulg1 sub1G; split; first exists G 1%G. by case: and3P => // [[gA gB ->]]; split; first exists (Group gA) (Group gB). Qed. Lemma pprodE K H : H \subset 'N(K) -> pprod K H = K * H. Proof. move=> nKH; rewrite /pprod nKH !groupP /=. by do 2?case: eqP => [-> | _]; rewrite ?mulg1 ?mul1g. Qed. Lemma pprodEY K H : H \subset 'N(K) -> pprod K H = K <*> H. Proof. by move=> nKH; rewrite pprodE ?norm_joinEr. Qed. Lemma pprodW A B G : pprod A B = G -> A * B = G. Proof. by case/pprodP. Qed. Lemma pprodWC A B G : pprod A B = G -> B * A = G. Proof. by case/pprodP=> _ <- /normC. Qed. Lemma pprodWY A B G : pprod A B = G -> A <*> B = G. Proof. by case/pprodP=> [[K H -> ->] <- /norm_joinEr]. Qed. Lemma pprodJ A B x : pprod A B :^ x = pprod (A :^ x) (B :^ x). Proof. rewrite /pprod !conjsg_eq1 !group_setJ normJ conjSg -conjsMg. by do 3?case: ifP => // _; apply: conj0g. Qed. (* Properties of the remainders *) Lemma remgrMl K B x y : y \in K -> remgr K B (y * x) = remgr K B x. Proof. by move=> Ky; rewrite {1}/remgr rcosetM rcoset_id. Qed. Lemma remgrP K B x : (remgr K B x \in K :* x :&: B) = (x \in K * B). Proof. set y := _ x; apply/idP/mulsgP=> [|[g b Kg Bb x_gb]]. rewrite inE rcoset_sym mem_rcoset => /andP[Kxy' By]. by exists (x * y^-1) y; rewrite ?mulgKV. by apply: (mem_repr b); rewrite inE rcoset_sym mem_rcoset x_gb mulgK Kg. Qed. Lemma remgr1 K H x : x \in K -> remgr K H x = 1. Proof. by move=> Kx; rewrite /remgr rcoset_id ?repr_group. Qed. Lemma divgr_eq A B x : x = divgr A B x * remgr A B x. Proof. by rewrite mulgKV. Qed. Lemma divgrMl K B x y : x \in K -> divgr K B (x * y) = x * divgr K B y. Proof. by move=> Hx; rewrite /divgr remgrMl ?mulgA. Qed. Lemma divgr_id K H x : x \in K -> divgr K H x = x. Proof. by move=> Kx; rewrite /divgr remgr1 // invg1 mulg1. Qed. Lemma mem_remgr K B x : x \in K * B -> remgr K B x \in B. Proof. by rewrite -remgrP => /setIP[]. Qed. Lemma mem_divgr K B x : x \in K * B -> divgr K B x \in K. Proof. by rewrite -remgrP inE rcoset_sym mem_rcoset => /andP[]. Qed. Section DisjointRem. Variables K H : {group gT}. Hypothesis tiKH : K :&: H = 1. Lemma remgr_id x : x \in H -> remgr K H x = x. Proof. move=> Hx; apply/eqP; rewrite eq_mulgV1 (sameP eqP set1gP) -tiKH inE. rewrite -mem_rcoset groupMr ?groupV // -in_setI remgrP. by apply: subsetP Hx; apply: mulG_subr. Qed. Lemma remgrMid x y : x \in K -> y \in H -> remgr K H (x * y) = y. Proof. by move=> Kx Hy; rewrite remgrMl ?remgr_id. Qed. Lemma divgrMid x y : x \in K -> y \in H -> divgr K H (x * y) = x. Proof. by move=> Kx Hy; rewrite /divgr remgrMid ?mulgK. Qed. End DisjointRem. (* Intersection of a centraliser with a disjoint product. *) Lemma subcent_TImulg K H A : K :&: H = 1 -> A \subset 'N(K) :&: 'N(H) -> 'C_K(A) * 'C_H(A) = 'C_(K * H)(A). Proof. move=> tiKH /subsetIP[nKA nHA]; apply/eqP. rewrite group_modl ?subsetIr // eqEsubset setSI ?mulSg ?subsetIl //=. apply/subsetP=> _ /setIP[/mulsgP[x y Kx Hy ->] cAxy]. rewrite inE cAxy mem_mulg // inE Kx /=. apply/centP=> z Az; apply/commgP/conjg_fixP. move/commgP/conjg_fixP/(congr1 (divgr K H)): (centP cAxy z Az). by rewrite conjMg !divgrMid ?memJ_norm // (subsetP nKA, subsetP nHA). Qed. (* Complements, and splitting. *) Lemma complP H A B : reflect (A :&: H = 1 /\ A * H = B) (H \in [complements to A in B]). Proof. by apply: (iffP setIdP); case; split; apply/eqP. Qed. Lemma splitsP B A : reflect (exists H, H \in [complements to A in B]) [splits B, over A]. Proof. exact: set0Pn. Qed. Lemma complgC H K G : (H \in [complements to K in G]) = (K \in [complements to H in G]). Proof. rewrite !inE setIC; congr (_ && _). by apply/eqP/eqP=> defG; rewrite -(comm_group_setP _) // defG groupP. Qed. Section NormalComplement. Variables K H G : {group gT}. Hypothesis complH_K : H \in [complements to K in G]. Lemma remgrM : K <| G -> {in G &, {morph remgr K H : x y / x * y}}. Proof. case/normalP=> _; case/complP: complH_K => tiKH <- nK_KH x y KHx KHy. rewrite {1}(divgr_eq K H y) mulgA (conjgCV x) {2}(divgr_eq K H x) -2!mulgA. rewrite mulgA remgrMid //; last by rewrite groupMl mem_remgr. by rewrite groupMl !(=^~ mem_conjg, nK_KH, mem_divgr). Qed. Lemma divgrM : H \subset 'C(K) -> {in G &, {morph divgr K H : x y / x * y}}. Proof. move=> cKH; have /complP[_ defG] := complH_K. have nsKG: K <| G by rewrite -defG -cent_joinEr // normalYl cents_norm. move=> x y Gx Gy; rewrite {1}/divgr remgrM // invMg -!mulgA (mulgA y). by congr (_ * _); rewrite -(centsP cKH) ?groupV ?(mem_remgr, mem_divgr, defG). Qed. End NormalComplement. (* Semi-direct product *) Lemma sdprod1g : left_id 1 sdprod. Proof. by move=> A; rewrite /sdprod subsetIl pprod1g. Qed. Lemma sdprodg1 : right_id 1 sdprod. Proof. by move=> A; rewrite /sdprod subsetIr pprodg1. Qed. Lemma sdprodP A B G : A ><| B = G -> [/\ are_groups A B, A * B = G, B \subset 'N(A) & A :&: B = 1]. Proof. rewrite /sdprod; case: ifP => [trAB | _ /group_not0[] //]. case/pprodP=> gAB defG nBA; split=> {defG nBA}//. by case: gAB trAB => H K -> -> /trivgP. Qed. Lemma sdprodE K H : H \subset 'N(K) -> K :&: H = 1 -> K ><| H = K * H. Proof. by move=> nKH tiKH; rewrite /sdprod tiKH subxx pprodE. Qed. Lemma sdprodEY K H : H \subset 'N(K) -> K :&: H = 1 -> K ><| H = K <*> H. Proof. by move=> nKH tiKH; rewrite sdprodE ?norm_joinEr. Qed. Lemma sdprodWpp A B G : A ><| B = G -> pprod A B = G. Proof. by case/sdprodP=> [[K H -> ->] <- /pprodE]. Qed. Lemma sdprodW A B G : A ><| B = G -> A * B = G. Proof. by move/sdprodWpp/pprodW. Qed. Lemma sdprodWC A B G : A ><| B = G -> B * A = G. Proof. by move/sdprodWpp/pprodWC. Qed. Lemma sdprodWY A B G : A ><| B = G -> A <*> B = G. Proof. by move/sdprodWpp/pprodWY. Qed. Lemma sdprodJ A B x : (A ><| B) :^ x = A :^ x ><| B :^ x. Proof. rewrite /sdprod -conjIg sub_conjg conjs1g -pprodJ. by case: ifP => _ //; apply: imset0. Qed. Lemma sdprod_context G K H : K ><| H = G -> [/\ K <| G, H \subset G, K * H = G, H \subset 'N(K) & K :&: H = 1]. Proof. case/sdprodP=> _ <- nKH tiKH. by rewrite /normal mulG_subl mulG_subr mulG_subG normG. Qed. Lemma sdprod_compl G K H : K ><| H = G -> H \in [complements to K in G]. Proof. by case/sdprodP=> _ mulKH _ tiKH; apply/complP. Qed. Lemma sdprod_normal_complP G K H : K <| G -> reflect (K ><| H = G) (K \in [complements to H in G]). Proof. case/andP=> _ nKG; rewrite complgC. apply: (iffP idP); [case/complP=> tiKH mulKH | exact: sdprod_compl]. by rewrite sdprodE ?(subset_trans _ nKG) // -mulKH mulG_subr. Qed. Lemma sdprod_card G A B : A ><| B = G -> (#|A| * #|B|)%N = #|G|. Proof. by case/sdprodP=> [[H K -> ->] <- _ /TI_cardMg]. Qed. Lemma sdprod_isom G A B : A ><| B = G -> {nAB : B \subset 'N(A) | isom B (G / A) (restrm nAB (coset A))}. Proof. case/sdprodP=> [[K H -> ->] <- nKH tiKH]. by exists nKH; rewrite quotientMidl quotient_isom. Qed. Lemma sdprod_isog G A B : A ><| B = G -> B \isog G / A. Proof. by case/sdprod_isom=> nAB; apply: isom_isog. Qed. Lemma sdprod_subr G A B M : A ><| B = G -> M \subset B -> A ><| M = A <*> M. Proof. case/sdprodP=> [[K H -> ->] _ nKH tiKH] sMH. by rewrite sdprodEY ?(subset_trans sMH) //; apply/trivgP; rewrite -tiKH setIS. Qed. Lemma index_sdprod G A B : A ><| B = G -> #|B| = #|G : A|. Proof. case/sdprodP=> [[K H -> ->] <- _ tiHK]. by rewrite indexMg -indexgI setIC tiHK indexg1. Qed. Lemma index_sdprodr G A B M : A ><| B = G -> M \subset B -> #|B : M| = #|G : A <*> M|. Proof. move=> defG; case/sdprodP: defG (defG) => [[K H -> ->] mulKH nKH _] defG sMH. rewrite -!divgS //=; last by rewrite -genM_join gen_subG -mulKH mulgS. by rewrite -(sdprod_card defG) -(sdprod_card (sdprod_subr defG sMH)) divnMl. Qed. Lemma quotient_sdprodr_isom G A B M : A ><| B = G -> M <| B -> {f : {morphism B / M >-> coset_of (A <*> M)} | isom (B / M) (G / (A <*> M)) f & forall L, L \subset B -> f @* (L / M) = A <*> L / (A <*> M)}. Proof. move=> defG nsMH; have [defA defB]: A = <>%G /\ B = <>%G. by have [[K1 H1 -> ->] _ _ _] := sdprodP defG; rewrite /= !genGid. do [rewrite {}defA {}defB; move: {A}<>%G {B}<>%G => K H] in defG nsMH *. have [[nKH /isomP[injKH imKH]] sMH] := (sdprod_isom defG, normal_sub nsMH). have [[nsKG sHG mulKH _ _] nKM] := (sdprod_context defG, subset_trans sMH nKH). have nsKMG: K <*> M <| G. by rewrite -quotientYK // -mulKH -quotientK ?cosetpre_normal ?quotient_normal. have [/= f inj_f im_f] := third_isom (joing_subl K M) nsKG nsKMG. rewrite quotientYidl //= -imKH -(restrm_quotientE nKH sMH) in f inj_f im_f. have /domP[h [_ ker_h _ im_h]]: 'dom (f \o quotm _ nsMH) = H / M. by rewrite ['dom _]morphpre_quotm injmK. have{} im_h L: L \subset H -> h @* (L / M) = K <*> L / (K <*> M). move=> sLH; have [sLG sKKM] := (subset_trans sLH sHG, joing_subl K M). rewrite im_h morphim_comp morphim_quotm [_ @* L]restrm_quotientE ?im_f //. rewrite quotientY ?(normsG sKKM) ?(subset_trans sLG) ?normal_norm //. by rewrite (quotientS1 sKKM) joing1G. exists h => //; apply/isomP; split; last by rewrite im_h //= (sdprodWY defG). by rewrite ker_h injm_comp ?injm_quotm. Qed. Lemma quotient_sdprodr_isog G A B M : A ><| B = G -> M <| B -> B / M \isog G / (A <*> M). Proof. move=> defG; case/sdprodP: defG (defG) => [[K H -> ->] _ _ _] => defG nsMH. by have [h /isom_isog->] := quotient_sdprodr_isom defG nsMH. Qed. Lemma sdprod_modl A B G H : A ><| B = G -> A \subset H -> A ><| (B :&: H) = G :&: H. Proof. case/sdprodP=> {A B} [[A B -> ->]] <- nAB tiAB sAH. rewrite -group_modl ?sdprodE ?subIset ?nAB //. by rewrite setIA tiAB (setIidPl _) ?sub1G. Qed. Lemma sdprod_modr A B G H : A ><| B = G -> B \subset H -> (H :&: A) ><| B = H :&: G. Proof. case/sdprodP=> {A B}[[A B -> ->]] <- nAB tiAB sAH. rewrite -group_modr ?sdprodE ?normsI // ?normsG //. by rewrite -setIA tiAB (setIidPr _) ?sub1G. Qed. Lemma subcent_sdprod B C G A : B ><| C = G -> A \subset 'N(B) :&: 'N(C) -> 'C_B(A) ><| 'C_C(A) = 'C_G(A). Proof. case/sdprodP=> [[H K -> ->] <- nHK tiHK] nHKA {B C G}. rewrite sdprodE ?subcent_TImulg ?normsIG //. by rewrite -setIIl tiHK (setIidPl (sub1G _)). Qed. Lemma sdprod_recl n G K H K1 : #|G| <= n -> K ><| H = G -> K1 \proper K -> H \subset 'N(K1) -> exists G1 : {group gT}, [/\ #|G1| < n, G1 \subset G & K1 ><| H = G1]. Proof. move=> leGn; case/sdprodP=> _ defG nKH tiKH ltK1K nK1H. have tiK1H: K1 :&: H = 1 by apply/trivgP; rewrite -tiKH setSI ?proper_sub. exists (K1 <*> H)%G; rewrite /= -defG sdprodE // norm_joinEr //. rewrite ?mulSg ?proper_sub ?(leq_trans _ leGn) //=. by rewrite -defG ?TI_cardMg // ltn_pmul2r ?proper_card. Qed. Lemma sdprod_recr n G K H H1 : #|G| <= n -> K ><| H = G -> H1 \proper H -> exists G1 : {group gT}, [/\ #|G1| < n, G1 \subset G & K ><| H1 = G1]. Proof. move=> leGn; case/sdprodP=> _ defG nKH tiKH ltH1H. have [sH1H _] := andP ltH1H; have nKH1 := subset_trans sH1H nKH. have tiKH1: K :&: H1 = 1 by apply/trivgP; rewrite -tiKH setIS. exists (K <*> H1)%G; rewrite /= -defG sdprodE // norm_joinEr //. rewrite ?mulgS // ?(leq_trans _ leGn) //=. by rewrite -defG ?TI_cardMg // ltn_pmul2l ?proper_card. Qed. Lemma mem_sdprod G A B x : A ><| B = G -> x \in G -> exists y, exists z, [/\ y \in A, z \in B, x = y * z & {in A & B, forall u t, x = u * t -> u = y /\ t = z}]. Proof. case/sdprodP=> [[K H -> ->{A B}] <- _ tiKH] /mulsgP[y z Ky Hz ->{x}]. exists y; exists z; split=> // u t Ku Ht eqyzut. move: (congr1 (divgr K H) eqyzut) (congr1 (remgr K H) eqyzut). by rewrite !remgrMid // !divgrMid. Qed. (* Central product *) Lemma cprod1g : left_id 1 cprod. Proof. by move=> A; rewrite /cprod cents1 pprod1g. Qed. Lemma cprodg1 : right_id 1 cprod. Proof. by move=> A; rewrite /cprod sub1G pprodg1. Qed. Lemma cprodP A B G : A \* B = G -> [/\ are_groups A B, A * B = G & B \subset 'C(A)]. Proof. by rewrite /cprod; case: ifP => [cAB /pprodP[] | _ /group_not0[]]. Qed. Lemma cprodE G H : H \subset 'C(G) -> G \* H = G * H. Proof. by move=> cGH; rewrite /cprod cGH pprodE ?cents_norm. Qed. Lemma cprodEY G H : H \subset 'C(G) -> G \* H = G <*> H. Proof. by move=> cGH; rewrite cprodE ?cent_joinEr. Qed. Lemma cprodWpp A B G : A \* B = G -> pprod A B = G. Proof. by case/cprodP=> [[K H -> ->] <- /cents_norm/pprodE]. Qed. Lemma cprodW A B G : A \* B = G -> A * B = G. Proof. by move/cprodWpp/pprodW. Qed. Lemma cprodWC A B G : A \* B = G -> B * A = G. Proof. by move/cprodWpp/pprodWC. Qed. Lemma cprodWY A B G : A \* B = G -> A <*> B = G. Proof. by move/cprodWpp/pprodWY. Qed. Lemma cprodJ A B x : (A \* B) :^ x = A :^ x \* B :^ x. Proof. by rewrite /cprod centJ conjSg -pprodJ; case: ifP => _ //; apply: imset0. Qed. Lemma cprod_normal2 A B G : A \* B = G -> A <| G /\ B <| G. Proof. case/cprodP=> [[K H -> ->] <- cKH]; rewrite -cent_joinEr //. by rewrite normalYl normalYr !cents_norm // centsC. Qed. Lemma bigcprodW I (r : seq I) P F G : \big[cprod/1]_(i <- r | P i) F i = G -> \prod_(i <- r | P i) F i = G. Proof. elim/big_rec2: _ G => // i A B _ IH G /cprodP[[_ H _ defB] <- _]. by rewrite (IH H) defB. Qed. Lemma bigcprodWY I (r : seq I) P F G : \big[cprod/1]_(i <- r | P i) F i = G -> << \bigcup_(i <- r | P i) F i >> = G. Proof. elim/big_rec2: _ G => [|i A B _ IH G]; first by rewrite gen0. case/cprodP => [[K H -> defB] <- cKH]. by rewrite -[<<_>>]joing_idr (IH H) ?cent_joinEr -?defB. Qed. Lemma triv_cprod A B : (A \* B == 1) = (A == 1) && (B == 1). Proof. case A1: (A == 1); first by rewrite (eqP A1) cprod1g. apply/eqP=> /cprodP[[G H defA ->]] /eqP. by rewrite defA trivMg -defA A1. Qed. Lemma cprod_ntriv A B : A != 1 -> B != 1 -> A \* B = if [&& group_set A, group_set B & B \subset 'C(A)] then A * B else set0. Proof. move=> A1 B1; rewrite /cprod; case: ifP => cAB; rewrite ?cAB ?andbF //=. by rewrite /pprod -if_neg A1 -if_neg B1 cents_norm. Qed. Lemma trivg0 : (@set0 gT == 1) = false. Proof. by rewrite eqEcard cards0 cards1 andbF. Qed. Lemma group0 : group_set (@set0 gT) = false. Proof. by rewrite /group_set inE. Qed. Lemma cprod0g A : set0 \* A = set0. Proof. by rewrite /cprod centsC sub0set /pprod group0 trivg0 !if_same. Qed. Lemma cprodC : commutative cprod. Proof. rewrite /cprod => A B; case: ifP => cAB; rewrite centsC cAB // /pprod. by rewrite andbCA normC !cents_norm // 1?centsC //; do 2!case: eqP => // ->. Qed. Lemma cprodA : associative cprod. Proof. move=> A B C; case A1: (A == 1); first by rewrite (eqP A1) !cprod1g. case B1: (B == 1); first by rewrite (eqP B1) cprod1g cprodg1. case C1: (C == 1); first by rewrite (eqP C1) !cprodg1. rewrite !(triv_cprod, cprod_ntriv) ?{}A1 ?{}B1 ?{}C1 //. case: isgroupP => [[G ->{A}] | _]; last by rewrite group0. case: (isgroupP B) => [[H ->{B}] | _]; last by rewrite group0. case: (isgroupP C) => [[K ->{C}] | _]; last by rewrite group0 !andbF. case cGH: (H \subset 'C(G)); case cHK: (K \subset 'C(H)); last first. - by rewrite group0. - by rewrite group0 /= mulG_subG cGH andbF. - by rewrite group0 /= centM subsetI cHK !andbF. rewrite /= mulgA mulG_subG centM subsetI cGH cHK andbT -(cent_joinEr cHK). by rewrite -(cent_joinEr cGH) !groupP. Qed. Canonical cprod_law := Monoid.Law cprodA cprod1g cprodg1. Canonical cprod_abelaw := Monoid.ComLaw cprodC. Lemma cprod_modl A B G H : A \* B = G -> A \subset H -> A \* (B :&: H) = G :&: H. Proof. case/cprodP=> [[U V -> -> {A B}]] defG cUV sUH. by rewrite cprodE; [rewrite group_modl ?defG | rewrite subIset ?cUV]. Qed. Lemma cprod_modr A B G H : A \* B = G -> B \subset H -> (H :&: A) \* B = H :&: G. Proof. by rewrite -!(cprodC B) !(setIC H); apply: cprod_modl. Qed. Lemma bigcprodYP (I : finType) (P : pred I) (H : I -> {group gT}) : reflect (forall i j, P i -> P j -> i != j -> H i \subset 'C(H j)) (\big[cprod/1]_(i | P i) H i == (\prod_(i | P i) H i)%G). Proof. apply: (iffP eqP) => [defG i j Pi Pj neq_ij | cHH]. rewrite (bigD1 j) // (bigD1 i) /= ?cprodA in defG; last exact/andP. by case/cprodP: defG => [[K _ /cprodP[//]]]. set Q := P; have sQP: subpred Q P by []; have [n leQn] := ubnP #|Q|. elim: n => // n IHn in (Q) leQn sQP *. have [i Qi | Q0] := pickP Q; last by rewrite !big_pred0. rewrite (cardD1x Qi) add1n ltnS !(bigD1 i Qi) /= in leQn *. rewrite {}IHn {n leQn}// => [|j /andP[/sQP //]]. rewrite bigprodGE cprodEY // gen_subG; apply/bigcupsP=> j /andP[neq_ji Qj]. by rewrite cHH ?sQP. Qed. Lemma bigcprodEY I r (P : pred I) (H : I -> {group gT}) G : abelian G -> (forall i, P i -> H i \subset G) -> \big[cprod/1]_(i <- r | P i) H i = (\prod_(i <- r | P i) H i)%G. Proof. move=> cGG sHG; apply/eqP; rewrite !(big_tnth _ _ r). by apply/bigcprodYP=> i j Pi Pj _; rewrite (sub_abelian_cent2 cGG) ?sHG. Qed. Lemma perm_bigcprod (I : eqType) r1 r2 (A : I -> {set gT}) G x : \big[cprod/1]_(i <- r1) A i = G -> {in r1, forall i, x i \in A i} -> perm_eq r1 r2 -> \prod_(i <- r1) x i = \prod_(i <- r2) x i. Proof. elim: r1 r2 G => [|i r1 IHr] r2 G defG Ax eq_r12. by rewrite perm_sym in eq_r12; rewrite (perm_small_eq _ eq_r12) ?big_nil. have /rot_to[n r3 Dr2]: i \in r2 by rewrite -(perm_mem eq_r12) mem_head. transitivity (\prod_(j <- rot n r2) x j). rewrite Dr2 !big_cons in defG Ax *; have [[_ G1 _ defG1] _ _] := cprodP defG. rewrite (IHr r3 G1) //; first by case/allP/andP: Ax => _ /allP. by rewrite -(perm_cons i) -Dr2 perm_sym perm_rot perm_sym. rewrite -(cat_take_drop n r2) [in LHS]cat_take_drop in eq_r12 *. rewrite (perm_big _ eq_r12) !big_cat /= !(big_nth i) !big_mkord in defG *. have /cprodP[[G1 G2 defG1 defG2] _ /centsP-> //] := defG. rewrite defG2 -(bigcprodW defG2) mem_prodg // => k _; apply: Ax. by rewrite (perm_mem eq_r12) mem_cat orbC mem_nth. rewrite defG1 -(bigcprodW defG1) mem_prodg // => k _; apply: Ax. by rewrite (perm_mem eq_r12) mem_cat mem_nth. Qed. Lemma reindex_bigcprod (I J : finType) (h : J -> I) P (A : I -> {set gT}) G x : {on SimplPred P, bijective h} -> \big[cprod/1]_(i | P i) A i = G -> {in SimplPred P, forall i, x i \in A i} -> \prod_(i | P i) x i = \prod_(j | P (h j)) x (h j). Proof. case=> h1 hK h1K defG Ax; have [e big_e [Ue mem_e] _] := big_enumP P. rewrite -!big_e in defG *; rewrite -(big_map h P x) -[RHS]big_filter filter_map. apply: perm_bigcprod defG _ _ => [i|]; first by rewrite mem_e => /Ax. have [r _ [Ur /= mem_r] _] := big_enumP; apply: uniq_perm Ue _ _ => [|i]. by rewrite map_inj_in_uniq // => i j; rewrite !mem_r ; apply: (can_in_inj hK). rewrite mem_e; apply/idP/mapP=> [Pi|[j r_j ->]]; last by rewrite -mem_r. by exists (h1 i); rewrite ?mem_r h1K. Qed. (* Direct product *) Lemma dprod1g : left_id 1 dprod. Proof. by move=> A; rewrite /dprod subsetIl cprod1g. Qed. Lemma dprodg1 : right_id 1 dprod. Proof. by move=> A; rewrite /dprod subsetIr cprodg1. Qed. Lemma dprodP A B G : A \x B = G -> [/\ are_groups A B, A * B = G, B \subset 'C(A) & A :&: B = 1]. Proof. rewrite /dprod; case: ifP => trAB; last by case/group_not0. by case/cprodP=> gAB; split=> //; case: gAB trAB => ? ? -> -> /trivgP. Qed. Lemma dprodE G H : H \subset 'C(G) -> G :&: H = 1 -> G \x H = G * H. Proof. by move=> cGH trGH; rewrite /dprod trGH sub1G cprodE. Qed. Lemma dprodEY G H : H \subset 'C(G) -> G :&: H = 1 -> G \x H = G <*> H. Proof. by move=> cGH trGH; rewrite /dprod trGH subxx cprodEY. Qed. Lemma dprodEcp A B : A :&: B = 1 -> A \x B = A \* B. Proof. by move=> trAB; rewrite /dprod trAB subxx. Qed. Lemma dprodEsd A B : B \subset 'C(A) -> A \x B = A ><| B. Proof. by rewrite /dprod /cprod => ->. Qed. Lemma dprodWcp A B G : A \x B = G -> A \* B = G. Proof. by move=> defG; have [_ _ _ /dprodEcp <-] := dprodP defG. Qed. Lemma dprodWsd A B G : A \x B = G -> A ><| B = G. Proof. by move=> defG; have [_ _ /dprodEsd <-] := dprodP defG. Qed. Lemma dprodW A B G : A \x B = G -> A * B = G. Proof. by move/dprodWsd/sdprodW. Qed. Lemma dprodWC A B G : A \x B = G -> B * A = G. Proof. by move/dprodWsd/sdprodWC. Qed. Lemma dprodWY A B G : A \x B = G -> A <*> B = G. Proof. by move/dprodWsd/sdprodWY. Qed. Lemma cprod_card_dprod G A B : A \* B = G -> #|A| * #|B| <= #|G| -> A \x B = G. Proof. by case/cprodP=> [[K H -> ->] <- cKH] /cardMg_TI; apply: dprodE. Qed. Lemma dprodJ A B x : (A \x B) :^ x = A :^ x \x B :^ x. Proof. rewrite /dprod -conjIg sub_conjg conjs1g -cprodJ. by case: ifP => _ //; apply: imset0. Qed. Lemma dprod_normal2 A B G : A \x B = G -> A <| G /\ B <| G. Proof. by move/dprodWcp/cprod_normal2. Qed. Lemma dprodYP K H : reflect (K \x H = K <*> H) (H \subset 'C(K) :\: K^#). Proof. rewrite subsetD -setI_eq0 setIDA setD_eq0 setIC subG1 /=. by apply: (iffP andP) => [[cKH /eqP/dprodEY->] | /dprodP[_ _ -> ->]]. Qed. Lemma dprodC : commutative dprod. Proof. by move=> A B; rewrite /dprod setIC cprodC. Qed. Lemma dprodWsdC A B G : A \x B = G -> B ><| A = G. Proof. by rewrite dprodC => /dprodWsd. Qed. Lemma dprodA : associative dprod. Proof. move=> A B C; case A1: (A == 1); first by rewrite (eqP A1) !dprod1g. case B1: (B == 1); first by rewrite (eqP B1) dprod1g dprodg1. case C1: (C == 1); first by rewrite (eqP C1) !dprodg1. rewrite /dprod (fun_if (cprod A)) (fun_if (cprod^~ C)) -cprodA. rewrite -(cprodC set0) !cprod0g cprod_ntriv ?B1 ?{}C1 //. case: and3P B1 => [[] | _ _]; last by rewrite cprodC cprod0g !if_same. case/isgroupP=> H ->; case/isgroupP=> K -> {B C}; move/cent_joinEr=> eHK H1. rewrite cprod_ntriv ?trivMg ?{}A1 ?{}H1 // mulG_subG. case: and4P => [[] | _]; last by rewrite !if_same. case/isgroupP=> G ->{A} _ cGH _; rewrite cprodEY // -eHK. case trGH: (G :&: H \subset _); case trHK: (H :&: K \subset _); last first. - by rewrite !if_same. - rewrite if_same; case: ifP => // trG_HK; case/negP: trGH. by apply: subset_trans trG_HK; rewrite setIS ?joing_subl. - rewrite if_same; case: ifP => // trGH_K; case/negP: trHK. by apply: subset_trans trGH_K; rewrite setSI ?joing_subr. do 2![case: ifP] => // trGH_K trG_HK; [case/negP: trGH_K | case/negP: trG_HK]. apply: subset_trans trHK; rewrite subsetI subsetIr -{2}(mulg1 H) -mulGS. rewrite setIC group_modl ?joing_subr //= cent_joinEr // -eHK. by rewrite -group_modr ?joing_subl //= setIC -(normC (sub1G _)) mulSg. apply: subset_trans trGH; rewrite subsetI subsetIl -{2}(mul1g H) -mulSG. rewrite setIC group_modr ?joing_subl //= eHK -(cent_joinEr cGH). by rewrite -group_modl ?joing_subr //= setIC (normC (sub1G _)) mulgS. Qed. Canonical dprod_law := Monoid.Law dprodA dprod1g dprodg1. Canonical dprod_abelaw := Monoid.ComLaw dprodC. Lemma bigdprodWcp I (r : seq I) P F G : \big[dprod/1]_(i <- r | P i) F i = G -> \big[cprod/1]_(i <- r | P i) F i = G. Proof. elim/big_rec2: _ G => // i A B _ IH G /dprodP[[K H -> defB] <- cKH _]. by rewrite (IH H) // cprodE -defB. Qed. Lemma bigdprodW I (r : seq I) P F G : \big[dprod/1]_(i <- r | P i) F i = G -> \prod_(i <- r | P i) F i = G. Proof. by move/bigdprodWcp; apply: bigcprodW. Qed. Lemma bigdprodWY I (r : seq I) P F G : \big[dprod/1]_(i <- r | P i) F i = G -> << \bigcup_(i <- r | P i) F i >> = G. Proof. by move/bigdprodWcp; apply: bigcprodWY. Qed. Lemma bigdprodYP (I : finType) (P : pred I) (F : I -> {group gT}) : reflect (forall i, P i -> (\prod_(j | P j && (j != i)) F j)%G \subset 'C(F i) :\: (F i)^#) (\big[dprod/1]_(i | P i) F i == (\prod_(i | P i) F i)%G). Proof. apply: (iffP eqP) => [defG i Pi | dxG]. rewrite !(bigD1 i Pi) /= in defG; have [[_ G' _ defG'] _ _ _] := dprodP defG. by apply/dprodYP; rewrite -defG defG' bigprodGE (bigdprodWY defG'). set Q := P; have sQP: subpred Q P by []; have [n leQn] := ubnP #|Q|. elim: n => // n IHn in (Q) leQn sQP *. have [i Qi | Q0] := pickP Q; last by rewrite !big_pred0. rewrite (cardD1x Qi) add1n ltnS !(bigD1 i Qi) /= in leQn *. rewrite {}IHn {n leQn}// => [|j /andP[/sQP //]]. apply/dprodYP; apply: subset_trans (dxG i (sQP i Qi)); rewrite !bigprodGE. by apply: genS; apply/bigcupsP=> j /andP[Qj ne_ji]; rewrite (bigcup_max j) ?sQP. Qed. Lemma dprod_modl A B G H : A \x B = G -> A \subset H -> A \x (B :&: H) = G :&: H. Proof. case/dprodP=> [[U V -> -> {A B}]] defG cUV trUV sUH. rewrite dprodEcp; first by apply: cprod_modl; rewrite ?cprodE. by rewrite setIA trUV (setIidPl _) ?sub1G. Qed. Lemma dprod_modr A B G H : A \x B = G -> B \subset H -> (H :&: A) \x B = H :&: G. Proof. by rewrite -!(dprodC B) !(setIC H); apply: dprod_modl. Qed. Lemma subcent_dprod B C G A : B \x C = G -> A \subset 'N(B) :&: 'N(C) -> 'C_B(A) \x 'C_C(A) = 'C_G(A). Proof. move=> defG; have [_ _ cBC _] := dprodP defG; move: defG. by rewrite !dprodEsd 1?(centSS _ _ cBC) ?subsetIl //; apply: subcent_sdprod. Qed. Lemma dprod_card A B G : A \x B = G -> (#|A| * #|B|)%N = #|G|. Proof. by case/dprodP=> [[H K -> ->] <- _]; move/TI_cardMg. Qed. Lemma bigdprod_card I r (P : pred I) E G : \big[dprod/1]_(i <- r | P i) E i = G -> (\prod_(i <- r | P i) #|E i|)%N = #|G|. Proof. elim/big_rec2: _ G => [G <- | i A B _ IH G defG]; first by rewrite cards1. have [[_ H _ defH] _ _ _] := dprodP defG. by rewrite -(dprod_card defG) (IH H) defH. Qed. Lemma bigcprod_card_dprod I r (P : pred I) (A : I -> {set gT}) G : \big[cprod/1]_(i <- r | P i) A i = G -> \prod_(i <- r | P i) #|A i| <= #|G| -> \big[dprod/1]_(i <- r | P i) A i = G. Proof. elim: r G => [|i r IHr]; rewrite !(big_nil, big_cons) //; case: ifP => _ // G. case/cprodP=> [[K H -> defH]]; rewrite defH => <- cKH leKH_G. have /implyP := leq_trans leKH_G (dvdn_leq _ (dvdn_cardMg K H)). rewrite muln_gt0 leq_pmul2l !cardG_gt0 //= => /(IHr H defH){}defH. by rewrite defH dprodE // cardMg_TI // -(bigdprod_card defH). Qed. Lemma bigcprod_coprime_dprod (I : finType) (P : pred I) (A : I -> {set gT}) G : \big[cprod/1]_(i | P i) A i = G -> (forall i j, P i -> P j -> i != j -> coprime #|A i| #|A j|) -> \big[dprod/1]_(i | P i) A i = G. Proof. move=> defG coA; set Q := P in defG *; have sQP: subpred Q P by []. have [m leQm] := ubnP #|Q|; elim: m => // m IHm in (Q) leQm G defG sQP *. have [i Qi | Q0] := pickP Q; last by rewrite !big_pred0 in defG *. move: defG; rewrite !(bigD1 i Qi) /= => /cprodP[[Hi Gi defAi defGi] <-]. rewrite defAi defGi => cHGi. have{} defGi: \big[dprod/1]_(j | Q j && (j != i)) A j = Gi. by apply: IHm => [||j /andP[/sQP]] //; rewrite (cardD1x Qi) in leQm. rewrite defGi dprodE // coprime_TIg // -defAi -(bigdprod_card defGi). elim/big_rec: _ => [|j n /andP[neq_ji Qj] IHn]; first exact: coprimen1. by rewrite coprimeMr coprime_sym coA ?sQP. Qed. Lemma mem_dprod G A B x : A \x B = G -> x \in G -> exists y, exists z, [/\ y \in A, z \in B, x = y * z & {in A & B, forall u t, x = u * t -> u = y /\ t = z}]. Proof. move=> defG; have [_ _ cBA _] := dprodP defG. by apply: mem_sdprod; rewrite -dprodEsd. Qed. Lemma mem_bigdprod (I : finType) (P : pred I) F G x : \big[dprod/1]_(i | P i) F i = G -> x \in G -> exists c, [/\ forall i, P i -> c i \in F i, x = \prod_(i | P i) c i & forall e, (forall i, P i -> e i \in F i) -> x = \prod_(i | P i) e i -> forall i, P i -> e i = c i]. Proof. move=> defG; rewrite -(bigdprodW defG) => /prodsgP[c Fc ->]. have [r big_r [_ mem_r] _] := big_enumP P. exists c; split=> // e Fe eq_ce i Pi; rewrite -!{}big_r in defG eq_ce. have{Pi}: i \in r by rewrite mem_r. have{mem_r}: all P r by apply/allP=> j; rewrite mem_r. elim: r G defG eq_ce => // j r IHr G. rewrite !big_cons inE /= => /dprodP[[K H defK defH] _ _]. rewrite defK defH => tiFjH eq_ce /andP[Pj Pr]. suffices{i IHr} eq_cej: c j = e j. case/predU1P=> [-> //|]; apply: IHr defH _ Pr. by apply: (mulgI (c j)); rewrite eq_ce eq_cej. rewrite !(big_nth j) !big_mkord in defH eq_ce. move/(congr1 (divgr K H)): eq_ce; move/bigdprodW: defH => defH. move/(all_nthP j) in Pr. by rewrite !divgrMid // -?defK -?defH ?mem_prodg // => *; rewrite ?Fc ?Fe ?Pr. Qed. End InternalProd. Arguments complP {gT H A B}. Arguments splitsP {gT B A}. Arguments sdprod_normal_complP {gT G K H}. Arguments dprodYP {gT K H}. Arguments bigdprodYP {gT I P F}. Section MorphimInternalProd. Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Section OneProd. Variables G H K : {group gT}. Hypothesis sGD : G \subset D. Lemma morphim_pprod : pprod K H = G -> pprod (f @* K) (f @* H) = f @* G. Proof. case/pprodP=> _ defG mKH; rewrite pprodE ?morphim_norms //. by rewrite -morphimMl ?(subset_trans _ sGD) -?defG // mulG_subl. Qed. Lemma morphim_coprime_sdprod : K ><| H = G -> coprime #|K| #|H| -> f @* K ><| f @* H = f @* G. Proof. rewrite /sdprod => defG coHK; move: defG. by rewrite !coprime_TIg ?coprime_morph // !subxx; apply: morphim_pprod. Qed. Lemma injm_sdprod : 'injm f -> K ><| H = G -> f @* K ><| f @* H = f @* G. Proof. move=> inj_f; case/sdprodP=> _ defG nKH tiKH. by rewrite /sdprod -injmI // tiKH morphim1 subxx morphim_pprod // pprodE. Qed. Lemma morphim_cprod : K \* H = G -> f @* K \* f @* H = f @* G. Proof. case/cprodP=> _ defG cKH; rewrite /cprod morphim_cents // morphim_pprod //. by rewrite pprodE // cents_norm // centsC. Qed. Lemma injm_dprod : 'injm f -> K \x H = G -> f @* K \x f @* H = f @* G. Proof. move=> inj_f; case/dprodP=> _ defG cHK tiKH. by rewrite /dprod -injmI // tiKH morphim1 subxx morphim_cprod // cprodE. Qed. Lemma morphim_coprime_dprod : K \x H = G -> coprime #|K| #|H| -> f @* K \x f @* H = f @* G. Proof. rewrite /dprod => defG coHK; move: defG. by rewrite !coprime_TIg ?coprime_morph // !subxx; apply: morphim_cprod. Qed. End OneProd. Implicit Type G : {group gT}. Lemma morphim_bigcprod I r (P : pred I) (H : I -> {group gT}) G : G \subset D -> \big[cprod/1]_(i <- r | P i) H i = G -> \big[cprod/1]_(i <- r | P i) f @* H i = f @* G. Proof. elim/big_rec2: _ G => [|i fB B Pi def_fB] G sGD defG. by rewrite -defG morphim1. case/cprodP: defG (defG) => [[Hi Gi -> defB] _ _]; rewrite defB => defG. rewrite (def_fB Gi) //; first exact: morphim_cprod. by apply: subset_trans sGD; case/cprod_normal2: defG => _ /andP[]. Qed. Lemma injm_bigdprod I r (P : pred I) (H : I -> {group gT}) G : G \subset D -> 'injm f -> \big[dprod/1]_(i <- r | P i) H i = G -> \big[dprod/1]_(i <- r | P i) f @* H i = f @* G. Proof. move=> sGD injf; elim/big_rec2: _ G sGD => [|i fB B Pi def_fB] G sGD defG. by rewrite -defG morphim1. case/dprodP: defG (defG) => [[Hi Gi -> defB] _ _ _]; rewrite defB => defG. rewrite (def_fB Gi) //; first exact: injm_dprod. by apply: subset_trans sGD; case/dprod_normal2: defG => _ /andP[]. Qed. Lemma morphim_coprime_bigdprod (I : finType) P (H : I -> {group gT}) G : G \subset D -> \big[dprod/1]_(i | P i) H i = G -> (forall i j, P i -> P j -> i != j -> coprime #|H i| #|H j|) -> \big[dprod/1]_(i | P i) f @* H i = f @* G. Proof. move=> sGD /bigdprodWcp defG coH; have def_fG := morphim_bigcprod sGD defG. by apply: bigcprod_coprime_dprod => // i j *; rewrite coprime_morph ?coH. Qed. End MorphimInternalProd. Section QuotientInternalProd. Variables (gT : finGroupType) (G K H M : {group gT}). Hypothesis nMG: G \subset 'N(M). Lemma quotient_pprod : pprod K H = G -> pprod (K / M) (H / M) = G / M. Proof. exact: morphim_pprod. Qed. Lemma quotient_coprime_sdprod : K ><| H = G -> coprime #|K| #|H| -> (K / M) ><| (H / M) = G / M. Proof. exact: morphim_coprime_sdprod. Qed. Lemma quotient_cprod : K \* H = G -> (K / M) \* (H / M) = G / M. Proof. exact: morphim_cprod. Qed. Lemma quotient_coprime_dprod : K \x H = G -> coprime #|K| #|H| -> (K / M) \x (H / M) = G / M. Proof. exact: morphim_coprime_dprod. Qed. End QuotientInternalProd. Section ExternalDirProd. Variables gT1 gT2 : finGroupType. Definition extprod_mulg (x y : gT1 * gT2) := (x.1 * y.1, x.2 * y.2). Definition extprod_invg (x : gT1 * gT2) := (x.1^-1, x.2^-1). Lemma extprod_mul1g : left_id (1, 1) extprod_mulg. Proof. by case=> x1 x2; congr (_, _); apply: mul1g. Qed. Lemma extprod_mulVg : left_inverse (1, 1) extprod_invg extprod_mulg. Proof. by move=> x; congr (_, _); apply: mulVg. Qed. Lemma extprod_mulgA : associative extprod_mulg. Proof. by move=> x y z; congr (_, _); apply: mulgA. Qed. Definition extprod_groupMixin := Eval hnf in FinGroup.Mixin extprod_mulgA extprod_mul1g extprod_mulVg. Canonical extprod_baseFinGroupType := Eval hnf in BaseFinGroupType (gT1 * gT2) extprod_groupMixin. Canonical prod_group := FinGroupType extprod_mulVg. Lemma group_setX (H1 : {group gT1}) (H2 : {group gT2}) : group_set (setX H1 H2). Proof. apply/group_setP; split; first by rewrite inE !group1. case=> [x1 x2] [y1 y2]; rewrite !inE; case/andP=> Hx1 Hx2; case/andP=> Hy1 Hy2. by rewrite /= !groupM. Qed. Canonical setX_group H1 H2 := Group (group_setX H1 H2). Definition pairg1 x : gT1 * gT2 := (x, 1). Definition pair1g x : gT1 * gT2 := (1, x). Lemma pairg1_morphM : {morph pairg1 : x y / x * y}. Proof. by move=> x y /=; rewrite {2}/mulg /= /extprod_mulg /= mul1g. Qed. Canonical pairg1_morphism := @Morphism _ _ setT _ (in2W pairg1_morphM). Lemma pair1g_morphM : {morph pair1g : x y / x * y}. Proof. by move=> x y /=; rewrite {2}/mulg /= /extprod_mulg /= mul1g. Qed. Canonical pair1g_morphism := @Morphism _ _ setT _ (in2W pair1g_morphM). Lemma fst_morphM : {morph (@fst gT1 gT2) : x y / x * y}. Proof. by move=> x y. Qed. Lemma snd_morphM : {morph (@snd gT1 gT2) : x y / x * y}. Proof. by move=> x y. Qed. Canonical fst_morphism := @Morphism _ _ setT _ (in2W fst_morphM). Canonical snd_morphism := @Morphism _ _ setT _ (in2W snd_morphM). Lemma injm_pair1g : 'injm pair1g. Proof. by apply/subsetP=> x /morphpreP[_ /set1P[->]]; apply: set11. Qed. Lemma injm_pairg1 : 'injm pairg1. Proof. by apply/subsetP=> x /morphpreP[_ /set1P[->]]; apply: set11. Qed. Lemma morphim_pairg1 (H1 : {set gT1}) : pairg1 @* H1 = setX H1 1. Proof. by rewrite -imset2_pair imset2_set1r morphimEsub ?subsetT. Qed. Lemma morphim_pair1g (H2 : {set gT2}) : pair1g @* H2 = setX 1 H2. Proof. by rewrite -imset2_pair imset2_set1l morphimEsub ?subsetT. Qed. Lemma morphim_fstX (H1: {set gT1}) (H2 : {group gT2}) : [morphism of fun x => x.1] @* setX H1 H2 = H1. Proof. apply/eqP; rewrite eqEsubset morphimE setTI /=. apply/andP; split; apply/subsetP=> x. by case/imsetP=> x0; rewrite inE; move/andP=> [Hx1 _] ->. move=> Hx1; apply/imsetP; exists (x, 1); last by trivial. by rewrite in_setX Hx1 /=. Qed. Lemma morphim_sndX (H1: {group gT1}) (H2 : {set gT2}) : [morphism of fun x => x.2] @* setX H1 H2 = H2. Proof. apply/eqP; rewrite eqEsubset morphimE setTI /=. apply/andP; split; apply/subsetP=> x. by case/imsetP=> x0; rewrite inE; move/andP=> [_ Hx2] ->. move=> Hx2; apply/imsetP; exists (1, x); last by []. by rewrite in_setX Hx2 andbT. Qed. Lemma setX_prod (H1 : {set gT1}) (H2 : {set gT2}) : setX H1 1 * setX 1 H2 = setX H1 H2. Proof. apply/setP=> [[x y]]; rewrite !inE /=. apply/imset2P/andP=> [[[x1 u1] [v1 y1]] | [Hx Hy]]. rewrite !inE /= => /andP[Hx1 /eqP->] /andP[/eqP-> Hx] [-> ->]. by rewrite mulg1 mul1g. exists (x, 1 : gT2) (1 : gT1, y); rewrite ?inE ?Hx ?eqxx //. by rewrite /mulg /= /extprod_mulg /= mulg1 mul1g. Qed. Lemma setX_dprod (H1 : {group gT1}) (H2 : {group gT2}) : setX H1 1 \x setX 1 H2 = setX H1 H2. Proof. rewrite dprodE ?setX_prod //. apply/centsP=> [[x u]]; rewrite !inE /= => /andP[/eqP-> _] [v y]. by rewrite !inE /= => /andP[_ /eqP->]; congr (_, _); rewrite ?mul1g ?mulg1. apply/trivgP; apply/subsetP=> [[x y]]; rewrite !inE /= -!andbA. by case/and4P=> _ /eqP-> /eqP->; rewrite eqxx. Qed. Lemma isog_setX1 (H1 : {group gT1}) : isog H1 (setX H1 1). Proof. apply/isogP; exists [morphism of restrm (subsetT H1) pairg1]. by rewrite injm_restrm ?injm_pairg1. by rewrite morphim_restrm morphim_pairg1 setIid. Qed. Lemma isog_set1X (H2 : {group gT2}) : isog H2 (setX 1 H2). Proof. apply/isogP; exists [morphism of restrm (subsetT H2) pair1g]. by rewrite injm_restrm ?injm_pair1g. by rewrite morphim_restrm morphim_pair1g setIid. Qed. Lemma setX_gen (H1 : {set gT1}) (H2 : {set gT2}) : 1 \in H1 -> 1 \in H2 -> <> = setX <

> <

>. Proof. move=> H1_1 H2_1; apply/eqP. rewrite eqEsubset gen_subG setXS ?subset_gen //. rewrite -setX_prod -morphim_pair1g -morphim_pairg1 !morphim_gen ?subsetT //. by rewrite morphim_pair1g morphim_pairg1 mul_subG // genS // setXS ?sub1set. Qed. End ExternalDirProd. Section ExternalSDirProd. Variables (aT rT : finGroupType) (D : {group aT}) (R : {group rT}). (* The pair (a, x) denotes the product sdpair2 a * sdpair1 x *) Inductive sdprod_by (to : groupAction D R) : predArgType := SdPair (ax : aT * rT) of ax \in setX D R. Coercion pair_of_sd to (u : sdprod_by to) := let: SdPair ax _ := u in ax. Variable to : groupAction D R. Notation sdT := (sdprod_by to). Notation sdval := (@pair_of_sd to). Canonical sdprod_subType := Eval hnf in [subType for sdval]. Definition sdprod_eqMixin := Eval hnf in [eqMixin of sdT by <:]. Canonical sdprod_eqType := Eval hnf in EqType sdT sdprod_eqMixin. Definition sdprod_choiceMixin := [choiceMixin of sdT by <:]. Canonical sdprod_choiceType := ChoiceType sdT sdprod_choiceMixin. Definition sdprod_countMixin := [countMixin of sdT by <:]. Canonical sdprod_countType := CountType sdT sdprod_countMixin. Canonical sdprod_subCountType := Eval hnf in [subCountType of sdT]. Definition sdprod_finMixin := [finMixin of sdT by <:]. Canonical sdprod_finType := FinType sdT sdprod_finMixin. Canonical sdprod_subFinType := Eval hnf in [subFinType of sdT]. Definition sdprod_one := SdPair to (group1 _). Lemma sdprod_inv_proof (u : sdT) : (u.1^-1, to u.2^-1 u.1^-1) \in setX D R. Proof. by case: u => [[a x]] /= /setXP[Da Rx]; rewrite inE gact_stable !groupV ?Da. Qed. Definition sdprod_inv u := SdPair to (sdprod_inv_proof u). Lemma sdprod_mul_proof (u v : sdT) : (u.1 * v.1, to u.2 v.1 * v.2) \in setX D R. Proof. case: u v => [[a x] /= /setXP[Da Rx]] [[b y] /= /setXP[Db Ry]]. by rewrite inE !groupM //= gact_stable. Qed. Definition sdprod_mul u v := SdPair to (sdprod_mul_proof u v). Lemma sdprod_mul1g : left_id sdprod_one sdprod_mul. Proof. move=> u; apply: val_inj; case: u => [[a x] /=]; case/setXP=> Da _. by rewrite gact1 // !mul1g. Qed. Lemma sdprod_mulVg : left_inverse sdprod_one sdprod_inv sdprod_mul. Proof. move=> u; apply: val_inj; case: u => [[a x] /=]; case/setXP=> Da _. by rewrite actKVin ?mulVg. Qed. Lemma sdprod_mulgA : associative sdprod_mul. Proof. move=> u v w; apply: val_inj; case: u => [[a x]] /=; case/setXP=> Da Rx. case: v w => [[b y]] /=; case/setXP=> Db Ry [[c z]] /=; case/setXP=> Dc Rz. by rewrite !(actMin to) // gactM ?gact_stable // !mulgA. Qed. Canonical sdprod_groupMixin := FinGroup.Mixin sdprod_mulgA sdprod_mul1g sdprod_mulVg. Canonical sdprod_baseFinGroupType := Eval hnf in BaseFinGroupType sdT sdprod_groupMixin. Canonical sdprod_groupType := FinGroupType sdprod_mulVg. Definition sdpair1 x := insubd sdprod_one (1, x) : sdT. Definition sdpair2 a := insubd sdprod_one (a, 1) : sdT. Lemma sdpair1_morphM : {in R &, {morph sdpair1 : x y / x * y}}. Proof. move=> x y Rx Ry; apply: val_inj. by rewrite /= !val_insubd !inE !group1 !groupM ?Rx ?Ry //= mulg1 act1. Qed. Lemma sdpair2_morphM : {in D &, {morph sdpair2 : a b / a * b}}. Proof. move=> a b Da Db; apply: val_inj. by rewrite /= !val_insubd !inE !group1 !groupM ?Da ?Db //= mulg1 gact1. Qed. Canonical sdpair1_morphism := Morphism sdpair1_morphM. Canonical sdpair2_morphism := Morphism sdpair2_morphM. Lemma injm_sdpair1 : 'injm sdpair1. Proof. apply/subsetP=> x /setIP[Rx]. by rewrite !inE -val_eqE val_insubd inE Rx group1 /=; case/andP. Qed. Lemma injm_sdpair2 : 'injm sdpair2. Proof. apply/subsetP=> a /setIP[Da]. by rewrite !inE -val_eqE val_insubd inE Da group1 /=; case/andP. Qed. Lemma sdpairE (u : sdT) : u = sdpair2 u.1 * sdpair1 u.2. Proof. apply: val_inj; case: u => [[a x] /= /setXP[Da Rx]]. by rewrite !val_insubd !inE Da Rx !(group1, gact1) // mulg1 mul1g. Qed. Lemma sdpair_act : {in R & D, forall x a, sdpair1 (to x a) = sdpair1 x ^ sdpair2 a}. Proof. move=> x a Rx Da; apply: val_inj. rewrite /= !val_insubd !inE !group1 gact_stable ?Da ?Rx //=. by rewrite !mul1g mulVg invg1 mulg1 actKVin ?mul1g. Qed. Lemma sdpair_setact (G : {set rT}) a : G \subset R -> a \in D -> sdpair1 @* (to^~ a @: G) = (sdpair1 @* G) :^ sdpair2 a. Proof. move=> sGR Da; have GtoR := subsetP sGR; apply/eqP. rewrite eqEcard cardJg !(card_injm injm_sdpair1) //; last first. by apply/subsetP=> _ /imsetP[x Gx ->]; rewrite gact_stable ?GtoR. rewrite (card_imset _ (act_inj _ _)) leqnn andbT. apply/subsetP=> _ /morphimP[xa Rxa /imsetP[x Gx def_xa ->]]. rewrite mem_conjg -morphV // -sdpair_act ?groupV // def_xa actKin //. by rewrite mem_morphim ?GtoR. Qed. Lemma im_sdpair_norm : sdpair2 @* D \subset 'N(sdpair1 @* R). Proof. apply/subsetP=> _ /morphimP[a _ Da ->]. rewrite inE -sdpair_setact // morphimS //. by apply/subsetP=> _ /imsetP[x Rx ->]; rewrite gact_stable. Qed. Lemma im_sdpair_TI : (sdpair1 @* R) :&: (sdpair2 @* D) = 1. Proof. apply/trivgP; apply/subsetP=> _ /setIP[/morphimP[x _ Rx ->]]. case/morphimP=> a _ Da /eqP; rewrite inE -!val_eqE. by rewrite !val_insubd !inE Da Rx !group1 /eq_op /= eqxx; case/andP. Qed. Lemma im_sdpair : (sdpair1 @* R) * (sdpair2 @* D) = setT. Proof. apply/eqP; rewrite -subTset -(normC im_sdpair_norm). apply/subsetP=> /= u _; rewrite [u]sdpairE. by case: u => [[a x] /= /setXP[Da Rx]]; rewrite mem_mulg ?mem_morphim. Qed. Lemma sdprod_sdpair : sdpair1 @* R ><| sdpair2 @* D = setT. Proof. by rewrite sdprodE ?(im_sdpair_norm, im_sdpair, im_sdpair_TI). Qed. Variables (A : {set aT}) (G : {set rT}). Lemma gacentEsd : 'C_(|to)(A) = sdpair1 @*^-1 'C(sdpair2 @* A). Proof. apply/setP=> x; apply/idP/idP. case/setIP=> Rx /afixP cDAx; rewrite mem_morphpre //. apply/centP=> _ /morphimP[a Da Aa ->]; red. by rewrite conjgC -sdpair_act // cDAx // inE Da. case/morphpreP=> Rx cAx; rewrite inE Rx; apply/afixP=> a /setIP[Da Aa]. apply: (injmP injm_sdpair1); rewrite ?gact_stable /= ?sdpair_act //=. by rewrite /conjg (centP cAx) ?mulKg ?mem_morphim. Qed. Hypotheses (sAD : A \subset D) (sGR : G \subset R). Lemma astabEsd : 'C(G | to) = sdpair2 @*^-1 'C(sdpair1 @* G). Proof. have ssGR := subsetP sGR; apply/setP=> a; apply/idP/idP=> [cGa|]. rewrite mem_morphpre ?(astab_dom cGa) //. apply/centP=> _ /morphimP[x Rx Gx ->]; symmetry. by rewrite conjgC -sdpair_act ?(astab_act cGa) ?(astab_dom cGa). case/morphpreP=> Da cGa; rewrite !inE Da; apply/subsetP=> x Gx; rewrite inE. apply/eqP; apply: (injmP injm_sdpair1); rewrite ?gact_stable ?ssGR //=. by rewrite sdpair_act ?ssGR // /conjg -(centP cGa) ?mulKg ?mem_morphim ?ssGR. Qed. Lemma astabsEsd : 'N(G | to) = sdpair2 @*^-1 'N(sdpair1 @* G). Proof. apply/setP=> a; apply/idP/idP=> [nGa|]. have Da := astabs_dom nGa; rewrite mem_morphpre // inE sub_conjg. apply/subsetP=> _ /morphimP[x Rx Gx ->]. by rewrite mem_conjgV -sdpair_act // mem_morphim ?gact_stable ?astabs_act. case/morphpreP=> Da nGa; rewrite !inE Da; apply/subsetP=> x Gx. have Rx := subsetP sGR _ Gx; have Rxa: to x a \in R by rewrite gact_stable. rewrite inE -sub1set -(injmSK injm_sdpair1) ?morphim_set1 ?sub1set //=. by rewrite sdpair_act ?memJ_norm ?mem_morphim. Qed. Lemma actsEsd : [acts A, on G | to] = (sdpair2 @* A \subset 'N(sdpair1 @* G)). Proof. by rewrite sub_morphim_pre -?astabsEsd. Qed. End ExternalSDirProd. Section ProdMorph. Variables gT rT : finGroupType. Implicit Types A B : {set gT}. Implicit Types G H K : {group gT}. Implicit Types C D : {set rT}. Implicit Type L : {group rT}. Section defs. Variables (A B : {set gT}) (fA fB : gT -> FinGroup.sort rT). Definition pprodm of B \subset 'N(A) & {in A & B, morph_act 'J 'J fA fB} & {in A :&: B, fA =1 fB} := fun x => fA (divgr A B x) * fB (remgr A B x). End defs. Section Props. Variables H K : {group gT}. Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis nHK : K \subset 'N(H). Hypothesis actf : {in H & K, morph_act 'J 'J fH fK}. Hypothesis eqfHK : {in H :&: K, fH =1 fK}. Local Notation f := (pprodm nHK actf eqfHK). Lemma pprodmE x a : x \in H -> a \in K -> f (x * a) = fH x * fK a. Proof. move=> Hx Ka; have: x * a \in H * K by rewrite mem_mulg. rewrite -remgrP inE /f rcoset_sym mem_rcoset /divgr -mulgA groupMl //. case/andP; move: (remgr H K _) => b Hab Kb; rewrite morphM // -mulgA. have Kab: a * b^-1 \in K by rewrite groupM ?groupV. by congr (_ * _); rewrite eqfHK 1?inE ?Hab // -morphM // mulgKV. Qed. Lemma pprodmEl : {in H, f =1 fH}. Proof. by move=> x Hx; rewrite -(mulg1 x) pprodmE // morph1 !mulg1. Qed. Lemma pprodmEr : {in K, f =1 fK}. Proof. by move=> a Ka; rewrite -(mul1g a) pprodmE // morph1 !mul1g. Qed. Lemma pprodmM : {in H <*> K &, {morph f: x y / x * y}}. Proof. move=> xa yb; rewrite norm_joinEr //. move=> /imset2P[x a Ha Ka ->{xa}] /imset2P[y b Hy Kb ->{yb}]. have Hya: y ^ a^-1 \in H by rewrite -mem_conjg (normsP nHK). rewrite mulgA -(mulgA x) (conjgCV a y) (mulgA x) -mulgA !pprodmE 1?groupMl //. by rewrite morphM // actf ?groupV ?morphV // morphM // !mulgA mulgKV invgK. Qed. Canonical pprodm_morphism := Morphism pprodmM. Lemma morphim_pprodm A B : A \subset H -> B \subset K -> f @* (A * B) = fH @* A * fK @* B. Proof. move=> sAH sBK; rewrite [f @* _]morphimEsub /=; last first. by rewrite norm_joinEr // mulgSS. apply/setP=> y; apply/imsetP/idP=> [[_ /mulsgP[x a Ax Ba ->] ->{y}] |]. have Hx := subsetP sAH x Ax; have Ka := subsetP sBK a Ba. by rewrite pprodmE // imset2_f ?mem_morphim. case/mulsgP=> _ _ /morphimP[x Hx Ax ->] /morphimP[a Ka Ba ->] ->{y}. by exists (x * a); rewrite ?mem_mulg ?pprodmE. Qed. Lemma morphim_pprodml A : A \subset H -> f @* A = fH @* A. Proof. by move=> sAH; rewrite -{1}(mulg1 A) morphim_pprodm ?sub1G // morphim1 mulg1. Qed. Lemma morphim_pprodmr B : B \subset K -> f @* B = fK @* B. Proof. by move=> sBK; rewrite -{1}(mul1g B) morphim_pprodm ?sub1G // morphim1 mul1g. Qed. Lemma ker_pprodm : 'ker f = [set x * a^-1 | x in H, a in K & fH x == fK a]. Proof. apply/setP=> y; rewrite 3!inE {1}norm_joinEr //=. apply/andP/imset2P=> [[/mulsgP[x a Hx Ka ->{y}]]|[x a Hx]]. rewrite pprodmE // => fxa1. by exists x a^-1; rewrite ?invgK // inE groupVr ?morphV // eq_mulgV1 invgK. case/setIdP=> Kx /eqP fx ->{y}. by rewrite imset2_f ?pprodmE ?groupV ?morphV // fx mulgV. Qed. Lemma injm_pprodm : 'injm f = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == fH @* K]. Proof. apply/idP/and3P=> [injf | [injfH injfK]]. rewrite eq_sym -{1}morphimIdom -(morphim_pprodml (subsetIl _ _)) injmI //. rewrite morphim_pprodml // morphim_pprodmr //=; split=> //. apply/injmP=> x y Hx Hy /=; rewrite -!pprodmEl //. by apply: (injmP injf); rewrite ?mem_gen ?inE ?Hx ?Hy. apply/injmP=> a b Ka Kb /=; rewrite -!pprodmEr //. by apply: (injmP injf); rewrite ?mem_gen //; apply/setUP; right. move/eqP=> fHK; rewrite ker_pprodm; apply/subsetP=> y. case/imset2P=> x a Hx /setIdP[Ka /eqP fxa] ->. have: fH x \in fH @* K by rewrite -fHK inE {2}fxa !mem_morphim. case/morphimP=> z Hz Kz /(injmP injfH) def_x. rewrite def_x // eqfHK ?inE ?Hz // in fxa. by rewrite def_x // (injmP injfK _ _ Kz Ka fxa) mulgV set11. Qed. End Props. Section Sdprodm. Variables H K G : {group gT}. Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis eqHK_G : H ><| K = G. Hypothesis actf : {in H & K, morph_act 'J 'J fH fK}. Lemma sdprodm_norm : K \subset 'N(H). Proof. by case/sdprodP: eqHK_G. Qed. Lemma sdprodm_sub : G \subset H <*> K. Proof. by case/sdprodP: eqHK_G => _ <- nHK _; rewrite norm_joinEr. Qed. Lemma sdprodm_eqf : {in H :&: K, fH =1 fK}. Proof. by case/sdprodP: eqHK_G => _ _ _ -> _ /set1P->; rewrite !morph1. Qed. Definition sdprodm := restrm sdprodm_sub (pprodm sdprodm_norm actf sdprodm_eqf). Canonical sdprodm_morphism := Eval hnf in [morphism of sdprodm]. Lemma sdprodmE a b : a \in H -> b \in K -> sdprodm (a * b) = fH a * fK b. Proof. exact: pprodmE. Qed. Lemma sdprodmEl a : a \in H -> sdprodm a = fH a. Proof. exact: pprodmEl. Qed. Lemma sdprodmEr b : b \in K -> sdprodm b = fK b. Proof. exact: pprodmEr. Qed. Lemma morphim_sdprodm A B : A \subset H -> B \subset K -> sdprodm @* (A * B) = fH @* A * fK @* B. Proof. move=> sAH sBK; rewrite morphim_restrm /= (setIidPr _) ?morphim_pprodm //. by case/sdprodP: eqHK_G => _ <- _ _; apply: mulgSS. Qed. Lemma im_sdprodm : sdprodm @* G = fH @* H * fK @* K. Proof. by rewrite -morphim_sdprodm //; case/sdprodP: eqHK_G => _ ->. Qed. Lemma morphim_sdprodml A : A \subset H -> sdprodm @* A = fH @* A. Proof. by move=> sHA; rewrite -{1}(mulg1 A) morphim_sdprodm ?sub1G // morphim1 mulg1. Qed. Lemma morphim_sdprodmr B : B \subset K -> sdprodm @* B = fK @* B. Proof. by move=> sBK; rewrite -{1}(mul1g B) morphim_sdprodm ?sub1G // morphim1 mul1g. Qed. Lemma ker_sdprodm : 'ker sdprodm = [set a * b^-1 | a in H, b in K & fH a == fK b]. Proof. rewrite ker_restrm (setIidPr _) ?subIset ?ker_pprodm //; apply/orP; left. by case/sdprodP: eqHK_G => _ <- nHK _; rewrite norm_joinEr. Qed. Lemma injm_sdprodm : 'injm sdprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == 1]. Proof. rewrite ker_sdprodm -(ker_pprodm sdprodm_norm actf sdprodm_eqf) injm_pprodm. congr [&& _, _ & _ == _]; have [_ _ _ tiHK] := sdprodP eqHK_G. by rewrite -morphimIdom tiHK morphim1. Qed. End Sdprodm. Section Cprodm. Variables H K G : {group gT}. Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis eqHK_G : H \* K = G. Hypothesis cfHK : fK @* K \subset 'C(fH @* H). Hypothesis eqfHK : {in H :&: K, fH =1 fK}. Lemma cprodm_norm : K \subset 'N(H). Proof. by rewrite cents_norm //; case/cprodP: eqHK_G. Qed. Lemma cprodm_sub : G \subset H <*> K. Proof. by case/cprodP: eqHK_G => _ <- cHK; rewrite cent_joinEr. Qed. Lemma cprodm_actf : {in H & K, morph_act 'J 'J fH fK}. Proof. case/cprodP: eqHK_G => _ _ cHK a b Ha Kb /=. by rewrite /conjg -(centsP cHK b) // -(centsP cfHK (fK b)) ?mulKg ?mem_morphim. Qed. Definition cprodm := restrm cprodm_sub (pprodm cprodm_norm cprodm_actf eqfHK). Canonical cprodm_morphism := Eval hnf in [morphism of cprodm]. Lemma cprodmE a b : a \in H -> b \in K -> cprodm (a * b) = fH a * fK b. Proof. exact: pprodmE. Qed. Lemma cprodmEl a : a \in H -> cprodm a = fH a. Proof. exact: pprodmEl. Qed. Lemma cprodmEr b : b \in K -> cprodm b = fK b. Proof. exact: pprodmEr. Qed. Lemma morphim_cprodm A B : A \subset H -> B \subset K -> cprodm @* (A * B) = fH @* A * fK @* B. Proof. move=> sAH sBK; rewrite morphim_restrm /= (setIidPr _) ?morphim_pprodm //. by case/cprodP: eqHK_G => _ <- _; apply: mulgSS. Qed. Lemma im_cprodm : cprodm @* G = fH @* H * fK @* K. Proof. by have [_ defHK _] := cprodP eqHK_G; rewrite -{2}defHK morphim_cprodm. Qed. Lemma morphim_cprodml A : A \subset H -> cprodm @* A = fH @* A. Proof. by move=> sHA; rewrite -{1}(mulg1 A) morphim_cprodm ?sub1G // morphim1 mulg1. Qed. Lemma morphim_cprodmr B : B \subset K -> cprodm @* B = fK @* B. Proof. by move=> sBK; rewrite -{1}(mul1g B) morphim_cprodm ?sub1G // morphim1 mul1g. Qed. Lemma ker_cprodm : 'ker cprodm = [set a * b^-1 | a in H, b in K & fH a == fK b]. Proof. rewrite ker_restrm (setIidPr _) ?subIset ?ker_pprodm //; apply/orP; left. by case/cprodP: eqHK_G => _ <- cHK; rewrite cent_joinEr. Qed. Lemma injm_cprodm : 'injm cprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == fH @* K]. Proof. by rewrite ker_cprodm -(ker_pprodm cprodm_norm cprodm_actf eqfHK) injm_pprodm. Qed. End Cprodm. Section Dprodm. Variables G H K : {group gT}. Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis eqHK_G : H \x K = G. Hypothesis cfHK : fK @* K \subset 'C(fH @* H). Lemma dprodm_cprod : H \* K = G. Proof. by rewrite -eqHK_G /dprod; case/dprodP: eqHK_G => _ _ _ ->; rewrite subxx. Qed. Lemma dprodm_eqf : {in H :&: K, fH =1 fK}. Proof. by case/dprodP: eqHK_G => _ _ _ -> _ /set1P->; rewrite !morph1. Qed. Definition dprodm := cprodm dprodm_cprod cfHK dprodm_eqf. Canonical dprodm_morphism := Eval hnf in [morphism of dprodm]. Lemma dprodmE a b : a \in H -> b \in K -> dprodm (a * b) = fH a * fK b. Proof. exact: pprodmE. Qed. Lemma dprodmEl a : a \in H -> dprodm a = fH a. Proof. exact: pprodmEl. Qed. Lemma dprodmEr b : b \in K -> dprodm b = fK b. Proof. exact: pprodmEr. Qed. Lemma morphim_dprodm A B : A \subset H -> B \subset K -> dprodm @* (A * B) = fH @* A * fK @* B. Proof. exact: morphim_cprodm. Qed. Lemma im_dprodm : dprodm @* G = fH @* H * fK @* K. Proof. exact: im_cprodm. Qed. Lemma morphim_dprodml A : A \subset H -> dprodm @* A = fH @* A. Proof. exact: morphim_cprodml. Qed. Lemma morphim_dprodmr B : B \subset K -> dprodm @* B = fK @* B. Proof. exact: morphim_cprodmr. Qed. Lemma ker_dprodm : 'ker dprodm = [set a * b^-1 | a in H, b in K & fH a == fK b]. Proof. exact: ker_cprodm. Qed. Lemma injm_dprodm : 'injm dprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == 1]. Proof. rewrite injm_cprodm -(morphimIdom fH K). by case/dprodP: eqHK_G => _ _ _ ->; rewrite morphim1. Qed. End Dprodm. Lemma isog_dprod A B G C D L : A \x B = G -> C \x D = L -> isog A C -> isog B D -> isog G L. Proof. move=> defG {C D} /dprodP[[C D -> ->] defL cCD trCD]. case/dprodP: defG (defG) => {A B} [[A B -> ->] defG _ _] dG defC defD. case/isogP: defC defL cCD trCD => fA injfA <-{C}. case/isogP: defD => fB injfB <-{D} defL cCD trCD. apply/isogP; exists (dprodm_morphism dG cCD). by rewrite injm_dprodm injfA injfB trCD eqxx. by rewrite /= -{2}defG morphim_dprodm. Qed. End ProdMorph. Section ExtSdprodm. Variables gT aT rT : finGroupType. Variables (H : {group gT}) (K : {group aT}) (to : groupAction K H). Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis actf : {in H & K, morph_act to 'J fH fK}. Local Notation fsH := (fH \o invm (injm_sdpair1 to)). Local Notation fsK := (fK \o invm (injm_sdpair2 to)). Let DgH := sdpair1 to @* H. Let DgK := sdpair2 to @* K. Lemma xsdprodm_dom1 : DgH \subset 'dom fsH. Proof. by rewrite ['dom _]morphpre_invm. Qed. Local Notation gH := (restrm xsdprodm_dom1 fsH). Lemma xsdprodm_dom2 : DgK \subset 'dom fsK. Proof. by rewrite ['dom _]morphpre_invm. Qed. Local Notation gK := (restrm xsdprodm_dom2 fsK). Lemma im_sdprodm1 : gH @* DgH = fH @* H. Proof. by rewrite morphim_restrm setIid morphim_comp im_invm. Qed. Lemma im_sdprodm2 : gK @* DgK = fK @* K. Proof. by rewrite morphim_restrm setIid morphim_comp im_invm. Qed. Lemma xsdprodm_act : {in DgH & DgK, morph_act 'J 'J gH gK}. Proof. move=> fh fk; case/morphimP=> h _ Hh ->{fh}; case/morphimP=> k _ Kk ->{fk}. by rewrite /= -sdpair_act // /restrm /= !invmE ?actf ?gact_stable. Qed. Definition xsdprodm := sdprodm (sdprod_sdpair to) xsdprodm_act. Canonical xsdprod_morphism := [morphism of xsdprodm]. Lemma im_xsdprodm : xsdprodm @* setT = fH @* H * fK @* K. Proof. by rewrite -im_sdpair morphim_sdprodm // im_sdprodm1 im_sdprodm2. Qed. Lemma injm_xsdprodm : 'injm xsdprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == 1]. Proof. rewrite injm_sdprodm im_sdprodm1 im_sdprodm2 !subG1 /= !ker_restrm !ker_comp. rewrite !morphpre_invm !morphimIim. by rewrite !morphim_injm_eq1 ?subsetIl ?injm_sdpair1 ?injm_sdpair2. Qed. End ExtSdprodm. Section DirprodIsom. Variable gT : finGroupType. Implicit Types G H : {group gT}. Definition mulgm : gT * gT -> _ := prod_curry mulg. Lemma imset_mulgm (A B : {set gT}) : mulgm @: setX A B = A * B. Proof. by rewrite -curry_imset2X. Qed. Lemma mulgmP H1 H2 G : reflect (H1 \x H2 = G) (misom (setX H1 H2) G mulgm). Proof. apply: (iffP misomP) => [[pM /isomP[injf /= <-]] | ]. have /dprodP[_ /= defX cH12] := setX_dprod H1 H2. rewrite -{4}defX {}defX => /(congr1 (fun A => morphm pM @* A)). move/(morphimS (morphm_morphism pM)): cH12 => /=. have sH1H: setX H1 1 \subset setX H1 H2 by rewrite setXS ?sub1G. have sH2H: setX 1 H2 \subset setX H1 H2 by rewrite setXS ?sub1G. rewrite morphim1 injm_cent ?injmI //= subsetI => /andP[_]. by rewrite !morphimEsub //= !imset_mulgm mulg1 mul1g; apply: dprodE. case/dprodP=> _ defG cH12 trH12. have fM: morphic (setX H1 H2) mulgm. apply/morphicP=> [[x1 x2] [y1 y2] /setXP[_ Hx2] /setXP[Hy1 _]]. by rewrite /= mulgA -(mulgA x1) -(centsP cH12 x2) ?mulgA. exists fM; apply/isomP; split; last by rewrite morphimEsub //= imset_mulgm. apply/subsetP=> [[x1 x2]]; rewrite !inE /= andbC -eq_invg_mul. case: eqP => //= <-; rewrite groupV -in_setI trH12 => /set1P->. by rewrite invg1 eqxx. Qed. End DirprodIsom. Arguments mulgmP {gT H1 H2 G}. Prenex Implicits mulgm. math-comp-mathcomp-1.12.0/mathcomp/fingroup/morphism.v000066400000000000000000001500271375767750300230050ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import fintype finfun bigop finset fingroup. (******************************************************************************) (* This file contains the definitions of: *) (* *) (* {morphism D >-> rT} == *) (* the structure type of functions that are group morphisms mapping a *) (* domain set D : {set aT} to a type rT; rT must have a finGroupType *) (* structure, and D is usually a group (most of the theory expects this). *) (* mfun == the coercion projecting {morphism D >-> rT} to aT -> rT *) (* *) (* Basic examples: *) (* idm D == the identity morphism with domain D, or more precisely *) (* the identity function, but with a canonical *) (* {morphism G -> gT} structure. *) (* trivm D == the trivial morphism with domain D. *) (* If f has a {morphism D >-> rT} structure *) (* 'dom f == D, the domain of f. *) (* f @* A == the image of A by f, where f is defined. *) (* := f @: (D :&: A) *) (* f @*^-1 R == the pre-image of R by f, where f is defined. *) (* := D :&: f @^-1: R *) (* 'ker f == the kernel of f. *) (* := f @*^-1 1 *) (* 'ker_G f == the kernel of f restricted to G. *) (* := G :&: 'ker f (this is a pure notation) *) (* 'injm f <=> f injective on D. *) (* <-> ker f \subset 1 (this is a pure notation) *) (* invm injf == the inverse morphism of f, with domain f @* D, when f *) (* is injective (injf : 'injm f). *) (* restrm f sDom == the restriction of f to a subset A of D, given *) (* (sDom : A \subset D); restrm f sDom is transparently *) (* identical to f; the restrmP and domP lemmas provide *) (* opaque restrictions. *) (* invm f infj == the inverse morphism for an injective f, with domain *) (* f @* D, given (injf : 'injm f). *) (* *) (* G \isog H <=> G and H are isomorphic as groups. *) (* H \homg G <=> H is a homomorphic image of G. *) (* isom G H f <=> f maps G isomorphically to H, provided D contains G. *) (* := f @: G^# == H^# *) (* *) (* If, moreover, g : {morphism G >-> gT} with G : {group aT}, *) (* factm sKer sDom == the (natural) factor morphism mapping f @* G to g @* G *) (* with sDom : G \subset D, sKer : 'ker f \subset 'ker g. *) (* ifactm injf g == the (natural) factor morphism mapping f @* G to g @* G *) (* when f is injective (injf : 'injm f); here g must *) (* denote an actual morphism structure, not its function *) (* projection. *) (* *) (* If g has a {morphism G >-> aT} structure for any G : {group gT}, then *) (* f \o g has a canonical {morphism g @*^-1 D >-> rT} structure. *) (* *) (* Finally, for an arbitrary function f : aT -> rT *) (* morphic D f <=> f preserves group multiplication in D, i.e., *) (* f (x * y) = (f x) * (f y) for all x, y in D. *) (* morphm fM == a function identical to f, but with a canonical *) (* {morphism D >-> rT} structure, given fM : morphic D f. *) (* misom D C f <=> f is a morphism that maps D isomorphically to C. *) (* := morphic D f && isom D C f *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Reserved Notation "x \isog y" (at level 70). Section MorphismStructure. Variables aT rT : finGroupType. Structure morphism (D : {set aT}) : Type := Morphism { mfun :> aT -> FinGroup.sort rT; _ : {in D &, {morph mfun : x y / x * y}} }. (* We give the 'lightest' possible specification to define morphisms: local *) (* congruence, in D, with the group law of aT. We then provide the properties *) (* for the 'textbook' notion of morphism, when the required structures are *) (* available (e.g. its domain is a group). *) Definition morphism_for D of phant rT := morphism D. Definition clone_morphism D f := let: Morphism _ fM := f return {type of @Morphism D for f} -> morphism_for D (Phant rT) in fun k => k fM. Variables (D A : {set aT}) (R : {set rT}) (x : aT) (y : rT) (f : aT -> rT). Variant morphim_spec : Prop := MorphimSpec z & z \in D & z \in A & y = f z. Lemma morphimP : reflect morphim_spec (y \in f @: (D :&: A)). Proof. apply: (iffP imsetP) => [] [z]; first by case/setIP; exists z. by exists z; first apply/setIP. Qed. Lemma morphpreP : reflect (x \in D /\ f x \in R) (x \in D :&: f @^-1: R). Proof. by rewrite !inE; apply: andP. Qed. End MorphismStructure. Notation "{ 'morphism' D >-> T }" := (morphism_for D (Phant T)) (at level 0, format "{ 'morphism' D >-> T }") : group_scope. Notation "[ 'morphism' D 'of' f ]" := (@clone_morphism _ _ D _ (fun fM => @Morphism _ _ D f fM)) (at level 0, format "[ 'morphism' D 'of' f ]") : form_scope. Notation "[ 'morphism' 'of' f ]" := (clone_morphism (@Morphism _ _ _ f)) (at level 0, format "[ 'morphism' 'of' f ]") : form_scope. Arguments morphimP {aT rT D A y f}. Arguments morphpreP {aT rT D R x f}. (* Domain, image, preimage, kernel, using phantom types to infer the domain. *) Section MorphismOps1. Variables (aT rT : finGroupType) (D : {set aT}) (f : {morphism D >-> rT}). Lemma morphM : {in D &, {morph f : x y / x * y}}. Proof. by case f. Qed. Notation morPhantom := (phantom (aT -> rT)). Definition MorPhantom := Phantom (aT -> rT). Definition dom of morPhantom f := D. Definition morphim of morPhantom f := fun A => f @: (D :&: A). Definition morphpre of morPhantom f := fun R : {set rT} => D :&: f @^-1: R. Definition ker mph := morphpre mph 1. End MorphismOps1. Arguments morphim _ _ _%g _ _ _%g. Arguments morphpre _ _ _%g _ _ _%g. Notation "''dom' f" := (dom (MorPhantom f)) (at level 10, f at level 8, format "''dom' f") : group_scope. Notation "''ker' f" := (ker (MorPhantom f)) (at level 10, f at level 8, format "''ker' f") : group_scope. Notation "''ker_' H f" := (H :&: 'ker f) (at level 10, H at level 2, f at level 8, format "''ker_' H f") : group_scope. Notation "f @* A" := (morphim (MorPhantom f) A) (at level 24, format "f @* A") : group_scope. Notation "f @*^-1 R" := (morphpre (MorPhantom f) R) (at level 24, format "f @*^-1 R") : group_scope. Notation "''injm' f" := (pred_of_set ('ker f) \subset pred_of_set 1) (at level 10, f at level 8, format "''injm' f") : group_scope. Section MorphismTheory. Variables aT rT : finGroupType. Implicit Types A B : {set aT}. Implicit Types G H : {group aT}. Implicit Types R S : {set rT}. Implicit Types M : {group rT}. (* Most properties of morphims hold only when the domain is a group. *) Variables (D : {group aT}) (f : {morphism D >-> rT}). Lemma morph1 : f 1 = 1. Proof. by apply: (mulgI (f 1)); rewrite -morphM ?mulg1. Qed. Lemma morph_prod I r (P : pred I) F : (forall i, P i -> F i \in D) -> f (\prod_(i <- r | P i) F i) = \prod_( i <- r | P i) f (F i). Proof. move=> D_F; elim/(big_load (fun x => x \in D)): _. elim/big_rec2: _ => [|i _ x Pi [Dx <-]]; first by rewrite morph1. by rewrite groupM ?morphM // D_F. Qed. Lemma morphV : {in D, {morph f : x / x^-1}}. Proof. move=> x Dx; apply: (mulgI (f x)). by rewrite -morphM ?groupV // !mulgV morph1. Qed. Lemma morphJ : {in D &, {morph f : x y / x ^ y}}. Proof. by move=> * /=; rewrite !morphM ?morphV // ?groupM ?groupV. Qed. Lemma morphX n : {in D, {morph f : x / x ^+ n}}. Proof. by elim: n => [|n IHn] x Dx; rewrite ?morph1 // !expgS morphM ?(groupX, IHn). Qed. Lemma morphR : {in D &, {morph f : x y / [~ x, y]}}. Proof. by move=> * /=; rewrite morphM ?(groupV, groupJ) // morphJ ?morphV. Qed. (* Morphic image, preimage properties w.r.t. set-theoretic operations. *) Lemma morphimE A : f @* A = f @: (D :&: A). Proof. by []. Qed. Lemma morphpreE R : f @*^-1 R = D :&: f @^-1: R. Proof. by []. Qed. Lemma kerE : 'ker f = f @*^-1 1. Proof. by []. Qed. Lemma morphimEsub A : A \subset D -> f @* A = f @: A. Proof. by move=> sAD; rewrite /morphim (setIidPr sAD). Qed. Lemma morphimEdom : f @* D = f @: D. Proof. exact: morphimEsub. Qed. Lemma morphimIdom A : f @* (D :&: A) = f @* A. Proof. by rewrite /morphim setIA setIid. Qed. Lemma morphpreIdom R : D :&: f @*^-1 R = f @*^-1 R. Proof. by rewrite /morphim setIA setIid. Qed. Lemma morphpreIim R : f @*^-1 (f @* D :&: R) = f @*^-1 R. Proof. apply/setP=> x; rewrite morphimEdom !inE. by case Dx: (x \in D); rewrite // imset_f. Qed. Lemma morphimIim A : f @* D :&: f @* A = f @* A. Proof. by apply/setIidPr; rewrite imsetS // setIid subsetIl. Qed. Lemma mem_morphim A x : x \in D -> x \in A -> f x \in f @* A. Proof. by move=> Dx Ax; apply/morphimP; exists x. Qed. Lemma mem_morphpre R x : x \in D -> f x \in R -> x \in f @*^-1 R. Proof. by move=> Dx Rfx; apply/morphpreP. Qed. Lemma morphimS A B : A \subset B -> f @* A \subset f @* B. Proof. by move=> sAB; rewrite imsetS ?setIS. Qed. Lemma morphim_sub A : f @* A \subset f @* D. Proof. by rewrite imsetS // setIid subsetIl. Qed. Lemma leq_morphim A : #|f @* A| <= #|A|. Proof. by apply: (leq_trans (leq_imset_card _ _)); rewrite subset_leq_card ?subsetIr. Qed. Lemma morphpreS R S : R \subset S -> f @*^-1 R \subset f @*^-1 S. Proof. by move=> sRS; rewrite setIS ?preimsetS. Qed. Lemma morphpre_sub R : f @*^-1 R \subset D. Proof. exact: subsetIl. Qed. Lemma morphim_setIpre A R : f @* (A :&: f @*^-1 R) = f @* A :&: R. Proof. apply/setP=> fa; apply/morphimP/setIP=> [[a Da] | [/morphimP[a Da Aa ->] Rfa]]. by rewrite !inE Da /= => /andP[Aa Rfa] ->; rewrite mem_morphim. by exists a; rewrite // !inE Aa Da. Qed. Lemma morphim0 : f @* set0 = set0. Proof. by rewrite morphimE setI0 imset0. Qed. Lemma morphim_eq0 A : A \subset D -> (f @* A == set0) = (A == set0). Proof. by rewrite imset_eq0 => /setIidPr->. Qed. Lemma morphim_set1 x : x \in D -> f @* [set x] = [set f x]. Proof. by rewrite /morphim -sub1set => /setIidPr->; apply: imset_set1. Qed. Lemma morphim1 : f @* 1 = 1. Proof. by rewrite morphim_set1 ?morph1. Qed. Lemma morphimV A : f @* A^-1 = (f @* A)^-1. Proof. wlog suffices: A / f @* A^-1 \subset (f @* A)^-1. by move=> IH; apply/eqP; rewrite eqEsubset IH -invSg invgK -{1}(invgK A) IH. apply/subsetP=> _ /morphimP[x Dx Ax' ->]; rewrite !inE in Ax' *. by rewrite -morphV // imset_f // inE groupV Dx. Qed. Lemma morphpreV R : f @*^-1 R^-1 = (f @*^-1 R)^-1. Proof. apply/setP=> x; rewrite !inE groupV; case Dx: (x \in D) => //=. by rewrite morphV. Qed. Lemma morphimMl A B : A \subset D -> f @* (A * B) = f @* A * f @* B. Proof. move=> sAD; rewrite /morphim setIC -group_modl // (setIidPr sAD). apply/setP=> fxy; apply/idP/idP. case/imsetP=> _ /imset2P[x y Ax /setIP[Dy By] ->] ->{fxy}. by rewrite morphM // (subsetP sAD, imset2_f) // imset_f // inE By. case/imset2P=> _ _ /imsetP[x Ax ->] /morphimP[y Dy By ->] ->{fxy}. by rewrite -morphM // (subsetP sAD, imset_f) // mem_mulg // inE By. Qed. Lemma morphimMr A B : B \subset D -> f @* (A * B) = f @* A * f @* B. Proof. move=> sBD; apply: invg_inj. by rewrite invMg -!morphimV invMg morphimMl // -invGid invSg. Qed. Lemma morphpreMl R S : R \subset f @* D -> f @*^-1 (R * S) = f @*^-1 R * f @*^-1 S. Proof. move=> sRfD; apply/setP=> x; rewrite !inE. apply/andP/imset2P=> [[Dx] | [y z]]; last first. rewrite !inE => /andP[Dy Rfy] /andP[Dz Rfz] ->. by rewrite ?(groupM, morphM, imset2_f). case/imset2P=> fy fz Rfy Rfz def_fx. have /morphimP[y Dy _ def_fy]: fy \in f @* D := subsetP sRfD fy Rfy. exists y (y^-1 * x); last by rewrite mulKVg. by rewrite !inE Dy -def_fy. by rewrite !inE groupM ?(morphM, morphV, groupV) // def_fx -def_fy mulKg. Qed. Lemma morphimJ A x : x \in D -> f @* (A :^ x) = f @* A :^ f x. Proof. move=> Dx; rewrite !conjsgE morphimMl ?(morphimMr, sub1set, groupV) //. by rewrite !(morphim_set1, groupV, morphV). Qed. Lemma morphpreJ R x : x \in D -> f @*^-1 (R :^ f x) = f @*^-1 R :^ x. Proof. move=> Dx; apply/setP=> y; rewrite conjIg !inE conjGid // !mem_conjg inE. by case Dy: (y \in D); rewrite // morphJ ?(morphV, groupV). Qed. Lemma morphim_class x A : x \in D -> A \subset D -> f @* (x ^: A) = f x ^: f @* A. Proof. move=> Dx sAD; rewrite !morphimEsub ?class_subG // /class -!imset_comp. by apply: eq_in_imset => y Ay /=; rewrite morphJ // (subsetP sAD). Qed. Lemma classes_morphim A : A \subset D -> classes (f @* A) = [set f @* xA | xA in classes A]. Proof. move=> sAD; rewrite morphimEsub // /classes -!imset_comp. apply: eq_in_imset => x /(subsetP sAD) Dx /=. by rewrite morphim_class ?morphimEsub. Qed. Lemma morphimT : f @* setT = f @* D. Proof. by rewrite -morphimIdom setIT. Qed. Lemma morphimU A B : f @* (A :|: B) = f @* A :|: f @* B. Proof. by rewrite -imsetU -setIUr. Qed. Lemma morphimI A B : f @* (A :&: B) \subset f @* A :&: f @* B. Proof. by rewrite subsetI // ?morphimS ?(subsetIl, subsetIr). Qed. Lemma morphpre0 : f @*^-1 set0 = set0. Proof. by rewrite morphpreE preimset0 setI0. Qed. Lemma morphpreT : f @*^-1 setT = D. Proof. by rewrite morphpreE preimsetT setIT. Qed. Lemma morphpreU R S : f @*^-1 (R :|: S) = f @*^-1 R :|: f @*^-1 S. Proof. by rewrite -setIUr -preimsetU. Qed. Lemma morphpreI R S : f @*^-1 (R :&: S) = f @*^-1 R :&: f @*^-1 S. Proof. by rewrite -setIIr -preimsetI. Qed. Lemma morphpreD R S : f @*^-1 (R :\: S) = f @*^-1 R :\: f @*^-1 S. Proof. by apply/setP=> x; rewrite !inE; case: (x \in D). Qed. (* kernel, domain properties *) Lemma kerP x : x \in D -> reflect (f x = 1) (x \in 'ker f). Proof. by move=> Dx; rewrite 2!inE Dx; apply: set1P. Qed. Lemma dom_ker : {subset 'ker f <= D}. Proof. by move=> x /morphpreP[]. Qed. Lemma mker x : x \in 'ker f -> f x = 1. Proof. by move=> Kx; apply/kerP=> //; apply: dom_ker. Qed. Lemma mkerl x y : x \in 'ker f -> y \in D -> f (x * y) = f y. Proof. by move=> Kx Dy; rewrite morphM // ?(dom_ker, mker Kx, mul1g). Qed. Lemma mkerr x y : x \in D -> y \in 'ker f -> f (x * y) = f x. Proof. by move=> Dx Ky; rewrite morphM // ?(dom_ker, mker Ky, mulg1). Qed. Lemma rcoset_kerP x y : x \in D -> y \in D -> reflect (f x = f y) (x \in 'ker f :* y). Proof. move=> Dx Dy; rewrite mem_rcoset !inE groupM ?morphM ?groupV //=. by rewrite morphV // -eq_mulgV1; apply: eqP. Qed. Lemma ker_rcoset x y : x \in D -> y \in D -> f x = f y -> exists2 z, z \in 'ker f & x = z * y. Proof. by move=> Dx Dy eqfxy; apply/rcosetP; apply/rcoset_kerP. Qed. Lemma ker_norm : D \subset 'N('ker f). Proof. apply/subsetP=> x Dx; rewrite inE; apply/subsetP=> _ /imsetP[y Ky ->]. by rewrite !inE groupJ ?morphJ // ?dom_ker //= mker ?conj1g. Qed. Lemma ker_normal : 'ker f <| D. Proof. by rewrite /(_ <| D) subsetIl ker_norm. Qed. Lemma morphimGI G A : 'ker f \subset G -> f @* (G :&: A) = f @* G :&: f @* A. Proof. move=> sKG; apply/eqP; rewrite eqEsubset morphimI setIC. apply/subsetP=> _ /setIP[/morphimP[x Dx Ax ->] /morphimP[z Dz Gz]]. case/ker_rcoset=> {Dz}// y Ky def_x. have{z Gz y Ky def_x} Gx: x \in G by rewrite def_x groupMl // (subsetP sKG). by rewrite imset_f ?inE // Dx Gx Ax. Qed. Lemma morphimIG A G : 'ker f \subset G -> f @* (A :&: G) = f @* A :&: f @* G. Proof. by move=> sKG; rewrite setIC morphimGI // setIC. Qed. Lemma morphimD A B : f @* A :\: f @* B \subset f @* (A :\: B). Proof. rewrite subDset -morphimU morphimS //. by rewrite setDE setUIr setUCr setIT subsetUr. Qed. Lemma morphimDG A G : 'ker f \subset G -> f @* (A :\: G) = f @* A :\: f @* G. Proof. move=> sKG; apply/eqP; rewrite eqEsubset morphimD andbT !setDE subsetI. rewrite morphimS ?subsetIl // -[~: f @* G]setU0 -subDset setDE setCK. by rewrite -morphimIG //= setIAC -setIA setICr setI0 morphim0. Qed. Lemma morphimD1 A : (f @* A)^# \subset f @* A^#. Proof. by rewrite -!set1gE -morphim1 morphimD. Qed. (* group structure preservation *) Lemma morphpre_groupset M : group_set (f @*^-1 M). Proof. apply/group_setP; split=> [|x y]; rewrite !inE ?(morph1, group1) //. by case/andP=> Dx Mfx /andP[Dy Mfy]; rewrite morphM ?groupM. Qed. Lemma morphim_groupset G : group_set (f @* G). Proof. apply/group_setP; split=> [|_ _ /morphimP[x Dx Gx ->] /morphimP[y Dy Gy ->]]. by rewrite -morph1 imset_f ?group1. by rewrite -morphM ?imset_f ?inE ?groupM. Qed. Canonical morphpre_group fPh M := @group _ (morphpre fPh M) (morphpre_groupset M). Canonical morphim_group fPh G := @group _ (morphim fPh G) (morphim_groupset G). Canonical ker_group fPh : {group aT} := Eval hnf in [group of ker fPh]. Lemma morph_dom_groupset : group_set (f @: D). Proof. by rewrite -morphimEdom groupP. Qed. Canonical morph_dom_group := group morph_dom_groupset. Lemma morphpreMr R S : S \subset f @* D -> f @*^-1 (R * S) = f @*^-1 R * f @*^-1 S. Proof. move=> sSfD; apply: invg_inj. by rewrite invMg -!morphpreV invMg morphpreMl // -invSg invgK invGid. Qed. Lemma morphimK A : A \subset D -> f @*^-1 (f @* A) = 'ker f * A. Proof. move=> sAD; apply/setP=> x; rewrite !inE. apply/idP/idP=> [/andP[Dx /morphimP[y Dy Ay eqxy]] | /imset2P[z y Kz Ay ->{x}]]. rewrite -(mulgKV y x) mem_mulg // !inE !(groupM, morphM, groupV) //. by rewrite morphV //= eqxy mulgV. have [Dy Dz]: y \in D /\ z \in D by rewrite (subsetP sAD) // dom_ker. by rewrite groupM // morphM // mker // mul1g imset_f // inE Dy. Qed. Lemma morphimGK G : 'ker f \subset G -> G \subset D -> f @*^-1 (f @* G) = G. Proof. by move=> sKG sGD; rewrite morphimK // mulSGid. Qed. Lemma morphpre_set1 x : x \in D -> f @*^-1 [set f x] = 'ker f :* x. Proof. by move=> Dx; rewrite -morphim_set1 // morphimK ?sub1set. Qed. Lemma morphpreK R : R \subset f @* D -> f @* (f @*^-1 R) = R. Proof. move=> sRfD; apply/setP=> y; apply/morphimP/idP=> [[x _] | Ry]. by rewrite !inE; case/andP=> _ Rfx ->. have /morphimP[x Dx _ defy]: y \in f @* D := subsetP sRfD y Ry. by exists x; rewrite // !inE Dx -defy. Qed. Lemma morphim_ker : f @* 'ker f = 1. Proof. by rewrite morphpreK ?sub1G. Qed. Lemma ker_sub_pre M : 'ker f \subset f @*^-1 M. Proof. by rewrite morphpreS ?sub1G. Qed. Lemma ker_normal_pre M : 'ker f <| f @*^-1 M. Proof. by rewrite /normal ker_sub_pre subIset ?ker_norm. Qed. Lemma morphpreSK R S : R \subset f @* D -> (f @*^-1 R \subset f @*^-1 S) = (R \subset S). Proof. move=> sRfD; apply/idP/idP=> [sf'RS|]; last exact: morphpreS. suffices: R \subset f @* D :&: S by rewrite subsetI sRfD. rewrite -(morphpreK sRfD) -[_ :&: S]morphpreK (morphimS, subsetIl) //. by rewrite morphpreI morphimGK ?subsetIl // setIA setIid. Qed. Lemma sub_morphim_pre A R : A \subset D -> (f @* A \subset R) = (A \subset f @*^-1 R). Proof. move=> sAD; rewrite -morphpreSK (morphimS, morphimK) //. apply/idP/idP; first by apply: subset_trans; apply: mulG_subr. by move/(mulgS ('ker f)); rewrite -morphpreMl ?(sub1G, mul1g). Qed. Lemma morphpre_proper R S : R \subset f @* D -> S \subset f @* D -> (f @*^-1 R \proper f @*^-1 S) = (R \proper S). Proof. by move=> dQ dR; rewrite /proper !morphpreSK. Qed. Lemma sub_morphpre_im R G : 'ker f \subset G -> G \subset D -> R \subset f @* D -> (f @*^-1 R \subset G) = (R \subset f @* G). Proof. by symmetry; rewrite -morphpreSK ?morphimGK. Qed. Lemma ker_trivg_morphim A : (A \subset 'ker f) = (A \subset D) && (f @* A \subset [1]). Proof. case sAD: (A \subset D); first by rewrite sub_morphim_pre. by rewrite subsetI sAD. Qed. Lemma morphimSK A B : A \subset D -> (f @* A \subset f @* B) = (A \subset 'ker f * B). Proof. move=> sAD; transitivity (A \subset 'ker f * (D :&: B)). by rewrite -morphimK ?subsetIl // -sub_morphim_pre // /morphim setIA setIid. by rewrite setIC group_modl (subsetIl, subsetI) // andbC sAD. Qed. Lemma morphimSGK A G : A \subset D -> 'ker f \subset G -> (f @* A \subset f @* G) = (A \subset G). Proof. by move=> sGD skfK; rewrite morphimSK // mulSGid. Qed. Lemma ltn_morphim A : [1] \proper 'ker_A f -> #|f @* A| < #|A|. Proof. case/properP; rewrite sub1set => /setIP[A1 _] [x /setIP[Ax kx] x1]. rewrite (cardsD1 1 A) A1 ltnS -{1}(setD1K A1) morphimU morphim1. rewrite (setUidPr _) ?sub1set; last first. by rewrite -(mker kx) mem_morphim ?(dom_ker kx) // inE x1. by rewrite (leq_trans (leq_imset_card _ _)) ?subset_leq_card ?subsetIr. Qed. (* injectivity of image and preimage *) Lemma morphpre_inj : {in [pred R : {set rT} | R \subset f @* D] &, injective (fun R => f @*^-1 R)}. Proof. exact: can_in_inj morphpreK. Qed. Lemma morphim_injG : {in [pred G : {group aT} | 'ker f \subset G & G \subset D] &, injective (fun G => f @* G)}. Proof. move=> G H /andP[sKG sGD] /andP[sKH sHD] eqfGH. by apply: val_inj; rewrite /= -(morphimGK sKG sGD) eqfGH morphimGK. Qed. Lemma morphim_inj G H : ('ker f \subset G) && (G \subset D) -> ('ker f \subset H) && (H \subset D) -> f @* G = f @* H -> G :=: H. Proof. by move=> nsGf nsHf /morphim_injG->. Qed. (* commutation with generated groups and cycles *) Lemma morphim_gen A : A \subset D -> f @* <> = <>. Proof. move=> sAD; apply/eqP. rewrite eqEsubset andbC gen_subG morphimS; last exact: subset_gen. by rewrite sub_morphim_pre gen_subG // -sub_morphim_pre // subset_gen. Qed. Lemma morphim_cycle x : x \in D -> f @* <[x]> = <[f x]>. Proof. by move=> Dx; rewrite morphim_gen (sub1set, morphim_set1). Qed. Lemma morphimY A B : A \subset D -> B \subset D -> f @* (A <*> B) = f @* A <*> f @* B. Proof. by move=> sAD sBD; rewrite morphim_gen ?morphimU // subUset sAD. Qed. Lemma morphpre_gen R : 1 \in R -> R \subset f @* D -> f @*^-1 <> = <>. Proof. move=> R1 sRfD; apply/eqP. rewrite eqEsubset andbC gen_subG morphpreS; last exact: subset_gen. rewrite -{1}(morphpreK sRfD) -morphim_gen ?subsetIl // morphimGK //=. by rewrite sub_gen // setIS // preimsetS ?sub1set. by rewrite gen_subG subsetIl. Qed. (* commutator, normaliser, normal, center properties*) Lemma morphimR A B : A \subset D -> B \subset D -> f @* [~: A, B] = [~: f @* A, f @* B]. Proof. move/subsetP=> sAD /subsetP sBD. rewrite morphim_gen; last first; last congr <<_>>. by apply/subsetP=> _ /imset2P[x y Ax By ->]; rewrite groupR; auto. apply/setP=> fz; apply/morphimP/imset2P=> [[z _] | [fx fy]]. case/imset2P=> x y Ax By -> -> {z fz}. have Dx := sAD x Ax; have Dy := sBD y By. by exists (f x) (f y); rewrite ?(imset_f, morphR) // ?(inE, Dx, Dy). case/morphimP=> x Dx Ax ->{fx}; case/morphimP=> y Dy By ->{fy} -> {fz}. by exists [~ x, y]; rewrite ?(inE, morphR, groupR, imset2_f). Qed. Lemma morphim_norm A : f @* 'N(A) \subset 'N(f @* A). Proof. apply/subsetP=> fx; case/morphimP=> x Dx Nx -> {fx}. by rewrite inE -morphimJ ?(normP Nx). Qed. Lemma morphim_norms A B : A \subset 'N(B) -> f @* A \subset 'N(f @* B). Proof. by move=> nBA; apply: subset_trans (morphim_norm B); apply: morphimS. Qed. Lemma morphim_subnorm A B : f @* 'N_A(B) \subset 'N_(f @* A)(f @* B). Proof. exact: subset_trans (morphimI A _) (setIS _ (morphim_norm B)). Qed. Lemma morphim_normal A B : A <| B -> f @* A <| f @* B. Proof. by case/andP=> sAB nAB; rewrite /(_ <| _) morphimS // morphim_norms. Qed. Lemma morphim_cent1 x : x \in D -> f @* 'C[x] \subset 'C[f x]. Proof. by move=> Dx; rewrite -(morphim_set1 Dx) morphim_norm. Qed. Lemma morphim_cent1s A x : x \in D -> A \subset 'C[x] -> f @* A \subset 'C[f x]. Proof. by move=> Dx cAx; apply: subset_trans (morphim_cent1 Dx); apply: morphimS. Qed. Lemma morphim_subcent1 A x : x \in D -> f @* 'C_A[x] \subset 'C_(f @* A)[f x]. Proof. by move=> Dx; rewrite -(morphim_set1 Dx) morphim_subnorm. Qed. Lemma morphim_cent A : f @* 'C(A) \subset 'C(f @* A). Proof. apply/bigcapsP=> fx; case/morphimP=> x Dx Ax ->{fx}. by apply: subset_trans (morphim_cent1 Dx); apply: morphimS; apply: bigcap_inf. Qed. Lemma morphim_cents A B : A \subset 'C(B) -> f @* A \subset 'C(f @* B). Proof. by move=> cBA; apply: subset_trans (morphim_cent B); apply: morphimS. Qed. Lemma morphim_subcent A B : f @* 'C_A(B) \subset 'C_(f @* A)(f @* B). Proof. exact: subset_trans (morphimI A _) (setIS _ (morphim_cent B)). Qed. Lemma morphim_abelian A : abelian A -> abelian (f @* A). Proof. exact: morphim_cents. Qed. Lemma morphpre_norm R : f @*^-1 'N(R) \subset 'N(f @*^-1 R). Proof. apply/subsetP=> x; rewrite !inE => /andP[Dx Nfx]. by rewrite -morphpreJ ?morphpreS. Qed. Lemma morphpre_norms R S : R \subset 'N(S) -> f @*^-1 R \subset 'N(f @*^-1 S). Proof. by move=> nSR; apply: subset_trans (morphpre_norm S); apply: morphpreS. Qed. Lemma morphpre_normal R S : R \subset f @* D -> S \subset f @* D -> (f @*^-1 R <| f @*^-1 S) = (R <| S). Proof. move=> sRfD sSfD; apply/idP/andP=> [|[sRS nSR]]. by move/morphim_normal; rewrite !morphpreK //; case/andP. by rewrite /(_ <| _) (subset_trans _ (morphpre_norm _)) morphpreS. Qed. Lemma morphpre_subnorm R S : f @*^-1 'N_R(S) \subset 'N_(f @*^-1 R)(f @*^-1 S). Proof. by rewrite morphpreI setIS ?morphpre_norm. Qed. Lemma morphim_normG G : 'ker f \subset G -> G \subset D -> f @* 'N(G) = 'N_(f @* D)(f @* G). Proof. move=> sKG sGD; apply/eqP; rewrite eqEsubset -{1}morphimIdom morphim_subnorm. rewrite -(morphpreK (subsetIl _ _)) morphimS //= morphpreI subIset // orbC. by rewrite -{2}(morphimGK sKG sGD) morphpre_norm. Qed. Lemma morphim_subnormG A G : 'ker f \subset G -> G \subset D -> f @* 'N_A(G) = 'N_(f @* A)(f @* G). Proof. move=> sKB sBD; rewrite morphimIG ?normsG // morphim_normG //. by rewrite setICA setIA morphimIim. Qed. Lemma morphpre_cent1 x : x \in D -> 'C_D[x] \subset f @*^-1 'C[f x]. Proof. move=> Dx; rewrite -sub_morphim_pre ?subsetIl //. by apply: subset_trans (morphim_cent1 Dx); rewrite morphimS ?subsetIr. Qed. Lemma morphpre_cent1s R x : x \in D -> R \subset f @* D -> f @*^-1 R \subset 'C[x] -> R \subset 'C[f x]. Proof. by move=> Dx sRfD; move/(morphim_cent1s Dx); rewrite morphpreK. Qed. Lemma morphpre_subcent1 R x : x \in D -> 'C_(f @*^-1 R)[x] \subset f @*^-1 'C_R[f x]. Proof. move=> Dx; rewrite -morphpreIdom -setIA setICA morphpreI setIS //. exact: morphpre_cent1. Qed. Lemma morphpre_cent A : 'C_D(A) \subset f @*^-1 'C(f @* A). Proof. rewrite -sub_morphim_pre ?subsetIl // morphimGI ?(subsetIl, subIset) // orbC. by rewrite (subset_trans (morphim_cent _)). Qed. Lemma morphpre_cents A R : R \subset f @* D -> f @*^-1 R \subset 'C(A) -> R \subset 'C(f @* A). Proof. by move=> sRfD; move/morphim_cents; rewrite morphpreK. Qed. Lemma morphpre_subcent R A : 'C_(f @*^-1 R)(A) \subset f @*^-1 'C_R(f @* A). Proof. by rewrite -morphpreIdom -setIA setICA morphpreI setIS //; apply: morphpre_cent. Qed. (* local injectivity properties *) Lemma injmP : reflect {in D &, injective f} ('injm f). Proof. apply: (iffP subsetP) => [injf x y Dx Dy | injf x /= Kx]. by case/ker_rcoset=> // z /injf/set1P->; rewrite mul1g. have Dx := dom_ker Kx; apply/set1P/injf => //. by apply/rcoset_kerP; rewrite // mulg1. Qed. Lemma card_im_injm : (#|f @* D| == #|D|) = 'injm f. Proof. by rewrite morphimEdom (sameP imset_injP injmP). Qed. Section Injective. Hypothesis injf : 'injm f. Lemma ker_injm : 'ker f = 1. Proof. exact/trivgP. Qed. Lemma injmK A : A \subset D -> f @*^-1 (f @* A) = A. Proof. by move=> sAD; rewrite morphimK // ker_injm // mul1g. Qed. Lemma injm_morphim_inj A B : A \subset D -> B \subset D -> f @* A = f @* B -> A = B. Proof. by move=> sAD sBD eqAB; rewrite -(injmK sAD) eqAB injmK. Qed. Lemma card_injm A : A \subset D -> #|f @* A| = #|A|. Proof. move=> sAD; rewrite morphimEsub // card_in_imset //. exact: (sub_in2 (subsetP sAD) (injmP injf)). Qed. Lemma order_injm x : x \in D -> #[f x] = #[x]. Proof. by move=> Dx; rewrite orderE -morphim_cycle // card_injm ?cycle_subG. Qed. Lemma injm1 x : x \in D -> f x = 1 -> x = 1. Proof. by move=> Dx; move/(kerP Dx); rewrite ker_injm; move/set1P. Qed. Lemma morph_injm_eq1 x : x \in D -> (f x == 1) = (x == 1). Proof. by move=> Dx; rewrite -morph1 (inj_in_eq (injmP injf)) ?group1. Qed. Lemma injmSK A B : A \subset D -> (f @* A \subset f @* B) = (A \subset B). Proof. by move=> sAD; rewrite morphimSK // ker_injm mul1g. Qed. Lemma sub_morphpre_injm R A : A \subset D -> R \subset f @* D -> (f @*^-1 R \subset A) = (R \subset f @* A). Proof. by move=> sAD sRfD; rewrite -morphpreSK ?injmK. Qed. Lemma injm_eq A B : A \subset D -> B \subset D -> (f @* A == f @* B) = (A == B). Proof. by move=> sAD sBD; rewrite !eqEsubset !injmSK. Qed. Lemma morphim_injm_eq1 A : A \subset D -> (f @* A == 1) = (A == 1). Proof. by move=> sAD; rewrite -morphim1 injm_eq ?sub1G. Qed. Lemma injmI A B : f @* (A :&: B) = f @* A :&: f @* B. Proof. rewrite -morphimIdom setIIr -4!(injmK (subsetIl D _), =^~ morphimIdom). by rewrite -morphpreI morphpreK // subIset ?morphim_sub. Qed. Lemma injmD1 A : f @* A^# = (f @* A)^#. Proof. by have:= morphimDG A injf; rewrite morphim1. Qed. Lemma nclasses_injm A : A \subset D -> #|classes (f @* A)| = #|classes A|. Proof. move=> sAD; rewrite classes_morphim // card_in_imset //. move=> _ _ /imsetP[x Ax ->] /imsetP[y Ay ->]. by apply: injm_morphim_inj; rewrite // class_subG ?(subsetP sAD). Qed. Lemma injm_norm A : A \subset D -> f @* 'N(A) = 'N_(f @* D)(f @* A). Proof. move=> sAD; apply/eqP; rewrite -morphimIdom eqEsubset morphim_subnorm. rewrite -sub_morphpre_injm ?subsetIl // morphpreI injmK // setIS //. by rewrite -{2}(injmK sAD) morphpre_norm. Qed. Lemma injm_norms A B : A \subset D -> B \subset D -> (f @* A \subset 'N(f @* B)) = (A \subset 'N(B)). Proof. by move=> sAD sBD; rewrite -injmSK // injm_norm // subsetI morphimS. Qed. Lemma injm_normal A B : A \subset D -> B \subset D -> (f @* A <| f @* B) = (A <| B). Proof. by move=> sAD sBD; rewrite /normal injmSK ?injm_norms. Qed. Lemma injm_subnorm A B : B \subset D -> f @* 'N_A(B) = 'N_(f @* A)(f @* B). Proof. by move=> sBD; rewrite injmI injm_norm // setICA setIA morphimIim. Qed. Lemma injm_cent1 x : x \in D -> f @* 'C[x] = 'C_(f @* D)[f x]. Proof. by move=> Dx; rewrite injm_norm ?morphim_set1 ?sub1set. Qed. Lemma injm_subcent1 A x : x \in D -> f @* 'C_A[x] = 'C_(f @* A)[f x]. Proof. by move=> Dx; rewrite injm_subnorm ?morphim_set1 ?sub1set. Qed. Lemma injm_cent A : A \subset D -> f @* 'C(A) = 'C_(f @* D)(f @* A). Proof. move=> sAD; apply/eqP; rewrite -morphimIdom eqEsubset morphim_subcent. apply/subsetP=> fx; case/setIP; case/morphimP=> x Dx _ ->{fx} cAfx. rewrite mem_morphim // inE Dx -sub1set centsC cent_set1 -injmSK //. by rewrite injm_cent1 // subsetI morphimS // -cent_set1 centsC sub1set. Qed. Lemma injm_cents A B : A \subset D -> B \subset D -> (f @* A \subset 'C(f @* B)) = (A \subset 'C(B)). Proof. by move=> sAD sBD; rewrite -injmSK // injm_cent // subsetI morphimS. Qed. Lemma injm_subcent A B : B \subset D -> f @* 'C_A(B) = 'C_(f @* A)(f @* B). Proof. by move=> sBD; rewrite injmI injm_cent // setICA setIA morphimIim. Qed. Lemma injm_abelian A : A \subset D -> abelian (f @* A) = abelian A. Proof. by move=> sAD; rewrite /abelian -subsetIidl -injm_subcent // injmSK ?subsetIidl. Qed. End Injective. Lemma eq_morphim (g : {morphism D >-> rT}): {in D, f =1 g} -> forall A, f @* A = g @* A. Proof. by move=> efg A; apply: eq_in_imset; apply: sub_in1 efg => x /setIP[]. Qed. Lemma eq_in_morphim B A (g : {morphism B >-> rT}) : D :&: A = B :&: A -> {in A, f =1 g} -> f @* A = g @* A. Proof. move=> eqDBA eqAfg; rewrite /morphim /= eqDBA. by apply: eq_in_imset => x /setIP[_]/eqAfg. Qed. End MorphismTheory. Notation "''ker' f" := (ker_group (MorPhantom f)) : Group_scope. Notation "''ker_' G f" := (G :&: 'ker f)%G : Group_scope. Notation "f @* G" := (morphim_group (MorPhantom f) G) : Group_scope. Notation "f @*^-1 M" := (morphpre_group (MorPhantom f) M) : Group_scope. Notation "f @: D" := (morph_dom_group f D) : Group_scope. Arguments injmP {aT rT D f}. Arguments morphpreK {aT rT D f} [R] sRf. Section IdentityMorphism. Variable gT : finGroupType. Implicit Types A B : {set gT}. Implicit Type G : {group gT}. Definition idm of {set gT} := fun x : gT => x : FinGroup.sort gT. Lemma idm_morphM A : {in A & , {morph idm A : x y / x * y}}. Proof. by []. Qed. Canonical idm_morphism A := Morphism (@idm_morphM A). Lemma injm_idm G : 'injm (idm G). Proof. by apply/injmP=> x y _ _. Qed. Lemma ker_idm G : 'ker (idm G) = 1. Proof. by apply/trivgP; apply: injm_idm. Qed. Lemma morphim_idm A B : B \subset A -> idm A @* B = B. Proof. rewrite /morphim /= /idm => /setIidPr->. by apply/setP=> x; apply/imsetP/idP=> [[y By ->]|Bx]; last exists x. Qed. Lemma morphpre_idm A B : idm A @*^-1 B = A :&: B. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma im_idm A : idm A @* A = A. Proof. exact: morphim_idm. Qed. End IdentityMorphism. Arguments idm {_} _%g _%g. Section RestrictedMorphism. Variables aT rT : finGroupType. Variables A D : {set aT}. Implicit Type B : {set aT}. Implicit Type R : {set rT}. Definition restrm of A \subset D := @id (aT -> FinGroup.sort rT). Section Props. Hypothesis sAD : A \subset D. Variable f : {morphism D >-> rT}. Local Notation fA := (restrm sAD (mfun f)). Canonical restrm_morphism := @Morphism aT rT A fA (sub_in2 (subsetP sAD) (morphM f)). Lemma morphim_restrm B : fA @* B = f @* (A :&: B). Proof. by rewrite {2}/morphim setIA (setIidPr sAD). Qed. Lemma restrmEsub B : B \subset A -> fA @* B = f @* B. Proof. by rewrite morphim_restrm => /setIidPr->. Qed. Lemma im_restrm : fA @* A = f @* A. Proof. exact: restrmEsub. Qed. Lemma morphpre_restrm R : fA @*^-1 R = A :&: f @*^-1 R. Proof. by rewrite setIA (setIidPl sAD). Qed. Lemma ker_restrm : 'ker fA = 'ker_A f. Proof. exact: morphpre_restrm. Qed. Lemma injm_restrm : 'injm f -> 'injm fA. Proof. by apply: subset_trans; rewrite ker_restrm subsetIr. Qed. End Props. Lemma restrmP (f : {morphism D >-> rT}) : A \subset 'dom f -> {g : {morphism A >-> rT} | [/\ g = f :> (aT -> rT), 'ker g = 'ker_A f, forall R, g @*^-1 R = A :&: f @*^-1 R & forall B, B \subset A -> g @* B = f @* B]}. Proof. move=> sAD; exists (restrm_morphism sAD f). split=> // [|R|B sBA]; first 1 [exact: ker_restrm | exact: morphpre_restrm]. by rewrite morphim_restrm (setIidPr sBA). Qed. Lemma domP (f : {morphism D >-> rT}) : 'dom f = A -> {g : {morphism A >-> rT} | [/\ g = f :> (aT -> rT), 'ker g = 'ker f, forall R, g @*^-1 R = f @*^-1 R & forall B, g @* B = f @* B]}. Proof. by move <-; exists f. Qed. End RestrictedMorphism. Arguments restrm {_ _ _%g _%g} _ _%g. Arguments restrmP {aT rT A D}. Arguments domP {aT rT A D}. Section TrivMorphism. Variables aT rT : finGroupType. Definition trivm of {set aT} & aT := 1 : FinGroup.sort rT. Lemma trivm_morphM (A : {set aT}) : {in A &, {morph trivm A : x y / x * y}}. Proof. by move=> x y /=; rewrite mulg1. Qed. Canonical triv_morph A := Morphism (@trivm_morphM A). Lemma morphim_trivm (G H : {group aT}) : trivm G @* H = 1. Proof. apply/setP=> /= y; rewrite inE; apply/idP/eqP=> [|->]; first by case/morphimP. by apply/morphimP; exists (1 : aT); rewrite /= ?group1. Qed. Lemma ker_trivm (G : {group aT}) : 'ker (trivm G) = G. Proof. by apply/setIidPl/subsetP=> x _; rewrite !inE /=. Qed. End TrivMorphism. Arguments trivm {aT rT} _%g _%g. (* The composition of two morphisms is a Canonical morphism instance. *) Section MorphismComposition. Variables gT hT rT : finGroupType. Variables (G : {group gT}) (H : {group hT}). Variable f : {morphism G >-> hT}. Variable g : {morphism H >-> rT}. Local Notation gof := (mfun g \o mfun f). Lemma comp_morphM : {in f @*^-1 H &, {morph gof: x y / x * y}}. Proof. by move=> x y; rewrite /= !inE => /andP[? ?] /andP[? ?]; rewrite !morphM. Qed. Canonical comp_morphism := Morphism comp_morphM. Lemma ker_comp : 'ker gof = f @*^-1 'ker g. Proof. by apply/setP=> x; rewrite !inE andbA. Qed. Lemma injm_comp : 'injm f -> 'injm g -> 'injm gof. Proof. by move=> injf; rewrite ker_comp; move/trivgP=> ->. Qed. Lemma morphim_comp (A : {set gT}) : gof @* A = g @* (f @* A). Proof. apply/setP=> z; apply/morphimP/morphimP=> [[x]|[y Hy fAy ->{z}]]. rewrite !inE => /andP[Gx Hfx]; exists (f x) => //. by apply/morphimP; exists x. by case/morphimP: fAy Hy => x Gx Ax ->{y} Hfx; exists x; rewrite ?inE ?Gx. Qed. Lemma morphpre_comp (C : {set rT}) : gof @*^-1 C = f @*^-1 (g @*^-1 C). Proof. by apply/setP=> z; rewrite !inE andbA. Qed. End MorphismComposition. (* The factor morphism *) Section FactorMorphism. Variables aT qT rT : finGroupType. Variables G H : {group aT}. Variable f : {morphism G >-> rT}. Variable q : {morphism H >-> qT}. Definition factm of 'ker q \subset 'ker f & G \subset H := fun x => f (repr (q @*^-1 [set x])). Hypothesis sKqKf : 'ker q \subset 'ker f. Hypothesis sGH : G \subset H. Notation ff := (factm sKqKf sGH). Lemma factmE x : x \in G -> ff (q x) = f x. Proof. rewrite /ff => Gx; have Hx := subsetP sGH x Gx. have /mem_repr: x \in q @*^-1 [set q x] by rewrite !inE Hx /=. case/morphpreP; move: (repr _) => y Hy /set1P. by case/ker_rcoset=> // z Kz ->; rewrite mkerl ?(subsetP sKqKf). Qed. Lemma factm_morphM : {in q @* G &, {morph ff : x y / x * y}}. Proof. move=> _ _ /morphimP[x Hx Gx ->] /morphimP[y Hy Gy ->]. by rewrite -morphM ?factmE ?groupM // morphM. Qed. Canonical factm_morphism := Morphism factm_morphM. Lemma morphim_factm (A : {set aT}) : ff @* (q @* A) = f @* A. Proof. rewrite -morphim_comp /= {1}/morphim /= morphimGK //; last first. by rewrite (subset_trans sKqKf) ?subsetIl. apply/setP=> y; apply/morphimP/morphimP; by case=> x Gx Ax ->{y}; exists x; rewrite //= factmE. Qed. Lemma morphpre_factm (C : {set rT}) : ff @*^-1 C = q @* (f @*^-1 C). Proof. apply/setP=> y; rewrite !inE /=; apply/andP/morphimP=> [[]|[x Hx]]; last first. by case/morphpreP=> Gx Cfx ->; rewrite factmE ?imset_f ?inE ?Hx. case/morphimP=> x Hx Gx ->; rewrite factmE //. by exists x; rewrite // !inE Gx. Qed. Lemma ker_factm : 'ker ff = q @* 'ker f. Proof. exact: morphpre_factm. Qed. Lemma injm_factm : 'injm f -> 'injm ff. Proof. by rewrite ker_factm => /trivgP->; rewrite morphim1. Qed. Lemma injm_factmP : reflect ('ker f = 'ker q) ('injm ff). Proof. rewrite ker_factm -morphimIdom sub_morphim_pre ?subsetIl //. rewrite setIA (setIidPr sGH) (sameP setIidPr eqP) (setIidPl _) // eq_sym. exact: eqP. Qed. Lemma ker_factm_loc (K : {group aT}) : 'ker_(q @* K) ff = q @* 'ker_K f. Proof. by rewrite ker_factm -morphimIG. Qed. End FactorMorphism. Prenex Implicits factm. Section InverseMorphism. Variables aT rT : finGroupType. Implicit Types A B : {set aT}. Implicit Types C D : {set rT}. Variables (G : {group aT}) (f : {morphism G >-> rT}). Hypothesis injf : 'injm f. Lemma invm_subker : 'ker f \subset 'ker (idm G). Proof. by rewrite ker_idm. Qed. Definition invm := factm invm_subker (subxx _). Canonical invm_morphism := Eval hnf in [morphism of invm]. Lemma invmE : {in G, cancel f invm}. Proof. exact: factmE. Qed. Lemma invmK : {in f @* G, cancel invm f}. Proof. by move=> fx; case/morphimP=> x _ Gx ->; rewrite invmE. Qed. Lemma morphpre_invm A : invm @*^-1 A = f @* A. Proof. by rewrite morphpre_factm morphpre_idm morphimIdom. Qed. Lemma morphim_invm A : A \subset G -> invm @* (f @* A) = A. Proof. by move=> sAG; rewrite morphim_factm morphim_idm. Qed. Lemma morphim_invmE C : invm @* C = f @*^-1 C. Proof. rewrite -morphpreIdom -(morphim_invm (subsetIl _ _)). by rewrite morphimIdom -morphpreIim morphpreK (subsetIl, morphimIdom). Qed. Lemma injm_proper A B : A \subset G -> B \subset G -> (f @* A \proper f @* B) = (A \proper B). Proof. move=> dA dB; rewrite -morphpre_invm -(morphpre_invm B). by rewrite morphpre_proper ?morphim_invm. Qed. Lemma injm_invm : 'injm invm. Proof. by move/can_in_inj/injmP: invmK. Qed. Lemma ker_invm : 'ker invm = 1. Proof. by move/trivgP: injm_invm. Qed. Lemma im_invm : invm @* (f @* G) = G. Proof. exact: morphim_invm. Qed. End InverseMorphism. Prenex Implicits invm. Section InjFactm. Variables (gT aT rT : finGroupType) (D G : {group gT}). Variables (g : {morphism G >-> rT}) (f : {morphism D >-> aT}) (injf : 'injm f). Definition ifactm := tag (domP [morphism of g \o invm injf] (morphpre_invm injf G)). Lemma ifactmE : {in D, forall x, ifactm (f x) = g x}. Proof. rewrite /ifactm => x Dx; case: domP => f' /= [def_f' _ _ _]. by rewrite {f'}def_f' //= invmE. Qed. Lemma morphim_ifactm (A : {set gT}) : A \subset D -> ifactm @* (f @* A) = g @* A. Proof. rewrite /ifactm => sAD; case: domP => _ /= [_ _ _ ->]. by rewrite morphim_comp morphim_invm. Qed. Lemma im_ifactm : G \subset D -> ifactm @* (f @* G) = g @* G. Proof. exact: morphim_ifactm. Qed. Lemma morphpre_ifactm C : ifactm @*^-1 C = f @* (g @*^-1 C). Proof. rewrite /ifactm; case: domP => _ /= [_ _ -> _]. by rewrite morphpre_comp morphpre_invm. Qed. Lemma ker_ifactm : 'ker ifactm = f @* 'ker g. Proof. exact: morphpre_ifactm. Qed. Lemma injm_ifactm : 'injm g -> 'injm ifactm. Proof. by rewrite ker_ifactm => /trivgP->; rewrite morphim1. Qed. End InjFactm. (* Reflected (boolean) form of morphism and isomorphism properties. *) Section ReflectProp. Variables aT rT : finGroupType. Section Defs. Variables (A : {set aT}) (B : {set rT}). (* morphic is the morphM property of morphisms seen through morphicP. *) Definition morphic (f : aT -> rT) := [forall u in [predX A & A], f (u.1 * u.2) == f u.1 * f u.2]. Definition isom f := f @: A^# == B^#. Definition misom f := morphic f && isom f. Definition isog := [exists f : {ffun aT -> rT}, misom f]. Section MorphicProps. Variable f : aT -> rT. Lemma morphicP : reflect {in A &, {morph f : x y / x * y}} (morphic f). Proof. apply: (iffP forallP) => [fM x y Ax Ay | fM [x y] /=]. by apply/eqP; have:= fM (x, y); rewrite inE /= Ax Ay. by apply/implyP=> /andP[Ax Ay]; rewrite fM. Qed. Definition morphm of morphic f := f : aT -> FinGroup.sort rT. Lemma morphmE fM : morphm fM = f. Proof. by []. Qed. Canonical morphm_morphism fM := @Morphism _ _ A (morphm fM) (morphicP fM). End MorphicProps. Lemma misomP f : reflect {fM : morphic f & isom (morphm fM)} (misom f). Proof. by apply: (iffP andP) => [] [fM fiso] //; exists fM. Qed. Lemma misom_isog f : misom f -> isog. Proof. case/andP=> fM iso_f; apply/existsP; exists (finfun f). apply/andP; split; last by rewrite /misom /isom !(eq_imset _ (ffunE f)). by apply/forallP=> u; rewrite !ffunE; apply: forallP fM u. Qed. Lemma isom_isog (D : {group aT}) (f : {morphism D >-> rT}) : A \subset D -> isom f -> isog. Proof. move=> sAD isof; apply: (@misom_isog f); rewrite /misom isof andbT. by apply/morphicP; apply: (sub_in2 (subsetP sAD) (morphM f)). Qed. Lemma isog_isom : isog -> {f : {morphism A >-> rT} | isom f}. Proof. by case/existsP/sigW=> f /misomP[fM isom_f]; exists (morphm_morphism fM). Qed. End Defs. Infix "\isog" := isog. Arguments isom_isog [A B D]. (* The real reflection properties only hold for true groups and morphisms. *) Section Main. Variables (G : {group aT}) (H : {group rT}). Lemma isomP (f : {morphism G >-> rT}) : reflect ('injm f /\ f @* G = H) (isom G H f). Proof. apply: (iffP eqP) => [eqfGH | [injf <-]]; last first. by rewrite -injmD1 // morphimEsub ?subsetDl. split. apply/subsetP=> x /morphpreP[Gx fx1]; have: f x \notin H^# by rewrite inE fx1. by apply: contraR => ntx; rewrite -eqfGH imset_f // inE ntx. rewrite morphimEdom -{2}(setD1K (group1 G)) imsetU eqfGH. by rewrite imset_set1 morph1 setD1K. Qed. Lemma isogP : reflect (exists2 f : {morphism G >-> rT}, 'injm f & f @* G = H) (G \isog H). Proof. apply: (iffP idP) => [/isog_isom[f /isomP[]] | [f injf fG]]; first by exists f. by apply: (isom_isog f) => //; apply/isomP. Qed. Variable f : {morphism G >-> rT}. Hypothesis isoGH : isom G H f. Lemma isom_inj : 'injm f. Proof. by have /isomP[] := isoGH. Qed. Lemma isom_im : f @* G = H. Proof. by have /isomP[] := isoGH. Qed. Lemma isom_card : #|G| = #|H|. Proof. by rewrite -isom_im card_injm ?isom_inj. Qed. Lemma isom_sub_im : H \subset f @* G. Proof. by rewrite isom_im. Qed. Definition isom_inv := restrm isom_sub_im (invm isom_inj). End Main. Variables (G : {group aT}) (f : {morphism G >-> rT}). Lemma morphim_isom (H : {group aT}) (K : {group rT}) : H \subset G -> isom H K f -> f @* H = K. Proof. by case/(restrmP f)=> g [gf _ _ <- //]; rewrite -gf; case/isomP. Qed. Lemma sub_isom (A : {set aT}) (C : {set rT}) : A \subset G -> f @* A = C -> 'injm f -> isom A C f. Proof. move=> sAG; case: (restrmP f sAG) => g [_ _ _ img] <-{C} injf. rewrite /isom -morphimEsub ?morphimDG ?morphim1 //. by rewrite subDset setUC subsetU ?sAG. Qed. Lemma sub_isog (A : {set aT}) : A \subset G -> 'injm f -> isog A (f @* A). Proof. by move=> sAG injf; apply: (isom_isog f sAG); apply: sub_isom. Qed. Lemma restr_isom_to (A : {set aT}) (C R : {group rT}) (sAG : A \subset G) : f @* A = C -> isom G R f -> isom A C (restrm sAG f). Proof. by move=> defC /isomP[inj_f _]; apply: sub_isom. Qed. Lemma restr_isom (A : {group aT}) (R : {group rT}) (sAG : A \subset G) : isom G R f -> isom A (f @* A) (restrm sAG f). Proof. exact: restr_isom_to. Qed. End ReflectProp. Arguments isom {_ _} _%g _%g _. Arguments morphic {_ _} _%g _. Arguments misom _ _ _%g _%g _. Arguments isog {_ _} _%g _%g. Arguments morphicP {aT rT A f}. Arguments misomP {aT rT A B f}. Arguments isom_isog [aT rT A B D]. Arguments isomP {aT rT G H f}. Arguments isogP {aT rT G H}. Prenex Implicits morphm. Notation "x \isog y":= (isog x y). Section Isomorphisms. Variables gT hT kT : finGroupType. Variables (G : {group gT}) (H : {group hT}) (K : {group kT}). Lemma idm_isom : isom G G (idm G). Proof. exact: sub_isom (im_idm G) (injm_idm G). Qed. Lemma isog_refl : G \isog G. Proof. exact: isom_isog idm_isom. Qed. Lemma card_isog : G \isog H -> #|G| = #|H|. Proof. by case/isogP=> f injf <-; apply: isom_card (f) _; apply/isomP. Qed. Lemma isog_abelian : G \isog H -> abelian G = abelian H. Proof. by case/isogP=> f injf <-; rewrite injm_abelian. Qed. Lemma trivial_isog : G :=: 1 -> H :=: 1 -> G \isog H. Proof. move=> -> ->; apply/isogP. exists [morphism of @trivm gT hT 1]; rewrite /= ?morphim1 //. by rewrite ker_trivm; apply: subxx. Qed. Lemma isog_eq1 : G \isog H -> (G :==: 1) = (H :==: 1). Proof. by move=> isoGH; rewrite !trivg_card1 card_isog. Qed. Lemma isom_sym (f : {morphism G >-> hT}) (isoGH : isom G H f) : isom H G (isom_inv isoGH). Proof. rewrite sub_isom 1?injm_restrm ?injm_invm // im_restrm. by rewrite -(isom_im isoGH) im_invm. Qed. Lemma isog_symr : G \isog H -> H \isog G. Proof. by case/isog_isom=> f /isom_sym/isom_isog->. Qed. Lemma isog_trans : G \isog H -> H \isog K -> G \isog K. Proof. case/isogP=> f injf <-; case/isogP=> g injg <-. have defG: f @*^-1 (f @* G) = G by rewrite morphimGK ?subsetIl. rewrite -morphim_comp -{1 8}defG. by apply/isogP; exists [morphism of g \o f]; rewrite ?injm_comp. Qed. Lemma nclasses_isog : G \isog H -> #|classes G| = #|classes H|. Proof. by case/isogP=> f injf <-; rewrite nclasses_injm. Qed. End Isomorphisms. Section IsoBoolEquiv. Variables gT hT kT : finGroupType. Variables (G : {group gT}) (H : {group hT}) (K : {group kT}). Lemma isog_sym : (G \isog H) = (H \isog G). Proof. by apply/idP/idP; apply: isog_symr. Qed. Lemma isog_transl : G \isog H -> (G \isog K) = (H \isog K). Proof. by move=> iso; apply/idP/idP; apply: isog_trans; rewrite // -isog_sym. Qed. Lemma isog_transr : G \isog H -> (K \isog G) = (K \isog H). Proof. by move=> iso; apply/idP/idP; move/isog_trans; apply; rewrite // -isog_sym. Qed. End IsoBoolEquiv. Section Homg. Implicit Types rT gT aT : finGroupType. Definition homg rT aT (C : {set rT}) (D : {set aT}) := [exists (f : {ffun aT -> rT} | morphic D f), f @: D == C]. Lemma homgP rT aT (C : {set rT}) (D : {set aT}) : reflect (exists f : {morphism D >-> rT}, f @* D = C) (homg C D). Proof. apply: (iffP exists_eq_inP) => [[f fM <-] | [f <-]]. by exists (morphm_morphism fM); rewrite /morphim /= setIid. exists (finfun f); first by apply/morphicP=> x y Dx Dy; rewrite !ffunE morphM. by rewrite /morphim setIid; apply: eq_imset => x; rewrite ffunE. Qed. Lemma morphim_homg aT rT (A D : {set aT}) (f : {morphism D >-> rT}) : A \subset D -> homg (f @* A) A. Proof. move=> sAD; apply/homgP; exists (restrm_morphism sAD f). by rewrite morphim_restrm setIid. Qed. Lemma leq_homg rT aT (C : {set rT}) (G : {group aT}) : homg C G -> #|C| <= #|G|. Proof. by case/homgP=> f <-; apply: leq_morphim. Qed. Lemma homg_refl aT (A : {set aT}) : homg A A. Proof. by apply/homgP; exists (idm_morphism A); rewrite im_idm. Qed. Lemma homg_trans aT (B : {set aT}) rT (C : {set rT}) gT (G : {group gT}) : homg C B -> homg B G -> homg C G. Proof. move=> homCB homBG; case/homgP: homBG homCB => fG <- /homgP[fK <-]. by rewrite -morphim_comp morphim_homg // -sub_morphim_pre. Qed. Lemma isogEcard rT aT (G : {group rT}) (H : {group aT}) : (G \isog H) = (homg G H) && (#|H| <= #|G|). Proof. rewrite isog_sym; apply/isogP/andP=> [[f injf <-] | []]. by rewrite leq_eqVlt eq_sym card_im_injm injf morphim_homg. case/homgP=> f <-; rewrite leq_eqVlt eq_sym card_im_injm. by rewrite ltnNge leq_morphim orbF; exists f. Qed. Lemma isog_hom rT aT (G : {group rT}) (H : {group aT}) : G \isog H -> homg G H. Proof. by rewrite isogEcard; case/andP. Qed. Lemma isogEhom rT aT (G : {group rT}) (H : {group aT}) : (G \isog H) = homg G H && homg H G. Proof. apply/idP/andP=> [isoGH | [homGH homHG]]. by rewrite !isog_hom // isog_sym. by rewrite isogEcard homGH leq_homg. Qed. Lemma eq_homgl gT aT rT (G : {group gT}) (H : {group aT}) (K : {group rT}) : G \isog H -> homg G K = homg H K. Proof. by rewrite isogEhom => /andP[homGH homHG]; apply/idP/idP; apply: homg_trans. Qed. Lemma eq_homgr gT rT aT (G : {group gT}) (H : {group rT}) (K : {group aT}) : G \isog H -> homg K G = homg K H. Proof. rewrite isogEhom => /andP[homGH homHG]. by apply/idP/idP=> homK; apply: homg_trans homK _. Qed. End Homg. Arguments homg _ _ _%g _%g. Notation "G \homg H" := (homg G H) (at level 70, no associativity) : group_scope. Arguments homgP {rT aT C D}. (* Isomorphism between a group and its subtype. *) Section SubMorphism. Variables (gT : finGroupType) (G : {group gT}). Canonical sgval_morphism := Morphism (@sgvalM _ G). Canonical subg_morphism := Morphism (@subgM _ G). Lemma injm_sgval : 'injm sgval. Proof. exact/injmP/(in2W subg_inj). Qed. Lemma injm_subg : 'injm (subg G). Proof. exact/injmP/(can_in_inj subgK). Qed. Hint Resolve injm_sgval injm_subg : core. Lemma ker_sgval : 'ker sgval = 1. Proof. exact/trivgP. Qed. Lemma ker_subg : 'ker (subg G) = 1. Proof. exact/trivgP. Qed. Lemma im_subg : subg G @* G = [subg G]. Proof. apply/eqP; rewrite -subTset morphimEdom. by apply/subsetP=> u _; rewrite -(sgvalK u) imset_f ?subgP. Qed. Lemma sgval_sub A : sgval @* A \subset G. Proof. by apply/subsetP=> x; case/imsetP=> u _ ->; apply: subgP. Qed. Lemma sgvalmK A : subg G @* (sgval @* A) = A. Proof. apply/eqP; rewrite eqEcard !card_injm ?subsetT ?sgval_sub // leqnn andbT. rewrite -morphim_comp; apply/subsetP=> _ /morphimP[v _ Av ->] /=. by rewrite sgvalK. Qed. Lemma subgmK (A : {set gT}) : A \subset G -> sgval @* (subg G @* A) = A. Proof. move=> sAG; apply/eqP; rewrite eqEcard !card_injm ?subsetT //. rewrite leqnn andbT -morphim_comp morphimE /= morphpreT. by apply/subsetP=> _ /morphimP[v Gv Av ->] /=; rewrite subgK. Qed. Lemma im_sgval : sgval @* [subg G] = G. Proof. by rewrite -{2}im_subg subgmK. Qed. Lemma isom_subg : isom G [subg G] (subg G). Proof. by apply/isomP; rewrite im_subg. Qed. Lemma isom_sgval : isom [subg G] G sgval. Proof. by apply/isomP; rewrite im_sgval. Qed. Lemma isog_subg : isog G [subg G]. Proof. exact: isom_isog isom_subg. Qed. End SubMorphism. Arguments sgvalmK {gT G} A. Arguments subgmK {gT G} [A] sAG. math-comp-mathcomp-1.12.0/mathcomp/fingroup/perm.v000066400000000000000000000712101375767750300221060ustar00rootroot00000000000000(* (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 fintype tuple finfun bigop finset binomial. From mathcomp Require Import fingroup morphism. (******************************************************************************) (* This file contains the definition and properties associated to the group *) (* of permutations of an arbitrary finite type. *) (* {perm T} == the type of permutations of a finite type T, i.e., *) (* injective (finite) functions from T to T. Permutations *) (* coerce to CiC functions. *) (* 'S_n == the set of all permutations of 'I_n, i.e., of *) (* {0,.., n-1} *) (* perm_on A u == u is a permutation with support A, i.e., u only *) (* displaces elements of A (u x != x implies x \in A). *) (* tperm x y == the transposition of x, y. *) (* aperm x s == the image of x under the action of the permutation s. *) (* := s x *) (* cast_perm Emn s == the 'S_m permutation cast as a 'S_n permutation using *) (* Emn : m = n *) (* porbit s x == the set of all elements that are in the same cycle of *) (* the permutation s as x, i.e., {x, s x, (s ^+ 2) x, ...}.*) (* porbits s == the set of all the cycles of the permutation s. *) (* (s : bool) == s is an odd permutation (the coercion is called *) (* odd_perm). *) (* dpair u == u is a pair (x, y) of distinct objects (i.e., x != y). *) (* Sym S == the set of permutations with support S *) (* lift_perm i j s == the permutation obtained by lifting s : 'S_n.-1 over *) (* (i |-> j), that maps i to j and lift i k to *) (* lift j (s k). *) (* Canonical structures are defined allowing permutations to be an eqType, *) (* choiceType, countType, finType, subType, finGroupType; permutations with *) (* composition form a group, therefore inherit all generic group notations: *) (* 1 == identity permutation, * == composition, ^-1 == inverse permutation. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section PermDefSection. Variable T : finType. Inductive perm_type : predArgType := Perm (pval : {ffun T -> T}) & injectiveb pval. Definition pval p := let: Perm f _ := p in f. Definition perm_of of phant T := perm_type. Identity Coercion type_of_perm : perm_of >-> perm_type. Notation pT := (perm_of (Phant T)). Canonical perm_subType := Eval hnf in [subType for pval]. Definition perm_eqMixin := Eval hnf in [eqMixin of perm_type by <:]. Canonical perm_eqType := Eval hnf in EqType perm_type perm_eqMixin. Definition perm_choiceMixin := [choiceMixin of perm_type by <:]. Canonical perm_choiceType := Eval hnf in ChoiceType perm_type perm_choiceMixin. Definition perm_countMixin := [countMixin of perm_type by <:]. Canonical perm_countType := Eval hnf in CountType perm_type perm_countMixin. Canonical perm_subCountType := Eval hnf in [subCountType of perm_type]. Definition perm_finMixin := [finMixin of perm_type by <:]. Canonical perm_finType := Eval hnf in FinType perm_type perm_finMixin. Canonical perm_subFinType := Eval hnf in [subFinType of perm_type]. Canonical perm_for_subType := Eval hnf in [subType of pT]. Canonical perm_for_eqType := Eval hnf in [eqType of pT]. Canonical perm_for_choiceType := Eval hnf in [choiceType of pT]. Canonical perm_for_countType := Eval hnf in [countType of pT]. Canonical perm_for_subCountType := Eval hnf in [subCountType of pT]. Canonical perm_for_finType := Eval hnf in [finType of pT]. Canonical perm_for_subFinType := Eval hnf in [subFinType of pT]. Lemma perm_proof (f : T -> T) : injective f -> injectiveb (finfun f). Proof. by move=> f_inj; apply/injectiveP; apply: eq_inj f_inj _ => x; rewrite ffunE. Qed. End PermDefSection. Notation "{ 'perm' T }" := (perm_of (Phant T)) (at level 0, format "{ 'perm' T }") : type_scope. Arguments pval _ _%g. Bind Scope group_scope with perm_type. Bind Scope group_scope with perm_of. Notation "''S_' n" := {perm 'I_n} (at level 8, n at level 2, format "''S_' n"). Local Notation fun_of_perm_def := (fun T (u : perm_type T) => val u : T -> T). Local Notation perm_def := (fun T f injf => Perm (@perm_proof T f injf)). Module Type PermDefSig. Parameter fun_of_perm : forall T, perm_type T -> T -> T. Parameter perm : forall (T : finType) (f : T -> T), injective f -> {perm T}. Axiom fun_of_permE : fun_of_perm = fun_of_perm_def. Axiom permE : perm = perm_def. End PermDefSig. Module PermDef : PermDefSig. Definition fun_of_perm := fun_of_perm_def. Definition perm := perm_def. Lemma fun_of_permE : fun_of_perm = fun_of_perm_def. Proof. by []. Qed. Lemma permE : perm = perm_def. Proof. by []. Qed. End PermDef. Notation fun_of_perm := PermDef.fun_of_perm. Notation "@ 'perm'" := (@PermDef.perm) (at level 10, format "@ 'perm'"). Notation perm := (@PermDef.perm _ _). Canonical fun_of_perm_unlock := Unlockable PermDef.fun_of_permE. Canonical perm_unlock := Unlockable PermDef.permE. Coercion fun_of_perm : perm_type >-> Funclass. Section Theory. Variable T : finType. Implicit Types (x y : T) (s t : {perm T}) (S : {set T}). Lemma permP s t : s =1 t <-> s = t. Proof. by split=> [| -> //]; rewrite unlock => eq_sv; apply/val_inj/ffunP. Qed. Lemma pvalE s : pval s = s :> (T -> T). Proof. by rewrite [@fun_of_perm]unlock. Qed. Lemma permE f f_inj : @perm T f f_inj =1 f. Proof. by move=> x; rewrite -pvalE [@perm]unlock ffunE. Qed. Lemma perm_inj {s} : injective s. Proof. by rewrite -!pvalE; apply: (injectiveP _ (valP s)). Qed. Hint Resolve perm_inj : core. Lemma perm_onto s : codom s =i predT. Proof. by apply/subset_cardP; rewrite ?card_codom ?subset_predT. Qed. Definition perm_one := perm (@inj_id T). Lemma perm_invK s : cancel (fun x => iinv (perm_onto s x)) s. Proof. by move=> x /=; rewrite f_iinv. Qed. Definition perm_inv s := perm (can_inj (perm_invK s)). Definition perm_mul s t := perm (inj_comp (@perm_inj t) (@perm_inj s)). Lemma perm_oneP : left_id perm_one perm_mul. Proof. by move=> s; apply/permP => x; rewrite permE /= permE. Qed. Lemma perm_invP : left_inverse perm_one perm_inv perm_mul. Proof. by move=> s; apply/permP=> x; rewrite !permE /= permE f_iinv. Qed. Lemma perm_mulP : associative perm_mul. Proof. by move=> s t u; apply/permP=> x; do !rewrite permE /=. Qed. Definition perm_of_baseFinGroupMixin : FinGroup.mixin_of (perm_type T) := FinGroup.Mixin perm_mulP perm_oneP perm_invP. Canonical perm_baseFinGroupType := Eval hnf in BaseFinGroupType (perm_type T) perm_of_baseFinGroupMixin. Canonical perm_finGroupType := @FinGroupType perm_baseFinGroupType perm_invP. Canonical perm_of_baseFinGroupType := Eval hnf in [baseFinGroupType of {perm T}]. Canonical perm_of_finGroupType := Eval hnf in [finGroupType of {perm T} ]. Lemma perm1 x : (1 : {perm T}) x = x. Proof. by rewrite permE. Qed. Lemma permM s t x : (s * t) x = t (s x). Proof. by rewrite permE. Qed. Lemma permK s : cancel s s^-1. Proof. by move=> x; rewrite -permM mulgV perm1. Qed. Lemma permKV s : cancel s^-1 s. Proof. by have:= permK s^-1; rewrite invgK. Qed. Lemma permJ s t x : (s ^ t) (t x) = t (s x). Proof. by rewrite !permM permK. Qed. Lemma permX s x n : (s ^+ n) x = iter n s x. Proof. by elim: n => [|n /= <-]; rewrite ?perm1 // -permM expgSr. Qed. Lemma permX_fix s x n : s x = x -> (s ^+ n) x = x. Proof. move=> Hs; elim: n => [|n IHn]; first by rewrite expg0 perm1. by rewrite expgS permM Hs. Qed. Lemma im_permV s S : s^-1 @: S = s @^-1: S. Proof. exact: can2_imset_pre (permKV s) (permK s). Qed. Lemma preim_permV s S : s^-1 @^-1: S = s @: S. Proof. by rewrite -im_permV invgK. Qed. Definition perm_on S : pred {perm T} := fun s => [pred x | s x != x] \subset S. Lemma perm_closed S s x : perm_on S s -> (s x \in S) = (x \in S). Proof. move/subsetP=> s_on_S; have [-> // | nfix_s_x] := eqVneq (s x) x. by rewrite !s_on_S // inE /= ?(inj_eq perm_inj). Qed. Lemma perm_on1 H : perm_on H 1. Proof. by apply/subsetP=> x; rewrite inE /= perm1 eqxx. Qed. Lemma perm_onM H s t : perm_on H s -> perm_on H t -> perm_on H (s * t). Proof. move/subsetP=> sH /subsetP tH; apply/subsetP => x; rewrite inE /= permM. by have [-> /tH | /sH] := eqVneq (s x) x. Qed. Lemma out_perm S u x : perm_on S u -> x \notin S -> u x = x. Proof. by move=> uS; apply: contraNeq (subsetP uS x). Qed. Lemma im_perm_on u S : perm_on S u -> u @: S = S. Proof. move=> Su; rewrite -preim_permV; apply/setP=> x. by rewrite !inE -(perm_closed _ Su) permKV. Qed. Lemma imset_perm1 (S : {set T}) : [set (1 : {perm T}) x | x in S] = S. Proof. apply: im_perm_on; exact: perm_on1. Qed. Lemma tperm_proof x y : involutive [fun z => z with x |-> y, y |-> x]. Proof. move=> z /=; case: (z =P x) => [-> | ne_zx]; first by rewrite eqxx; case: eqP. by case: (z =P y) => [->| ne_zy]; [rewrite eqxx | do 2?case: eqP]. Qed. Definition tperm x y := perm (can_inj (tperm_proof x y)). Variant tperm_spec x y z : T -> Type := | TpermFirst of z = x : tperm_spec x y z y | TpermSecond of z = y : tperm_spec x y z x | TpermNone of z <> x & z <> y : tperm_spec x y z z. Lemma tpermP x y z : tperm_spec x y z (tperm x y z). Proof. by rewrite permE /=; do 2?[case: eqP => /=]; constructor; auto. Qed. Lemma tpermL x y : tperm x y x = y. Proof. by case: tpermP. Qed. Lemma tpermR x y : tperm x y y = x. Proof. by case: tpermP. Qed. Lemma tpermD x y z : x != z -> y != z -> tperm x y z = z. Proof. by case: tpermP => // ->; rewrite eqxx. Qed. Lemma tpermC x y : tperm x y = tperm y x. Proof. by apply/permP => z; do 2![case: tpermP => //] => ->. Qed. Lemma tperm1 x : tperm x x = 1. Proof. by apply/permP => z; rewrite perm1; case: tpermP. Qed. Lemma tpermK x y : involutive (tperm x y). Proof. by move=> z; rewrite !permE tperm_proof. Qed. Lemma tpermKg x y : involutive (mulg (tperm x y)). Proof. by move=> s; apply/permP=> z; rewrite !permM tpermK. Qed. Lemma tpermV x y : (tperm x y)^-1 = tperm x y. Proof. by set t := tperm x y; rewrite -{2}(mulgK t t) -mulgA tpermKg. Qed. Lemma tperm2 x y : tperm x y * tperm x y = 1. Proof. by rewrite -{1}tpermV mulVg. Qed. Lemma card_perm A : #|perm_on A| = (#|A|)`!. Proof. pose ffA := {ffun {x | x \in A} -> T}. rewrite -ffactnn -{2}(card_sig (mem A)) /= -card_inj_ffuns_on. pose fT (f : ffA) := [ffun x => oapp f x (insub x)]. pose pfT f := insubd (1 : {perm T}) (fT f). pose fA s : ffA := [ffun u => s (val u)]. rewrite -!sum1dep_card -sum1_card (reindex_onto fA pfT) => [|f]. apply: eq_bigl => p; rewrite andbC; apply/idP/and3P=> [onA | []]; first split. - apply/eqP; suffices fTAp: fT (fA p) = pval p. by apply/permP=> x; rewrite -!pvalE insubdK fTAp //; apply: (valP p). apply/ffunP=> x; rewrite ffunE pvalE. by case: insubP => [u _ <- | /out_perm->] //=; rewrite ffunE. - by apply/forallP=> [[x Ax]]; rewrite ffunE /= perm_closed. - by apply/injectiveP=> u v; rewrite !ffunE => /perm_inj; apply: val_inj. move/eqP=> <- _ _; apply/subsetP=> x; rewrite !inE -pvalE val_insubd fun_if. by rewrite if_arg ffunE; case: insubP; rewrite // pvalE perm1 if_same eqxx. case/andP=> /forallP-onA /injectiveP-f_inj. apply/ffunP=> u; rewrite ffunE -pvalE insubdK; first by rewrite ffunE valK. apply/injectiveP=> {u} x y; rewrite !ffunE. case: insubP => [u _ <-|]; case: insubP => [v _ <-|] //=; first by move/f_inj->. by move=> Ay' def_y; rewrite -def_y [_ \in A]onA in Ay'. by move=> Ax' def_x; rewrite def_x [_ \in A]onA in Ax'. Qed. End Theory. Prenex Implicits tperm permK permKV tpermK. Arguments perm_inj {T s} [x1 x2] eq_sx12. (* Shorthand for using a permutation to reindex a bigop. *) Notation reindex_perm s := (reindex_inj (@perm_inj _ s)). Lemma inj_tperm (T T' : finType) (f : T -> T') x y z : injective f -> f (tperm x y z) = tperm (f x) (f y) (f z). Proof. by move=> injf; rewrite !permE /= !(inj_eq injf) !(fun_if f). Qed. Lemma tpermJ (T : finType) x y (s : {perm T}) : (tperm x y) ^ s = tperm (s x) (s y). Proof. by apply/permP => z; rewrite -(permKV s z) permJ; apply/inj_tperm/perm_inj. Qed. Lemma tuple_permP {T : eqType} {n} {s : seq T} {t : n.-tuple T} : reflect (exists p : 'S_n, s = [tuple tnth t (p i) | i < n]) (perm_eq s t). Proof. apply: (iffP idP) => [|[p ->]]; last first. rewrite /= (map_comp (tnth t)) -{1}(map_tnth_enum t) perm_map //. apply: uniq_perm => [||i]; rewrite ?enum_uniq //. by apply/injectiveP; apply: perm_inj. by rewrite mem_enum -[i](permKV p) image_f. case: n => [|n] in t *; last have x0 := tnth t ord0. rewrite tuple0 => /perm_small_eq-> //. by exists 1; rewrite [mktuple _]tuple0. case/(perm_iotaP x0); rewrite size_tuple => Is eqIst ->{s}. have uniqIs: uniq Is by rewrite (perm_uniq eqIst) iota_uniq. have szIs: size Is == n.+1 by rewrite (perm_size eqIst) !size_tuple. have pP i : tnth (Tuple szIs) i < n.+1. by rewrite -[_ < _](mem_iota 0) -(perm_mem eqIst) mem_tnth. have inj_p: injective (fun i => Ordinal (pP i)). by apply/injectiveP/(@map_uniq _ _ val); rewrite -map_comp map_tnth_enum. exists (perm inj_p); rewrite -[Is]/(tval (Tuple szIs)); congr (tval _). by apply: eq_from_tnth => i; rewrite tnth_map tnth_mktuple permE (tnth_nth x0). Qed. Section PermutationParity. Variable T : finType. Implicit Types (s t u v : {perm T}) (x y z a b : T). (* Note that porbit s x is the orbit of x by <[s]> under the action aperm. *) (* Hence, the porbit lemmas below are special cases of more general lemmas *) (* on orbits that will be stated in action.v. *) (* Defining porbit directly here avoids a dependency of matrix.v on *) (* action.v and hence morphism.v. *) Definition aperm x s := s x. Definition porbit s x := aperm x @: <[s]>. Definition porbits s := porbit s @: T. Definition odd_perm (s : perm_type T) := odd #|T| (+) odd #|porbits s|. Lemma apermE x s : aperm x s = s x. Proof. by []. Qed. Lemma mem_porbit s i x : (s ^+ i) x \in porbit s x. Proof. by rewrite (imset_f (aperm x)) ?mem_cycle. Qed. Lemma porbit_id s x : x \in porbit s x. Proof. by rewrite -{1}[x]perm1 (mem_porbit s 0). Qed. Lemma card_porbit_neq0 s x : #|porbit s x| != 0. Proof. by rewrite -lt0n card_gt0; apply/set0Pn; exists x; exact: porbit_id. Qed. Lemma uniq_traject_porbit s x : uniq (traject s x #|porbit s x|). Proof. case def_n: #|_| => // [n]; rewrite looping_uniq. apply: contraL (card_size (traject s x n)) => /loopingP t_sx. rewrite -ltnNge size_traject -def_n ?subset_leq_card //. by apply/subsetP=> _ /imsetP[_ /cycleP[i ->] ->]; rewrite /aperm permX t_sx. Qed. Lemma porbit_traject s x : porbit s x =i traject s x #|porbit s x|. Proof. apply: fsym; apply/subset_cardP. by rewrite (card_uniqP _) ?size_traject ?uniq_traject_porbit. by apply/subsetP=> _ /trajectP[i _ ->]; rewrite -permX mem_porbit. Qed. Lemma iter_porbit s x : iter #|porbit s x| s x = x. Proof. case def_n: #|_| (uniq_traject_porbit s x) => [//|n] Ut. have: looping s x n.+1. by rewrite -def_n -[looping _ _ _]porbit_traject -permX mem_porbit. rewrite /looping => /trajectP[[|i] //= lt_i_n /perm_inj eq_i_n_sx]. move: lt_i_n; rewrite ltnS ltn_neqAle andbC => /andP[le_i_n /negP[]]. by rewrite -(nth_uniq x _ _ Ut) ?size_traject ?nth_traject // eq_i_n_sx. Qed. Lemma eq_porbit_mem s x y : (porbit s x == porbit s y) = (x \in porbit s y). Proof. apply/eqP/idP=> [<- | /imsetP[si s_si ->]]; first exact: porbit_id. apply/setP => z; apply/imsetP/imsetP=> [] [sj s_sj ->]. by exists (si * sj); rewrite ?groupM /aperm ?permM. exists (si^-1 * sj); first by rewrite groupM ?groupV. by rewrite /aperm permM permK. Qed. Lemma porbit_sym s x y : (x \in porbit s y) = (y \in porbit s x). Proof. by rewrite -!eq_porbit_mem eq_sym. Qed. Lemma porbit_perm s i x : porbit s ((s ^+ i) x) = porbit s x. Proof. by apply/eqP; rewrite eq_porbit_mem mem_porbit. Qed. Lemma porbitPmin s x y : y \in porbit s x -> exists2 i, i < #[s] & y = (s ^+ i) x. Proof. by move=> /imsetP [z /cyclePmin[ i Hi ->{z}] ->{y}]; exists i. Qed. Lemma porbitP s x y : reflect (exists i, y = (s ^+ i) x) (y \in porbit s x). Proof. apply (iffP idP) => [/porbitPmin [i _ ->]| [i ->]]; last exact: mem_porbit. by exists i. Qed. Lemma porbits_mul_tperm s x y : let t := tperm x y in #|porbits (t * s)| + (x \notin porbit s y).*2 = #|porbits s| + (x != y). Proof. pose xf a b u := find (pred2 a b) (traject u (u a) #|porbit u a|). have xf_size a b u: xf a b u <= #|porbit u a|. by rewrite (leq_trans (find_size _ _)) ?size_traject. have lt_xf a b u n : n < xf a b u -> ~~ pred2 a b ((u ^+ n.+1) a). move=> lt_n; apply: contraFN (before_find (u a) lt_n). by rewrite permX iterSr nth_traject // (leq_trans lt_n). pose t a b u := tperm a b * u. have tC a b u : t a b u = t b a u by rewrite /t tpermC. have tK a b: involutive (t a b) by move=> u; apply: tpermKg. have tXC a b u n: n <= xf a b u -> (t a b u ^+ n.+1) b = (u ^+ n.+1) a. elim: n => [|n IHn] lt_n_f; first by rewrite permM tpermR. rewrite !(expgSr _ n.+1) !permM {}IHn 1?ltnW //; congr (u _). by case/lt_xf/norP: lt_n_f => ne_a ne_b; rewrite tpermD // eq_sym. have eq_xf a b u: pred2 a b ((u ^+ (xf a b u).+1) a). have ua_a: a \in porbit u (u a) by rewrite porbit_sym (mem_porbit _ 1). have has_f: has (pred2 a b) (traject u (u a) #|porbit u (u a)|). by apply/hasP; exists a; rewrite /= ?eqxx -?porbit_traject. have:= nth_find (u a) has_f; rewrite has_find size_traject in has_f. rewrite -eq_porbit_mem in ua_a. by rewrite nth_traject // -iterSr -permX -(eqP ua_a). have xfC a b u: xf b a (t a b u) = xf a b u. without loss lt_a: a b u / xf b a (t a b u) < xf a b u. move=> IHab; set m := xf b a _; set n := xf a b u. by case: (ltngtP m n) => // ltx; [apply: IHab | rewrite -[m]IHab tC tK]. by move/lt_xf: (lt_a); rewrite -(tXC a b) 1?ltnW //= orbC [_ || _]eq_xf. pose ts := t x y s; rewrite /= -[_ * s]/ts. pose dp u := #|porbits u :\ porbit u y :\ porbit u x|. rewrite !(addnC #|_|) (cardsD1 (porbit ts y)) imset_f ?inE //. rewrite (cardsD1 (porbit ts x)) inE imset_f ?inE //= -/(dp ts) {}/ts. rewrite (cardsD1 (porbit s y)) (cardsD1 (porbit s x)) !(imset_f, inE) //. rewrite -/(dp s) !addnA !eq_porbit_mem andbT; congr (_ + _); last first. wlog suffices: s / dp s <= dp (t x y s). by move=> IHs; apply/eqP; rewrite eqn_leq -{2}(tK x y s) !IHs. apply/subset_leq_card/subsetP=> {dp} C. rewrite !inE andbA andbC !(eq_sym C) => /and3P[/imsetP[z _ ->{C}]]. rewrite 2!eq_porbit_mem => sxz syz. suffices ts_z: porbit (t x y s) z = porbit s z. by rewrite -ts_z !eq_porbit_mem {1 2}ts_z sxz syz imset_f ?inE. suffices exp_id n: ((t x y s) ^+ n) z = (s ^+ n) z. apply/setP=> u; apply/idP/idP=> /imsetP[_ /cycleP[i ->] ->]. by rewrite /aperm exp_id mem_porbit. by rewrite /aperm -exp_id mem_porbit. elim: n => // n IHn; rewrite !expgSr !permM {}IHn tpermD //. by apply: contraNneq sxz => ->; apply: mem_porbit. by apply: contraNneq syz => ->; apply: mem_porbit. case: eqP {dp} => [<- | ne_xy]; first by rewrite /t tperm1 mul1g porbit_id. suff ->: (x \in porbit (t x y s) y) = (x \notin porbit s y) by case: (x \in _). without loss xf_x: s x y ne_xy / (s ^+ (xf x y s).+1) x = x. move=> IHs; have ne_yx := nesym ne_xy; have:= eq_xf x y s; set n := xf x y s. case/pred2P=> [|snx]; first exact: IHs. by rewrite -[x \in _]negbK ![x \in _]porbit_sym -{}IHs ?xfC ?tXC // tC tK. rewrite -{1}xf_x -(tXC _ _ _ _ (leqnn _)) mem_porbit; symmetry. rewrite -eq_porbit_mem eq_sym eq_porbit_mem porbit_traject. apply/trajectP=> [[n _ snx]]. have: looping s x (xf x y s).+1 by rewrite /looping -permX xf_x inE eqxx. move/loopingP/(_ n); rewrite -{n}snx. case/trajectP=> [[_|i]]; first exact: nesym; rewrite ltnS -permX => lt_i def_y. by move/lt_xf: lt_i; rewrite def_y /= eqxx orbT. Qed. Lemma odd_perm1 : odd_perm 1 = false. Proof. rewrite /odd_perm card_imset ?addbb // => x y; move/eqP. by rewrite eq_porbit_mem /porbit cycle1 imset_set1 /aperm perm1; move/set1P. Qed. Lemma odd_mul_tperm x y s : odd_perm (tperm x y * s) = (x != y) (+) odd_perm s. Proof. rewrite addbC -addbA -[~~ _]oddb -oddD -porbits_mul_tperm. by rewrite oddD odd_double addbF. Qed. Lemma odd_tperm x y : odd_perm (tperm x y) = (x != y). Proof. by rewrite -[_ y]mulg1 odd_mul_tperm odd_perm1 addbF. Qed. Definition dpair (eT : eqType) := [pred t | t.1 != t.2 :> eT]. Arguments dpair {eT}. Lemma prod_tpermP s : {ts : seq (T * T) | s = \prod_(t <- ts) tperm t.1 t.2 & all dpair ts}. Proof. have [n] := ubnP #|[pred x | s x != x]|; elim: n s => // n IHn s /ltnSE-le_s_n. case: (pickP (fun x => s x != x)) => [x s_x | s_id]; last first. exists nil; rewrite // big_nil; apply/permP=> x. by apply/eqP/idPn; rewrite perm1 s_id. have [|ts def_s ne_ts] := IHn (tperm x (s^-1 x) * s); last first. exists ((x, s^-1 x) :: ts); last by rewrite /= -(canF_eq (permK _)) s_x. by rewrite big_cons -def_s mulgA tperm2 mul1g. rewrite (cardD1 x) !inE s_x in le_s_n; apply: leq_ltn_trans le_s_n. apply: subset_leq_card; apply/subsetP=> y. rewrite !inE permM permE /= -(canF_eq (permK _)). have [-> | ne_yx] := eqVneq y x; first by rewrite permKV eqxx. by case: (s y =P x) => // -> _; rewrite eq_sym. Qed. Lemma odd_perm_prod ts : all dpair ts -> odd_perm (\prod_(t <- ts) tperm t.1 t.2) = odd (size ts). Proof. elim: ts => [_|t ts IHts] /=; first by rewrite big_nil odd_perm1. by case/andP=> dt12 dts; rewrite big_cons odd_mul_tperm dt12 IHts. Qed. Lemma odd_permM : {morph odd_perm : s1 s2 / s1 * s2 >-> s1 (+) s2}. Proof. move=> s1 s2; case: (prod_tpermP s1) => ts1 ->{s1} dts1. case: (prod_tpermP s2) => ts2 ->{s2} dts2. by rewrite -big_cat !odd_perm_prod ?all_cat ?dts1 // size_cat oddD. Qed. Lemma odd_permV s : odd_perm s^-1 = odd_perm s. Proof. by rewrite -{2}(mulgK s s) !odd_permM -addbA addKb. Qed. Lemma odd_permJ s1 s2 : odd_perm (s1 ^ s2) = odd_perm s1. Proof. by rewrite !odd_permM odd_permV addbC addbK. Qed. End PermutationParity. Coercion odd_perm : perm_type >-> bool. Arguments dpair {eT}. Prenex Implicits porbit dpair porbits aperm. Section Symmetry. Variables (T : finType) (S : {set T}). Definition Sym : {set {perm T}} := [set s | perm_on S s]. Lemma Sym_group_set : group_set Sym. Proof. apply/group_setP; split => [| s t]; rewrite !inE; [exact: perm_on1 | exact: perm_onM]. Qed. Canonical Sym_group : {group {perm T}} := Group Sym_group_set. Lemma card_Sym : #|Sym| = #|S|`!. Proof. by rewrite cardsE /= card_perm. Qed. End Symmetry. Section LiftPerm. (* Somewhat more specialised constructs for permutations on ordinals. *) Variable n : nat. Implicit Types i j : 'I_n.+1. Implicit Types s t : 'S_n. Lemma card_Sn : #|'S_(n)| = n`!. Proof. rewrite (eq_card (B := perm_on [set : 'I_n])). by rewrite card_perm /= cardsE /= card_ord. move=> p; rewrite inE unfold_in /perm_on /=. by apply/esym/subsetP => i _; rewrite in_set. Qed. Definition lift_perm_fun i j s k := if unlift i k is Some k' then lift j (s k') else j. Lemma lift_permK i j s : cancel (lift_perm_fun i j s) (lift_perm_fun j i s^-1). Proof. rewrite /lift_perm_fun => k. by case: (unliftP i k) => [j'|] ->; rewrite (liftK, unlift_none) ?permK. Qed. Definition lift_perm i j s := perm (can_inj (lift_permK i j s)). Lemma lift_perm_id i j s : lift_perm i j s i = j. Proof. by rewrite permE /lift_perm_fun unlift_none. Qed. Lemma lift_perm_lift i j s k' : lift_perm i j s (lift i k') = lift j (s k') :> 'I_n.+1. Proof. by rewrite permE /lift_perm_fun liftK. Qed. Lemma lift_permM i j k s t : lift_perm i j s * lift_perm j k t = lift_perm i k (s * t). Proof. apply/permP=> i1; case: (unliftP i i1) => [i2|] ->{i1}. by rewrite !(permM, lift_perm_lift). by rewrite permM !lift_perm_id. Qed. Lemma lift_perm1 i : lift_perm i i 1 = 1. Proof. by apply: (mulgI (lift_perm i i 1)); rewrite lift_permM !mulg1. Qed. Lemma lift_permV i j s : (lift_perm i j s)^-1 = lift_perm j i s^-1. Proof. by apply/eqP; rewrite eq_invg_mul lift_permM mulgV lift_perm1. Qed. Lemma odd_lift_perm i j s : lift_perm i j s = odd i (+) odd j (+) s :> bool. Proof. rewrite -{1}(mul1g s) -(lift_permM _ j) odd_permM. congr (_ (+) _); last first. case: (prod_tpermP s) => ts ->{s} _. elim: ts => [|t ts IHts] /=; first by rewrite big_nil lift_perm1 !odd_perm1. rewrite big_cons odd_mul_tperm -(lift_permM _ j) odd_permM {}IHts //. congr (_ (+) _); transitivity (tperm (lift j t.1) (lift j t.2)); last first. by rewrite odd_tperm (inj_eq (pcan_inj (liftK j))). congr odd_perm; apply/permP=> k; case: (unliftP j k) => [k'|] ->. by rewrite lift_perm_lift inj_tperm //; apply: lift_inj. by rewrite lift_perm_id tpermD // eq_sym neq_lift. suff{i j s} odd_lift0 (k : 'I_n.+1): lift_perm ord0 k 1 = odd k :> bool. rewrite -!odd_lift0 -{2}invg1 -lift_permV odd_permV -odd_permM. by rewrite lift_permM mulg1. elim: {k}(k : nat) {1 3}k (erefl (k : nat)) => [|m IHm] k def_k. by rewrite (_ : k = ord0) ?lift_perm1 ?odd_perm1 //; apply: val_inj. have le_mn: m < n.+1 by [rewrite -def_k ltnW]; pose j := Ordinal le_mn. rewrite -(mulg1 1)%g -(lift_permM _ j) odd_permM {}IHm // addbC. rewrite (_ : _ 1 = tperm j k); first by rewrite odd_tperm neq_ltn def_k leqnn. apply/permP=> i; case: (unliftP j i) => [i'|] ->; last first. by rewrite lift_perm_id tpermL. apply: ord_inj; rewrite lift_perm_lift !permE /= eq_sym -if_neg neq_lift. rewrite fun_if -val_eqE /= def_k /bump ltn_neqAle andbC. case: leqP => [_ | lt_i'm] /=; last by rewrite -if_neg neq_ltn leqW. by rewrite add1n eqSS; case: eqVneq. Qed. End LiftPerm. Prenex Implicits lift_perm lift_permK. Lemma permS0 : all_equal_to (1 : 'S_0). Proof. by move=> g; apply/permP; case. Qed. Lemma permS1 : all_equal_to (1 : 'S_1). Proof. by move=> g; apply/permP => i; rewrite !ord1. Qed. Lemma permS01 n : n <= 1 -> all_equal_to (1 : 'S_n). Proof. by case: n => [|[|]//=] _ g; rewrite (permS0, permS1). Qed. Section CastSn. Definition cast_perm m n (eq_mn : m = n) (s : 'S_m) := let: erefl in _ = n := eq_mn return 'S_n in s. Lemma cast_perm_id n eq_n s : cast_perm eq_n s = s :> 'S_n. Proof. by apply/permP => i; rewrite /cast_perm /= eq_axiomK. Qed. Lemma cast_ord_permE m n eq_m_n (s : 'S_m) i : @cast_ord m n eq_m_n (s i) = (cast_perm eq_m_n s) (cast_ord eq_m_n i). Proof. by subst m; rewrite cast_perm_id !cast_ord_id. Qed. Lemma cast_permE m n (eq_m_n : m = n) (s : 'S_m) (i : 'I_n) : cast_perm eq_m_n s i = cast_ord eq_m_n (s (cast_ord (esym eq_m_n) i)). Proof. by rewrite cast_ord_permE cast_ordKV. Qed. Lemma cast_perm_comp m n p (eq_m_n : m = n) (eq_n_p : n = p) s : cast_perm eq_n_p (cast_perm eq_m_n s) = cast_perm (etrans eq_m_n eq_n_p) s. Proof. by case: _ / eq_n_p. Qed. Lemma cast_permK m n eq_m_n : cancel (@cast_perm m n eq_m_n) (cast_perm (esym eq_m_n)). Proof. by subst m. Qed. Lemma cast_permKV m n eq_m_n : cancel (cast_perm (esym eq_m_n)) (@cast_perm m n eq_m_n). Proof. by subst m. Qed. Lemma cast_perm_sym m n (eq_m_n : m = n) s t : s = cast_perm eq_m_n t -> t = cast_perm (esym eq_m_n) s. Proof. by move/(canLR (cast_permK _)). Qed. Lemma cast_perm_inj m n eq_m_n : injective (@cast_perm m n eq_m_n). Proof. exact: can_inj (cast_permK eq_m_n). Qed. Lemma cast_perm_morphM m n eq_m_n : {morph @cast_perm m n eq_m_n : x y / x * y >-> x * y}. Proof. by subst m. Qed. Canonical morph_of_cast_perm m n eq_m_n := @Morphism _ _ setT (cast_perm eq_m_n) (in2W (@cast_perm_morphM m n eq_m_n)). Lemma isom_cast_perm m n eq_m_n : isom setT setT (@cast_perm m n eq_m_n). Proof. case: {n} _ / eq_m_n; apply/isomP; split. exact/injmP/(in2W (@cast_perm_inj _ _ _)). by apply/setP => /= s; rewrite !inE; apply/imsetP; exists s; rewrite ?inE. Qed. End CastSn. Notation tuple_perm_eqP := (deprecate tuple_perm_eqP tuple_permP) (only parsing). Notation pcycle := (deprecate pcycle porbit _) (only parsing). Notation pcycles := (deprecate pcycles porbits _) (only parsing). Notation mem_pcycle := (deprecate mem_pcycle mem_porbit _) (only parsing). Notation pcycle_id := (deprecate pcycle_id porbit_id _) (only parsing). Notation uniq_traject_pcycle := (deprecate uniq_traject_pcycle uniq_traject_porbit _) (only parsing). Notation pcycle_traject := (deprecate pcycle_traject porbit_traject _) (only parsing). Notation iter_pcycle := (deprecate iter_pcycle iter_porbit _) (only parsing). Notation eq_pcycle_mem := (deprecate eq_pcycle_mem eq_porbit_mem _) (only parsing). Notation pcycle_sym := (deprecate pcycle_sym porbit_sym _) (only parsing). Notation pcycle_perm := (deprecate pcycle_perm porbit_perm _) (only parsing). Notation ncycles_mul_tperm := (deprecate ncycles_mul_tperm porbits_mul_tperm _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/fingroup/presentation.v000066400000000000000000000261341375767750300236630ustar00rootroot00000000000000(* (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. From mathcomp Require Import fintype finset fingroup morphism. (******************************************************************************) (* Support for generator-and-relation presentations of groups. We provide the *) (* syntax: *) (* G \homg Grp (x_1 : ... x_n : (s_1 = t_1, ..., s_m = t_m)) *) (* <=> G is generated by elements x_1, ..., x_m satisfying the relations *) (* s_1 = t_1, ..., s_m = t_m, i.e., G is a homomorphic image of the *) (* group generated by the x_i, subject to the relations s_j = t_j. *) (* G \isog Grp (x_1 : ... x_n : (s_1 = t_1, ..., s_m = t_m)) *) (* <=> G is isomorphic to the group generated by the x_i, subject to the *) (* relations s_j = t_j. This is an intensional predicate (in Prop), as *) (* even the non-triviality of a generated group is undecidable. *) (* Syntax details: *) (* - Grp is a litteral constant. *) (* - There must be at least one generator and one relation. *) (* - A relation s_j = 1 can be abbreviated as simply s_j (a.k.a. a relator). *) (* - Two consecutive relations s_j = t, s_j+1 = t can be abbreviated *) (* s_j = s_j+1 = t. *) (* - The s_j and t_j are terms built from the x_i and the standard group *) (* operators *, 1, ^-1, ^+, ^-, ^, [~ u_1, ..., u_k]; no other operator or *) (* abbreviation may be used, as the notation is implemented using static *) (* overloading. *) (* - This is the closest we could get to the notation used in Aschbacher, *) (* Grp (x_1, ... x_n : t_1,1 = ... = t_1,k1, ..., t_m,1 = ... = t_m,km) *) (* under the current limitations of the Coq Notation facility. *) (* Semantics details: *) (* - G \isog Grp (...) : Prop expands to the statement *) (* forall rT (H : {group rT}), (H \homg G) = (H \homg Grp (...)) *) (* (with rT : finGroupType). *) (* - G \homg Grp (x_1 : ... x_n : (s_1 = t_1, ..., s_m = t_m)) : bool, with *) (* G : {set gT}, is convertible to the boolean expression *) (* [exists t : gT * ... gT, let: (x_1, ..., x_n) := t in *) (* (<[x_1]> <*> ... <*> <[x_n]>, (s_1, ... (s_m-1, s_m) ...)) *) (* == (G, (t_1, ... (t_m-1, t_m) ...))] *) (* where the tuple comparison above is convertible to the conjunction *) (* [&& <[x_1]> <*> ... <*> <[x_n]> == G, s_1 == t_1, ... & s_m == t_m] *) (* Thus G \homg Grp (...) can be easily exploited by destructing the tuple *) (* created case/existsP, then destructing the tuple equality with case/eqP. *) (* Conversely it can be proved by using apply/existsP, providing the tuple *) (* with a single exists (u_1, ..., u_n), then using rewrite !xpair_eqE /= *) (* to expose the conjunction, and optionally using an apply/and{m+1}P view *) (* to split it into subgoals (in that case, the rewrite is in principle *) (* redundant, but necessary in practice because of the poor performance of *) (* conversion in the Coq unifier). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope group_presentation. Declare Scope nt_group_presentation. Import GroupScope. Module Presentation. Section Presentation. Implicit Types gT rT : finGroupType. Implicit Type vT : finType. (* tuple value type *) Inductive term := | Cst of nat | Idx | Inv of term | Exp of term & nat | Mul of term & term | Conj of term & term | Comm of term & term. Fixpoint eval {gT} e t : gT := match t with | Cst i => nth 1 e i | Idx => 1 | Inv t1 => (eval e t1)^-1 | Exp t1 n => eval e t1 ^+ n | Mul t1 t2 => eval e t1 * eval e t2 | Conj t1 t2 => eval e t1 ^ eval e t2 | Comm t1 t2 => [~ eval e t1, eval e t2] end. Inductive formula := Eq2 of term & term | And of formula & formula. Definition Eq1 s := Eq2 s Idx. Definition Eq3 s1 s2 t := And (Eq2 s1 t) (Eq2 s2 t). Inductive rel_type := NoRel | Rel vT of vT & vT. Definition bool_of_rel r := if r is Rel vT v1 v2 then v1 == v2 else true. Local Coercion bool_of_rel : rel_type >-> bool. Definition and_rel vT (v1 v2 : vT) r := if r is Rel wT w1 w2 then Rel (v1, w1) (v2, w2) else Rel v1 v2. Fixpoint rel {gT} (e : seq gT) f r := match f with | Eq2 s t => and_rel (eval e s) (eval e t) r | And f1 f2 => rel e f1 (rel e f2 r) end. Inductive type := Generator of term -> type | Formula of formula. Definition Cast p : type := p. (* syntactic scope cast *) Local Coercion Formula : formula >-> type. Inductive env gT := Env of {set gT} & seq gT. Definition env1 {gT} (x : gT : finType) := Env <[x]> [:: x]. Fixpoint sat gT vT B n (s : vT -> env gT) p := match p with | Formula f => [exists v, let: Env A e := s v in and_rel A B (rel (rev e) f NoRel)] | Generator p' => let s' v := let: Env A e := s v.1 in Env (A <*> <[v.2]>) (v.2 :: e) in sat B n.+1 s' (p' (Cst n)) end. Definition hom gT (B : {set gT}) p := sat B 1 env1 (p (Cst 0)). Definition iso gT (B : {set gT}) p := forall rT (H : {group rT}), (H \homg B) = hom H p. End Presentation. End Presentation. Import Presentation. Coercion bool_of_rel : rel_type >-> bool. Coercion Eq1 : term >-> formula. Coercion Formula : formula >-> type. (* Declare (implicitly) the argument scope tags. *) Notation "1" := Idx : group_presentation. Arguments Inv _%group_presentation. Arguments Exp _%group_presentation _%N. Arguments Mul _%group_presentation _%group_presentation. Arguments Conj _%group_presentation _%group_presentation. Arguments Comm _%group_presentation _%group_presentation. Arguments Eq1 _%group_presentation. Arguments Eq2 _%group_presentation _%group_presentation. Arguments Eq3 _%group_presentation _%group_presentation _%group_presentation. Arguments And _%group_presentation _%group_presentation. Arguments Formula _%group_presentation. Arguments Cast _%group_presentation. Infix "*" := Mul : group_presentation. Infix "^+" := Exp : group_presentation. Infix "^" := Conj : group_presentation. Notation "x ^-1" := (Inv x) : group_presentation. Notation "x ^- n" := (Inv (x ^+ n)) : group_presentation. Notation "[ ~ x1 , x2 , .. , xn ]" := (Comm .. (Comm x1 x2) .. xn) : group_presentation. Notation "x = y" := (Eq2 x y) : group_presentation. Notation "x = y = z" := (Eq3 x y z) : group_presentation. Notation "( r1 , r2 , .. , rn )" := (And .. (And r1 r2) .. rn) : group_presentation. (* Declare (implicitly) the argument scope tags. *) Notation "x : p" := (fun x => Cast p) : nt_group_presentation. Arguments Generator _%nt_group_presentation. Arguments hom _ _%group_scope _%nt_group_presentation. Arguments iso _ _%group_scope _%nt_group_presentation. Notation "x : p" := (Generator (x : p)) : group_presentation. Notation "H \homg 'Grp' p" := (hom H p) (at level 70, p at level 0, format "H \homg 'Grp' p") : group_scope. Notation "H \isog 'Grp' p" := (iso H p) (at level 70, p at level 0, format "H \isog 'Grp' p") : group_scope. Notation "H \homg 'Grp' ( x : p )" := (hom H (x : p)) (at level 70, x at level 0, format "'[hv' H '/ ' \homg 'Grp' ( x : p ) ']'") : group_scope. Notation "H \isog 'Grp' ( x : p )" := (iso H (x : p)) (at level 70, x at level 0, format "'[hv' H '/ ' \isog 'Grp' ( x : p ) ']'") : group_scope. Section PresentationTheory. Implicit Types gT rT : finGroupType. Import Presentation. Lemma isoGrp_hom gT (G : {group gT}) p : G \isog Grp p -> G \homg Grp p. Proof. by move <-; apply: homg_refl. Qed. Lemma isoGrpP gT (G : {group gT}) p rT (H : {group rT}) : G \isog Grp p -> reflect (#|H| = #|G| /\ H \homg Grp p) (H \isog G). Proof. move=> isoGp; apply: (iffP idP) => [isoGH | [oH homHp]]. by rewrite (card_isog isoGH) -isoGp isog_hom. by rewrite isogEcard isoGp homHp /= oH. Qed. Lemma homGrp_trans rT gT (H : {set rT}) (G : {group gT}) p : H \homg G -> G \homg Grp p -> H \homg Grp p. Proof. case/homgP=> h <-{H}; rewrite /hom; move: {p}(p _) => p. have evalG e t: all (mem G) e -> eval (map h e) t = h (eval e t). move=> Ge; apply: (@proj2 (eval e t \in G)); elim: t => /=. - move=> i; case: (leqP (size e) i) => [le_e_i | lt_i_e]. by rewrite !nth_default ?size_map ?morph1. by rewrite (nth_map 1) // [_ \in G](allP Ge) ?mem_nth. - by rewrite morph1. - by move=> t [Gt ->]; rewrite groupV morphV. - by move=> t [Gt ->] n; rewrite groupX ?morphX. - by move=> t1 [Gt1 ->] t2 [Gt2 ->]; rewrite groupM ?morphM. - by move=> t1 [Gt1 ->] t2 [Gt2 ->]; rewrite groupJ ?morphJ. by move=> t1 [Gt1 ->] t2 [Gt2 ->]; rewrite groupR ?morphR. have and_relE xT x1 x2 r: @and_rel xT x1 x2 r = (x1 == x2) && r :> bool. by case: r => //=; rewrite andbT. have rsatG e f: all (mem G) e -> rel e f NoRel -> rel (map h e) f NoRel. move=> Ge; have: NoRel -> NoRel by []; move: NoRel {2 4}NoRel. elim: f => [x1 x2 | f1 IH1 f2 IH2] r hr IHr; last by apply: IH1; apply: IH2. by rewrite !and_relE !evalG //; case/andP; move/eqP->; rewrite eqxx. set s := env1; set vT := gT : finType in s *. set s' := env1; set vT' := rT : finType in s' *. have (v): let: Env A e := s v in A \subset G -> all (mem G) e /\ exists v', s' v' = Env (h @* A) (map h e). - rewrite /= cycle_subG andbT => Gv; rewrite morphim_cycle //. by split; last exists (h v). elim: p 1%N vT vT' s s' => /= [p IHp | f] n vT vT' s s' Gs. apply: IHp => [[v x]] /=; case: (s v) {Gs}(Gs v) => A e /= Gs. rewrite join_subG cycle_subG; case/andP=> sAG Gx; rewrite Gx. have [//|-> [v' def_v']] := Gs; split=> //; exists (v', h x); rewrite def_v'. by congr (Env _ _); rewrite morphimY ?cycle_subG // morphim_cycle. case/existsP=> v; case: (s v) {Gs}(Gs v) => /= A e Gs. rewrite and_relE => /andP[/eqP defA rel_f]. have{Gs} [|Ge [v' def_v']] := Gs; first by rewrite defA. apply/existsP; exists v'; rewrite def_v' and_relE defA eqxx /=. by rewrite -map_rev rsatG ?(eq_all_r (mem_rev e)). Qed. Lemma eq_homGrp gT rT (G : {group gT}) (H : {group rT}) p : G \isog H -> (G \homg Grp p) = (H \homg Grp p). Proof. by rewrite isogEhom => /andP[homGH homHG]; apply/idP/idP; apply: homGrp_trans. Qed. Lemma isoGrp_trans gT rT (G : {group gT}) (H : {group rT}) p : G \isog H -> H \isog Grp p -> G \isog Grp p. Proof. by move=> isoGH isoHp kT K; rewrite -isoHp; apply: eq_homgr. Qed. Lemma intro_isoGrp gT (G : {group gT}) p : G \homg Grp p -> (forall rT (H : {group rT}), H \homg Grp p -> H \homg G) -> G \isog Grp p. Proof. move=> homGp freeG rT H. by apply/idP/idP=> [homHp|]; [apply: homGrp_trans homGp | apply: freeG]. Qed. End PresentationTheory. math-comp-mathcomp-1.12.0/mathcomp/fingroup/quotient.v000066400000000000000000001036241375767750300230200ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype prime finset fingroup morphism. From mathcomp Require Import automorphism. (******************************************************************************) (* This file contains the definitions of: *) (* coset_of H == the (sub)type of bilateral cosets of H (see below). *) (* coset H == the canonical projection into coset_of H. *) (* A / H == the quotient of A by H, that is, the morphic image *) (* of A by coset H. We do not require H <| A, so in a *) (* textbook A / H would be written 'N_A(H) * H / H. *) (* quotm f (nHG : H <| G) == the quotient morphism induced by f, *) (* mapping G / H onto f @* G / f @* H. *) (* qisom f (eqHG : H = G) == the identity isomorphism between *) (* [set: coset_of G] and [set: coset_of H]. *) (* We also prove the three isomorphism theorems, and counting lemmas for *) (* morphisms. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Cosets. Variables (gT : finGroupType) (Q A : {set gT}). (******************************************************************************) (* Cosets are right cosets of elements in the normaliser. *) (* We let cosets coerce to GroupSet.sort, so they inherit the group subset *) (* base group structure. Later we will define a proper group structure on *) (* cosets, which will then hide the inherited structure once coset_of unifies *) (* with FinGroup.sort; the coercion to GroupSet.sort will no longer be used. *) (* Note that for Hx Hy : coset_of H, Hx * Hy : {set gT} can mean either *) (* set_of_coset (mulg Hx Hy) OR mulg (set_of_coset Hx) (set_of_coset Hy). *) (* However, since the two terms are actually convertible, we can live with *) (* this ambiguity. *) (* We take great care that neither the type coset_of H, nor its Canonical *) (* finGroupType structure, nor the coset H morphism depend on the actual *) (* group structure of H. Otherwise, rewriting would be extremely awkward *) (* because all our equalities are stated at the set level. *) (* The trick we use is to interpret coset_of A, when A is any set, as the *) (* type of cosets of the group <> generated by A, in the group A <*> N(A) *) (* generated by A and its normaliser. This coincides with the type of *) (* bilateral cosets of A when A is a group. We restrict the domain of coset A *) (* to 'N(A), so that we get almost all the same conversion equalities as if *) (* we had forced A to be a group in the first place; the only exception, that *) (* 1 : coset_of A : {set gT} = <> rather than A, can be handled by genGid. *) (******************************************************************************) Notation H := <>. Definition coset_range := [pred B in rcosets H 'N(A)]. Record coset_of : Type := Coset { set_of_coset :> GroupSet.sort gT; _ : coset_range set_of_coset }. Canonical coset_subType := Eval hnf in [subType for set_of_coset]. Definition coset_eqMixin := Eval hnf in [eqMixin of coset_of by <:]. Canonical coset_eqType := Eval hnf in EqType coset_of coset_eqMixin. Definition coset_choiceMixin := [choiceMixin of coset_of by <:]. Canonical coset_choiceType := Eval hnf in ChoiceType coset_of coset_choiceMixin. Definition coset_countMixin := [countMixin of coset_of by <:]. Canonical coset_countType := Eval hnf in CountType coset_of coset_countMixin. Canonical coset_subCountType := Eval hnf in [subCountType of coset_of]. Definition coset_finMixin := [finMixin of coset_of by <:]. Canonical coset_finType := Eval hnf in FinType coset_of coset_finMixin. Canonical coset_subFinType := Eval hnf in [subFinType of coset_of]. (* We build a new (canonical) structure of groupType for cosets. *) (* When A is a group, this is the largest possible quotient 'N(A) / A. *) Lemma coset_one_proof : coset_range H. Proof. by apply/rcosetsP; exists (1 : gT); rewrite (group1, mulg1). Qed. Definition coset_one := Coset coset_one_proof. Let nNH := subsetP (norm_gen A). Lemma coset_range_mul (B C : coset_of) : coset_range (B * C). Proof. case: B C => _ /= /rcosetsP[x Nx ->] [_ /= /rcosetsP[y Ny ->]]. by apply/rcosetsP; exists (x * y); rewrite !(groupM, rcoset_mul, nNH). Qed. Definition coset_mul B C := Coset (coset_range_mul B C). Lemma coset_range_inv (B : coset_of) : coset_range B^-1. Proof. case: B => _ /= /rcosetsP[x Nx ->]; rewrite norm_rlcoset ?nNH // invg_lcoset. by apply/rcosetsP; exists x^-1; rewrite ?groupV. Qed. Definition coset_inv B := Coset (coset_range_inv B). Lemma coset_mulP : associative coset_mul. Proof. by move=> B C D; apply: val_inj; rewrite /= mulgA. Qed. Lemma coset_oneP : left_id coset_one coset_mul. Proof. case=> B coB; apply: val_inj => /=; case/rcosetsP: coB => x Hx ->{B}. by rewrite mulgA mulGid. Qed. Lemma coset_invP : left_inverse coset_one coset_inv coset_mul. Proof. case=> B coB; apply: val_inj => /=; case/rcosetsP: coB => x Hx ->{B}. rewrite invg_rcoset -mulgA (mulgA H) mulGid. by rewrite norm_rlcoset ?nNH // -lcosetM mulVg mul1g. Qed. Definition coset_of_groupMixin := FinGroup.Mixin coset_mulP coset_oneP coset_invP. Canonical coset_baseGroupType := Eval hnf in BaseFinGroupType coset_of coset_of_groupMixin. Canonical coset_groupType := FinGroupType coset_invP. (* Projection of the initial group type over the cosets groupType. *) Definition coset x : coset_of := insubd (1 : coset_of) (H :* x). (* This is a primitive lemma -- we'll need to restate it for *) (* the case where A is a group. *) Lemma val_coset_prim x : x \in 'N(A) -> coset x :=: H :* x. Proof. by move=> Nx; rewrite val_insubd /= mem_rcosets -{1}(mul1g x) mem_mulg. Qed. Lemma coset_morphM : {in 'N(A) &, {morph coset : x y / x * y}}. Proof. move=> x y Nx Ny; apply: val_inj. by rewrite /= !val_coset_prim ?groupM //= rcoset_mul ?nNH. Qed. Canonical coset_morphism := Morphism coset_morphM. Lemma ker_coset_prim : 'ker coset = 'N_H(A). Proof. apply/setP=> z; rewrite !in_setI andbC 2!inE -val_eqE /=. case Nz: (z \in 'N(A)); rewrite ?andbF ?val_coset_prim // !andbT. by apply/eqP/idP=> [<-| Az]; rewrite (rcoset_refl, rcoset_id). Qed. Implicit Type xbar : coset_of. Lemma coset_mem y xbar : y \in xbar -> coset y = xbar. Proof. case: xbar => /= Hx NHx Hxy; apply: val_inj=> /=. case/rcosetsP: NHx (NHx) Hxy => x Nx -> NHx Hxy. by rewrite val_insubd /= (rcoset_eqP Hxy) NHx. Qed. (* coset is an inverse to repr *) Lemma mem_repr_coset xbar : repr xbar \in xbar. Proof. by case: xbar => /= _ /rcosetsP[x _ ->]; apply: mem_repr_rcoset. Qed. Lemma repr_coset1 : repr (1 : coset_of) = 1. Proof. exact: repr_group. Qed. Lemma coset_reprK : cancel (fun xbar => repr xbar) coset. Proof. by move=> xbar; apply: coset_mem (mem_repr_coset xbar). Qed. (* cosetP is slightly stronger than using repr because we only *) (* guarantee repr xbar \in 'N(A) when A is a group. *) Lemma cosetP xbar : {x | x \in 'N(A) & xbar = coset x}. Proof. pose x := repr 'N_xbar(A). have [xbar_x Nx]: x \in xbar /\ x \in 'N(A). apply/setIP; rewrite {}/x; case: xbar => /= _ /rcosetsP[y Ny ->]. by apply: (mem_repr y); rewrite inE rcoset_refl. by exists x; last rewrite (coset_mem xbar_x). Qed. Lemma coset_id x : x \in A -> coset x = 1. Proof. by move=> Ax; apply: coset_mem; apply: mem_gen. Qed. Lemma im_coset : coset @* 'N(A) = setT. Proof. by apply/setP=> xbar; case: (cosetP xbar) => x Nx ->; rewrite inE mem_morphim. Qed. Lemma sub_im_coset (C : {set coset_of}) : C \subset coset @* 'N(A). Proof. by rewrite im_coset subsetT. Qed. Lemma cosetpre_proper C D : (coset @*^-1 C \proper coset @*^-1 D) = (C \proper D). Proof. by rewrite morphpre_proper ?sub_im_coset. Qed. Definition quotient : {set coset_of} := coset @* Q. Lemma quotientE : quotient = coset @* Q. Proof. by []. Qed. End Cosets. Arguments coset_of {gT} H%g : rename. Arguments coset {gT} H%g x%g : rename. Arguments quotient {gT} A%g H%g : rename. Arguments coset_reprK {gT H%g} xbar%g : rename. Bind Scope group_scope with coset_of. Notation "A / H" := (quotient A H) : group_scope. Section CosetOfGroupTheory. Variables (gT : finGroupType) (H : {group gT}). Implicit Types (A B : {set gT}) (G K : {group gT}) (xbar yb : coset_of H). Implicit Types (C D : {set coset_of H}) (L M : {group coset_of H}). Canonical quotient_group G A : {group coset_of A} := Eval hnf in [group of G / A]. Infix "/" := quotient_group : Group_scope. Lemma val_coset x : x \in 'N(H) -> coset H x :=: H :* x. Proof. by move=> Nx; rewrite val_coset_prim // genGid. Qed. Lemma coset_default x : (x \in 'N(H)) = false -> coset H x = 1. Proof. move=> Nx; apply: val_inj. by rewrite val_insubd /= mem_rcosets /= genGid mulSGid ?normG ?Nx. Qed. Lemma coset_norm xbar : xbar \subset 'N(H). Proof. case: xbar => /= _ /rcosetsP[x Nx ->]. by rewrite genGid mul_subG ?sub1set ?normG. Qed. Lemma ker_coset : 'ker (coset H) = H. Proof. by rewrite ker_coset_prim genGid (setIidPl _) ?normG. Qed. Lemma coset_idr x : x \in 'N(H) -> coset H x = 1 -> x \in H. Proof. by move=> Nx Hx1; rewrite -ker_coset mem_morphpre //= Hx1 set11. Qed. Lemma repr_coset_norm xbar : repr xbar \in 'N(H). Proof. exact: subsetP (coset_norm _) _ (mem_repr_coset _). Qed. Lemma imset_coset G : coset H @: G = G / H. Proof. apply/eqP; rewrite eqEsubset andbC imsetS ?subsetIr //=. apply/subsetP=> _ /imsetP[x Gx ->]. by case Nx: (x \in 'N(H)); rewrite ?(coset_default Nx) ?mem_morphim ?group1. Qed. Lemma val_quotient A : val @: (A / H) = rcosets H 'N_A(H). Proof. apply/setP=> B; apply/imsetP/rcosetsP=> [[xbar Axbar]|[x /setIP[Ax Nx]]] ->{B}. case/morphimP: Axbar => x Nx Ax ->{xbar}. by exists x; [rewrite inE Ax | rewrite /= val_coset]. by exists (coset H x); [apply/morphimP; exists x | rewrite /= val_coset]. Qed. Lemma card_quotient_subnorm A : #|A / H| = #|'N_A(H) : H|. Proof. by rewrite -(card_imset _ val_inj) val_quotient. Qed. Lemma leq_quotient A : #|A / H| <= #|A|. Proof. exact: leq_morphim. Qed. Lemma ltn_quotient A : H :!=: 1 -> H \subset A -> #|A / H| < #|A|. Proof. by move=> ntH sHA; rewrite ltn_morphim // ker_coset (setIidPr sHA) proper1G. Qed. Lemma card_quotient A : A \subset 'N(H) -> #|A / H| = #|A : H|. Proof. by move=> nHA; rewrite card_quotient_subnorm (setIidPl nHA). Qed. Lemma divg_normal G : H <| G -> #|G| %/ #|H| = #|G / H|. Proof. by case/andP=> sHG nHG; rewrite divgS ?card_quotient. Qed. (* Specializing all the morphisms lemmas that have different assumptions *) (* (e.g., because 'ker (coset H) = H), or conclusions (e.g., because we use *) (* A / H rather than coset H @* A). We may want to reevaluate later, and *) (* eliminate variants that aren't used . *) (* Variant of morph1; no specialization for other morph lemmas. *) Lemma coset1 : coset H 1 :=: H. Proof. by rewrite morph1 /= genGid. Qed. (* Variant of kerE. *) Lemma cosetpre1 : coset H @*^-1 1 = H. Proof. by rewrite -kerE ker_coset. Qed. (* Variant of morphimEdom; mophimE[sub] covered by imset_coset. *) (* morph[im|pre]Iim are also covered by im_quotient. *) Lemma im_quotient : 'N(H) / H = setT. Proof. exact: im_coset. Qed. Lemma quotientT : setT / H = setT. Proof. by rewrite -im_quotient; apply: morphimT. Qed. (* Variant of morphimIdom. *) Lemma quotientInorm A : 'N_A(H) / H = A / H. Proof. by rewrite /quotient setIC morphimIdom. Qed. Lemma quotient_setIpre A D : (A :&: coset H @*^-1 D) / H = A / H :&: D. Proof. exact: morphim_setIpre. Qed. Lemma mem_quotient x G : x \in G -> coset H x \in G / H. Proof. by move=> Gx; rewrite -imset_coset imset_f. Qed. Lemma quotientS A B : A \subset B -> A / H \subset B / H. Proof. exact: morphimS. Qed. Lemma quotient0 : set0 / H = set0. Proof. exact: morphim0. Qed. Lemma quotient_set1 x : x \in 'N(H) -> [set x] / H = [set coset H x]. Proof. exact: morphim_set1. Qed. Lemma quotient1 : 1 / H = 1. Proof. exact: morphim1. Qed. Lemma quotientV A : A^-1 / H = (A / H)^-1. Proof. exact: morphimV. Qed. Lemma quotientMl A B : A \subset 'N(H) -> A * B / H = (A / H) * (B / H). Proof. exact: morphimMl. Qed. Lemma quotientMr A B : B \subset 'N(H) -> A * B / H = (A / H) * (B / H). Proof. exact: morphimMr. Qed. Lemma cosetpreM C D : coset H @*^-1 (C * D) = coset H @*^-1 C * coset H @*^-1 D. Proof. by rewrite morphpreMl ?sub_im_coset. Qed. Lemma quotientJ A x : x \in 'N(H) -> A :^ x / H = (A / H) :^ coset H x. Proof. exact: morphimJ. Qed. Lemma quotientU A B : (A :|: B) / H = A / H :|: B / H. Proof. exact: morphimU. Qed. Lemma quotientI A B : (A :&: B) / H \subset A / H :&: B / H. Proof. exact: morphimI. Qed. Lemma quotientY A B : A \subset 'N(H) -> B \subset 'N(H) -> (A <*> B) / H = (A / H) <*> (B / H). Proof. exact: morphimY. Qed. Lemma quotient_homg A : A \subset 'N(H) -> homg (A / H) A. Proof. exact: morphim_homg. Qed. Lemma coset_kerl x y : x \in H -> coset H (x * y) = coset H y. Proof. move=> Hx; case Ny: (y \in 'N(H)); first by rewrite mkerl ?ker_coset. by rewrite !coset_default ?groupMl // (subsetP (normG H)). Qed. Lemma coset_kerr x y : y \in H -> coset H (x * y) = coset H x. Proof. move=> Hy; case Nx: (x \in 'N(H)); first by rewrite mkerr ?ker_coset. by rewrite !coset_default ?groupMr // (subsetP (normG H)). Qed. Lemma rcoset_kercosetP x y : x \in 'N(H) -> y \in 'N(H) -> reflect (coset H x = coset H y) (x \in H :* y). Proof. by rewrite -{6}ker_coset; apply: rcoset_kerP. Qed. Lemma kercoset_rcoset x y : x \in 'N(H) -> y \in 'N(H) -> coset H x = coset H y -> exists2 z, z \in H & x = z * y. Proof. by move=> Nx Ny eqfxy; rewrite -ker_coset; apply: ker_rcoset. Qed. Lemma quotientGI G A : H \subset G -> (G :&: A) / H = G / H :&: A / H. Proof. by rewrite -{1}ker_coset; apply: morphimGI. Qed. Lemma quotientIG A G : H \subset G -> (A :&: G) / H = A / H :&: G / H. Proof. by rewrite -{1}ker_coset; apply: morphimIG. Qed. Lemma quotientD A B : A / H :\: B / H \subset (A :\: B) / H. Proof. exact: morphimD. Qed. Lemma quotientD1 A : (A / H)^# \subset A^# / H. Proof. exact: morphimD1. Qed. Lemma quotientDG A G : H \subset G -> (A :\: G) / H = A / H :\: G / H. Proof. by rewrite -{1}ker_coset; apply: morphimDG. Qed. Lemma quotientK A : A \subset 'N(H) -> coset H @*^-1 (A / H) = H * A. Proof. by rewrite -{8}ker_coset; apply: morphimK. Qed. Lemma quotientYK G : G \subset 'N(H) -> coset H @*^-1 (G / H) = H <*> G. Proof. by move=> nHG; rewrite quotientK ?norm_joinEr. Qed. Lemma quotientGK G : H <| G -> coset H @*^-1 (G / H) = G. Proof. by case/andP; rewrite -{1}ker_coset; apply: morphimGK. Qed. Lemma quotient_class x A : x \in 'N(H) -> A \subset 'N(H) -> x ^: A / H = coset H x ^: (A / H). Proof. exact: morphim_class. Qed. Lemma classes_quotient A : A \subset 'N(H) -> classes (A / H) = [set xA / H | xA in classes A]. Proof. exact: classes_morphim. Qed. Lemma cosetpre_set1 x : x \in 'N(H) -> coset H @*^-1 [set coset H x] = H :* x. Proof. by rewrite -{9}ker_coset; apply: morphpre_set1. Qed. Lemma cosetpre_set1_coset xbar : coset H @*^-1 [set xbar] = xbar. Proof. by case: (cosetP xbar) => x Nx ->; rewrite cosetpre_set1 ?val_coset. Qed. Lemma cosetpreK C : coset H @*^-1 C / H = C. Proof. by rewrite /quotient morphpreK ?sub_im_coset. Qed. (* Variant of morhphim_ker *) Lemma trivg_quotient : H / H = 1. Proof. by rewrite -{3}ker_coset /quotient morphim_ker. Qed. Lemma quotientS1 G : G \subset H -> G / H = 1. Proof. by move=> sGH; apply/trivgP; rewrite -trivg_quotient quotientS. Qed. Lemma sub_cosetpre M : H \subset coset H @*^-1 M. Proof. by rewrite -{1}ker_coset; apply: ker_sub_pre. Qed. Lemma quotient_proper G K : H <| G -> H <| K -> (G / H \proper K / H) = (G \proper K). Proof. by move=> nHG nHK; rewrite -cosetpre_proper ?quotientGK. Qed. Lemma normal_cosetpre M : H <| coset H @*^-1 M. Proof. by rewrite -{1}ker_coset; apply: ker_normal_pre. Qed. Lemma cosetpreSK C D : (coset H @*^-1 C \subset coset H @*^-1 D) = (C \subset D). Proof. by rewrite morphpreSK ?sub_im_coset. Qed. Lemma sub_quotient_pre A C : A \subset 'N(H) -> (A / H \subset C) = (A \subset coset H @*^-1 C). Proof. exact: sub_morphim_pre. Qed. Lemma sub_cosetpre_quo C G : H <| G -> (coset H @*^-1 C \subset G) = (C \subset G / H). Proof. by move=> nHG; rewrite -cosetpreSK quotientGK. Qed. (* Variant of ker_trivg_morphim. *) Lemma quotient_sub1 A : A \subset 'N(H) -> (A / H \subset [1]) = (A \subset H). Proof. by move=> nHA /=; rewrite -{10}ker_coset ker_trivg_morphim nHA. Qed. Lemma quotientSK A B : A \subset 'N(H) -> (A / H \subset B / H) = (A \subset H * B). Proof. by move=> nHA; rewrite morphimSK ?ker_coset. Qed. Lemma quotientSGK A G : A \subset 'N(H) -> H \subset G -> (A / H \subset G / H) = (A \subset G). Proof. by rewrite -{2}ker_coset; apply: morphimSGK. Qed. Lemma quotient_injG : {in [pred G : {group gT} | H <| G] &, injective (fun G => G / H)}. Proof. by rewrite /normal -{1}ker_coset; apply: morphim_injG. Qed. Lemma quotient_inj G1 G2 : H <| G1 -> H <| G2 -> G1 / H = G2 / H -> G1 :=: G2. Proof. by rewrite /normal -[in mem H]ker_coset; apply: morphim_inj. Qed. Lemma quotient_neq1 A : H <| A -> (A / H != 1) = (H \proper A). Proof. case/andP=> sHA nHA; rewrite /proper sHA -trivg_quotient eqEsubset andbC. by rewrite quotientS //= quotientSGK. Qed. Lemma quotient_gen A : A \subset 'N(H) -> <> / H = <>. Proof. exact: morphim_gen. Qed. Lemma cosetpre_gen C : 1 \in C -> coset H @*^-1 <> = <>. Proof. by move=> C1; rewrite morphpre_gen ?sub_im_coset. Qed. Lemma quotientR A B : A \subset 'N(H) -> B \subset 'N(H) -> [~: A, B] / H = [~: A / H, B / H]. Proof. exact: morphimR. Qed. Lemma quotient_norm A : 'N(A) / H \subset 'N(A / H). Proof. exact: morphim_norm. Qed. Lemma quotient_norms A B : A \subset 'N(B) -> A / H \subset 'N(B / H). Proof. exact: morphim_norms. Qed. Lemma quotient_subnorm A B : 'N_A(B) / H \subset 'N_(A / H)(B / H). Proof. exact: morphim_subnorm. Qed. Lemma quotient_normal A B : A <| B -> A / H <| B / H. Proof. exact: morphim_normal. Qed. Lemma quotient_cent1 x : 'C[x] / H \subset 'C[coset H x]. Proof. case Nx: (x \in 'N(H)); first exact: morphim_cent1. by rewrite coset_default // cent11T subsetT. Qed. Lemma quotient_cent1s A x : A \subset 'C[x] -> A / H \subset 'C[coset H x]. Proof. by move=> sAC; apply: subset_trans (quotientS sAC) (quotient_cent1 x). Qed. Lemma quotient_subcent1 A x : 'C_A[x] / H \subset 'C_(A / H)[coset H x]. Proof. exact: subset_trans (quotientI _ _) (setIS _ (quotient_cent1 x)). Qed. Lemma quotient_cent A : 'C(A) / H \subset 'C(A / H). Proof. exact: morphim_cent. Qed. Lemma quotient_cents A B : A \subset 'C(B) -> A / H \subset 'C(B / H). Proof. exact: morphim_cents. Qed. Lemma quotient_abelian A : abelian A -> abelian (A / H). Proof. exact: morphim_abelian. Qed. Lemma quotient_subcent A B : 'C_A(B) / H \subset 'C_(A / H)(B / H). Proof. exact: morphim_subcent. Qed. Lemma norm_quotient_pre A C : A \subset 'N(H) -> A / H \subset 'N(C) -> A \subset 'N(coset H @*^-1 C). Proof. by move/sub_quotient_pre=> -> /subset_trans-> //; apply: morphpre_norm. Qed. Lemma cosetpre_normal C D : (coset H @*^-1 C <| coset H @*^-1 D) = (C <| D). Proof. by rewrite morphpre_normal ?sub_im_coset. Qed. Lemma quotient_normG G : H <| G -> 'N(G) / H = 'N(G / H). Proof. case/andP=> sHG nHG. by rewrite [_ / _]morphim_normG ?ker_coset // im_coset setTI. Qed. Lemma quotient_subnormG A G : H <| G -> 'N_A(G) / H = 'N_(A / H)(G / H). Proof. by case/andP=> sHG nHG; rewrite -morphim_subnormG ?ker_coset. Qed. Lemma cosetpre_cent1 x : 'C_('N(H))[x] \subset coset H @*^-1 'C[coset H x]. Proof. case Nx: (x \in 'N(H)); first by rewrite morphpre_cent1. by rewrite coset_default // cent11T morphpreT subsetIl. Qed. Lemma cosetpre_cent1s C x : coset H @*^-1 C \subset 'C[x] -> C \subset 'C[coset H x]. Proof. move=> sC; rewrite -cosetpreSK; apply: subset_trans (cosetpre_cent1 x). by rewrite subsetI subsetIl. Qed. Lemma cosetpre_subcent1 C x : 'C_(coset H @*^-1 C)[x] \subset coset H @*^-1 'C_C[coset H x]. Proof. by rewrite -morphpreIdom -setIA setICA morphpreI setIS // cosetpre_cent1. Qed. Lemma cosetpre_cent A : 'C_('N(H))(A) \subset coset H @*^-1 'C(A / H). Proof. exact: morphpre_cent. Qed. Lemma cosetpre_cents A C : coset H @*^-1 C \subset 'C(A) -> C \subset 'C(A / H). Proof. by apply: morphpre_cents; rewrite ?sub_im_coset. Qed. Lemma cosetpre_subcent C A : 'C_(coset H @*^-1 C)(A) \subset coset H @*^-1 'C_C(A / H). Proof. exact: morphpre_subcent. Qed. Lemma restrm_quotientE G A (nHG : G \subset 'N(H)) : A \subset G -> restrm nHG (coset H) @* A = A / H. Proof. exact: restrmEsub. Qed. Section InverseImage. Variables (G : {group gT}) (Kbar : {group coset_of H}). Hypothesis nHG : H <| G. Variant inv_quotient_spec (P : pred {group gT}) : Prop := InvQuotientSpec K of Kbar :=: K / H & H \subset K & P K. Lemma inv_quotientS : Kbar \subset G / H -> inv_quotient_spec (fun K => K \subset G). Proof. case/andP: nHG => sHG nHG' sKbarG. have sKdH: Kbar \subset 'N(H) / H by rewrite (subset_trans sKbarG) ?morphimS. exists (coset H @*^-1 Kbar)%G; first by rewrite cosetpreK. by rewrite -{1}ker_coset morphpreS ?sub1G. by rewrite sub_cosetpre_quo. Qed. Lemma inv_quotientN : Kbar <| G / H -> inv_quotient_spec (fun K => K <| G). Proof. move=> nKbar; case/inv_quotientS: (normal_sub nKbar) => K defKbar sHK sKG. exists K => //; rewrite defKbar -cosetpre_normal !quotientGK // in nKbar. exact: normalS nHG. Qed. End InverseImage. Lemma quotientMidr A : A * H / H = A / H. Proof. by rewrite [_ /_]morphimMr ?normG //= -!quotientE trivg_quotient mulg1. Qed. Lemma quotientMidl A : H * A / H = A / H. Proof. by rewrite [_ /_]morphimMl ?normG //= -!quotientE trivg_quotient mul1g. Qed. Lemma quotientYidr G : G \subset 'N(H) -> G <*> H / H = G / H. Proof. move=> nHG; rewrite -genM_join quotient_gen ?mul_subG ?normG //. by rewrite quotientMidr genGid. Qed. Lemma quotientYidl G : G \subset 'N(H) -> H <*> G / H = G / H. Proof. by move=> nHG; rewrite joingC quotientYidr. Qed. Section Injective. Variables (G : {group gT}). Hypotheses (nHG : G \subset 'N(H)) (tiHG : H :&: G = 1). Lemma quotient_isom : isom G (G / H) (restrm nHG (coset H)). Proof. by apply/isomP; rewrite ker_restrm setIC ker_coset tiHG im_restrm. Qed. Lemma quotient_isog : isog G (G / H). Proof. exact: isom_isog quotient_isom. Qed. End Injective. End CosetOfGroupTheory. Notation "A / H" := (quotient_group A H) : Group_scope. Section Quotient1. Variables (gT : finGroupType) (A : {set gT}). Lemma coset1_injm : 'injm (@coset gT 1). Proof. by rewrite ker_coset /=. Qed. Lemma quotient1_isom : isom A (A / 1) (coset 1). Proof. by apply: sub_isom coset1_injm; rewrite ?norms1. Qed. Lemma quotient1_isog : isog A (A / 1). Proof. by apply: isom_isog quotient1_isom; apply: norms1. Qed. End Quotient1. Section QuotientMorphism. Variable (gT rT : finGroupType) (G H : {group gT}) (f : {morphism G >-> rT}). Implicit Types A : {set gT}. Implicit Types B : {set (coset_of H)}. Hypotheses (nsHG : H <| G). Let sHG : H \subset G := normal_sub nsHG. Let nHG : G \subset 'N(H) := normal_norm nsHG. Let nfHfG : f @* G \subset 'N(f @* H) := morphim_norms f nHG. Notation fH := (coset (f @* H) \o f). Lemma quotm_dom_proof : G \subset 'dom fH. Proof. by rewrite -sub_morphim_pre. Qed. Notation fH_G := (restrm quotm_dom_proof fH). Lemma quotm_ker_proof : 'ker (coset H) \subset 'ker fH_G. Proof. by rewrite ker_restrm ker_comp !ker_coset morphpreIdom morphimK ?mulG_subr. Qed. Definition quotm := factm quotm_ker_proof nHG. Canonical quotm_morphism := [morphism G / H of quotm]. Lemma quotmE x : x \in G -> quotm (coset H x) = coset (f @* H) (f x). Proof. exact: factmE. Qed. Lemma morphim_quotm A : quotm @* (A / H) = f @* A / f @* H. Proof. by rewrite morphim_factm morphim_restrm morphim_comp morphimIdom. Qed. Lemma morphpre_quotm Abar : quotm @*^-1 (Abar / f @* H) = f @*^-1 Abar / H. Proof. rewrite morphpre_factm morphpre_restrm morphpre_comp /=. rewrite morphpreIdom -[Abar / _]quotientInorm quotientK ?subsetIr //=. rewrite morphpreMl ?morphimS // morphimK // [_ * H]normC ?subIset ?nHG //. rewrite -quotientE -mulgA quotientMidl /= setIC -morphpreIim setIA. by rewrite (setIidPl nfHfG) morphpreIim -morphpreMl ?sub1G ?mul1g. Qed. Lemma ker_quotm : 'ker quotm = 'ker f / H. Proof. by rewrite -morphpre_quotm /quotient morphim1. Qed. Lemma injm_quotm : 'injm f -> 'injm quotm. Proof. by move/trivgP=> /= kf1; rewrite ker_quotm kf1 quotientE morphim1. Qed. End QuotientMorphism. Section EqIso. Variables (gT : finGroupType) (G H : {group gT}). Hypothesis (eqGH : G :=: H). Lemma im_qisom_proof : 'N(H) \subset 'N(G). Proof. by rewrite eqGH. Qed. Lemma qisom_ker_proof : 'ker (coset G) \subset 'ker (coset H). Proof. by rewrite eqGH. Qed. Lemma qisom_restr_proof : setT \subset 'N(H) / G. Proof. by rewrite eqGH im_quotient. Qed. Definition qisom := restrm qisom_restr_proof (factm qisom_ker_proof im_qisom_proof). Canonical qisom_morphism := Eval hnf in [morphism of qisom]. Lemma qisomE x : qisom (coset G x) = coset H x. Proof. case Nx: (x \in 'N(H)); first exact: factmE. by rewrite !coset_default ?eqGH ?morph1. Qed. Lemma val_qisom Gx : val (qisom Gx) = val Gx. Proof. by case: (cosetP Gx) => x Nx ->{Gx}; rewrite qisomE /= !val_coset -?eqGH. Qed. Lemma morphim_qisom A : qisom @* (A / G) = A / H. Proof. by rewrite morphim_restrm setTI morphim_factm. Qed. Lemma morphpre_qisom A : qisom @*^-1 (A / H) = A / G. Proof. rewrite morphpre_restrm setTI morphpre_factm eqGH. by rewrite morphpreK // im_coset subsetT. Qed. Lemma injm_qisom : 'injm qisom. Proof. by rewrite -quotient1 -morphpre_qisom morphpreS ?sub1G. Qed. Lemma im_qisom : qisom @* setT = setT. Proof. by rewrite -{2}im_quotient morphim_qisom eqGH im_quotient. Qed. Lemma qisom_isom : isom setT setT qisom. Proof. by apply/isomP; rewrite injm_qisom im_qisom. Qed. Lemma qisom_isog : [set: coset_of G] \isog [set: coset_of H]. Proof. exact: isom_isog qisom_isom. Qed. Lemma qisom_inj : injective qisom. Proof. by move=> x y; apply: (injmP injm_qisom); rewrite inE. Qed. Lemma morphim_qisom_inj : injective (fun Gx => qisom @* Gx). Proof. by move=> Gx Gy; apply: injm_morphim_inj; rewrite (injm_qisom, subsetT). Qed. End EqIso. Arguments qisom_inj {gT G H} eqGH [x1 x2]. Arguments morphim_qisom_inj {gT G H} eqGH [x1 x2]. Section FirstIsomorphism. Variables aT rT : finGroupType. Lemma first_isom (G : {group aT}) (f : {morphism G >-> rT}) : {g : {morphism G / 'ker f >-> rT} | 'injm g & forall A : {set aT}, g @* (A / 'ker f) = f @* A}. Proof. have nkG := ker_norm f. have skk: 'ker (coset ('ker f)) \subset 'ker f by rewrite ker_coset. exists (factm_morphism skk nkG) => /=; last exact: morphim_factm. by rewrite ker_factm -quotientE trivg_quotient. Qed. Variables (G H : {group aT}) (f : {morphism G >-> rT}). Hypothesis sHG : H \subset G. Lemma first_isog : (G / 'ker f) \isog (f @* G). Proof. by case: (first_isom f) => g injg im_g; apply/isogP; exists g; rewrite ?im_g. Qed. Lemma first_isom_loc : {g : {morphism H / 'ker_H f >-> rT} | 'injm g & forall A : {set aT}, A \subset H -> g @* (A / 'ker_H f) = f @* A}. Proof. case: (first_isom (restrm_morphism sHG f)). rewrite ker_restrm => g injg im_g; exists g => // A sAH. by rewrite im_g morphim_restrm (setIidPr sAH). Qed. Lemma first_isog_loc : (H / 'ker_H f) \isog (f @* H). Proof. by case: first_isom_loc => g injg im_g; apply/isogP; exists g; rewrite ?im_g. Qed. End FirstIsomorphism. Section SecondIsomorphism. Variables (gT : finGroupType) (H K : {group gT}). Hypothesis nKH : H \subset 'N(K). Lemma second_isom : {f : {morphism H / (K :&: H) >-> coset_of K} | 'injm f & forall A : {set gT}, A \subset H -> f @* (A / (K :&: H)) = A / K}. Proof. have ->: K :&: H = 'ker_H (coset K) by rewrite ker_coset setIC. exact: first_isom_loc. Qed. Lemma second_isog : H / (K :&: H) \isog H / K. Proof. by rewrite setIC -{1 3}(ker_coset K); apply: first_isog_loc. Qed. Lemma weak_second_isog : H / (K :&: H) \isog H * K / K. Proof. by rewrite quotientMidr; apply: second_isog. Qed. End SecondIsomorphism. Section ThirdIsomorphism. Variables (gT : finGroupType) (G H K : {group gT}). Lemma homg_quotientS (A : {set gT}) : A \subset 'N(H) -> A \subset 'N(K) -> H \subset K -> A / K \homg A / H. Proof. rewrite -!(gen_subG A) /=; set L := <> => nHL nKL sKH. have sub_ker: 'ker (restrm nHL (coset H)) \subset 'ker (restrm nKL (coset K)). by rewrite !ker_restrm !ker_coset setIS. have sAL: A \subset L := subset_gen A; rewrite -(setIidPr sAL). rewrite -[_ / H](morphim_restrm nHL) -[_ / K](morphim_restrm nKL) /=. by rewrite -(morphim_factm sub_ker (subxx L)) morphim_homg ?morphimS. Qed. Hypothesis sHK : H \subset K. Hypothesis snHG : H <| G. Hypothesis snKG : K <| G. Theorem third_isom : {f : {morphism (G / H) / (K / H) >-> coset_of K} | 'injm f & forall A : {set gT}, A \subset G -> f @* (A / H / (K / H)) = A / K}. Proof. have [[sKG nKG] [sHG nHG]] := (andP snKG, andP snHG). have sHker: 'ker (coset H) \subset 'ker (restrm nKG (coset K)). by rewrite ker_restrm !ker_coset subsetI sHG. have:= first_isom_loc (factm_morphism sHker nHG) (subxx _) => /=. rewrite ker_factm_loc ker_restrm ker_coset !(setIidPr sKG) /= -!quotientE. case=> f injf im_f; exists f => // A sAG; rewrite im_f ?morphimS //. by rewrite morphim_factm morphim_restrm (setIidPr sAG). Qed. Theorem third_isog : (G / H / (K / H)) \isog (G / K). Proof. by case: third_isom => f inj_f im_f; apply/isogP; exists f; rewrite ?im_f. Qed. End ThirdIsomorphism. Lemma char_from_quotient (gT : finGroupType) (G H K : {group gT}) : H <| K -> H \char G -> K / H \char G / H -> K \char G. Proof. case/andP=> sHK nHK chHG. have nsHG := char_normal chHG; have [sHG nHG] := andP nsHG. case/charP; rewrite quotientSGK // => sKG /= chKG. apply/charP; split=> // f injf Gf; apply/morphim_fixP => //. rewrite -(quotientSGK _ sHK); last by rewrite -morphimIim Gf subIset ?nHG. have{chHG} Hf: f @* H = H by case/charP: chHG => _; apply. set q := quotm_morphism f nsHG; have{injf}: 'injm q by apply: injm_quotm. have: q @* _ = _ := morphim_quotm _ _ _; move: q; rewrite Hf => q im_q injq. by rewrite -im_q chKG // im_q Gf. Qed. (* Counting lemmas for morphisms. *) Section CardMorphism. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Implicit Types G H : {group aT}. Implicit Types L M : {group rT}. Lemma card_morphim G : #|f @* G| = #|D :&: G : 'ker f|. Proof. rewrite -morphimIdom -indexgI -card_quotient; last first. by rewrite normsI ?normG ?subIset ?ker_norm. by apply: esym (card_isog _); rewrite first_isog_loc ?subsetIl. Qed. Lemma dvdn_morphim G : #|f @* G| %| #|G|. Proof. rewrite card_morphim (dvdn_trans (dvdn_indexg _ _)) //. by rewrite cardSg ?subsetIr. Qed. Lemma logn_morphim p G : logn p #|f @* G| <= logn p #|G|. Proof. by rewrite dvdn_leq_log ?dvdn_morphim. Qed. Lemma coprime_morphl G p : coprime #|G| p -> coprime #|f @* G| p. Proof. exact: coprime_dvdl (dvdn_morphim G). Qed. Lemma coprime_morphr G p : coprime p #|G| -> coprime p #|f @* G|. Proof. exact: coprime_dvdr (dvdn_morphim G). Qed. Lemma coprime_morph G H : coprime #|G| #|H| -> coprime #|f @* G| #|f @* H|. Proof. by move=> coGH; rewrite coprime_morphl // coprime_morphr. Qed. Lemma index_morphim_ker G H : H \subset G -> G \subset D -> (#|f @* G : f @* H| * #|'ker_G f : H|)%N = #|G : H|. Proof. move=> sHG sGD; apply/eqP. rewrite -(eqn_pmul2l (cardG_gt0 (f @* H))) mulnA Lagrange ?morphimS //. rewrite !card_morphim (setIidPr sGD) (setIidPr (subset_trans sHG sGD)). rewrite -(eqn_pmul2l (cardG_gt0 ('ker_H f))) /=. by rewrite -{1}(setIidPr sHG) setIAC mulnCA mulnC mulnA !LagrangeI Lagrange. Qed. Lemma index_morphim G H : G :&: H \subset D -> #|f @* G : f @* H| %| #|G : H|. Proof. move=> dGH; rewrite -(indexgI G) -(setIidPr dGH) setIA. apply: dvdn_trans (indexSg (subsetIl _ H) (subsetIr D G)). rewrite -index_morphim_ker ?subsetIl ?subsetIr ?dvdn_mulr //= morphimIdom. by rewrite indexgS ?morphimS ?subsetIr. Qed. Lemma index_injm G H : 'injm f -> G \subset D -> #|f @* G : f @* H| = #|G : H|. Proof. move=> injf dG; rewrite -{2}(setIidPr dG) -(indexgI _ H) /=. rewrite -index_morphim_ker ?subsetIl ?subsetIr //= setIAC morphimIdom setIC. rewrite injmI ?subsetIr // indexgI /= morphimIdom setIC ker_injm //. by rewrite -(indexgI (1 :&: _)) /= -setIA !(setIidPl (sub1G _)) indexgg muln1. Qed. Lemma card_morphpre L : L \subset f @* D -> #|f @*^-1 L| = (#|'ker f| * #|L|)%N. Proof. move/morphpreK=> {2} <-; rewrite card_morphim morphpreIdom. by rewrite Lagrange // morphpreS ?sub1G. Qed. Lemma index_morphpre L M : L \subset f @* D -> #|f @*^-1 L : f @*^-1 M| = #|L : M|. Proof. move=> dL; rewrite -!divgI -morphpreI card_morphpre //. have: L :&: M \subset f @* D by rewrite subIset ?dL. by move/card_morphpre->; rewrite divnMl ?cardG_gt0. Qed. End CardMorphism. Lemma card_homg (aT rT : finGroupType) (G : {group aT}) (R : {group rT}) : G \homg R -> #|G| %| #|R|. Proof. by case/homgP=> f <-; rewrite card_morphim setIid dvdn_indexg. Qed. Section CardCosetpre. Variables (gT : finGroupType) (G H K : {group gT}) (L M : {group coset_of H}). Lemma dvdn_quotient : #|G / H| %| #|G|. Proof. exact: dvdn_morphim. Qed. Lemma index_quotient_ker : K \subset G -> G \subset 'N(H) -> (#|G / H : K / H| * #|G :&: H : K|)%N = #|G : K|. Proof. by rewrite -{5}(ker_coset H); apply: index_morphim_ker. Qed. Lemma index_quotient : G :&: K \subset 'N(H) -> #|G / H : K / H| %| #|G : K|. Proof. exact: index_morphim. Qed. Lemma index_quotient_eq : G :&: H \subset K -> K \subset G -> G \subset 'N(H) -> #|G / H : K / H| = #|G : K|. Proof. move=> sGH_K sKG sGN; rewrite -index_quotient_ker {sKG sGN}//. by rewrite -(indexgI _ K) (setIidPl sGH_K) indexgg muln1. Qed. Lemma card_cosetpre : #|coset H @*^-1 L| = (#|H| * #|L|)%N. Proof. by rewrite card_morphpre ?ker_coset ?sub_im_coset. Qed. Lemma index_cosetpre : #|coset H @*^-1 L : coset H @*^-1 M| = #|L : M|. Proof. by rewrite index_morphpre ?sub_im_coset. Qed. End CardCosetpre. math-comp-mathcomp-1.12.0/mathcomp/solvable/000077500000000000000000000000001375767750300207315ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/solvable/AUTHORS000077700000000000000000000000001375767750300234722../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/solvable/CeCILL-B000077700000000000000000000000001375767750300235442../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/solvable/INSTALL.md000077700000000000000000000000001375767750300244322../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/solvable/Make000066400000000000000000000007201375767750300215300ustar00rootroot00000000000000abelian.v all_solvable.v alt.v burnside_app.v center.v commutator.v cyclic.v extraspecial.v extremal.v finmodule.v frobenius.v gfunctor.v gseries.v hall.v jordanholder.v maximal.v nilpotent.v pgroup.v primitive_action.v sylow.v -R . mathcomp.solvable -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scopemath-comp-mathcomp-1.12.0/mathcomp/solvable/Makefile000066400000000000000000000002531375767750300223710ustar00rootroot00000000000000# -*- Makefile -*- COQPROJECT=Make COQMAKEOPTIONS=--no-print-directory # -------------------------------------------------------------------- include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/solvable/README.md000077700000000000000000000000001375767750300241102../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/solvable/abelian.v000066400000000000000000002570061375767750300225250ustar00rootroot00000000000000(* (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 fintype finfun bigop finset prime binomial. From mathcomp Require Import fingroup morphism perm automorphism action. From mathcomp Require Import quotient gfunctor gproduct ssralg finalg zmodp. From mathcomp Require Import cyclic pgroup gseries nilpotent sylow. (******************************************************************************) (* Constructions based on abelian groups and their structure, with some *) (* emphasis on elementary abelian p-groups. *) (* 'Ldiv_n() == the set of all x that satisfy x ^+ n = 1, or, *) (* equivalently the set of x whose order divides n. *) (* 'Ldiv_n(G) == the set of x in G that satisfy x ^+ n = 1. *) (* := G :&: 'Ldiv_n() (pure Notation) *) (* exponent G == the exponent of G: the least e such that x ^+ e = 1 *) (* for all x in G (the LCM of the orders of x \in G). *) (* If G is nilpotent its exponent is reached. Note that *) (* `exponent G %| m' reads as `G has exponent m'. *) (* 'm(G) == the generator rank of G: the size of a smallest *) (* generating set for G (this is a basis for G if G *) (* abelian). *) (* abelian_type G == the abelian type of G : if G is abelian, a lexico- *) (* graphically maximal sequence of the orders of the *) (* elements of a minimal basis of G (if G is a p-group *) (* this is the sequence of orders for any basis of G, *) (* sorted in decending order). *) (* homocyclic G == G is the direct product of cycles of equal order, *) (* i.e., G is abelian with constant abelian type. *) (* p.-abelem G == G is an elementary abelian p-group, i.e., it is *) (* an abelian p-group of exponent p, and thus of order *) (* p ^ 'm(G) and rank (logn p #|G|). *) (* is_abelem G == G is an elementary abelian p-group for some prime p. *) (* 'E_p(G) == the set of elementary abelian p-subgroups of G. *) (* := [set E : {group _} | p.-abelem E & E \subset G] *) (* 'E_p^n(G) == the set of elementary abelian p-subgroups of G of *) (* order p ^ n (or, equivalently, of rank n). *) (* := [set E in 'E_p(G) | logn p #|E| == n] *) (* := [set E in 'E_p(G) | #|E| == p ^ n]%N if p is prime *) (* 'E*_p(G) == the set of maximal elementary abelian p-subgroups *) (* of G. *) (* := [set E | [max E | E \in 'E_p(G)]] *) (* 'E^n(G) == the set of elementary abelian subgroups of G that *) (* have gerank n (i.e., p-rank n for some prime p). *) (* := \bigcup_(0 <= p < #|G|.+1) 'E_p^n(G) *) (* 'r_p(G) == the p-rank of G: the maximal rank of an elementary *) (* subgroup of G. *) (* := \max_(E in 'E_p(G)) logn p #|E|. *) (* 'r(G) == the rank of G. *) (* := \max_(0 <= p < #|G|.+1) 'm_p(G). *) (* Note that 'r(G) coincides with 'r_p(G) if G is a p-group, and with 'm(G) *) (* if G is abelian, but is much more useful than 'm(G) in the proof of the *) (* Odd Order Theorem. *) (* 'Ohm_n(G) == the group generated by the x in G with order p ^ m *) (* for some prime p and some m <= n. Usually, G will be *) (* a p-group, so 'Ohm_n(G) will be generated by *) (* 'Ldiv_(p ^ n)(G), set of elements of G of order at *) (* most p ^ n. If G is also abelian then 'Ohm_n(G) *) (* consists exactly of those element, and the abelian *) (* type of G can be computed from the orders of the *) (* 'Ohm_n(G) subgroups. *) (* 'Mho^n(G) == the group generated by the x ^+ (p ^ n) for x a *) (* p-element of G for some prime p. Usually G is a *) (* p-group, and 'Mho^n(G) is generated by all such *) (* x ^+ (p ^ n); it consists of exactly these if G is *) (* also abelian. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section AbelianDefs. (* We defer the definition of the functors ('Omh_n(G), 'Mho^n(G)) because *) (* they must quantify over the finGroupType explicitly. *) Variable gT : finGroupType. Implicit Types (x : gT) (A B : {set gT}) (pi : nat_pred) (p n : nat). Definition Ldiv n := [set x : gT | x ^+ n == 1]. Definition exponent A := \big[lcmn/1%N]_(x in A) #[x]. Definition abelem p A := [&& p.-group A, abelian A & exponent A %| p]. Definition is_abelem A := abelem (pdiv #|A|) A. Definition pElem p A := [set E : {group gT} | E \subset A & abelem p E]. Definition pnElem p n A := [set E in pElem p A | logn p #|E| == n]. Definition nElem n A := \bigcup_(0 <= p < #|A|.+1) pnElem p n A. Definition pmaxElem p A := [set E | [max E | E \in pElem p A]]. Definition p_rank p A := \max_(E in pElem p A) logn p #|E|. Definition rank A := \max_(0 <= p < #|A|.+1) p_rank p A. Definition gen_rank A := #|[arg min_(B < A | <> == A) #|B|]|. (* The definition of abelian_type depends on an existence lemma. *) (* The definition of homocyclic depends on abelian_type. *) End AbelianDefs. Arguments exponent {gT} A%g. Arguments abelem {gT} p%N A%g. Arguments is_abelem {gT} A%g. Arguments pElem {gT} p%N A%g. Arguments pnElem {gT} p%N n%N A%g. Arguments nElem {gT} n%N A%g. Arguments pmaxElem {gT} p%N A%g. Arguments p_rank {gT} p%N A%g. Arguments rank {gT} A%g. Arguments gen_rank {gT} A%g. Notation "''Ldiv_' n ()" := (Ldiv _ n) (at level 8, n at level 2, format "''Ldiv_' n ()") : group_scope. Notation "''Ldiv_' n ( G )" := (G :&: 'Ldiv_n()) (at level 8, n at level 2, format "''Ldiv_' n ( G )") : group_scope. Prenex Implicits exponent. Notation "p .-abelem" := (abelem p) (at level 2, format "p .-abelem") : group_scope. Notation "''E_' p ( G )" := (pElem p G) (at level 8, p at level 2, format "''E_' p ( G )") : group_scope. Notation "''E_' p ^ n ( G )" := (pnElem p n G) (at level 8, p, n at level 2, format "''E_' p ^ n ( G )") : group_scope. Notation "''E' ^ n ( G )" := (nElem n G) (at level 8, n at level 2, format "''E' ^ n ( G )") : group_scope. Notation "''E*_' p ( G )" := (pmaxElem p G) (at level 8, p at level 2, format "''E*_' p ( G )") : group_scope. Notation "''m' ( A )" := (gen_rank A) (at level 8, format "''m' ( A )") : group_scope. Notation "''r' ( A )" := (rank A) (at level 8, format "''r' ( A )") : group_scope. Notation "''r_' p ( A )" := (p_rank p A) (at level 8, p at level 2, format "''r_' p ( A )") : group_scope. Section Functors. (* A functor needs to quantify over the finGroupType just beore the set. *) Variables (n : nat) (gT : finGroupType) (A : {set gT}). Definition Ohm := <<[set x in A | x ^+ (pdiv #[x] ^ n) == 1]>>. Definition Mho := <<[set x ^+ (pdiv #[x] ^ n) | x in A & (pdiv #[x]).-elt x]>>. Canonical Ohm_group : {group gT} := Eval hnf in [group of Ohm]. Canonical Mho_group : {group gT} := Eval hnf in [group of Mho]. Lemma pdiv_p_elt (p : nat) (x : gT) : p.-elt x -> x != 1 -> pdiv #[x] = p. Proof. move=> p_x; rewrite /order -cycle_eq1. by case/(pgroup_pdiv p_x)=> p_pr _ [k ->]; rewrite pdiv_pfactor. Qed. Lemma OhmPredP (x : gT) : reflect (exists2 p, prime p & x ^+ (p ^ n) = 1) (x ^+ (pdiv #[x] ^ n) == 1). Proof. have [-> | nt_x] := eqVneq x 1. by rewrite expg1n eqxx; left; exists 2; rewrite ?expg1n. apply: (iffP idP) => [/eqP | [p p_pr /eqP x_pn]]. by exists (pdiv #[x]); rewrite ?pdiv_prime ?order_gt1. rewrite (@pdiv_p_elt p) //; rewrite -order_dvdn in x_pn. by rewrite [p_elt _ _](pnat_dvd x_pn) // pnatX pnat_id. Qed. Lemma Mho_p_elt (p : nat) x : x \in A -> p.-elt x -> x ^+ (p ^ n) \in Mho. Proof. move=> Ax p_x; have [-> | ntx] := eqVneq x 1; first by rewrite groupX. by apply/mem_gen/imsetP; exists x; rewrite ?inE ?Ax (pdiv_p_elt p_x). Qed. End Functors. Arguments Ohm n%N {gT} A%g. Arguments Ohm_group n%N {gT} A%g. Arguments Mho n%N {gT} A%g. Arguments Mho_group n%N {gT} A%g. Arguments OhmPredP {n gT x}. Notation "''Ohm_' n ( G )" := (Ohm n G) (at level 8, n at level 2, format "''Ohm_' n ( G )") : group_scope. Notation "''Ohm_' n ( G )" := (Ohm_group n G) : Group_scope. Notation "''Mho^' n ( G )" := (Mho n G) (at level 8, n at level 2, format "''Mho^' n ( G )") : group_scope. Notation "''Mho^' n ( G )" := (Mho_group n G) : Group_scope. Section ExponentAbelem. Variable gT : finGroupType. Implicit Types (p n : nat) (pi : nat_pred) (x : gT) (A B C : {set gT}). Implicit Types E G H K P X Y : {group gT}. Lemma LdivP A n x : reflect (x \in A /\ x ^+ n = 1) (x \in 'Ldiv_n(A)). Proof. by rewrite !inE; apply: (iffP andP) => [] [-> /eqP]. Qed. Lemma dvdn_exponent x A : x \in A -> #[x] %| exponent A. Proof. by move=> Ax; rewrite (biglcmn_sup x). Qed. Lemma expg_exponent x A : x \in A -> x ^+ exponent A = 1. Proof. by move=> Ax; apply/eqP; rewrite -order_dvdn dvdn_exponent. Qed. Lemma exponentS A B : A \subset B -> exponent A %| exponent B. Proof. by move=> sAB; apply/dvdn_biglcmP=> x Ax; rewrite dvdn_exponent ?(subsetP sAB). Qed. Lemma exponentP A n : reflect (forall x, x \in A -> x ^+ n = 1) (exponent A %| n). Proof. apply: (iffP (dvdn_biglcmP _ _ _)) => eAn x Ax. by apply/eqP; rewrite -order_dvdn eAn. by rewrite order_dvdn eAn. Qed. Arguments exponentP {A n}. Lemma trivg_exponent G : (G :==: 1) = (exponent G %| 1). Proof. rewrite -subG1. by apply/subsetP/exponentP=> trG x /trG; rewrite expg1 => /set1P. Qed. Lemma exponent1 : exponent [1 gT] = 1%N. Proof. by apply/eqP; rewrite -dvdn1 -trivg_exponent eqxx. Qed. Lemma exponent_dvdn G : exponent G %| #|G|. Proof. by apply/dvdn_biglcmP=> x Gx; apply: order_dvdG. Qed. Lemma exponent_gt0 G : 0 < exponent G. Proof. exact: dvdn_gt0 (exponent_dvdn G). Qed. Hint Resolve exponent_gt0 : core. Lemma pnat_exponent pi G : pi.-nat (exponent G) = pi.-group G. Proof. congr (_ && _); first by rewrite cardG_gt0 exponent_gt0. apply: eq_all_r => p; rewrite !mem_primes cardG_gt0 exponent_gt0 /=. apply: andb_id2l => p_pr; apply/idP/idP=> pG. exact: dvdn_trans pG (exponent_dvdn G). by case/Cauchy: pG => // x Gx <-; apply: dvdn_exponent. Qed. Lemma exponentJ A x : exponent (A :^ x) = exponent A. Proof. rewrite /exponent (reindex_inj (conjg_inj x)). by apply: eq_big => [y | y _]; rewrite ?orderJ ?memJ_conjg. Qed. Lemma exponent_witness G : nilpotent G -> {x | x \in G & exponent G = #[x]}. Proof. move=> nilG; have [//=| /= x Gx max_x] := @arg_maxnP _ 1 (mem G) order. exists x => //; apply/eqP; rewrite eqn_dvd dvdn_exponent // andbT. apply/dvdn_biglcmP=> y Gy; apply/dvdn_partP=> //= p. rewrite mem_primes => /andP[p_pr _]; have p_gt1: p > 1 := prime_gt1 p_pr. rewrite p_part pfactor_dvdn // -(leq_exp2l _ _ p_gt1) -!p_part. rewrite -(leq_pmul2r (part_gt0 p^' #[x])) partnC // -!order_constt. rewrite -orderM ?order_constt ?coprime_partC // ?max_x ?groupM ?groupX //. case/dprodP: (nilpotent_pcoreC p nilG) => _ _ cGpGp' _. have inGp := mem_normal_Hall (nilpotent_pcore_Hall _ nilG) (pcore_normal _ _). by red; rewrite -(centsP cGpGp') // inGp ?p_elt_constt ?groupX. Qed. Lemma exponent_cycle x : exponent <[x]> = #[x]. Proof. by apply/eqP; rewrite eqn_dvd exponent_dvdn dvdn_exponent ?cycle_id. Qed. Lemma exponent_cyclic X : cyclic X -> exponent X = #|X|. Proof. by case/cyclicP=> x ->; apply: exponent_cycle. Qed. Lemma primes_exponent G : primes (exponent G) = primes (#|G|). Proof. apply/eq_primes => p; rewrite !mem_primes exponent_gt0 cardG_gt0 /=. by apply: andb_id2l => p_pr; apply: negb_inj; rewrite -!p'natE // pnat_exponent. Qed. Lemma pi_of_exponent G : \pi(exponent G) = \pi(G). Proof. by rewrite /pi_of primes_exponent. Qed. Lemma partn_exponentS pi H G : H \subset G -> #|G|`_pi %| #|H| -> (exponent H)`_pi = (exponent G)`_pi. Proof. move=> sHG Gpi_dvd_H; apply/eqP; rewrite eqn_dvd. rewrite partn_dvd ?exponentS ?exponent_gt0 //=; apply/dvdn_partP=> // p. rewrite pi_of_part ?exponent_gt0 // => /andP[_ /= pi_p]. have sppi: {subset (p : nat_pred) <= pi} by move=> q /eqnP->. have [P sylP] := Sylow_exists p H; have sPH := pHall_sub sylP. have{} sylP: p.-Sylow(G) P. rewrite pHallE (subset_trans sPH) //= (card_Hall sylP) eqn_dvd andbC. by rewrite -{1}(partn_part _ sppi) !partn_dvd ?cardSg ?cardG_gt0. rewrite partn_part ?partn_biglcm //. apply: (@big_ind _ (dvdn^~ _)) => [|m n|x Gx]; first exact: dvd1n. by rewrite dvdn_lcm => ->. rewrite -order_constt; have p_y := p_elt_constt p x; set y := x.`_p in p_y *. have sYG: <[y]> \subset G by rewrite cycle_subG groupX. have [z _ Pyz] := Sylow_Jsub sylP sYG p_y. rewrite (bigD1 (y ^ z)) ?(subsetP sPH) -?cycle_subG ?cycleJ //=. by rewrite orderJ part_pnat_id ?dvdn_lcml // (pi_pnat p_y). Qed. Lemma exponent_Hall pi G H : pi.-Hall(G) H -> exponent H = (exponent G)`_pi. Proof. move=> hallH; have [sHG piH _] := and3P hallH. rewrite -(partn_exponentS sHG) -?(card_Hall hallH) ?part_pnat_id //. by apply: pnat_dvd piH; apply: exponent_dvdn. Qed. Lemma exponent_Zgroup G : Zgroup G -> exponent G = #|G|. Proof. move/forall_inP=> ZgG; apply/eqP; rewrite eqn_dvd exponent_dvdn. apply/(dvdn_partP _ (cardG_gt0 _)) => p _. have [S sylS] := Sylow_exists p G; rewrite -(card_Hall sylS). have /cyclicP[x defS]: cyclic S by rewrite ZgG ?(p_Sylow sylS). by rewrite defS dvdn_exponent // -cycle_subG -defS (pHall_sub sylS). Qed. Lemma cprod_exponent A B G : A \* B = G -> lcmn (exponent A) (exponent B) = (exponent G). Proof. case/cprodP=> [[K H -> ->{A B}] <- cKH]. apply/eqP; rewrite eqn_dvd dvdn_lcm !exponentS ?mulG_subl ?mulG_subr //=. apply/exponentP=> _ /imset2P[x y Kx Hy ->]. rewrite -[1]mulg1 expgMn; last by red; rewrite -(centsP cKH). congr (_ * _); apply/eqP; rewrite -order_dvdn. by rewrite (dvdn_trans (dvdn_exponent Kx)) ?dvdn_lcml. by rewrite (dvdn_trans (dvdn_exponent Hy)) ?dvdn_lcmr. Qed. Lemma dprod_exponent A B G : A \x B = G -> lcmn (exponent A) (exponent B) = (exponent G). Proof. case/dprodP=> [[K H -> ->{A B}] defG cKH _]. by apply: cprod_exponent; rewrite cprodE. Qed. Lemma sub_LdivT A n : (A \subset 'Ldiv_n()) = (exponent A %| n). Proof. by apply/subsetP/exponentP=> eAn x /eAn; rewrite inE => /eqP. Qed. Lemma LdivT_J n x : 'Ldiv_n() :^ x = 'Ldiv_n(). Proof. apply/setP=> y; rewrite !inE mem_conjg inE -conjXg. by rewrite (canF_eq (conjgKV x)) conj1g. Qed. Lemma LdivJ n A x : 'Ldiv_n(A :^ x) = 'Ldiv_n(A) :^ x. Proof. by rewrite conjIg LdivT_J. Qed. Lemma sub_Ldiv A n : (A \subset 'Ldiv_n(A)) = (exponent A %| n). Proof. by rewrite subsetI subxx sub_LdivT. Qed. Lemma group_Ldiv G n : abelian G -> group_set 'Ldiv_n(G). Proof. move=> cGG; apply/group_setP. split=> [|x y]; rewrite !inE ?group1 ?expg1n //=. case/andP=> Gx /eqP xn /andP[Gy /eqP yn]. by rewrite groupM //= expgMn ?xn ?yn ?mulg1 //; apply: (centsP cGG). Qed. Lemma abelian_exponent_gen A : abelian A -> exponent <> = exponent A. Proof. rewrite -abelian_gen; set n := exponent A; set G := <> => cGG. apply/eqP; rewrite eqn_dvd andbC exponentS ?subset_gen //= -sub_Ldiv. rewrite -(gen_set_id (group_Ldiv n cGG)) genS // subsetI subset_gen /=. by rewrite sub_LdivT. Qed. Lemma abelem_pgroup p A : p.-abelem A -> p.-group A. Proof. by case/andP. Qed. Lemma abelem_abelian p A : p.-abelem A -> abelian A. Proof. by case/and3P. Qed. Lemma abelem1 p : p.-abelem [1 gT]. Proof. by rewrite /abelem pgroup1 abelian1 exponent1 dvd1n. Qed. Lemma abelemE p G : prime p -> p.-abelem G = abelian G && (exponent G %| p). Proof. move=> p_pr; rewrite /abelem -pnat_exponent andbA -!(andbC (_ %| _)). by case: (dvdn_pfactor _ 1 p_pr) => // [[k _ ->]]; rewrite pnatX pnat_id. Qed. Lemma abelemP p G : prime p -> reflect (abelian G /\ forall x, x \in G -> x ^+ p = 1) (p.-abelem G). Proof. by move=> p_pr; rewrite abelemE //; apply: (iffP andP) => [] [-> /exponentP]. Qed. Lemma abelem_order_p p G x : p.-abelem G -> x \in G -> x != 1 -> #[x] = p. Proof. case/and3P=> pG _ eG Gx; rewrite -cycle_eq1 => ntX. have{ntX} [p_pr p_x _] := pgroup_pdiv (mem_p_elt pG Gx) ntX. by apply/eqP; rewrite eqn_dvd p_x andbT order_dvdn (exponentP eG). Qed. Lemma cyclic_abelem_prime p X : p.-abelem X -> cyclic X -> X :!=: 1 -> #|X| = p. Proof. move=> abelX cycX; case/cyclicP: cycX => x -> in abelX *. by rewrite cycle_eq1; apply: abelem_order_p abelX (cycle_id x). Qed. Lemma cycle_abelem p x : p.-elt x || prime p -> p.-abelem <[x]> = (#[x] %| p). Proof. move=> p_xVpr; rewrite /abelem cycle_abelian /=. apply/andP/idP=> [[_ xp1] | x_dvd_p]. by rewrite order_dvdn (exponentP xp1) ?cycle_id. split; last exact: dvdn_trans (exponent_dvdn _) x_dvd_p. by case/orP: p_xVpr => // /pnat_id; apply: pnat_dvd. Qed. Lemma exponent2_abelem G : exponent G %| 2 -> 2.-abelem G. Proof. move/exponentP=> expG; apply/abelemP=> //; split=> //. apply/centsP=> x Gx y Gy; apply: (mulIg x); apply: (mulgI y). by rewrite -!mulgA !(mulgA y) -!(expgS _ 1) !expG ?mulg1 ?groupM. Qed. Lemma prime_abelem p G : prime p -> #|G| = p -> p.-abelem G. Proof. move=> p_pr oG; rewrite /abelem -oG exponent_dvdn. by rewrite /pgroup cyclic_abelian ?prime_cyclic ?oG ?pnat_id. Qed. Lemma abelem_cyclic p G : p.-abelem G -> cyclic G = (logn p #|G| <= 1). Proof. move=> abelG; have [pG _ expGp] := and3P abelG. case: (eqsVneq G 1) => [-> | ntG]; first by rewrite cyclic1 cards1 logn1. have [p_pr _ [e oG]] := pgroup_pdiv pG ntG; apply/idP/idP. case/cyclicP=> x defG; rewrite -(pfactorK 1 p_pr) dvdn_leq_log ?prime_gt0 //. by rewrite defG order_dvdn (exponentP expGp) // defG cycle_id. by rewrite oG pfactorK // ltnS leqn0 => e0; rewrite prime_cyclic // oG (eqP e0). Qed. Lemma abelemS p H G : H \subset G -> p.-abelem G -> p.-abelem H. Proof. move=> sHG /and3P[cGG pG Gp1]; rewrite /abelem. by rewrite (pgroupS sHG) // (abelianS sHG) // (dvdn_trans (exponentS sHG)). Qed. Lemma abelemJ p G x : p.-abelem (G :^ x) = p.-abelem G. Proof. by rewrite /abelem pgroupJ abelianJ exponentJ. Qed. Lemma cprod_abelem p A B G : A \* B = G -> p.-abelem G = p.-abelem A && p.-abelem B. Proof. case/cprodP=> [[H K -> ->{A B}] defG cHK]. apply/idP/andP=> [abelG | []]. by rewrite !(abelemS _ abelG) // -defG (mulG_subl, mulG_subr). case/and3P=> pH cHH expHp; case/and3P=> pK cKK expKp. rewrite -defG /abelem pgroupM pH pK abelianM cHH cKK cHK /=. apply/exponentP=> _ /imset2P[x y Hx Ky ->]. rewrite expgMn; last by red; rewrite -(centsP cHK). by rewrite (exponentP expHp) // (exponentP expKp) // mul1g. Qed. Lemma dprod_abelem p A B G : A \x B = G -> p.-abelem G = p.-abelem A && p.-abelem B. Proof. move=> defG; case/dprodP: (defG) => _ _ _ tiHK. by apply: cprod_abelem; rewrite -dprodEcp. Qed. Lemma is_abelem_pgroup p G : p.-group G -> is_abelem G = p.-abelem G. Proof. rewrite /is_abelem => pG. case: (eqsVneq G 1) => [-> | ntG]; first by rewrite !abelem1. by have [p_pr _ [k ->]] := pgroup_pdiv pG ntG; rewrite pdiv_pfactor. Qed. Lemma is_abelemP G : reflect (exists2 p, prime p & p.-abelem G) (is_abelem G). Proof. apply: (iffP idP) => [abelG | [p p_pr abelG]]. case: (eqsVneq G 1) => [-> | ntG]; first by exists 2; rewrite ?abelem1. by exists (pdiv #|G|); rewrite ?pdiv_prime // ltnNge -trivg_card_le1. by rewrite (is_abelem_pgroup (abelem_pgroup abelG)). Qed. Lemma pElemP p A E : reflect (E \subset A /\ p.-abelem E) (E \in 'E_p(A)). Proof. by rewrite inE; apply: andP. Qed. Arguments pElemP {p A E}. Lemma pElemS p A B : A \subset B -> 'E_p(A) \subset 'E_p(B). Proof. by move=> sAB; apply/subsetP=> E; rewrite !inE => /andP[/subset_trans->]. Qed. Lemma pElemI p A B : 'E_p(A :&: B) = 'E_p(A) :&: subgroups B. Proof. by apply/setP=> E; rewrite !inE subsetI andbAC. Qed. Lemma pElemJ x p A E : ((E :^ x)%G \in 'E_p(A :^ x)) = (E \in 'E_p(A)). Proof. by rewrite !inE conjSg abelemJ. Qed. Lemma pnElemP p n A E : reflect [/\ E \subset A, p.-abelem E & logn p #|E| = n] (E \in 'E_p^n(A)). Proof. by rewrite !inE -andbA; apply: (iffP and3P) => [] [-> -> /eqP]. Qed. Arguments pnElemP {p n A E}. Lemma pnElemPcard p n A E : E \in 'E_p^n(A) -> [/\ E \subset A, p.-abelem E & #|E| = p ^ n]%N. Proof. by case/pnElemP=> -> abelE <-; rewrite -card_pgroup // abelem_pgroup. Qed. Lemma card_pnElem p n A E : E \in 'E_p^n(A) -> #|E| = (p ^ n)%N. Proof. by case/pnElemPcard. Qed. Lemma pnElem0 p G : 'E_p^0(G) = [set 1%G]. Proof. apply/setP=> E; rewrite !inE -andbA; apply/and3P/idP=> [[_ pE] | /eqP->]. apply: contraLR; case/(pgroup_pdiv (abelem_pgroup pE)) => p_pr _ [k ->]. by rewrite pfactorK. by rewrite sub1G abelem1 cards1 logn1. Qed. Lemma pnElem_prime p n A E : E \in 'E_p^n.+1(A) -> prime p. Proof. by case/pnElemP=> _ _; rewrite lognE; case: prime. Qed. Lemma pnElemE p n A : prime p -> 'E_p^n(A) = [set E in 'E_p(A) | #|E| == (p ^ n)%N]. Proof. move/pfactorK=> pnK; apply/setP=> E; rewrite 3!inE. case: (@andP (E \subset A)) => //= [[_]] /andP[/p_natP[k ->] _]. by rewrite pnK (can_eq pnK). Qed. Lemma pnElemS p n A B : A \subset B -> 'E_p^n(A) \subset 'E_p^n(B). Proof. move=> sAB; apply/subsetP=> E. by rewrite !inE -!andbA => /andP[/subset_trans->]. Qed. Lemma pnElemI p n A B : 'E_p^n(A :&: B) = 'E_p^n(A) :&: subgroups B. Proof. by apply/setP=> E; rewrite !inE subsetI -!andbA; do !bool_congr. Qed. Lemma pnElemJ x p n A E : ((E :^ x)%G \in 'E_p^n(A :^ x)) = (E \in 'E_p^n(A)). Proof. by rewrite inE pElemJ cardJg !inE. Qed. Lemma abelem_pnElem p n G : p.-abelem G -> n <= logn p #|G| -> exists E, E \in 'E_p^n(G). Proof. case: n => [|n] abelG lt_nG; first by exists 1%G; rewrite pnElem0 set11. have p_pr: prime p by move: lt_nG; rewrite lognE; case: prime. case/(normal_pgroup (abelem_pgroup abelG)): lt_nG => // E [sEG _ oE]. by exists E; rewrite pnElemE // !inE oE sEG (abelemS sEG) /=. Qed. Lemma card_p1Elem p A X : X \in 'E_p^1(A) -> #|X| = p. Proof. exact: card_pnElem. Qed. Lemma p1ElemE p A : prime p -> 'E_p^1(A) = [set X in subgroups A | #|X| == p]. Proof. move=> p_pr; apply/setP=> X; rewrite pnElemE // !inE -andbA; congr (_ && _). by apply: andb_idl => /eqP oX; rewrite prime_abelem ?oX. Qed. Lemma TIp1ElemP p A X Y : X \in 'E_p^1(A) -> Y \in 'E_p^1(A) -> reflect (X :&: Y = 1) (X :!=: Y). Proof. move=> EpX EpY; have p_pr := pnElem_prime EpX. have [oX oY] := (card_p1Elem EpX, card_p1Elem EpY). have [<-|] := eqVneq. by right=> X1; rewrite -oX -(setIid X) X1 cards1 in p_pr. by rewrite eqEcard oX oY leqnn andbT; left; rewrite prime_TIg ?oX. Qed. Lemma card_p1Elem_pnElem p n A E : E \in 'E_p^n(A) -> #|'E_p^1(E)| = (\sum_(i < n) p ^ i)%N. Proof. case/pnElemP=> _ {A} abelE dimE; have [pE cEE _] := and3P abelE. have [E1 | ntE] := eqsVneq E 1. rewrite -dimE E1 cards1 logn1 big_ord0 eq_card0 // => X. by rewrite !inE subG1 trivg_card1; case: eqP => // ->; rewrite logn1 andbF. have [p_pr _ _] := pgroup_pdiv pE ntE; have p_gt1 := prime_gt1 p_pr. apply/eqP; rewrite -(@eqn_pmul2l (p - 1)) ?subn_gt0 // subn1 -predn_exp. have groupD1_inj: injective (fun X => (gval X)^#). apply: can_inj (@generated_group _) _ => X. by apply: val_inj; rewrite /= genD1 ?group1 ?genGid. rewrite -dimE -card_pgroup // (cardsD1 1 E) group1 /= mulnC. rewrite -(card_imset _ groupD1_inj) eq_sym. apply/eqP; apply: card_uniform_partition => [X'|]. case/imsetP=> X; rewrite pnElemE // expn1 => /setIdP[_ /eqP <-] ->. by rewrite (cardsD1 1 X) group1. apply/and3P; split; last 1 first. - apply/imsetP=> [[X /card_p1Elem oX X'0]]. by rewrite -oX (cardsD1 1) -X'0 group1 cards0 in p_pr. - rewrite eqEsubset; apply/andP; split. by apply/bigcupsP=> _ /imsetP[X /pnElemP[sXE _ _] ->]; apply: setSD. apply/subsetP=> x /setD1P[ntx Ex]. apply/bigcupP; exists <[x]>^#; last by rewrite !inE ntx cycle_id. apply/imsetP; exists <[x]>%G; rewrite ?p1ElemE // !inE cycle_subG Ex /=. by rewrite -orderE (abelem_order_p abelE). apply/trivIsetP=> _ _ /imsetP[X EpX ->] /imsetP[Y EpY ->]; apply/implyP. rewrite (inj_eq groupD1_inj) -setI_eq0 -setDIl setD_eq0 subG1. by rewrite (sameP eqP (TIp1ElemP EpX EpY)) implybb. Qed. Lemma card_p1Elem_p2Elem p A E : E \in 'E_p^2(A) -> #|'E_p^1(E)| = p.+1. Proof. by move/card_p1Elem_pnElem->; rewrite big_ord_recl big_ord1. Qed. Lemma p2Elem_dprodP p A E X Y : E \in 'E_p^2(A) -> X \in 'E_p^1(E) -> Y \in 'E_p^1(E) -> reflect (X \x Y = E) (X :!=: Y). Proof. move=> Ep2E EpX EpY; have [_ abelE oE] := pnElemPcard Ep2E. apply: (iffP (TIp1ElemP EpX EpY)) => [tiXY|]; last by case/dprodP. have [[sXE _ oX] [sYE _ oY]] := (pnElemPcard EpX, pnElemPcard EpY). rewrite dprodE ?(sub_abelian_cent2 (abelem_abelian abelE)) //. by apply/eqP; rewrite eqEcard mul_subG //= TI_cardMg // oX oY oE. Qed. Lemma nElemP n G E : reflect (exists p, E \in 'E_p^n(G)) (E \in 'E^n(G)). Proof. rewrite ['E^n(G)]big_mkord. apply: (iffP bigcupP) => [[[p /= _] _] | [p]]; first by exists p. case: n => [|n EpnE]; first by rewrite pnElem0; exists ord0; rewrite ?pnElem0. suffices lepG: p < #|G|.+1 by exists (Ordinal lepG). have:= EpnE; rewrite pnElemE ?(pnElem_prime EpnE) // !inE -andbA ltnS. case/and3P=> sEG _ oE; rewrite dvdn_leq // (dvdn_trans _ (cardSg sEG)) //. by rewrite (eqP oE) dvdn_exp. Qed. Arguments nElemP {n G E}. Lemma nElem0 G : 'E^0(G) = [set 1%G]. Proof. apply/setP=> E; apply/nElemP/idP=> [[p] |]; first by rewrite pnElem0. by exists 2; rewrite pnElem0. Qed. Lemma nElem1P G E : reflect (E \subset G /\ exists2 p, prime p & #|E| = p) (E \in 'E^1(G)). Proof. apply: (iffP nElemP) => [[p pE] | [sEG [p p_pr oE]]]. have p_pr := pnElem_prime pE; rewrite pnElemE // !inE -andbA in pE. by case/and3P: pE => -> _ /eqP; split; last exists p. exists p; rewrite pnElemE // !inE sEG oE eqxx abelemE // -oE exponent_dvdn. by rewrite cyclic_abelian // prime_cyclic // oE. Qed. Lemma nElemS n G H : G \subset H -> 'E^n(G) \subset 'E^n(H). Proof. move=> sGH; apply/subsetP=> E /nElemP[p EpnG_E]. by apply/nElemP; exists p; rewrite // (subsetP (pnElemS _ _ sGH)). Qed. Lemma nElemI n G H : 'E^n(G :&: H) = 'E^n(G) :&: subgroups H. Proof. apply/setP=> E; apply/nElemP/setIP=> [[p] | []]. by rewrite pnElemI; case/setIP; split=> //; apply/nElemP; exists p. by case/nElemP=> p EpnG_E sHE; exists p; rewrite pnElemI inE EpnG_E. Qed. Lemma def_pnElem p n G : 'E_p^n(G) = 'E_p(G) :&: 'E^n(G). Proof. apply/setP=> E; rewrite inE in_setI; apply: andb_id2l => /pElemP[sEG abelE]. apply/idP/nElemP=> [|[q]]; first by exists p; rewrite !inE sEG abelE. rewrite !inE -2!andbA => /and4P[_ /pgroupP qE _]. have [->|] := eqVneq E 1%G; first by rewrite cards1 !logn1. case/(pgroup_pdiv (abelem_pgroup abelE)) => p_pr pE _. by rewrite (eqnP (qE p p_pr pE)). Qed. Lemma pmaxElemP p A E : reflect (E \in 'E_p(A) /\ forall H, H \in 'E_p(A) -> E \subset H -> H :=: E) (E \in 'E*_p(A)). Proof. by rewrite [E \in 'E*_p(A)]inE; apply: (iffP maxgroupP). Qed. Lemma pmaxElem_exists p A D : D \in 'E_p(A) -> {E | E \in 'E*_p(A) & D \subset E}. Proof. move=> EpD; have [E maxE sDE] := maxgroup_exists (EpD : mem 'E_p(A) D). by exists E; rewrite // inE. Qed. Lemma pmaxElem_LdivP p G E : prime p -> reflect ('Ldiv_p('C_G(E)) = E) (E \in 'E*_p(G)). Proof. move=> p_pr; apply: (iffP (pmaxElemP p G E)) => [[] | defE]. case/pElemP=> sEG abelE maxE; have [_ cEE eE] := and3P abelE. apply/setP=> x; rewrite !inE -andbA; apply/and3P/idP=> [[Gx cEx xp] | Ex]. rewrite -(maxE (<[x]> <*> E)%G) ?joing_subr //. by rewrite -cycle_subG joing_subl. rewrite inE join_subG cycle_subG Gx sEG /=. rewrite (cprod_abelem _ (cprodEY _)); last by rewrite centsC cycle_subG. by rewrite cycle_abelem ?p_pr ?orbT // order_dvdn xp. by rewrite (subsetP sEG) // (subsetP cEE) // (exponentP eE). split=> [|H]; last first. case/pElemP=> sHG /abelemP[// | cHH Hp1] sEH. apply/eqP; rewrite eqEsubset sEH andbC /= -defE; apply/subsetP=> x Hx. by rewrite 3!inE (subsetP sHG) // Hp1 ?(subsetP (centsS _ cHH)) /=. apply/pElemP; split; first by rewrite -defE -setIA subsetIl. apply/abelemP=> //; rewrite /abelian -{1 3}defE setIAC subsetIr. by split=> //; apply/exponentP; rewrite -sub_LdivT setIAC subsetIr. Qed. Lemma pmaxElemS p A B : A \subset B -> 'E*_p(B) :&: subgroups A \subset 'E*_p(A). Proof. move=> sAB; apply/subsetP=> E; rewrite !inE. case/andP=> /maxgroupP[/pElemP[_ abelE] maxE] sEA. apply/maxgroupP; rewrite inE sEA; split=> // D EpD. by apply: maxE; apply: subsetP EpD; apply: pElemS. Qed. Lemma pmaxElemJ p A E x : ((E :^ x)%G \in 'E*_p(A :^ x)) = (E \in 'E*_p(A)). Proof. apply/pmaxElemP/pmaxElemP=> [] [EpE maxE]. rewrite pElemJ in EpE; split=> //= H EpH sEH; apply: (act_inj 'Js x). by apply: maxE; rewrite ?conjSg ?pElemJ. rewrite pElemJ; split=> // H; rewrite -(actKV 'JG x H) pElemJ conjSg => EpHx'. by move/maxE=> /= ->. Qed. Lemma grank_min B : 'm(<>) <= #|B|. Proof. by rewrite /gen_rank; case: arg_minnP => [|_ _ -> //]; rewrite genGid. Qed. Lemma grank_witness G : {B | <> = G & #|B| = 'm(G)}. Proof. rewrite /gen_rank; case: arg_minnP => [|B defG _]; first by rewrite genGid. by exists B; first apply/eqP. Qed. Lemma p_rank_witness p G : {E | E \in 'E_p^('r_p(G))(G)}. Proof. have [E EG_E mE]: {E | E \in 'E_p(G) & 'r_p(G) = logn p #|E| }. by apply: eq_bigmax_cond; rewrite (cardD1 1%G) inE sub1G abelem1. by exists E; rewrite inE EG_E -mE /=. Qed. Lemma p_rank_geP p n G : reflect (exists E, E \in 'E_p^n(G)) (n <= 'r_p(G)). Proof. apply: (iffP idP) => [|[E]]; last first. by rewrite inE => /andP[Ep_E /eqP <-]; rewrite (bigmax_sup E). have [D /pnElemP[sDG abelD <-]] := p_rank_witness p G. by case/abelem_pnElem=> // E; exists E; apply: (subsetP (pnElemS _ _ sDG)). Qed. Lemma p_rank_gt0 p H : ('r_p(H) > 0) = (p \in \pi(H)). Proof. rewrite mem_primes cardG_gt0 /=; apply/p_rank_geP/andP=> [[E] | [p_pr]]. case/pnElemP=> sEG _; rewrite lognE; case: and3P => // [[-> _ pE] _]. by rewrite (dvdn_trans _ (cardSg sEG)). case/Cauchy=> // x Hx ox; exists <[x]>%G; rewrite 2!inE [#|_|]ox cycle_subG. by rewrite Hx (pfactorK 1) ?abelemE // cycle_abelian -ox exponent_dvdn. Qed. Lemma p_rank1 p : 'r_p([1 gT]) = 0. Proof. by apply/eqP; rewrite eqn0Ngt p_rank_gt0 /= cards1. Qed. Lemma logn_le_p_rank p A E : E \in 'E_p(A) -> logn p #|E| <= 'r_p(A). Proof. by move=> EpA_E; rewrite (bigmax_sup E). Qed. Lemma p_rank_le_logn p G : 'r_p(G) <= logn p #|G|. Proof. have [E EpE] := p_rank_witness p G. by have [sEG _ <-] := pnElemP EpE; apply: lognSg. Qed. Lemma p_rank_abelem p G : p.-abelem G -> 'r_p(G) = logn p #|G|. Proof. move=> abelG; apply/eqP; rewrite eqn_leq andbC (bigmax_sup G) //. by apply/bigmax_leqP=> E; rewrite inE => /andP[/lognSg->]. by rewrite inE subxx. Qed. Lemma p_rankS p A B : A \subset B -> 'r_p(A) <= 'r_p(B). Proof. move=> sAB; apply/bigmax_leqP=> E /(subsetP (pElemS p sAB)) EpB_E. by rewrite (bigmax_sup E). Qed. Lemma p_rankElem_max p A : 'E_p^('r_p(A))(A) \subset 'E*_p(A). Proof. apply/subsetP=> E /setIdP[EpE dimE]. apply/pmaxElemP; split=> // F EpF sEF; apply/eqP. have pF: p.-group F by case/pElemP: EpF => _ /and3P[]. have pE: p.-group E by case/pElemP: EpE => _ /and3P[]. rewrite eq_sym eqEcard sEF dvdn_leq // (card_pgroup pE) (card_pgroup pF). by rewrite (eqP dimE) dvdn_exp2l // logn_le_p_rank. Qed. Lemma p_rankJ p A x : 'r_p(A :^ x) = 'r_p(A). Proof. rewrite /p_rank (reindex_inj (act_inj 'JG x)). by apply: eq_big => [E | E _]; rewrite ?cardJg ?pElemJ. Qed. Lemma p_rank_Sylow p G H : p.-Sylow(G) H -> 'r_p(H) = 'r_p(G). Proof. move=> sylH; apply/eqP; rewrite eqn_leq (p_rankS _ (pHall_sub sylH)) /=. apply/bigmax_leqP=> E; rewrite inE => /andP[sEG abelE]. have [P sylP sEP] := Sylow_superset sEG (abelem_pgroup abelE). have [x _ ->] := Sylow_trans sylP sylH. by rewrite p_rankJ -(p_rank_abelem abelE) (p_rankS _ sEP). Qed. Lemma p_rank_Hall pi p G H : pi.-Hall(G) H -> p \in pi -> 'r_p(H) = 'r_p(G). Proof. move=> hallH pi_p; have [P sylP] := Sylow_exists p H. by rewrite -(p_rank_Sylow sylP) (p_rank_Sylow (subHall_Sylow hallH pi_p sylP)). Qed. Lemma p_rank_pmaxElem_exists p r G : 'r_p(G) >= r -> exists2 E, E \in 'E*_p(G) & 'r_p(E) >= r. Proof. case/p_rank_geP=> D /setIdP[EpD /eqP <- {r}]. have [E EpE sDE] := pmaxElem_exists EpD; exists E => //. case/pmaxElemP: EpE => /setIdP[_ abelE] _. by rewrite (p_rank_abelem abelE) lognSg. Qed. Lemma rank1 : 'r([1 gT]) = 0. Proof. by rewrite ['r(1)]big1_seq // => p _; rewrite p_rank1. Qed. Lemma p_rank_le_rank p G : 'r_p(G) <= 'r(G). Proof. case: (posnP 'r_p(G)) => [-> //|]; rewrite p_rank_gt0 mem_primes. case/and3P=> p_pr _ pG; have lepg: p < #|G|.+1 by rewrite ltnS dvdn_leq. by rewrite ['r(G)]big_mkord (bigmax_sup (Ordinal lepg)). Qed. Lemma rank_gt0 G : ('r(G) > 0) = (G :!=: 1). Proof. case: (eqsVneq G 1) => [-> |]; first by rewrite rank1. case: (trivgVpdiv G) => [/eqP->// | [p p_pr]]. case/Cauchy=> // x Gx oxp _; apply: leq_trans (p_rank_le_rank p G). have EpGx: <[x]>%G \in 'E_p(G). by rewrite inE cycle_subG Gx abelemE // cycle_abelian -oxp exponent_dvdn. by apply: leq_trans (logn_le_p_rank EpGx); rewrite -orderE oxp logn_prime ?eqxx. Qed. Lemma rank_witness G : {p | prime p & 'r(G) = 'r_p(G)}. Proof. have [p _ defmG]: {p : 'I_(#|G|.+1) | true & 'r(G) = 'r_p(G)}. by rewrite ['r(G)]big_mkord; apply: eq_bigmax_cond; rewrite card_ord. case: (eqsVneq G 1) => [-> | ]; first by exists 2; rewrite // rank1 p_rank1. by rewrite -rank_gt0 defmG p_rank_gt0 mem_primes; case/andP; exists p. Qed. Lemma rank_pgroup p G : p.-group G -> 'r(G) = 'r_p(G). Proof. move=> pG; apply/eqP; rewrite eqn_leq p_rank_le_rank andbT. rewrite ['r(G)]big_mkord; apply/bigmax_leqP=> [[q /= _] _]. case: (posnP 'r_q(G)) => [-> // |]; rewrite p_rank_gt0 mem_primes. by case/and3P=> q_pr _ qG; rewrite (eqnP (pgroupP pG q q_pr qG)). Qed. Lemma rank_Sylow p G P : p.-Sylow(G) P -> 'r(P) = 'r_p(G). Proof. move=> sylP; have pP := pHall_pgroup sylP. by rewrite -(p_rank_Sylow sylP) -(rank_pgroup pP). Qed. Lemma rank_abelem p G : p.-abelem G -> 'r(G) = logn p #|G|. Proof. by move=> abelG; rewrite (rank_pgroup (abelem_pgroup abelG)) p_rank_abelem. Qed. Lemma nt_pnElem p n E A : E \in 'E_p^n(A) -> n > 0 -> E :!=: 1. Proof. by case/pnElemP=> _ /rank_abelem <- <-; rewrite rank_gt0. Qed. Lemma rankJ A x : 'r(A :^ x) = 'r(A). Proof. by rewrite /rank cardJg; apply: eq_bigr => p _; rewrite p_rankJ. Qed. Lemma rankS A B : A \subset B -> 'r(A) <= 'r(B). Proof. move=> sAB; rewrite /rank !big_mkord; apply/bigmax_leqP=> p _. have leAB: #|A| < #|B|.+1 by rewrite ltnS subset_leq_card. by rewrite (bigmax_sup (widen_ord leAB p)) // p_rankS. Qed. Lemma rank_geP n G : reflect (exists E, E \in 'E^n(G)) (n <= 'r(G)). Proof. apply: (iffP idP) => [|[E]]. have [p _ ->] := rank_witness G; case/p_rank_geP=> E. by rewrite def_pnElem; case/setIP; exists E. case/nElemP=> p; rewrite inE => /andP[EpG_E /eqP <-]. by rewrite (leq_trans (logn_le_p_rank EpG_E)) ?p_rank_le_rank. Qed. End ExponentAbelem. Arguments LdivP {gT A n x}. Arguments exponentP {gT A n}. Arguments abelemP {gT p G}. Arguments is_abelemP {gT G}. Arguments pElemP {gT p A E}. Arguments pnElemP {gT p n A E}. Arguments nElemP {gT n G E}. Arguments nElem1P {gT G E}. Arguments pmaxElemP {gT p A E}. Arguments pmaxElem_LdivP {gT p G E}. Arguments p_rank_geP {gT p n G}. Arguments rank_geP {gT n G}. Section MorphAbelem. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Implicit Types (G H E : {group aT}) (A B : {set aT}). Lemma exponent_morphim G : exponent (f @* G) %| exponent G. Proof. apply/exponentP=> _ /morphimP[x Dx Gx ->]. by rewrite -morphX // expg_exponent // morph1. Qed. Lemma morphim_LdivT n : f @* 'Ldiv_n() \subset 'Ldiv_n(). Proof. apply/subsetP=> _ /morphimP[x Dx xn ->]; rewrite inE in xn. by rewrite inE -morphX // (eqP xn) morph1. Qed. Lemma morphim_Ldiv n A : f @* 'Ldiv_n(A) \subset 'Ldiv_n(f @* A). Proof. by apply: subset_trans (morphimI f A _) (setIS _ _); apply: morphim_LdivT. Qed. Lemma morphim_abelem p G : p.-abelem G -> p.-abelem (f @* G). Proof. case: (eqsVneq G 1) => [-> | ntG] abelG; first by rewrite morphim1 abelem1. have [p_pr _ _] := pgroup_pdiv (abelem_pgroup abelG) ntG. case/abelemP: abelG => // abG elemG; apply/abelemP; rewrite ?morphim_abelian //. by split=> // _ /morphimP[x Dx Gx ->]; rewrite -morphX // elemG ?morph1. Qed. Lemma morphim_pElem p G E : E \in 'E_p(G) -> (f @* E)%G \in 'E_p(f @* G). Proof. by rewrite !inE => /andP[sEG abelE]; rewrite morphimS // morphim_abelem. Qed. Lemma morphim_pnElem p n G E : E \in 'E_p^n(G) -> {m | m <= n & (f @* E)%G \in 'E_p^m(f @* G)}. Proof. rewrite inE => /andP[EpE /eqP <-]. by exists (logn p #|f @* E|); rewrite ?logn_morphim // inE morphim_pElem /=. Qed. Lemma morphim_grank G : G \subset D -> 'm(f @* G) <= 'm(G). Proof. have [B defG <-] := grank_witness G; rewrite -defG gen_subG => sBD. by rewrite morphim_gen ?morphimEsub ?(leq_trans (grank_min _)) ?leq_imset_card. Qed. (* There are no general morphism relations for the p-rank. We later prove *) (* some relations for the p-rank of a quotient in the QuotientAbelem section. *) End MorphAbelem. Section InjmAbelem. Variables (aT rT : finGroupType) (D G : {group aT}) (f : {morphism D >-> rT}). Hypotheses (injf : 'injm f) (sGD : G \subset D). Let defG : invm injf @* (f @* G) = G := morphim_invm injf sGD. Lemma exponent_injm : exponent (f @* G) = exponent G. Proof. by apply/eqP; rewrite eqn_dvd -{3}defG !exponent_morphim. Qed. Lemma injm_Ldiv n A : f @* 'Ldiv_n(A) = 'Ldiv_n(f @* A). Proof. apply/eqP; rewrite eqEsubset morphim_Ldiv. rewrite -[f @* 'Ldiv_n(A)](morphpre_invm injf). rewrite -sub_morphim_pre; last by rewrite subIset ?morphim_sub. rewrite injmI ?injm_invm // setISS ?morphim_LdivT //. by rewrite sub_morphim_pre ?morphim_sub // morphpre_invm. Qed. Lemma injm_abelem p : p.-abelem (f @* G) = p.-abelem G. Proof. by apply/idP/idP; first rewrite -{2}defG; apply: morphim_abelem. Qed. Lemma injm_pElem p (E : {group aT}) : E \subset D -> ((f @* E)%G \in 'E_p(f @* G)) = (E \in 'E_p(G)). Proof. move=> sED; apply/idP/idP=> EpE; last exact: morphim_pElem. by rewrite -defG -(group_inj (morphim_invm injf sED)) morphim_pElem. Qed. Lemma injm_pnElem p n (E : {group aT}) : E \subset D -> ((f @* E)%G \in 'E_p^n(f @* G)) = (E \in 'E_p^n(G)). Proof. by move=> sED; rewrite inE injm_pElem // card_injm ?inE. Qed. Lemma injm_nElem n (E : {group aT}) : E \subset D -> ((f @* E)%G \in 'E^n(f @* G)) = (E \in 'E^n(G)). Proof. move=> sED; apply/nElemP/nElemP=> [] [p EpE]; by exists p; rewrite injm_pnElem in EpE *. Qed. Lemma injm_pmaxElem p (E : {group aT}) : E \subset D -> ((f @* E)%G \in 'E*_p(f @* G)) = (E \in 'E*_p(G)). Proof. move=> sED; have defE := morphim_invm injf sED. apply/pmaxElemP/pmaxElemP=> [] [EpE maxE]. split=> [|H EpH sEH]; first by rewrite injm_pElem in EpE. have sHD: H \subset D by apply: subset_trans (sGD); case/pElemP: EpH. by rewrite -(morphim_invm injf sHD) [f @* H]maxE ?morphimS ?injm_pElem. rewrite injm_pElem //; split=> // fH Ep_fH sfEH; have [sfHG _] := pElemP Ep_fH. have sfHD : fH \subset f @* D by rewrite (subset_trans sfHG) ?morphimS. rewrite -(morphpreK sfHD); congr (f @* _). rewrite [_ @*^-1 fH]maxE -?sub_morphim_pre //. by rewrite -injm_pElem ?subsetIl // (group_inj (morphpreK sfHD)). Qed. Lemma injm_grank : 'm(f @* G) = 'm(G). Proof. by apply/eqP; rewrite eqn_leq -{3}defG !morphim_grank ?morphimS. Qed. Lemma injm_p_rank p : 'r_p(f @* G) = 'r_p(G). Proof. apply/eqP; rewrite eqn_leq; apply/andP; split. have [fE] := p_rank_witness p (f @* G); move: 'r_p(_) => n Ep_fE. apply/p_rank_geP; exists (f @*^-1 fE)%G. rewrite -injm_pnElem ?subsetIl ?(group_inj (morphpreK _)) //. by case/pnElemP: Ep_fE => sfEG _ _; rewrite (subset_trans sfEG) ?morphimS. have [E] := p_rank_witness p G; move: 'r_p(_) => n EpE. apply/p_rank_geP; exists (f @* E)%G; rewrite injm_pnElem //. by case/pnElemP: EpE => sEG _ _; rewrite (subset_trans sEG). Qed. Lemma injm_rank : 'r(f @* G) = 'r(G). Proof. apply/eqP; rewrite eqn_leq; apply/andP; split. by have [p _ ->] := rank_witness (f @* G); rewrite injm_p_rank p_rank_le_rank. by have [p _ ->] := rank_witness G; rewrite -injm_p_rank p_rank_le_rank. Qed. End InjmAbelem. Section IsogAbelem. Variables (aT rT : finGroupType) (G : {group aT}) (H : {group rT}). Hypothesis isoGH : G \isog H. Lemma exponent_isog : exponent G = exponent H. Proof. by case/isogP: isoGH => f injf <-; rewrite exponent_injm. Qed. Lemma isog_abelem p : p.-abelem G = p.-abelem H. Proof. by case/isogP: isoGH => f injf <-; rewrite injm_abelem. Qed. Lemma isog_grank : 'm(G) = 'm(H). Proof. by case/isogP: isoGH => f injf <-; rewrite injm_grank. Qed. Lemma isog_p_rank p : 'r_p(G) = 'r_p(H). Proof. by case/isogP: isoGH => f injf <-; rewrite injm_p_rank. Qed. Lemma isog_rank : 'r(G) = 'r(H). Proof. by case/isogP: isoGH => f injf <-; rewrite injm_rank. Qed. End IsogAbelem. Section QuotientAbelem. Variables (gT : finGroupType) (p : nat). Implicit Types E G K H : {group gT}. Lemma exponent_quotient G H : exponent (G / H) %| exponent G. Proof. exact: exponent_morphim. Qed. Lemma quotient_LdivT n H : 'Ldiv_n() / H \subset 'Ldiv_n(). Proof. exact: morphim_LdivT. Qed. Lemma quotient_Ldiv n A H : 'Ldiv_n(A) / H \subset 'Ldiv_n(A / H). Proof. exact: morphim_Ldiv. Qed. Lemma quotient_abelem G H : p.-abelem G -> p.-abelem (G / H). Proof. exact: morphim_abelem. Qed. Lemma quotient_pElem G H E : E \in 'E_p(G) -> (E / H)%G \in 'E_p(G / H). Proof. exact: morphim_pElem. Qed. Lemma logn_quotient G H : logn p #|G / H| <= logn p #|G|. Proof. exact: logn_morphim. Qed. Lemma quotient_pnElem G H n E : E \in 'E_p^n(G) -> {m | m <= n & (E / H)%G \in 'E_p^m(G / H)}. Proof. exact: morphim_pnElem. Qed. Lemma quotient_grank G H : G \subset 'N(H) -> 'm(G / H) <= 'm(G). Proof. exact: morphim_grank. Qed. Lemma p_rank_quotient G H : G \subset 'N(H) -> 'r_p(G) - 'r_p(H) <= 'r_p(G / H). Proof. move=> nHG; rewrite leq_subLR. have [E EpE] := p_rank_witness p G; have{EpE} [sEG abelE <-] := pnElemP EpE. rewrite -(LagrangeI E H) lognM ?cardG_gt0 //. rewrite -card_quotient ?(subset_trans sEG) // leq_add ?logn_le_p_rank // !inE. by rewrite subsetIr (abelemS (subsetIl E H)). by rewrite quotientS ?quotient_abelem. Qed. Lemma p_rank_dprod K H G : K \x H = G -> 'r_p(K) + 'r_p(H) = 'r_p(G). Proof. move=> defG; apply/eqP; rewrite eqn_leq -leq_subLR andbC. have [_ defKH cKH tiKH] := dprodP defG; have nKH := cents_norm cKH. rewrite {1}(isog_p_rank (quotient_isog nKH tiKH)) /= -quotientMidl defKH. rewrite p_rank_quotient; last by rewrite -defKH mul_subG ?normG. have [[E EpE] [F EpF]] := (p_rank_witness p K, p_rank_witness p H). have [[sEK abelE <-] [sFH abelF <-]] := (pnElemP EpE, pnElemP EpF). have defEF: E \x F = E <*> F. by rewrite dprodEY ?(centSS sFH sEK) //; apply/trivgP; rewrite -tiKH setISS. apply/p_rank_geP; exists (E <*> F)%G; rewrite !inE (dprod_abelem p defEF). rewrite -lognM ?cargG_gt0 // (dprod_card defEF) abelE abelF eqxx. by rewrite -(genGid G) -defKH genM_join genS ?setUSS. Qed. Lemma p_rank_p'quotient G H : (p : nat)^'.-group H -> G \subset 'N(H) -> 'r_p(G / H) = 'r_p(G). Proof. move=> p'H nHG; have [P sylP] := Sylow_exists p G. have [sPG pP _] := and3P sylP; have nHP := subset_trans sPG nHG. have tiHP: H :&: P = 1 := coprime_TIg (p'nat_coprime p'H pP). rewrite -(p_rank_Sylow sylP) -(p_rank_Sylow (quotient_pHall nHP sylP)). by rewrite (isog_p_rank (quotient_isog nHP tiHP)). Qed. End QuotientAbelem. Section OhmProps. Section Generic. Variables (n : nat) (gT : finGroupType). Implicit Types (p : nat) (x : gT) (rT : finGroupType). Implicit Types (A B : {set gT}) (D G H : {group gT}). Lemma Ohm_sub G : 'Ohm_n(G) \subset G. Proof. by rewrite gen_subG; apply/subsetP=> x /setIdP[]. Qed. Lemma Ohm1 : 'Ohm_n([1 gT]) = 1. Proof. exact: (trivgP (Ohm_sub _)). Qed. Lemma Ohm_id G : 'Ohm_n('Ohm_n(G)) = 'Ohm_n(G). Proof. apply/eqP; rewrite eqEsubset Ohm_sub genS //. by apply/subsetP=> x /setIdP[Gx oxn]; rewrite inE mem_gen // inE Gx. Qed. Lemma Ohm_cont rT G (f : {morphism G >-> rT}) : f @* 'Ohm_n(G) \subset 'Ohm_n(f @* G). Proof. rewrite morphim_gen ?genS //; last by rewrite -gen_subG Ohm_sub. apply/subsetP=> fx /morphimP[x Gx]; rewrite inE Gx /=. case/OhmPredP=> p p_pr xpn_1 -> {fx}. rewrite inE morphimEdom imset_f //=; apply/OhmPredP; exists p => //. by rewrite -morphX // xpn_1 morph1. Qed. Lemma OhmS H G : H \subset G -> 'Ohm_n(H) \subset 'Ohm_n(G). Proof. move=> sHG; apply: genS; apply/subsetP=> x; rewrite !inE => /andP[Hx ->]. by rewrite (subsetP sHG). Qed. Lemma OhmE p G : p.-group G -> 'Ohm_n(G) = <<'Ldiv_(p ^ n)(G)>>. Proof. move=> pG; congr <<_>>; apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. have [-> | ntx] := eqVneq x 1; first by rewrite !expg1n. by rewrite (pdiv_p_elt (mem_p_elt pG Gx)). Qed. Lemma OhmEabelian p G : p.-group G -> abelian 'Ohm_n(G) -> 'Ohm_n(G) = 'Ldiv_(p ^ n)(G). Proof. move=> pG; rewrite (OhmE pG) abelian_gen => cGGn; rewrite gen_set_id //. rewrite -(setIidPr (subset_gen 'Ldiv_(p ^ n)(G))) setIA. by rewrite [_ :&: G](setIidPl _) ?gen_subG ?subsetIl // group_Ldiv ?abelian_gen. Qed. Lemma Ohm_p_cycle p x : p.-elt x -> 'Ohm_n(<[x]>) = <[x ^+ (p ^ (logn p #[x] - n))]>. Proof. move=> p_x; apply/eqP; rewrite (OhmE p_x) eqEsubset cycle_subG mem_gen. rewrite gen_subG andbT; apply/subsetP=> y /LdivP[x_y ypn]. case: (leqP (logn p #[x]) n) => [|lt_n_x]. by rewrite -subn_eq0 => /eqP->. have p_pr: prime p by move: lt_n_x; rewrite lognE; case: (prime p). have def_y: <[y]> = <[x ^+ (#[x] %/ #[y])]>. apply: congr_group; apply/set1P. by rewrite -cycle_sub_group ?cardSg ?inE ?cycle_subG ?x_y /=. rewrite -cycle_subG def_y cycle_subG -{1}(part_pnat_id p_x) p_part. rewrite -{1}(subnK (ltnW lt_n_x)) expnD -muln_divA ?order_dvdn ?ypn //. by rewrite expgM mem_cycle. rewrite !inE mem_cycle -expgM -expnD addnC -maxnE -order_dvdn. by rewrite -{1}(part_pnat_id p_x) p_part dvdn_exp2l ?leq_maxr. Qed. Lemma Ohm_dprod A B G : A \x B = G -> 'Ohm_n(A) \x 'Ohm_n(B) = 'Ohm_n(G). Proof. case/dprodP => [[H K -> ->{A B}]] <- cHK tiHK. rewrite dprodEY //; last first. - by apply/trivgP; rewrite -tiHK setISS ?Ohm_sub. - by rewrite (subset_trans (subset_trans _ cHK)) ?centS ?Ohm_sub. apply/eqP; rewrite -(cent_joinEr cHK) eqEsubset join_subG /=. rewrite !OhmS ?joing_subl ?joing_subr //= cent_joinEr //= -genM_join genS //. apply/subsetP=> _ /setIdP[/imset2P[x y Hx Ky ->] /OhmPredP[p p_pr /eqP]]. have cxy: commute x y by red; rewrite -(centsP cHK). rewrite ?expgMn // -eq_invg_mul => /eqP def_x. have ypn1: y ^+ (p ^ n) = 1. by apply/set1P; rewrite -[[set 1]]tiHK inE -{1}def_x groupV !groupX. have xpn1: x ^+ (p ^ n) = 1 by rewrite -[x ^+ _]invgK def_x ypn1 invg1. by rewrite mem_mulg ?mem_gen // inE (Hx, Ky); apply/OhmPredP; exists p. Qed. Lemma Mho_sub G : 'Mho^n(G) \subset G. Proof. rewrite gen_subG; apply/subsetP=> _ /imsetP[x /setIdP[Gx _] ->]. exact: groupX. Qed. Lemma Mho1 : 'Mho^n([1 gT]) = 1. Proof. exact: (trivgP (Mho_sub _)). Qed. Lemma morphim_Mho rT D G (f : {morphism D >-> rT}) : G \subset D -> f @* 'Mho^n(G) = 'Mho^n(f @* G). Proof. move=> sGD; have sGnD := subset_trans (Mho_sub G) sGD. apply/eqP; rewrite eqEsubset {1}morphim_gen -1?gen_subG // !gen_subG. apply/andP; split; apply/subsetP=> y. case/morphimP=> xpn _ /imsetP[x /setIdP[Gx]]. set p := pdiv _ => p_x -> -> {xpn y}; have Dx := subsetP sGD x Gx. by rewrite morphX // Mho_p_elt ?morph_p_elt ?mem_morphim. case/imsetP=> _ /setIdP[/morphimP[x Dx Gx ->]]. set p := pdiv _ => p_fx ->{y}; rewrite -(constt_p_elt p_fx) -morph_constt //. by rewrite -morphX ?mem_morphim ?Mho_p_elt ?groupX ?p_elt_constt. Qed. Lemma Mho_cont rT G (f : {morphism G >-> rT}) : f @* 'Mho^n(G) \subset 'Mho^n(f @* G). Proof. by rewrite morphim_Mho. Qed. Lemma MhoS H G : H \subset G -> 'Mho^n(H) \subset 'Mho^n(G). Proof. move=> sHG; apply: genS; apply: imsetS; apply/subsetP=> x. by rewrite !inE => /andP[Hx]; rewrite (subsetP sHG). Qed. Lemma MhoE p G : p.-group G -> 'Mho^n(G) = <<[set x ^+ (p ^ n) | x in G]>>. Proof. move=> pG; apply/eqP; rewrite eqEsubset !gen_subG; apply/andP. do [split; apply/subsetP=> xpn; case/imsetP=> x] => [|Gx ->]; last first. by rewrite Mho_p_elt ?(mem_p_elt pG). case/setIdP=> Gx _ ->; have [-> | ntx] := eqVneq x 1; first by rewrite expg1n. by rewrite (pdiv_p_elt (mem_p_elt pG Gx) ntx) mem_gen //; apply: imset_f. Qed. Lemma MhoEabelian p G : p.-group G -> abelian G -> 'Mho^n(G) = [set x ^+ (p ^ n) | x in G]. Proof. move=> pG cGG; rewrite (MhoE pG); rewrite gen_set_id //; apply/group_setP. split=> [|xn yn]; first by apply/imsetP; exists 1; rewrite ?expg1n. case/imsetP=> x Gx ->; case/imsetP=> y Gy ->. by rewrite -expgMn; [apply: imset_f; rewrite groupM | apply: (centsP cGG)]. Qed. Lemma trivg_Mho G : 'Mho^n(G) == 1 -> 'Ohm_n(G) == G. Proof. rewrite -subG1 gen_subG eqEsubset Ohm_sub /= => Gp1. rewrite -{1}(Sylow_gen G) genS //; apply/bigcupsP=> P. case/SylowP=> p p_pr /and3P[sPG pP _]; apply/subsetP=> x Px. have Gx := subsetP sPG x Px; rewrite inE Gx //=. rewrite (sameP eqP set1P) (subsetP Gp1) ?mem_gen //; apply: imset_f. by rewrite inE Gx; apply: pgroup_p (mem_p_elt pP Px). Qed. Lemma Mho_p_cycle p x : p.-elt x -> 'Mho^n(<[x]>) = <[x ^+ (p ^ n)]>. Proof. move=> p_x. apply/eqP; rewrite (MhoE p_x) eqEsubset cycle_subG mem_gen; last first. by apply: imset_f; apply: cycle_id. rewrite gen_subG andbT; apply/subsetP=> _ /imsetP[_ /cycleP[k ->] ->]. by rewrite -expgM mulnC expgM mem_cycle. Qed. Lemma Mho_cprod A B G : A \* B = G -> 'Mho^n(A) \* 'Mho^n(B) = 'Mho^n(G). Proof. case/cprodP => [[H K -> ->{A B}]] <- cHK; rewrite cprodEY //; last first. by rewrite (subset_trans (subset_trans _ cHK)) ?centS ?Mho_sub. apply/eqP; rewrite -(cent_joinEr cHK) eqEsubset join_subG /=. rewrite !MhoS ?joing_subl ?joing_subr //= cent_joinEr // -genM_join. apply: genS; apply/subsetP=> xypn /imsetP[_ /setIdP[/imset2P[x y Hx Ky ->]]]. move/constt_p_elt; move: (pdiv _) => p <- ->. have cxy: commute x y by red; rewrite -(centsP cHK). rewrite consttM // expgMn; last exact: commuteX2. by rewrite mem_mulg ?Mho_p_elt ?groupX ?p_elt_constt. Qed. Lemma Mho_dprod A B G : A \x B = G -> 'Mho^n(A) \x 'Mho^n(B) = 'Mho^n(G). Proof. case/dprodP => [[H K -> ->{A B}]] defG cHK tiHK. rewrite dprodEcp; first by apply: Mho_cprod; rewrite cprodE. by apply/trivgP; rewrite -tiHK setISS ?Mho_sub. Qed. End Generic. Canonical Ohm_igFun i := [igFun by Ohm_sub i & Ohm_cont i]. Canonical Ohm_gFun i := [gFun by Ohm_cont i]. Canonical Ohm_mgFun i := [mgFun by OhmS i]. Canonical Mho_igFun i := [igFun by Mho_sub i & Mho_cont i]. Canonical Mho_gFun i := [gFun by Mho_cont i]. Canonical Mho_mgFun i := [mgFun by MhoS i]. Section char. Variables (n : nat) (gT rT : finGroupType) (D G : {group gT}). Lemma Ohm_char : 'Ohm_n(G) \char G. Proof. exact: gFchar. Qed. Lemma Ohm_normal : 'Ohm_n(G) <| G. Proof. exact: gFnormal. Qed. Lemma Mho_char : 'Mho^n(G) \char G. Proof. exact: gFchar. Qed. Lemma Mho_normal : 'Mho^n(G) <| G. Proof. exact: gFnormal. Qed. Lemma morphim_Ohm (f : {morphism D >-> rT}) : G \subset D -> f @* 'Ohm_n(G) \subset 'Ohm_n(f @* G). Proof. exact: morphimF. Qed. Lemma injm_Ohm (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> f @* 'Ohm_n(G) = 'Ohm_n(f @* G). Proof. by move=> injf; apply: injmF. Qed. Lemma isog_Ohm (H : {group rT}) : G \isog H -> 'Ohm_n(G) \isog 'Ohm_n(H). Proof. exact: gFisog. Qed. Lemma isog_Mho (H : {group rT}) : G \isog H -> 'Mho^n(G) \isog 'Mho^n(H). Proof. exact: gFisog. Qed. End char. Variable gT : finGroupType. Implicit Types (pi : nat_pred) (p : nat). Implicit Types (A B C : {set gT}) (D G H E : {group gT}). Lemma Ohm0 G : 'Ohm_0(G) = 1. Proof. apply/trivgP; rewrite /= gen_subG. by apply/subsetP=> x /setIdP[_]; rewrite inE. Qed. Lemma Ohm_leq m n G : m <= n -> 'Ohm_m(G) \subset 'Ohm_n(G). Proof. move/subnKC <-; rewrite genS //; apply/subsetP=> y. by rewrite !inE expnD expgM => /andP[-> /eqP->]; rewrite expg1n /=. Qed. Lemma OhmJ n G x : 'Ohm_n(G :^ x) = 'Ohm_n(G) :^ x. Proof. rewrite -{1}(setIid G) -(setIidPr (Ohm_sub n G)). by rewrite -!morphim_conj injm_Ohm ?injm_conj. Qed. Lemma Mho0 G : 'Mho^0(G) = G. Proof. apply/eqP; rewrite eqEsubset Mho_sub /=. apply/subsetP=> x Gx; rewrite -[x]prod_constt group_prod // => p _. exact: Mho_p_elt (groupX _ Gx) (p_elt_constt _ _). Qed. Lemma Mho_leq m n G : m <= n -> 'Mho^n(G) \subset 'Mho^m(G). Proof. move/subnKC <-; rewrite gen_subG //. apply/subsetP=> _ /imsetP[x /setIdP[Gx p_x] ->]. by rewrite expnD expgM groupX ?(Mho_p_elt _ _ p_x). Qed. Lemma MhoJ n G x : 'Mho^n(G :^ x) = 'Mho^n(G) :^ x. Proof. by rewrite -{1}(setIid G) -(setIidPr (Mho_sub n G)) -!morphim_conj morphim_Mho. Qed. Lemma extend_cyclic_Mho G p x : p.-group G -> x \in G -> 'Mho^1(G) = <[x ^+ p]> -> forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (p ^ k)]>. Proof. move=> pG Gx defG1 [//|k _]; have pX := mem_p_elt pG Gx. apply/eqP; rewrite eqEsubset cycle_subG (Mho_p_elt _ Gx pX) andbT. rewrite (MhoE _ pG) gen_subG; apply/subsetP=> ypk; case/imsetP=> y Gy ->{ypk}. have: y ^+ p \in <[x ^+ p]> by rewrite -defG1 (Mho_p_elt 1 _ (mem_p_elt pG Gy)). rewrite !expnS /= !expgM => /cycleP[j ->]. by rewrite -!expgM mulnCA mulnC expgM mem_cycle. Qed. Lemma Ohm1Eprime G : 'Ohm_1(G) = <<[set x in G | prime #[x]]>>. Proof. rewrite -['Ohm_1(G)](genD1 (group1 _)); congr <<_>>. apply/setP=> x; rewrite !inE andbCA -order_dvdn -order_gt1; congr (_ && _). apply/andP/idP=> [[p_gt1] | p_pr]; last by rewrite prime_gt1 ?pdiv_id. set p := pdiv _ => ox_p; have p_pr: prime p by rewrite pdiv_prime. by have [_ dv_p] := primeP p_pr; case/pred2P: (dv_p _ ox_p) p_gt1 => ->. Qed. Lemma abelem_Ohm1 p G : p.-group G -> p.-abelem 'Ohm_1(G) = abelian 'Ohm_1(G). Proof. move=> pG; rewrite /abelem (pgroupS (Ohm_sub 1 G)) //. case abG1: (abelian _) => //=; apply/exponentP=> x. by rewrite (OhmEabelian pG abG1); case/LdivP. Qed. Lemma Ohm1_abelem p G : p.-group G -> abelian G -> p.-abelem ('Ohm_1(G)). Proof. by move=> pG cGG; rewrite abelem_Ohm1 ?(abelianS (Ohm_sub 1 G)). Qed. Lemma Ohm1_id p G : p.-abelem G -> 'Ohm_1(G) = G. Proof. case/and3P=> pG cGG /exponentP Gp. apply/eqP; rewrite eqEsubset Ohm_sub (OhmE 1 pG) sub_gen //. by apply/subsetP=> x Gx; rewrite !inE Gx Gp /=. Qed. Lemma abelem_Ohm1P p G : abelian G -> p.-group G -> reflect ('Ohm_1(G) = G) (p.-abelem G). Proof. move=> cGG pG. by apply: (iffP idP) => [| <-]; [apply: Ohm1_id | apply: Ohm1_abelem]. Qed. Lemma TI_Ohm1 G H : H :&: 'Ohm_1(G) = 1 -> H :&: G = 1. Proof. move=> tiHG1; case: (trivgVpdiv (H :&: G)) => // [[p pr_p]]. case/Cauchy=> // x /setIP[Hx Gx] ox. suffices x1: x \in [1] by rewrite -ox (set1P x1) order1 in pr_p. by rewrite -{}tiHG1 inE Hx Ohm1Eprime mem_gen // inE Gx ox. Qed. Lemma Ohm1_eq1 G : ('Ohm_1(G) == 1) = (G :==: 1). Proof. apply/idP/idP => [/eqP G1_1 | /eqP->]; last by rewrite -subG1 Ohm_sub. by rewrite -(setIid G) TI_Ohm1 // G1_1 setIg1. Qed. Lemma meet_Ohm1 G H : G :&: H != 1 -> G :&: 'Ohm_1(H) != 1. Proof. by apply: contraNneq => /TI_Ohm1->. Qed. Lemma Ohm1_cent_max G E p : E \in 'E*_p(G) -> p.-group G -> 'Ohm_1('C_G(E)) = E. Proof. move=> EpmE pG; have [G1 | ntG]:= eqsVneq G 1. case/pmaxElemP: EpmE; case/pElemP; rewrite G1 => /trivgP-> _ _. by apply/trivgP; rewrite cent1T setIT Ohm_sub. have [p_pr _ _] := pgroup_pdiv pG ntG. by rewrite (OhmE 1 (pgroupS (subsetIl G _) pG)) (pmaxElem_LdivP _ _) ?genGid. Qed. Lemma Ohm1_cyclic_pgroup_prime p G : cyclic G -> p.-group G -> G :!=: 1 -> #|'Ohm_1(G)| = p. Proof. move=> cycG pG ntG; set K := 'Ohm_1(G). have abelK: p.-abelem K by rewrite Ohm1_abelem ?cyclic_abelian. have sKG: K \subset G := Ohm_sub 1 G. case/cyclicP: (cyclicS sKG cycG) => x /=; rewrite -/K => defK. rewrite defK -orderE (abelem_order_p abelK) //= -/K ?defK ?cycle_id //. rewrite -cycle_eq1 -defK -(setIidPr sKG). by apply: contraNneq ntG => /TI_Ohm1; rewrite setIid => ->. Qed. Lemma cyclic_pgroup_dprod_trivg p A B C : p.-group C -> cyclic C -> A \x B = C -> A = 1 /\ B = C \/ B = 1 /\ A = C. Proof. move=> pC cycC; case/cyclicP: cycC pC => x ->{C} pC defC. case/dprodP: defC => [] [G H -> ->{A B}] defC _ tiGH; rewrite -defC. have [/trivgP | ntC] := eqVneq <[x]> 1. by rewrite -defC mulG_subG => /andP[/trivgP-> _]; rewrite mul1g; left. have [pr_p _ _] := pgroup_pdiv pC ntC; pose K := 'Ohm_1(<[x]>). have prK : prime #|K| by rewrite (Ohm1_cyclic_pgroup_prime _ pC) ?cycle_cyclic. case: (prime_subgroupVti G prK) => [sKG |]; last first. move/TI_Ohm1; rewrite -defC (setIidPl (mulG_subl _ _)) => ->. by left; rewrite mul1g. case: (prime_subgroupVti H prK) => [sKH |]; last first. move/TI_Ohm1; rewrite -defC (setIidPl (mulG_subr _ _)) => ->. by right; rewrite mulg1. have K1: K :=: 1 by apply/trivgP; rewrite -tiGH subsetI sKG. by rewrite K1 cards1 in prK. Qed. Lemma piOhm1 G : \pi('Ohm_1(G)) = \pi(G). Proof. apply/eq_piP => p; apply/idP/idP; first exact: (piSg (Ohm_sub 1 G)). rewrite !mem_primes !cardG_gt0 => /andP[p_pr /Cauchy[] // x Gx oxp]. by rewrite p_pr -oxp order_dvdG //= Ohm1Eprime mem_gen // inE Gx oxp. Qed. Lemma Ohm1Eexponent p G : prime p -> exponent 'Ohm_1(G) %| p -> 'Ohm_1(G) = 'Ldiv_p(G). Proof. move=> p_pr expG1p; have pG: p.-group G. apply: sub_in_pnat (pnat_pi (cardG_gt0 G)) => q _. rewrite -piOhm1 mem_primes; case/and3P=> q_pr _; apply: pgroupP q_pr. by rewrite -pnat_exponent (pnat_dvd expG1p) ?pnat_id. apply/eqP; rewrite eqEsubset {2}(OhmE 1 pG) subset_gen subsetI Ohm_sub. by rewrite sub_LdivT expG1p. Qed. Lemma p_rank_Ohm1 p G : 'r_p('Ohm_1(G)) = 'r_p(G). Proof. apply/eqP; rewrite eqn_leq p_rankS ?Ohm_sub //. apply/bigmax_leqP=> E /setIdP[sEG abelE]. by rewrite (bigmax_sup E) // inE -{1}(Ohm1_id abelE) OhmS. Qed. Lemma rank_Ohm1 G : 'r('Ohm_1(G)) = 'r(G). Proof. apply/eqP; rewrite eqn_leq rankS ?Ohm_sub //. by have [p _ ->] := rank_witness G; rewrite -p_rank_Ohm1 p_rank_le_rank. Qed. Lemma p_rank_abelian p G : abelian G -> 'r_p(G) = logn p #|'Ohm_1(G)|. Proof. move=> cGG; have nilG := abelian_nil cGG; case p_pr: (prime p); last first. by apply/eqP; rewrite lognE p_pr eqn0Ngt p_rank_gt0 mem_primes p_pr. case/dprodP: (Ohm_dprod 1 (nilpotent_pcoreC p nilG)) => _ <- _ /TI_cardMg->. rewrite mulnC logn_Gauss; last first. rewrite prime_coprime // -p'natE // -/(pgroup _ _). exact: pgroupS (Ohm_sub _ _) (pcore_pgroup _ _). rewrite -(p_rank_Sylow (nilpotent_pcore_Hall p nilG)) -p_rank_Ohm1. rewrite p_rank_abelem // Ohm1_abelem ?pcore_pgroup //. exact: abelianS (pcore_sub _ _) cGG. Qed. Lemma rank_abelian_pgroup p G : p.-group G -> abelian G -> 'r(G) = logn p #|'Ohm_1(G)|. Proof. by move=> pG cGG; rewrite (rank_pgroup pG) p_rank_abelian. Qed. End OhmProps. Section AbelianStructure. Variable gT : finGroupType. Implicit Types (p : nat) (G H K E : {group gT}). Lemma abelian_splits x G : x \in G -> #[x] = exponent G -> abelian G -> [splits G, over <[x]>]. Proof. move=> Gx ox cGG; apply/splitsP; have [n] := ubnP #|G|. elim: n gT => // n IHn aT in x G Gx ox cGG * => /ltnSE-leGn. have: <[x]> \subset G by [rewrite cycle_subG]; rewrite subEproper. case/predU1P=> [<- | /properP[sxG [y]]]. by exists 1%G; rewrite inE -subG1 subsetIr mulg1 /=. have [m] := ubnP #[y]; elim: m y => // m IHm y /ltnSE-leym Gy x'y. case: (trivgVpdiv <[y]>) => [y1 | [p p_pr p_dv_y]]. by rewrite -cycle_subG y1 sub1G in x'y. case x_yp: (y ^+ p \in <[x]>); last first. apply: IHm (negbT x_yp); rewrite ?groupX ?(leq_trans _ leym) //. by rewrite orderXdiv // ltn_Pdiv ?prime_gt1. have{x_yp} xp_yp: (y ^+ p \in <[x ^+ p]>). have: <[y ^+ p]>%G \in [set <[x ^+ (#[x] %/ #[y ^+ p])]>%G]. by rewrite -cycle_sub_group ?order_dvdG // inE cycle_subG x_yp eqxx. rewrite inE -cycle_subG -val_eqE /=; move/eqP->. rewrite cycle_subG orderXdiv // divnA // mulnC ox. by rewrite -muln_divA ?dvdn_exponent ?expgM 1?groupX ?cycle_id. have: p <= #[y] by rewrite dvdn_leq. rewrite leq_eqVlt => /predU1P[{xp_yp m IHm leym}oy | ltpy]; last first. case/cycleP: xp_yp => k; rewrite -expgM mulnC expgM => def_yp. suffices: #[y * x ^- k] < m. by move/IHm; apply; rewrite groupMr // groupV groupX ?cycle_id. apply: leq_ltn_trans (leq_trans ltpy leym). rewrite dvdn_leq ?prime_gt0 // order_dvdn expgMn. by rewrite expgVn def_yp mulgV. by apply: (centsP cGG); rewrite ?groupV ?groupX. pose Y := <[y]>; have nsYG: Y <| G by rewrite -sub_abelian_normal ?cycle_subG. have [sYG nYG] := andP nsYG; have nYx := subsetP nYG x Gx. have GxY: coset Y x \in G / Y by rewrite mem_morphim. have tiYx: Y :&: <[x]> = 1 by rewrite prime_TIg ?indexg1 -?[#|_|]oy ?cycle_subG. have: #[coset Y x] = exponent (G / Y). apply/eqP; rewrite eqn_dvd dvdn_exponent //. apply/exponentP=> _ /morphimP[z Nz Gz ->]. rewrite -morphX // ((z ^+ _ =P 1) _) ?morph1 //. rewrite orderE -quotient_cycle ?card_quotient ?cycle_subG // -indexgI /=. by rewrite setIC tiYx indexg1 -orderE ox -order_dvdn dvdn_exponent. case/IHn => // [||Hq]; first exact: quotient_abelian. apply: leq_trans leGn; rewrite ltn_quotient // cycle_eq1. by apply: contra x'y; move/eqP->; rewrite group1. case/complP=> /= ti_x_Hq defGq. have: Hq \subset G / Y by rewrite -defGq mulG_subr. case/inv_quotientS=> // H defHq sYH sHG; exists H. have nYX: <[x]> \subset 'N(Y) by rewrite cycle_subG. rewrite inE -subG1 eqEsubset mul_subG //= -tiYx subsetI subsetIl andbT. rewrite -{2}(mulSGid sYH) mulgA (normC nYX) -mulgA -quotientSK ?quotientMl //. rewrite -quotient_sub1 ?(subset_trans (subsetIl _ _)) // quotientIG //= -/Y. by rewrite -defHq quotient_cycle // ti_x_Hq defGq !subxx. Qed. Lemma abelem_splits p G H : p.-abelem G -> H \subset G -> [splits G, over H]. Proof. have [m] := ubnP #|G|; elim: m G H => // m IHm G H /ltnSE-leGm abelG sHG. have [-> | ] := eqsVneq H 1. by apply/splitsP; exists G; rewrite inE mul1g -subG1 subsetIl /=. case/trivgPn=> x Hx ntx; have Gx := subsetP sHG x Hx. have [_ cGG eGp] := and3P abelG. have ox: #[x] = exponent G. by apply/eqP; rewrite eqn_dvd dvdn_exponent // (abelem_order_p abelG). case/splitsP: (abelian_splits Gx ox cGG) => K; case/complP=> tixK defG. have sKG: K \subset G by rewrite -defG mulG_subr. have ltKm: #|K| < m. rewrite (leq_trans _ leGm) ?proper_card //; apply/properP; split=> //. exists x => //; apply: contra ntx => Kx; rewrite -cycle_eq1 -subG1 -tixK. by rewrite subsetI subxx cycle_subG. case/splitsP: (IHm _ _ ltKm (abelemS sKG abelG) (subsetIr H K)) => L. case/complP=> tiHKL defK; apply/splitsP; exists L; rewrite inE. rewrite -subG1 -tiHKL -setIA setIS; last by rewrite subsetI -defK mulG_subr /=. by rewrite -(setIidPr sHG) -defG -group_modl ?cycle_subG //= setIC -mulgA defK. Qed. Fact abelian_type_subproof G : {H : {group gT} & abelian G -> {x | #[x] = exponent G & <[x]> \x H = G}}. Proof. case cGG: (abelian G); last by exists G. have [x Gx ox] := exponent_witness (abelian_nil cGG). case/splitsP/ex_mingroup: (abelian_splits Gx (esym ox) cGG) => H. case/mingroupp/complP=> tixH defG; exists H => _. exists x; rewrite ?dprodE // (sub_abelian_cent2 cGG) ?cycle_subG //. by rewrite -defG mulG_subr. Qed. Fixpoint abelian_type_rec n G := if n is n'.+1 then if abelian G && (G :!=: 1) then exponent G :: abelian_type_rec n' (tag (abelian_type_subproof G)) else [::] else [::]. Definition abelian_type (A : {set gT}) := abelian_type_rec #|A| <>. Lemma abelian_type_dvdn_sorted A : sorted [rel m n | n %| m] (abelian_type A). Proof. set R := SimplRel _; pose G := <>%G; pose M := G. suffices: path R (exponent M) (abelian_type A) by case: (_ A) => // m t /andP[]. rewrite /abelian_type -/G; have: G \subset M by []. elim: {A}#|A| G M => //= n IHn G M sGM. case: andP => //= -[cGG ntG]; rewrite exponentS ?IHn //=. case: (abelian_type_subproof G) => H /= [//| x _] /dprodP[_ /= <- _ _]. exact: mulG_subr. Qed. Lemma abelian_type_gt1 A : all [pred m | m > 1] (abelian_type A). Proof. rewrite /abelian_type; elim: {A}#|A| <>%G => //= n IHn G. case: ifP => //= /andP[_ ntG]; rewrite {n}IHn. by rewrite ltn_neqAle exponent_gt0 eq_sym -dvdn1 -trivg_exponent ntG. Qed. Lemma abelian_type_sorted A : sorted geq (abelian_type A). Proof. have:= abelian_type_dvdn_sorted A; have:= abelian_type_gt1 A. case: (abelian_type A) => //= m t; elim: t m => //= n t IHt m /andP[]. by move/ltnW=> m_gt0 t_gt1 /andP[n_dv_m /IHt->]; rewrite // dvdn_leq. Qed. Theorem abelian_structure G : abelian G -> {b | \big[dprod/1]_(x <- b) <[x]> = G & map order b = abelian_type G}. Proof. rewrite /abelian_type genGidG; have [n] := ubnPleq #|G|. elim: n G => /= [|n IHn] G leGn cGG; first by rewrite leqNgt cardG_gt0 in leGn. rewrite [in _ && _]cGG /=; case: ifP => [ntG|/eqP->]; last first. by exists [::]; rewrite ?big_nil. case: (abelian_type_subproof G) => H /= [//|x ox xdefG]; rewrite -ox. have [_ defG cxH tixH] := dprodP xdefG. have sHG: H \subset G by rewrite -defG mulG_subr. case/IHn: (abelianS sHG cGG) => [|b defH <-]. rewrite -ltnS (leq_trans _ leGn) // -defG TI_cardMg // -orderE. rewrite ltn_Pmull ?cardG_gt0 // ltn_neqAle order_gt0 eq_sym -dvdn1. by rewrite ox -trivg_exponent ntG. by exists (x :: b); rewrite // big_cons defH xdefG. Qed. Lemma count_logn_dprod_cycle p n b G : \big[dprod/1]_(x <- b) <[x]> = G -> count [pred x | logn p #[x] > n] b = logn p #|'Ohm_n.+1(G) : 'Ohm_n(G)|. Proof. have sOn1 H: 'Ohm_n(H) \subset 'Ohm_n.+1(H) by apply: Ohm_leq. pose lnO i (A : {set gT}) := logn p #|'Ohm_i(A)|. have lnO_le H: lnO n H <= lnO n.+1 H. by rewrite dvdn_leq_log ?cardG_gt0 // cardSg ?sOn1. have lnOx i A B H: A \x B = H -> lnO i A + lnO i B = lnO i H. move=> defH; case/dprodP: defH (defH) => {A B}[[A B -> ->]] _ _ _ defH. rewrite /lnO; case/dprodP: (Ohm_dprod i defH) => _ <- _ tiOAB. by rewrite TI_cardMg ?lognM. rewrite -divgS //= logn_div ?cardSg //= -/(lnO _ _) -/(lnO _ _). elim: b G => [_ <-|x b IHb G] /=. by rewrite big_nil /lnO !(trivgP (Ohm_sub _ _)) subnn. rewrite /= big_cons => defG; rewrite -!(lnOx _ _ _ _ defG) subnDA. case/dprodP: defG => [[_ H _ defH] _ _ _] {G}; rewrite defH (IHb _ defH). symmetry; do 2!rewrite addnC -addnBA ?lnO_le //; congr (_ + _). pose y := x.`_p; have p_y: p.-elt y by rewrite p_elt_constt. have{lnOx} lnOy i: lnO i <[x]> = lnO i <[y]>. have cXX := cycle_abelian x. have co_yx': coprime #[y] #[x.`_p^'] by rewrite !order_constt coprime_partC. have defX: <[y]> \x <[x.`_p^']> = <[x]>. rewrite dprodE ?coprime_TIg //. by rewrite -cycleM ?consttC //; apply: (centsP cXX); apply: mem_cycle. by apply: (sub_abelian_cent2 cXX); rewrite cycle_subG mem_cycle. rewrite -(lnOx i _ _ _ defX) addnC {1}/lnO lognE. case: and3P => // [[p_pr _ /idPn[]]]; rewrite -p'natE //. exact: pgroupS (Ohm_sub _ _) (p_elt_constt _ _). rewrite -logn_part -order_constt -/y !{}lnOy /lnO !(Ohm_p_cycle _ p_y). case: leqP => [| lt_n_y]. by rewrite -subn_eq0 -addn1 subnDA => /eqP->; rewrite subnn. rewrite -!orderE -(subSS n) subSn // expnSr expgM. have p_pr: prime p by move: lt_n_y; rewrite lognE; case: prime. set m := (p ^ _)%N; have m_gt0: m > 0 by rewrite expn_gt0 prime_gt0. suffices p_ym: p %| #[y ^+ m]. rewrite -logn_div ?orderXdvd // (orderXdiv p_ym) divnA // mulKn //. by rewrite logn_prime ?eqxx. rewrite orderXdiv ?pfactor_dvdn ?leq_subr // -(dvdn_pmul2r m_gt0). by rewrite -expnS -subSn // subSS divnK pfactor_dvdn ?leq_subr. Qed. Lemma abelian_type_pgroup p b G : p.-group G -> \big[dprod/1]_(x <- b) <[x]> = G -> 1 \notin b -> perm_eq (abelian_type G) (map order b). Proof. rewrite perm_sym; move: b => b1 pG defG1 ntb1. have cGG: abelian G. elim: (b1) {pG}G defG1 => [_ <-|x b IHb G]; first by rewrite big_nil abelian1. rewrite big_cons; case/dprodP=> [[_ H _ defH]] <-; rewrite defH => cxH _. by rewrite abelianM cycle_abelian IHb. have p_bG b: \big[dprod/1]_(x <- b) <[x]> = G -> all (p_elt p) b. elim: b {defG1 cGG}G pG => //= x b IHb G pG; rewrite big_cons. case/dprodP=> [[_ H _ defH]]; rewrite defH andbC => defG _ _. by rewrite -defG pgroupM in pG; case/andP: pG => p_x /IHb->. have [b2 defG2 def_t] := abelian_structure cGG. have ntb2: 1 \notin b2. apply: contraL (abelian_type_gt1 G) => b2_1. rewrite -def_t -has_predC has_map. by apply/hasP; exists 1; rewrite //= order1. rewrite -{}def_t; apply/allP=> m; rewrite -map_cat => /mapP[x b_x def_m]. have{ntb1 ntb2} ntx: x != 1. by apply: contraL b_x; move/eqP->; rewrite mem_cat negb_or ntb1 ntb2. have p_x: p.-elt x by apply: allP (x) b_x; rewrite all_cat !p_bG. rewrite -cycle_eq1 in ntx; have [p_pr _ [k ox]] := pgroup_pdiv p_x ntx. apply/eqnP; rewrite {m}def_m orderE ox !count_map. pose cnt_p k := count [pred x : gT | logn p #[x] > k]. have cnt_b b: \big[dprod/1]_(x <- b) <[x]> = G -> count [pred x | #[x] == p ^ k.+1]%N b = cnt_p k b - cnt_p k.+1 b. - move/p_bG; elim: b => //= _ b IHb /andP[/p_natP[j ->] /IHb-> {IHb}]. rewrite eqn_leq !leq_exp2l ?prime_gt1 // -eqn_leq pfactorK //. case: (ltngtP k.+1) => // _ {j}; rewrite subSn // add0n. by elim: b => //= y b IHb; rewrite leq_add // ltn_neqAle; case: (~~ _). by rewrite !cnt_b // /cnt_p !(@count_logn_dprod_cycle _ _ _ G). Qed. Lemma size_abelian_type G : abelian G -> size (abelian_type G) = 'r(G). Proof. move=> cGG; have [b defG def_t] := abelian_structure cGG. apply/eqP; rewrite -def_t size_map eqn_leq andbC; apply/andP; split. have [p p_pr ->] := rank_witness G; rewrite p_rank_abelian //. by rewrite -indexg1 -(Ohm0 G) -(count_logn_dprod_cycle _ _ defG) count_size. case/lastP def_b: b => // [b' x]; pose p := pdiv #[x]. have p_pr: prime p. have:= abelian_type_gt1 G; rewrite -def_t def_b map_rcons -cats1 all_cat. by rewrite /= andbT => /andP[_]; apply: pdiv_prime. suffices: all [pred y | logn p #[y] > 0] b. rewrite all_count (count_logn_dprod_cycle _ _ defG) -def_b; move/eqP <-. by rewrite Ohm0 indexg1 -p_rank_abelian ?p_rank_le_rank. apply/allP=> y; rewrite def_b mem_rcons inE /= => b_y. rewrite lognE p_pr order_gt0 (dvdn_trans (pdiv_dvd _)) //. case/predU1P: b_y => [-> // | b'_y]. have:= abelian_type_dvdn_sorted G; rewrite -def_t def_b. case/splitPr: b'_y => b1 b2; rewrite -cat_rcons rcons_cat map_cat !map_rcons. rewrite headI /= cat_path -(last_cons 2) -headI last_rcons. case/andP=> _ /order_path_min min_y. apply: (allP (min_y _)) => [? ? ? ? dv|]; first exact: (dvdn_trans dv). by rewrite mem_rcons mem_head. Qed. Lemma mul_card_Ohm_Mho_abelian n G : abelian G -> (#|'Ohm_n(G)| * #|'Mho^n(G)|)%N = #|G|. Proof. case/abelian_structure => b defG _. elim: b G defG => [_ <-|x b IHb G]. by rewrite !big_nil (trivgP (Ohm_sub _ _)) (trivgP (Mho_sub _ _)) !cards1. rewrite big_cons => defG; rewrite -(dprod_card defG). rewrite -(dprod_card (Ohm_dprod n defG)) -(dprod_card (Mho_dprod n defG)) /=. rewrite mulnCA -!mulnA mulnCA mulnA; case/dprodP: defG => [[_ H _ defH] _ _ _]. rewrite defH {b G defH IHb}(IHb H defH); congr (_ * _)%N => {H}. have [m] := ubnP #[x]; elim: m x => // m IHm x /ltnSE-lexm. case p_x: (p_group <[x]>); last first. case: (eqVneq x 1) p_x => [-> |]; first by rewrite cycle1 p_group1. rewrite -order_gt1 /p_group -orderE; set p := pdiv _ => ntx p'x. have def_x: <[x.`_p]> \x <[x.`_p^']> = <[x]>. have ?: coprime #[x.`_p] #[x.`_p^'] by rewrite !order_constt coprime_partC. have ?: commute x.`_p x.`_p^' by apply: commuteX2. rewrite dprodE ?coprime_TIg -?cycleM ?consttC //. by rewrite cent_cycle cycle_subG; apply/cent1P. rewrite -(dprod_card (Ohm_dprod n def_x)) -(dprod_card (Mho_dprod n def_x)). rewrite mulnCA -mulnA mulnCA mulnA. rewrite !{}IHm ?(dprod_card def_x) ?(leq_trans _ lexm) {m lexm}//. rewrite /order -(dprod_card def_x) -!orderE !order_constt ltn_Pmull //. rewrite p_part -(expn0 p) ltn_exp2l 1?lognE ?prime_gt1 ?pdiv_prime //. by rewrite order_gt0 pdiv_dvd. rewrite proper_card // properEneq cycle_subG mem_cycle andbT. by apply: contra (negbT p'x); move/eqP <-; apply: p_elt_constt. case/p_groupP: p_x => p p_pr p_x. rewrite (Ohm_p_cycle n p_x) (Mho_p_cycle n p_x) -!orderE. set k := logn p #[x]; have ox: #[x] = (p ^ k)%N by rewrite -card_pgroup. case: (leqP k n) => [le_k_n | lt_n_k]. rewrite -(subnKC le_k_n) subnDA subnn expg1 expnD expgM -ox. by rewrite expg_order expg1n order1 muln1. rewrite !orderXgcd ox -[in (p ^ k)%N](subnKC (ltnW lt_n_k)) expnD. rewrite gcdnC gcdnMl gcdnC gcdnMr. by rewrite mulnK ?mulKn ?expn_gt0 ?prime_gt0. Qed. Lemma grank_abelian G : abelian G -> 'm(G) = 'r(G). Proof. move=> cGG; apply/eqP; rewrite eqn_leq; apply/andP; split. rewrite -size_abelian_type //; case/abelian_structure: cGG => b defG <-. suffices <-: <<[set x in b]>> = G. by rewrite (leq_trans (grank_min _)) // size_map cardsE card_size. rewrite -{G defG}(bigdprodWY defG). elim: b => [|x b IHb]; first by rewrite big_nil gen0. by rewrite big_cons -joingE -joing_idr -IHb joing_idl joing_idr set_cons. have [p p_pr ->] := rank_witness G; pose K := 'Mho^1(G). have ->: 'r_p(G) = logn p #|G / K|. rewrite p_rank_abelian // card_quotient /= ?gFnorm // -divgS ?Mho_sub //. by rewrite -(mul_card_Ohm_Mho_abelian 1 cGG) mulnK ?cardG_gt0. case: (grank_witness G) => B genB <-; rewrite -genB. have{genB}: <> \subset G by rewrite genB. have [m] := ubnP #|B|; elim: m B => // m IHm B. have [-> | [x Bx]] := set_0Vmem B; first by rewrite gen0 quotient1 cards1 logn1. rewrite ltnS (cardsD1 x) Bx -[in <>](setD1K Bx); set B' := B :\ x => ltB'm. rewrite -joingE -joing_idl -joing_idr -/<[x]> join_subG => /andP[Gx sB'G]. rewrite cent_joinEl ?(sub_abelian_cent2 cGG) //. have nKx: x \in 'N(K) by rewrite -cycle_subG (subset_trans Gx) ?gFnorm. rewrite quotientMl ?cycle_subG // quotient_cycle //= -/K. have le_Kxp_1: logn p #[coset K x] <= 1. rewrite -(dvdn_Pexp2l _ _ (prime_gt1 p_pr)) -p_part -order_constt. rewrite order_dvdn -morph_constt // -morphX ?groupX //= coset_id //. by rewrite Mho_p_elt ?p_elt_constt ?groupX -?cycle_subG. apply: leq_trans (leq_add le_Kxp_1 (IHm _ ltB'm sB'G)). by rewrite -lognM ?dvdn_leq_log ?muln_gt0 ?cardG_gt0 // mul_cardG dvdn_mulr. Qed. Lemma rank_cycle (x : gT) : 'r(<[x]>) = (x != 1). Proof. have [->|ntx] := eqVneq x 1; first by rewrite cycle1 rank1. apply/eqP; rewrite eqn_leq rank_gt0 cycle_eq1 ntx andbT. by rewrite -grank_abelian ?cycle_abelian //= -(cards1 x) grank_min. Qed. Lemma abelian_rank1_cyclic G : abelian G -> cyclic G = ('r(G) <= 1). Proof. move=> cGG; have [b defG atypG] := abelian_structure cGG. apply/idP/idP; first by case/cyclicP=> x ->; rewrite rank_cycle leq_b1. rewrite -size_abelian_type // -{}atypG -{}defG unlock. by case: b => [|x []] //= _; rewrite ?cyclic1 // dprodg1 cycle_cyclic. Qed. Definition homocyclic A := abelian A && constant (abelian_type A). Lemma homocyclic_Ohm_Mho n p G : p.-group G -> homocyclic G -> 'Ohm_n(G) = 'Mho^(logn p (exponent G) - n)(G). Proof. move=> pG /andP[cGG homoG]; set e := exponent G. have{pG} p_e: p.-nat e by apply: pnat_dvd pG; apply: exponent_dvdn. have{homoG}: all (pred1 e) (abelian_type G). move: homoG; rewrite /abelian_type -(prednK (cardG_gt0 G)) /=. by case: (_ && _) (tag _); rewrite //= genGid eqxx. have{cGG} [b defG <-] := abelian_structure cGG. move: e => e in p_e *; elim: b => /= [|x b IHb] in G defG *. by rewrite -defG big_nil (trivgP (Ohm_sub _ _)) (trivgP (Mho_sub _ _)). case/andP=> /eqP ox e_b; rewrite big_cons in defG. rewrite -(Ohm_dprod _ defG) -(Mho_dprod _ defG). case/dprodP: defG => [[_ H _ defH] _ _ _]; rewrite defH IHb //; congr (_ \x _). by rewrite -ox in p_e *; rewrite (Ohm_p_cycle _ p_e) (Mho_p_cycle _ p_e). Qed. Lemma Ohm_Mho_homocyclic (n p : nat) G : abelian G -> p.-group G -> 0 < n < logn p (exponent G) -> 'Ohm_n(G) = 'Mho^(logn p (exponent G) - n)(G) -> homocyclic G. Proof. set e := exponent G => cGG pG /andP[n_gt0 n_lte] eq_Ohm_Mho. suffices: all (pred1 e) (abelian_type G). by rewrite /homocyclic cGG; apply: all_pred1_constant. case/abelian_structure: cGG (abelian_type_gt1 G) => b defG <-. set H := G in defG eq_Ohm_Mho *; have sHG: H \subset G by []. elim: b H defG sHG eq_Ohm_Mho => //= x b IHb H. rewrite big_cons => defG; case/dprodP: defG (defG) => [[_ K _ defK]]. rewrite defK => defHm cxK; rewrite setIC => /trivgP-tiKx defHd. rewrite -{}[in H \subset G]defHm mulG_subG cycle_subG ltnNge -trivg_card_le1. case/andP=> Gx sKG; rewrite -(Mho_dprod _ defHd) => /esym defMho /andP[ntx ntb]. have{defHd} defOhm := Ohm_dprod n defHd. apply/andP; split; last first. apply: (IHb K) => //; have:= dprod_modr defMho (Mho_sub _ _). rewrite -(dprod_modr defOhm (Ohm_sub _ _)). rewrite !(trivgP (subset_trans (setIS _ _) tiKx)) ?Ohm_sub ?Mho_sub //. by rewrite !dprod1g. have:= dprod_modl defMho (Mho_sub _ _). rewrite -(dprod_modl defOhm (Ohm_sub _ _)) . rewrite !(trivgP (subset_trans (setSI _ _) tiKx)) ?Ohm_sub ?Mho_sub //. move/eqP; rewrite eqEcard => /andP[_]. have p_x: p.-elt x := mem_p_elt pG Gx. have [p_pr p_dv_x _] := pgroup_pdiv p_x ntx. rewrite !dprodg1 (Ohm_p_cycle _ p_x) (Mho_p_cycle _ p_x) -!orderE. rewrite orderXdiv ?leq_divLR ?pfactor_dvdn ?leq_subr //. rewrite orderXgcd divn_mulAC ?dvdn_gcdl // leq_divRL ?gcdn_gt0 ?order_gt0 //. rewrite leq_pmul2l //; apply: contraLR. rewrite eqn_dvd dvdn_exponent //= -ltnNge => lt_x_e. rewrite (leq_trans (ltn_Pmull (prime_gt1 p_pr) _)) ?expn_gt0 ?prime_gt0 //. rewrite -expnS dvdn_leq // ?gcdn_gt0 ?order_gt0 // dvdn_gcd. rewrite pfactor_dvdn // dvdn_exp2l. by rewrite -[xp in _ < xp]subn0 ltn_sub2l // lognE p_pr order_gt0 p_dv_x. rewrite ltn_sub2r // ltnNge -(dvdn_Pexp2l _ _ (prime_gt1 p_pr)) -!p_part. by rewrite !part_pnat_id // (pnat_dvd (exponent_dvdn G)). Qed. Lemma abelem_homocyclic p G : p.-abelem G -> homocyclic G. Proof. move=> abelG; have [_ cGG _] := and3P abelG. rewrite /homocyclic cGG (@all_pred1_constant _ p) //. case/abelian_structure: cGG (abelian_type_gt1 G) => b defG <- => b_gt1. apply/allP=> _ /mapP[x b_x ->] /=; rewrite (abelem_order_p abelG) //. rewrite -cycle_subG -(bigdprodWY defG) ?sub_gen //. by rewrite bigcup_seq (bigcup_sup x). by rewrite -order_gt1 [_ > 1](allP b_gt1) ?map_f. Qed. Lemma homocyclic1 : homocyclic [1 gT]. Proof. exact: abelem_homocyclic (abelem1 _ 2). Qed. Lemma Ohm1_homocyclicP p G : p.-group G -> abelian G -> reflect ('Ohm_1(G) = 'Mho^(logn p (exponent G)).-1(G)) (homocyclic G). Proof. move=> pG cGG; set e := logn p (exponent G); rewrite -subn1. apply: (iffP idP) => [homoG | ]; first exact: homocyclic_Ohm_Mho. case: (ltnP 1 e) => [lt1e | ]; first exact: Ohm_Mho_homocyclic. rewrite -subn_eq0 => /eqP->; rewrite Mho0 => <-. exact: abelem_homocyclic (Ohm1_abelem pG cGG). Qed. Lemma abelian_type_homocyclic G : homocyclic G -> abelian_type G = nseq 'r(G) (exponent G). Proof. case/andP=> cGG; rewrite -size_abelian_type // /abelian_type. rewrite -(prednK (cardG_gt0 G)) /=; case: andP => //= _; move: (tag _) => H. by move/all_pred1P->; rewrite genGid size_nseq. Qed. Lemma abelian_type_abelem p G : p.-abelem G -> abelian_type G = nseq 'r(G) p. Proof. move=> abelG; rewrite (abelian_type_homocyclic (abelem_homocyclic abelG)). have [-> | ntG] := eqVneq G 1%G; first by rewrite rank1. congr nseq; apply/eqP; rewrite eqn_dvd; have [pG _ ->] := and3P abelG. have [p_pr] := pgroup_pdiv pG ntG; case/Cauchy=> // x Gx <- _. exact: dvdn_exponent. Qed. Lemma max_card_abelian G : abelian G -> #|G| <= exponent G ^ 'r(G) ?= iff homocyclic G. Proof. move=> cGG; have [b defG def_tG] := abelian_structure cGG. have Gb: all (mem G) b. apply/allP=> x b_x; rewrite -(bigdprodWY defG); have [b1 b2] := splitPr b_x. by rewrite big_cat big_cons /= mem_gen // setUCA inE cycle_id. have ->: homocyclic G = all (pred1 (exponent G)) (abelian_type G). rewrite /homocyclic cGG /abelian_type; case: #|G| => //= n. by move: (_ (tag _)) => t; case: ifP => //= _; rewrite genGid eqxx. rewrite -size_abelian_type // -{}def_tG -{defG}(bigdprod_card defG) size_map. rewrite unlock; elim: b Gb => //= x b IHb; case/andP=> Gx Gb. have eGgt0: exponent G > 0 := exponent_gt0 G. have le_x_G: #[x] <= exponent G by rewrite dvdn_leq ?dvdn_exponent. have:= leqif_mul (leqif_eq le_x_G) (IHb Gb). by rewrite -expnS expn_eq0 eqn0Ngt eGgt0. Qed. Lemma card_homocyclic G : homocyclic G -> #|G| = (exponent G ^ 'r(G))%N. Proof. by move=> homG; have [cGG _] := andP homG; apply/eqP; rewrite max_card_abelian. Qed. Lemma abelian_type_dprod_homocyclic p K H G : K \x H = G -> p.-group G -> homocyclic G -> abelian_type K = nseq 'r(K) (exponent G) /\ abelian_type H = nseq 'r(H) (exponent G). Proof. move=> defG pG homG; have [cGG _] := andP homG. have /mulG_sub[sKG sHG]: K * H = G by case/dprodP: defG. have [cKK cHH] := (abelianS sKG cGG, abelianS sHG cGG). suffices: all (pred1 (exponent G)) (abelian_type K ++ abelian_type H). rewrite all_cat => /andP[/all_pred1P-> /all_pred1P->]. by rewrite !size_abelian_type. suffices def_atG: abelian_type K ++ abelian_type H =i abelian_type G. rewrite (eq_all_r def_atG); apply/all_pred1P. by rewrite size_abelian_type // -abelian_type_homocyclic. have [bK defK atK] := abelian_structure cKK. have [bH defH atH] := abelian_structure cHH. apply/perm_mem; rewrite perm_sym -atK -atH -map_cat. apply: (abelian_type_pgroup pG); first by rewrite big_cat defK defH. have: all [pred m | m > 1] (map order (bK ++ bH)). by rewrite map_cat all_cat atK atH !abelian_type_gt1. by rewrite all_map (eq_all (@order_gt1 _)) all_predC has_pred1. Qed. Lemma dprod_homocyclic p K H G : K \x H = G -> p.-group G -> homocyclic G -> homocyclic K /\ homocyclic H. Proof. move=> defG pG homG; have [cGG _] := andP homG. have /mulG_sub[sKG sHG]: K * H = G by case/dprodP: defG. have [abtK abtH] := abelian_type_dprod_homocyclic defG pG homG. by rewrite /homocyclic !(abelianS _ cGG) // abtK abtH !constant_nseq. Qed. Lemma exponent_dprod_homocyclic p K H G : K \x H = G -> p.-group G -> homocyclic G -> K :!=: 1 -> exponent K = exponent G. Proof. move=> defG pG homG ntK; have [homK _] := dprod_homocyclic defG pG homG. have [] := abelian_type_dprod_homocyclic defG pG homG. by rewrite abelian_type_homocyclic // -['r(K)]prednK ?rank_gt0 => [[]|]. Qed. End AbelianStructure. Arguments abelian_type {gT} A%g. Arguments homocyclic {gT} A%g. Section IsogAbelian. Variables aT rT : finGroupType. Implicit Type (gT : finGroupType) (D G : {group aT}) (H : {group rT}). Lemma isog_abelian_type G H : isog G H -> abelian_type G = abelian_type H. Proof. pose lnO p n gT (A : {set gT}) := logn p #|'Ohm_n.+1(A) : 'Ohm_n(A)|. pose lni i p gT (A : {set gT}) := \max_(e < logn p #|A| | i < lnO p e _ A) e.+1. suffices{G} nth_abty gT (G : {group gT}) i: abelian G -> i < size (abelian_type G) -> nth 1%N (abelian_type G) i = (\prod_(p < #|G|.+1) p ^ lni i p _ G)%N. - move=> isoGH; case cGG: (abelian G); last first. rewrite /abelian_type -(prednK (cardG_gt0 G)) -(prednK (cardG_gt0 H)) /=. by rewrite {1}(genGid G) {1}(genGid H) -(isog_abelian isoGH) cGG. have cHH: abelian H by rewrite -(isog_abelian isoGH). have eq_sz: size (abelian_type G) = size (abelian_type H). by rewrite !size_abelian_type ?(isog_rank isoGH). apply: (@eq_from_nth _ 1%N) => // i lt_i_G; rewrite !nth_abty // -?eq_sz //. rewrite /lni (card_isog isoGH); apply: eq_bigr => p _; congr (p ^ _)%N. apply: eq_bigl => e; rewrite /lnO -!divgS ?(Ohm_leq _ (leqnSn _)) //=. by have:= card_isog (gFisog _ isoGH) => /= eqF; rewrite !eqF. move=> cGG. have (p): path leq 0 (map (logn p) (rev (abelian_type G))). move: (abelian_type_gt1 G) (abelian_type_dvdn_sorted G). case: abelian_type => //= m t; rewrite rev_cons map_rcons. elim: t m => //= n t IHt m /andP[/ltnW m_gt0 nt_gt1]. rewrite -cats1 cat_path rev_cons map_rcons last_rcons /=. by case/andP=> /dvdn_leq_log-> // /IHt->. have{cGG} [b defG <- b_sorted] := abelian_structure cGG. rewrite size_map => ltib; rewrite (nth_map 1 _ _ ltib); set x := nth 1 b i. have Gx: x \in G. have: x \in b by rewrite mem_nth. rewrite -(bigdprodWY defG); case/splitPr=> bl br. by rewrite mem_gen // big_cat big_cons !inE cycle_id orbT. have lexG: #[x] <= #|G| by rewrite dvdn_leq ?order_dvdG. rewrite -[#[x]]partn_pi // (widen_partn _ lexG) big_mkord big_mkcond. apply: eq_bigr => p _; transitivity (p ^ logn p #[x])%N. by rewrite -logn_gt0; case: posnP => // ->. suffices lti_lnO e: (i < lnO p e _ G) = (e < logn p #[x]). congr (p ^ _)%N; apply/eqP; rewrite eqn_leq andbC; apply/andP; split. by apply/bigmax_leqP=> e; rewrite lti_lnO. have [-> //|logx_gt0] := posnP (logn p #[x]). have lexpG: (logn p #[x]).-1 < logn p #|G|. by rewrite prednK // dvdn_leq_log ?order_dvdG. by rewrite (@bigmax_sup _ (Ordinal lexpG)) ?(prednK, lti_lnO). rewrite /lnO -(count_logn_dprod_cycle _ _ defG). case: (ltnP e) (b_sorted p) => [lt_e_x | le_x_e]. rewrite -(cat_take_drop i.+1 b) -map_rev rev_cat !map_cat cat_path. case/andP=> _ ordb; rewrite count_cat ((count _ _ =P i.+1) _) ?leq_addr //. rewrite -{2}(size_takel ltib) -all_count. move: ordb; rewrite (take_nth 1 ltib) -/x rev_rcons all_rcons /= lt_e_x. case/andP=> _ /=; move/(order_path_min leq_trans); apply: contraLR. rewrite -!has_predC !has_map; case/hasP=> y b_y /= le_y_e; apply/hasP. by exists y; rewrite ?mem_rev //=; apply: contra le_y_e; apply: leq_trans. rewrite -(cat_take_drop i b) -map_rev rev_cat !map_cat cat_path. case/andP=> ordb _; rewrite count_cat -{1}(size_takel (ltnW ltib)) ltnNge. rewrite addnC ((count _ _ =P 0) _) ?count_size //. rewrite eqn0Ngt -has_count; apply/hasPn=> y b_y /=; rewrite -leqNgt. apply: leq_trans le_x_e; have ->: x = last x (rev (drop i b)). by rewrite (drop_nth 1 ltib) rev_cons last_rcons. rewrite -mem_rev in b_y; case/splitPr: (rev _) / b_y ordb => b1 b2. rewrite !map_cat cat_path last_cat /=; case/and3P=> _ _. move/(order_path_min leq_trans); case/lastP: b2 => // b3 x'. by move/allP; apply; rewrite ?map_f ?last_rcons ?mem_rcons ?mem_head. Qed. Lemma eq_abelian_type_isog G H : abelian G -> abelian H -> isog G H = (abelian_type G == abelian_type H). Proof. move=> cGG cHH; apply/idP/eqP; first exact: isog_abelian_type. have{cGG} [bG defG <-] := abelian_structure cGG. have{cHH} [bH defH <-] := abelian_structure cHH. elim: bG bH G H defG defH => [|x bG IHb] [|y bH] // G H. rewrite !big_nil => <- <- _. by rewrite isog_cyclic_card ?cyclic1 ?cards1. rewrite !big_cons => defG defH /= [eqxy eqb]. apply: (isog_dprod defG defH). by rewrite isog_cyclic_card ?cycle_cyclic -?orderE ?eqxy /=. case/dprodP: defG => [[_ G' _ defG]] _ _ _; rewrite defG. case/dprodP: defH => [[_ H' _ defH]] _ _ _; rewrite defH. exact: IHb eqb. Qed. Lemma isog_abelem_card p G H : p.-abelem G -> isog G H = p.-abelem H && (#|H| == #|G|). Proof. move=> abelG; apply/idP/andP=> [isoGH | [abelH eqGH]]. by rewrite -(isog_abelem isoGH) (card_isog isoGH). rewrite eq_abelian_type_isog ?(@abelem_abelian _ p) //. by rewrite !(@abelian_type_abelem _ p) ?(@rank_abelem _ p) // (eqP eqGH). Qed. Variables (D : {group aT}) (f : {morphism D >-> rT}). Lemma morphim_rank_abelian G : abelian G -> 'r(f @* G) <= 'r(G). Proof. move=> cGG; have sHG := subsetIr D G; apply: leq_trans (rankS sHG). rewrite -!grank_abelian ?morphim_abelian ?(abelianS sHG) //=. by rewrite -morphimIdom morphim_grank ?subsetIl. Qed. Lemma morphim_p_rank_abelian p G : abelian G -> 'r_p(f @* G) <= 'r_p(G). Proof. move=> cGG; have sHG := subsetIr D G; apply: leq_trans (p_rankS p sHG). have cHH := abelianS sHG cGG; rewrite -morphimIdom /=; set H := D :&: G. have sylP := nilpotent_pcore_Hall p (abelian_nil cHH). have sPH := pHall_sub sylP. have sPD: 'O_p(H) \subset D by rewrite (subset_trans sPH) ?subsetIl. rewrite -(p_rank_Sylow (morphim_pHall f sPD sylP)) -(p_rank_Sylow sylP) //. rewrite -!rank_pgroup ?morphim_pgroup ?pcore_pgroup //. by rewrite morphim_rank_abelian ?(abelianS sPH). Qed. Lemma isog_homocyclic G H : G \isog H -> homocyclic G = homocyclic H. Proof. move=> isoGH. by rewrite /homocyclic (isog_abelian isoGH) (isog_abelian_type isoGH). Qed. End IsogAbelian. Section QuotientRank. Variables (gT : finGroupType) (p : nat) (G H : {group gT}). Hypothesis cGG : abelian G. Lemma quotient_rank_abelian : 'r(G / H) <= 'r(G). Proof. exact: morphim_rank_abelian. Qed. Lemma quotient_p_rank_abelian : 'r_p(G / H) <= 'r_p(G). Proof. exact: morphim_p_rank_abelian. Qed. End QuotientRank. Section FimModAbelem. Import GRing.Theory FinRing.Theory. Lemma fin_lmod_char_abelem p (R : ringType) (V : finLmodType R): p \in [char R]%R -> p.-abelem [set: V]. Proof. case/andP=> p_pr /eqP-pR0; apply/abelemP=> //. by split=> [|v _]; rewrite ?zmod_abelian // zmodXgE -scaler_nat pR0 scale0r. Qed. Lemma fin_Fp_lmod_abelem p (V : finLmodType 'F_p) : prime p -> p.-abelem [set: V]. Proof. by move/char_Fp/fin_lmod_char_abelem->. Qed. Lemma fin_ring_char_abelem p (R : finRingType) : p \in [char R]%R -> p.-abelem [set: R]. Proof. exact: fin_lmod_char_abelem [finLmodType R of R^o]. Qed. End FimModAbelem. math-comp-mathcomp-1.12.0/mathcomp/solvable/all_solvable.v000066400000000000000000000007371375767750300235660ustar00rootroot00000000000000Require Export abelian. Require Export alt. Require Export burnside_app. Require Export center. Require Export commutator. Require Export cyclic. Require Export extraspecial. Require Export extremal. Require Export finmodule. Require Export frobenius. Require Export gfunctor. Require Export gseries. Require Export hall. Require Export jordanholder. Require Export maximal. Require Export nilpotent. Require Export pgroup. Require Export primitive_action. Require Export sylow. math-comp-mathcomp-1.12.0/mathcomp/solvable/alt.v000066400000000000000000000560051375767750300217060ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype tuple tuple bigop prime finset fingroup. From mathcomp Require Import morphism perm automorphism quotient action cyclic. From mathcomp Require Import pgroup gseries sylow primitive_action. (******************************************************************************) (* Definitions of the symmetric and alternate groups, and some properties. *) (* 'Sym_T == The symmetric group over type T (which must have a finType *) (* structure). *) (* := [set: {perm T}] *) (* 'Alt_T == The alternating group over type T. *) (******************************************************************************) Unset Printing Implicit Defensive. Set Implicit Arguments. Unset Strict Implicit. Import GroupScope. Definition bool_groupMixin := FinGroup.Mixin addbA addFb addbb. Canonical bool_baseGroup := Eval hnf in BaseFinGroupType bool bool_groupMixin. Canonical boolGroup := Eval hnf in FinGroupType addbb. Section SymAltDef. Variable T : finType. Implicit Types (s : {perm T}) (x y z : T). (** Definitions of the alternate groups and some Properties **) Definition Sym of phant T : {set {perm T}} := setT. Canonical Sym_group phT := Eval hnf in [group of Sym phT]. Local Notation "'Sym_T" := (Sym (Phant T)) (at level 0). Canonical sign_morph := @Morphism _ _ 'Sym_T _ (in2W (@odd_permM _)). Definition Alt of phant T := 'ker (@odd_perm T). Canonical Alt_group phT := Eval hnf in [group of Alt phT]. Local Notation "'Alt_T" := (Alt (Phant T)) (at level 0). Lemma Alt_even p : (p \in 'Alt_T) = ~~ p. Proof. by rewrite !inE /=; case: odd_perm. Qed. Lemma Alt_subset : 'Alt_T \subset 'Sym_T. Proof. exact: subsetT. Qed. Lemma Alt_normal : 'Alt_T <| 'Sym_T. Proof. exact: ker_normal. Qed. Lemma Alt_norm : 'Sym_T \subset 'N('Alt_T). Proof. by case/andP: Alt_normal. Qed. Let n := #|T|. Lemma Alt_index : 1 < n -> #|'Sym_T : 'Alt_T| = 2. Proof. move=> lt1n; rewrite -card_quotient ?Alt_norm //=. have : ('Sym_T / 'Alt_T) \isog (@odd_perm T @* 'Sym_T) by apply: first_isog. case/isogP=> g /injmP/card_in_imset <-. rewrite /morphim setIid=> ->; rewrite -card_bool; apply: eq_card => b. apply/imsetP; case: b => /=; last first. by exists (1 : {perm T}); [rewrite setIid inE | rewrite odd_perm1]. case: (pickP T) lt1n => [x1 _ | d0]; last by rewrite /n eq_card0. rewrite /n (cardD1 x1) ltnS lt0n => /existsP[x2 /=]. by rewrite eq_sym andbT -odd_tperm; exists (tperm x1 x2); rewrite ?inE. Qed. Lemma card_Sym : #|'Sym_T| = n`!. Proof. rewrite -[n]cardsE -card_perm; apply: eq_card => p. by apply/idP/subsetP=> [? ?|]; rewrite !inE. Qed. Lemma card_Alt : 1 < n -> (2 * #|'Alt_T|)%N = n`!. Proof. by move/Alt_index <-; rewrite mulnC (Lagrange Alt_subset) card_Sym. Qed. Lemma Sym_trans : [transitive^n 'Sym_T, on setT | 'P]. Proof. apply/imsetP; pose t1 := [tuple of enum T]. have dt1: t1 \in n.-dtuple(setT) by rewrite inE enum_uniq; apply/subsetP. exists t1 => //; apply/setP=> t; apply/idP/imsetP=> [|[a _ ->{t}]]; last first. by apply: n_act_dtuple => //; apply/astabsP=> x; rewrite !inE. case/dtuple_onP=> injt _; have injf := inj_comp injt enum_rank_inj. exists (perm injf); first by rewrite inE. apply: eq_from_tnth => i; rewrite tnth_map /= [aperm _ _]permE; congr tnth. by rewrite (tnth_nth (enum_default i)) enum_valK. Qed. Lemma Alt_trans : [transitive^n.-2 'Alt_T, on setT | 'P]. Proof. case n_m2: n Sym_trans => [|[|m]] /= tr_m2; try exact: ntransitive0. have tr_m := ntransitive_weak (leqW (leqnSn m)) tr_m2. case/imsetP: tr_m2; case/tupleP=> x; case/tupleP=> y t. rewrite !dtuple_on_add 2![x \in _]inE inE negb_or /= -!andbA. case/and4P=> nxy ntx nty dt _; apply/imsetP; exists t => //; apply/setP=> u. apply/idP/imsetP=> [|[a _ ->{u}]]; last first. by apply: n_act_dtuple => //; apply/astabsP=> z; rewrite !inE. case/(atransP2 tr_m dt)=> /= a _ ->{u}. case odd_a: (odd_perm a); last by exists a => //; rewrite !inE /= odd_a. exists (tperm x y * a); first by rewrite !inE /= odd_permM odd_tperm nxy odd_a. apply/val_inj/eq_in_map => z tz; rewrite actM /= /aperm; congr (a _). by case: tpermP ntx nty => // <-; rewrite tz. Qed. Lemma aperm_faithful (A : {group {perm T}}) : [faithful A, on setT | 'P]. Proof. by apply/faithfulP=> /= p _ np1; apply/eqP/perm_act1P=> y; rewrite np1 ?inE. Qed. End SymAltDef. Notation "''Sym_' T" := (Sym (Phant T)) (at level 8, T at level 2, format "''Sym_' T") : group_scope. Notation "''Sym_' T" := (Sym_group (Phant T)) : Group_scope. Notation "''Alt_' T" := (Alt (Phant T)) (at level 8, T at level 2, format "''Alt_' T") : group_scope. Notation "''Alt_' T" := (Alt_group (Phant T)) : Group_scope. Lemma trivial_Alt_2 (T : finType) : #|T| <= 2 -> 'Alt_T = 1. Proof. rewrite leq_eqVlt => /predU1P[] oT. by apply: card_le1_trivg; rewrite -leq_double -mul2n card_Alt oT. suffices Sym1: 'Sym_T = 1 by apply/trivgP; rewrite -Sym1 subsetT. by apply: card1_trivg; rewrite card_Sym; case: #|T| oT; do 2?case. Qed. Lemma simple_Alt_3 (T : finType) : #|T| = 3 -> simple 'Alt_T. Proof. move=> T3; have{T3} oA: #|'Alt_T| = 3. by apply: double_inj; rewrite -mul2n card_Alt T3. apply/simpleP; split=> [|K]; [by rewrite trivg_card1 oA | case/andP=> sKH _]. have:= cardSg sKH; rewrite oA dvdn_divisors // !inE orbC /= -oA. case/pred2P=> eqK; [right | left]; apply/eqP. by rewrite eqEcard sKH eqK leqnn. by rewrite eq_sym eqEcard sub1G eqK cards1. Qed. Lemma not_simple_Alt_4 (T : finType) : #|T| = 4 -> ~~ simple 'Alt_T. Proof. move=> oT; set A := 'Alt_T. have oA: #|A| = 12 by apply: double_inj; rewrite -mul2n card_Alt oT. suffices [p]: exists p, [/\ prime p, 1 < #|A|`_p < #|A| & #|'Syl_p(A)| == 1%N]. case=> p_pr pA_int; rewrite /A; case/normal_sylowP=> P; case/pHallP. rewrite /= -/A => sPA pP nPA; apply/simpleP=> [] [_]; rewrite -pP in pA_int. by case/(_ P)=> // defP; rewrite defP oA ?cards1 in pA_int. have: #|'Syl_3(A)| \in filter [pred d | d %% 3 == 1%N] (divisors 12). by rewrite mem_filter -dvdn_divisors //= -oA card_Syl_dvd ?card_Syl_mod. rewrite /= oA mem_seq2 orbC. case/predU1P=> [oQ3|]; [exists 2 | exists 3]; split; rewrite ?p_part //. pose A3 := [set x : {perm T} | #[x] == 3]; suffices oA3: #|A :&: A3| = 8. have sQ2 P: P \in 'Syl_2(A) -> P :=: A :\: A3. rewrite inE pHallE oA p_part -natTrecE /= => /andP[sPA /eqP oP]. apply/eqP; rewrite eqEcard -(leq_add2l 8) -{1}oA3 cardsID oA oP. rewrite andbT subsetD sPA; apply/exists_inP=> -[x] /= Px. by rewrite inE => /eqP ox; have:= order_dvdG Px; rewrite oP ox. have [/= P sylP] := Sylow_exists 2 [group of A]. rewrite -(([set P] =P 'Syl_2(A)) _) ?cards1 // eqEsubset sub1set inE sylP. by apply/subsetP=> Q sylQ; rewrite inE -val_eqE /= !sQ2 // inE. rewrite -[8]/(4 * 2)%N -{}oQ3 -sum1_card -sum_nat_const. rewrite (partition_big (fun x => <[x]>%G) (mem 'Syl_3(A))) => [|x]; last first. by case/setIP=> Ax; rewrite /= !inE pHallE p_part cycle_subG Ax oA. apply: eq_bigr => Q; rewrite inE /= inE pHallE oA p_part -?natTrecE //=. case/andP=> sQA /eqP oQ; have:= oQ. rewrite (cardsD1 1) group1 -sum1_card => [[/= <-]]; apply: eq_bigl => x. rewrite setIC -val_eqE /= 2!inE in_setD1 -andbA -{4}[x]expg1 -order_dvdn dvdn1. apply/and3P/andP=> [[/eqP-> _ /eqP <-] | [ntx Qx]]; first by rewrite cycle_id. have:= order_dvdG Qx; rewrite oQ dvdn_divisors // mem_seq2 (negPf ntx) /=. by rewrite eqEcard cycle_subG Qx (subsetP sQA) // oQ /order => /eqP->. Qed. Lemma simple_Alt5_base (T : finType) : #|T| = 5 -> simple 'Alt_T. Proof. move=> oT. have F1: #|'Alt_T| = 60 by apply: double_inj; rewrite -mul2n card_Alt oT. have FF (H : {group {perm T}}): H <| 'Alt_T -> H :<>: 1 -> 20 %| #|H|. - move=> Hh1 Hh3. have [x _]: exists x, x \in T by apply/existsP/eqP; rewrite oT. have F2 := Alt_trans T; rewrite oT /= in F2. have F3: [transitive 'Alt_T, on setT | 'P] by apply: ntransitive1 F2. have F4: [primitive 'Alt_T, on setT | 'P] by apply: ntransitive_primitive F2. case: (prim_trans_norm F4 Hh1) => F5. by case: Hh3; apply/trivgP; apply: subset_trans F5 (aperm_faithful _). have F6: 5 %| #|H| by rewrite -oT -cardsT (atrans_dvd F5). have F7: 4 %| #|H|. have F7: #|[set~ x]| = 4 by rewrite cardsC1 oT. case: (pickP (mem [set~ x])) => [y Hy | ?]; last by rewrite eq_card0 in F7. pose K := 'C_H[x | 'P]%G. have F8 : K \subset H by apply: subsetIl. pose Gx := 'C_('Alt_T)[x | 'P]%G. have F9: [transitive^2 Gx, on [set~ x] | 'P]. by rewrite -[[set~ x]]setTI -setDE stab_ntransitive ?inE. have F10: [transitive Gx, on [set~ x] | 'P]. exact: ntransitive1 F9. have F11: [primitive Gx, on [set~ x] | 'P]. exact: ntransitive_primitive F9. have F12: K \subset Gx by apply: setSI; apply: normal_sub. have F13: K <| Gx by rewrite /(K <| _) F12 normsIG // normal_norm. case: (prim_trans_norm F11 F13) => Ksub; last first. by apply: dvdn_trans (cardSg F8); rewrite -F7; apply: atrans_dvd Ksub. have F14: [faithful Gx, on [set~ x] | 'P]. apply/subsetP=> g; do 2![case/setIP] => Altg cgx cgx'. apply: (subsetP (aperm_faithful 'Alt_T)). rewrite inE Altg /=; apply/astabP=> z _. case: (z =P x) => [->|]; first exact: (astab1P cgx). by move/eqP=> nxz; rewrite (astabP cgx') ?inE //. have Hreg g (z : T): g \in H -> g z = z -> g = 1. have F15 h: h \in H -> h x = x -> h = 1. move=> Hh Hhx; have: h \in K by rewrite inE Hh; apply/astab1P. by rewrite (trivGP (subset_trans Ksub F14)) => /set1P. move=> Hg Hgz; have:= in_setT x; rewrite -(atransP F3 z) ?inE //. case/imsetP=> g1 Hg1 Hg2; apply: (conjg_inj g1); rewrite conj1g. apply: F15; last by rewrite Hg2 -permM mulKVg permM Hgz. by case/normalP: Hh1 => _ nH1; rewrite -(nH1 _ Hg1) memJ_conjg. clear K F8 F12 F13 Ksub F14. case: (Cauchy _ F6) => // h Hh /eqP Horder. have diff_hnx_x n: 0 < n -> n < 5 -> x != (h ^+ n) x. move=> Hn1 Hn2; rewrite eq_sym; apply/negP => HH. have: #[h ^+ n] = 5. rewrite orderXgcd // (eqP Horder). by move: Hn1 Hn2 {HH}; do 5 (case: n => [|n] //). have Hhd2: h ^+ n \in H by rewrite groupX. by rewrite (Hreg _ _ Hhd2 (eqP HH)) order1. pose S1 := [tuple x; h x; (h ^+ 3) x]. have DnS1: S1 \in 3.-dtuple(setT). rewrite inE memtE subset_all /= !inE /= !negb_or -!andbA /= andbT. rewrite -{1}[h]expg1 !diff_hnx_x // expgSr permM. by rewrite (inj_eq perm_inj) diff_hnx_x. pose S2 := [tuple x; h x; (h ^+ 2) x]. have DnS2: S2 \in 3.-dtuple(setT). rewrite inE memtE subset_all /= !inE /= !negb_or -!andbA /= andbT. rewrite -{1}[h]expg1 !diff_hnx_x // expgSr permM. by rewrite (inj_eq perm_inj) diff_hnx_x. case: (atransP2 F2 DnS1 DnS2) => g Hg [/=]. rewrite /aperm => Hgx Hghx Hgh3x. have h_g_com: h * g = g * h. suff HH: (g * h * g^-1) * h^-1 = 1 by rewrite -[h * g]mul1g -HH !gnorm. apply: (Hreg _ x); last first. by rewrite !permM -Hgx Hghx -!permM mulKVg mulgV perm1. rewrite groupM // ?groupV // (conjgCV g) mulgK -mem_conjg. by case/normalP: Hh1 => _ ->. have: (g * (h ^+ 2) * g ^-1) x = (h ^+ 3) x. rewrite !permM -Hgx. have ->: h (h x) = (h ^+ 2) x by rewrite /= permM. by rewrite {1}Hgh3x -!permM /= mulgV mulg1 -expgSr. rewrite commuteX // mulgK {1}[expgn]lock expgS permM -lock. by move/perm_inj=> eqxhx; case/eqP: (diff_hnx_x 1%N isT isT); rewrite expg1. by rewrite (@Gauss_dvd 4 5) // F7. apply/simpleP; split => [|H Hnorm]; first by rewrite trivg_card1 F1. case Hcard1: (#|H| == 1%N); move/eqP: Hcard1 => Hcard1. by left; apply: card1_trivg; rewrite Hcard1. right; case Hcard60: (#|H| == 60%N); move/eqP: Hcard60 => Hcard60. by apply/eqP; rewrite eqEcard Hcard60 F1 andbT; case/andP: Hnorm. have {Hcard1 Hcard60} Hcard20: #|H| = 20. have Hdiv: 20 %| #|H| by apply: FF => // HH; case Hcard1; rewrite HH cards1. case H20: (#|H| == 20); first exact/eqP. case: Hcard60; case/andP: Hnorm; move/cardSg; rewrite F1 => Hdiv1 _. by case/dvdnP: Hdiv H20 Hdiv1 => n ->; move: n; do 4!case=> //. have prime_5: prime 5 by []. have nSyl5: #|'Syl_5(H)| = 1%N. move: (card_Syl_dvd 5 H) (card_Syl_mod H prime_5). rewrite Hcard20; case: (card _) => // n Hdiv. move: (dvdn_leq (isT: (0 < 20)%N) Hdiv). by move: (n) Hdiv; do 20 (case=> //). case: (Sylow_exists 5 H) => S; case/pHallP=> sSH oS. have{} oS: #|S| = 5 by rewrite oS p_part Hcard20. suff: 20 %| #|S| by rewrite oS. apply: FF => [|S1]; last by rewrite S1 cards1 in oS. apply: char_normal_trans Hnorm; apply: lone_subgroup_char => // Q sQH isoQS. rewrite subEproper; apply/norP=> [[nQS _]]; move: nSyl5. rewrite (cardsD1 S) (cardsD1 Q) 4!{1}inE nQS !pHallE sQH sSH Hcard20 p_part. by rewrite (card_isog isoQS) oS. Qed. Section Restrict. Variables (T : finType) (x : T). Notation T' := {y | y != x}. Lemma rfd_funP (p : {perm T}) (u : T') : let p1 := if p x == x then p else 1 in p1 (val u) != x. Proof. case: (p x =P x) => /= [pxx | _]; last by rewrite perm1 (valP u). by rewrite -[x in _ != x]pxx (inj_eq perm_inj); apply: (valP u). Qed. Definition rfd_fun p := [fun u => Sub ((_ : {perm T}) _) (rfd_funP p u) : T']. Lemma rfdP p : injective (rfd_fun p). Proof. apply: can_inj (rfd_fun p^-1) _ => u; apply: val_inj => /=. rewrite -(can_eq (permK p)) permKV eq_sym. by case: eqP => _; rewrite !(perm1, permK). Qed. Definition rfd p := perm (@rfdP p). Hypothesis card_T : 2 < #|T|. Lemma rfd_morph : {in 'C_('Sym_T)[x | 'P] &, {morph rfd : y z / y * z}}. Proof. move=> p q; rewrite !setIA !setIid; move/astab1P=> p_x; move/astab1P=> q_x. apply/permP=> u; apply: val_inj. by rewrite permE /= !permM !permE /= [p x]p_x [q x]q_x eqxx permM /=. Qed. Canonical rfd_morphism := Morphism rfd_morph. Definition rgd_fun (p : {perm T'}) := [fun x1 => if insub x1 is Some u then sval (p u) else x]. Lemma rgdP p : injective (rgd_fun p). Proof. apply: can_inj (rgd_fun p^-1) _ => y /=. case: (insubP _ y) => [u _ val_u|]; first by rewrite valK permK. by rewrite negbK; move/eqP->; rewrite insubF //= eqxx. Qed. Definition rgd p := perm (@rgdP p). Lemma rfd_odd (p : {perm T}) : p x = x -> rfd p = p :> bool. Proof. have rfd1: rfd 1 = 1. by apply/permP => u; apply: val_inj; rewrite permE /= if_same !perm1. have [n] := ubnP #|[set x | p x != x]|; elim: n p => // n IHn p le_p_n px_x. have [p_id | [x1 Hx1]] := set_0Vmem [set x | p x != x]. suffices ->: p = 1 by rewrite rfd1 !odd_perm1. by apply/permP => z; apply: contraFeq (in_set0 z); rewrite perm1 -p_id inE. have nx1x: x1 != x by apply: contraTneq Hx1 => ->; rewrite inE px_x eqxx. have npxx1: p x != x1 by apply: contraNneq nx1x => <-; rewrite px_x. have npx1x: p x1 != x by rewrite -px_x (inj_eq perm_inj). pose p1 := p * tperm x1 (p x1). have fix_p1 y: p y = y -> p1 y = y. by move=> pyy; rewrite permM; have [<-|/perm_inj<-|] := tpermP; rewrite ?pyy. have p1x_x: p1 x = x by apply: fix_p1. have{le_p_n} lt_p1_n: #|[set x | p1 x != x]| < n. move: le_p_n; rewrite ltnS (cardsD1 x1) Hx1; apply/leq_trans/subset_leq_card. rewrite subsetD1 inE permM tpermR eqxx andbT. by apply/subsetP=> y; rewrite !inE; apply: contraNneq=> /fix_p1->. transitivity (p1 (+) true); last first. by rewrite odd_permM odd_tperm -Hx1 inE eq_sym addbK. have ->: p = p1 * tperm x1 (p x1) by rewrite -tpermV mulgK. rewrite morphM; last 2 first; first by rewrite 2!inE; apply/astab1P. by rewrite 2!inE; apply/astab1P; rewrite -[RHS]p1x_x permM px_x. rewrite odd_permM IHn //=; congr (_ (+) _). pose x2 : T' := Sub x1 nx1x; pose px2 : T' := Sub (p x1) npx1x. suffices ->: rfd (tperm x1 (p x1)) = tperm x2 px2. by rewrite odd_tperm eq_sym; rewrite inE in Hx1. apply/permP => z; apply/val_eqP; rewrite permE /= tpermD // eqxx. by rewrite !permE /= -!val_eqE /= !(fun_if sval) /=. Qed. Lemma rfd_iso : 'C_('Alt_T)[x | 'P] \isog 'Alt_T'. Proof. have rgd_x p: rgd p x = x by rewrite permE /= insubF //= eqxx. have rfd_rgd p: rfd (rgd p) = p. apply/permP => [[z Hz]]; apply/val_eqP; rewrite !permE. by rewrite /= [rgd _ _]permE /= insubF eqxx // permE /= insubT. have sSd: 'C_('Alt_T)[x | 'P] \subset 'dom rfd. by apply/subsetP=> p; rewrite !inE /=; case/andP. apply/isogP; exists [morphism of restrm sSd rfd] => /=; last first. rewrite morphim_restrm setIid; apply/setP=> z; apply/morphimP/idP=> [[p _]|]. case/setIP; rewrite Alt_even => Hp; move/astab1P=> Hp1 ->. by rewrite Alt_even rfd_odd. have dz': rgd z x == x by rewrite rgd_x. move=> kz; exists (rgd z); last by rewrite /= rfd_rgd. by rewrite 2!inE (sameP astab1P eqP). rewrite 4!inE /= (sameP astab1P eqP) dz' -rfd_odd; last exact/eqP. by rewrite rfd_rgd mker // ?set11. apply/injmP=> x1 y1 /=. case/setIP=> Hax1; move/astab1P; rewrite /= /aperm => Hx1. case/setIP=> Hay1; move/astab1P; rewrite /= /aperm => Hy1 Hr. apply/permP => z. case (z =P x) => [->|]; [by rewrite Hx1 | move/eqP => nzx]. move: (congr1 (fun q : {perm T'} => q (Sub z nzx)) Hr). by rewrite !permE => [[]]; rewrite Hx1 Hy1 !eqxx. Qed. End Restrict. Lemma simple_Alt5 (T : finType) : #|T| >= 5 -> simple 'Alt_T. Proof. suff F1 n: #|T| = n + 5 -> simple 'Alt_T by move/subnK/esym/F1. elim: n T => [| n Hrec T Hde]; first exact: simple_Alt5_base. have oT: 5 < #|T| by rewrite Hde addnC. apply/simpleP; split=> [|H Hnorm]; last have [Hh1 nH] := andP Hnorm. rewrite trivg_card1 -[#|_|]half_double -mul2n card_Alt Hde addnC //. by rewrite addSn factS mulnC -(prednK (fact_gt0 _)). case E1: (pred0b T); first by rewrite /pred0b in E1; rewrite (eqP E1) in oT. case/pred0Pn: E1 => x _; have Hx := in_setT x. have F2: [transitive^4 'Alt_T, on setT | 'P]. by apply: ntransitive_weak (Alt_trans T); rewrite -(subnKC oT). have F3 := ntransitive1 (isT: 0 < 4) F2. have F4 := ntransitive_primitive (isT: 1 < 4) F2. case Hcard1: (#|H| == 1%N); move/eqP: Hcard1 => Hcard1. by left; apply: card1_trivg; rewrite Hcard1. right; case: (prim_trans_norm F4 Hnorm) => F5. by rewrite (trivGP (subset_trans F5 (aperm_faithful _))) cards1 in Hcard1. case E1: (pred0b (predD1 T x)). rewrite /pred0b in E1; move: oT. by rewrite (cardD1 x) (eqP E1); case: (T x). case/pred0Pn: E1 => y Hdy; case/andP: (Hdy) => diff_x_y Hy. pose K := 'C_H[x | 'P]%G. have F8: K \subset H by apply: subsetIl. pose Gx := 'C_('Alt_T)[x | 'P]. have F9: [transitive^3 Gx, on [set~ x] | 'P]. by rewrite -[[set~ x]]setTI -setDE stab_ntransitive ?inE. have F10: [transitive Gx, on [set~ x] | 'P]. by apply: ntransitive1 F9. have F11: [primitive Gx, on [set~ x] | 'P]. by apply: ntransitive_primitive F9. have F12: K \subset Gx by rewrite setSI // normal_sub. have F13: K <| Gx by apply/andP; rewrite normsIG. have:= prim_trans_norm F11; case/(_ K) => //= => Ksub; last first. have F14: Gx * H = 'Alt_T by apply/(subgroup_transitiveP _ _ F3). have: simple Gx. by rewrite (isog_simple (rfd_iso x)) Hrec //= card_sig cardC1 Hde. case/simpleP=> _ simGx; case/simGx: F13 => /= HH2. case Ez: (pred0b (predD1 (predD1 T x) y)). move: oT; rewrite /pred0b in Ez. by rewrite (cardD1 x) (cardD1 y) (eqP Ez) inE /= inE /= diff_x_y. case/pred0Pn: Ez => z; case/andP => diff_y_z Hdz. have [diff_x_z Hz] := andP Hdz. have: z \in [set~ x] by rewrite !inE. rewrite -(atransP Ksub y) ?inE //; case/imsetP => g. rewrite /= HH2 inE; move/eqP=> -> HH4. by case/negP: diff_y_z; rewrite HH4 act1. by rewrite /= -F14 -[Gx]HH2 (mulSGid F8). have F14: [faithful Gx, on [set~ x] | 'P]. apply: subset_trans (aperm_faithful 'Sym_T); rewrite subsetI subsetT. apply/subsetP=> g; do 2![case/setIP]=> _ cgx cgx'; apply/astabP=> z _ /=. case: (z =P x) => [->|]; first exact: (astab1P cgx). by move/eqP=> zx; rewrite [_ g](astabP cgx') ?inE. have Hreg g z: g \in H -> g z = z -> g = 1. have F15 h: h \in H -> h x = x -> h = 1. move=> Hh Hhx; have: h \in K by rewrite inE Hh; apply/astab1P. by rewrite [K](trivGP (subset_trans Ksub F14)) => /set1P. move=> Hg Hgz; have:= in_setT x; rewrite -(atransP F3 z) ?inE //. case/imsetP=> g1 Hg1 Hg2; apply: (conjg_inj g1); rewrite conj1g. apply: F15; last by rewrite Hg2 -permM mulKVg permM Hgz. by rewrite memJ_norm ?(subsetP nH). clear K F8 F12 F13 Ksub F14. have Hcard: 5 < #|H|. apply: (leq_trans oT); apply: dvdn_leq; first exact: cardG_gt0. by rewrite -cardsT (atrans_dvd F5). case Eh: (pred0b [predD1 H & 1]). by move: Hcard; rewrite /pred0b in Eh; rewrite (cardD1 1) group1 (eqP Eh). case/pred0Pn: Eh => h; case/andP => diff_1_h /= Hh. case Eg: (pred0b (predD1 (predD1 [predD1 H & 1] h) h^-1)). move: Hcard; rewrite ltnNge; case/negP. rewrite (cardD1 1) group1 (cardD1 h) (cardD1 h^-1) (eqnP Eg). by do 2!case: (_ \in _). case/pred0Pn: Eg => g; case/andP => diff_h1_g; case/andP => diff_h_g. case/andP => diff_1_g /= Hg. case diff_hx_x: (h x == x). by case/negP: diff_1_h; apply/eqP; apply: (Hreg _ _ Hh (eqP diff_hx_x)). case diff_gx_x: (g x == x). case/negP: diff_1_g; apply/eqP; apply: (Hreg _ _ Hg (eqP diff_gx_x)). case diff_gx_hx: (g x == h x). case/negP: diff_h_g; apply/eqP; symmetry; apply: (mulIg g^-1); rewrite gsimp. apply: (Hreg _ x); first by rewrite groupM // groupV. by rewrite permM -(eqP diff_gx_hx) -permM mulgV perm1. case diff_hgx_x: ((h * g) x == x). case/negP: diff_h1_g; apply/eqP; apply: (mulgI h); rewrite !gsimp. by apply: (Hreg _ x); [apply: groupM | apply/eqP]. case diff_hgx_hx: ((h * g) x == h x). case/negP: diff_1_g; apply/eqP. by apply: (Hreg _ (h x)) => //; apply/eqP; rewrite -permM. case diff_hgx_gx: ((h * g) x == g x). by case/idP: diff_hx_x; rewrite -(can_eq (permK g)) -permM. case Ez: (pred0b (predD1 (predD1 (predD1 (predD1 T x) (h x)) (g x)) ((h * g) x))). - move: oT; rewrite /pred0b in Ez. rewrite (cardD1 x) (cardD1 (h x)) (cardD1 (g x)) (cardD1 ((h * g) x)). by rewrite (eqP Ez) addnC; do 3!case: (_ x \in _). case/pred0Pn: Ez => z. case/and5P=> diff_hgx_z diff_gx_z diff_hx_z diff_x_z /= Hz. pose S1 := [tuple x; h x; g x; z]. have DnS1: S1 \in 4.-dtuple(setT). rewrite inE memtE subset_all -!andbA !negb_or /= !inE !andbT. rewrite -!(eq_sym z) diff_gx_z diff_x_z diff_hx_z. by rewrite !(eq_sym x) diff_hx_x diff_gx_x eq_sym diff_gx_hx. pose S2 := [tuple x; h x; g x; (h * g) x]. have DnS2: S2 \in 4.-dtuple(setT). rewrite inE memtE subset_all -!andbA !negb_or /= !inE !andbT !(eq_sym x). rewrite diff_hx_x diff_gx_x diff_hgx_x. by rewrite !(eq_sym (h x)) diff_gx_hx diff_hgx_hx eq_sym diff_hgx_gx. case: (atransP2 F2 DnS1 DnS2) => k Hk [/=]. rewrite /aperm => Hkx Hkhx Hkgx Hkhgx. have h_k_com: h * k = k * h. suff HH: (k * h * k^-1) * h^-1 = 1 by rewrite -[h * k]mul1g -HH !gnorm. apply: (Hreg _ x); last first. by rewrite !permM -Hkx Hkhx -!permM mulKVg mulgV perm1. by rewrite groupM // ?groupV // (conjgCV k) mulgK -mem_conjg (normsP nH). have g_k_com: g * k = k * g. suff HH: (k * g * k^-1) * g^-1 = 1 by rewrite -[g * k]mul1g -HH !gnorm. apply: (Hreg _ x); last first. by rewrite !permM -Hkx Hkgx -!permM mulKVg mulgV perm1. by rewrite groupM // ?groupV // (conjgCV k) mulgK -mem_conjg (normsP nH). have HH: (k * (h * g) * k ^-1) x = z. by rewrite 2!permM -Hkx Hkhgx -permM mulgV perm1. case/negP: diff_hgx_z. rewrite -HH !mulgA -h_k_com -!mulgA [k * _]mulgA. by rewrite -g_k_com -!mulgA mulgV mulg1. Qed. math-comp-mathcomp-1.12.0/mathcomp/solvable/burnside_app.v000066400000000000000000001362461375767750300236070ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype tuple finfun bigop finset fingroup. From mathcomp Require Import action perm primitive_action. (* Application of the Burside formula to count the number of distinct *) (* colorings of the vertices of a square and a cube. *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Lemma burnside_formula : forall (gT : finGroupType) s (G : {group gT}), uniq s -> s =i G -> forall (sT : finType) (to : {action gT &-> sT}), (#|orbit to G @: setT| * size s)%N = \sum_(p <- s) #|'Fix_to[p]|. Proof. move=> gT s G Us sG sT to. rewrite big_uniq // -(card_uniqP Us) (eq_card sG) -Frobenius_Cauchy. by apply: eq_big => // p _; rewrite setTI. by apply/actsP=> ? _ ?; rewrite !inE. Qed. Arguments burnside_formula {gT}. Section colouring. Variable n : nat. Definition colors := 'I_n. Canonical colors_eqType := Eval hnf in [eqType of colors]. Canonical colors_choiceType := Eval hnf in [choiceType of colors]. Canonical colors_countType := Eval hnf in [countType of colors]. Canonical colors_finType := Eval hnf in [finType of colors]. Section square_colouring. Definition square := 'I_4. Canonical square_eqType := Eval hnf in [eqType of square]. Canonical square_choiceType := Eval hnf in [choiceType of square]. Canonical square_countType := Eval hnf in [countType of square]. Canonical square_finType := Eval hnf in [finType of square]. Canonical square_subType := Eval hnf in [subType of square]. Canonical square_subCountType := Eval hnf in [subCountType of square]. Canonical square_subFinType := Eval hnf in [subFinType of square]. Definition mksquare i : square := Sub (i %% _) (ltn_mod i 4). Definition c0 := mksquare 0. Definition c1 := mksquare 1. Definition c2 := mksquare 2. Definition c3 := mksquare 3. (*rotations*) Definition R1 (sc : square) : square := tnth [tuple c1; c2; c3; c0] sc. Definition R2 (sc : square) : square := tnth [tuple c2; c3; c0; c1] sc. Definition R3 (sc : square) : square := tnth [tuple c3; c0; c1; c2] sc. Ltac get_inv elt l := match l with | (_, (elt, ?x)) => x | (elt, ?x) => x | (?x, _) => get_inv elt x end. Definition rot_inv := ((R1, R3), (R2, R2), (R3, R1)). Ltac inj_tac := move: (erefl rot_inv); unfold rot_inv; match goal with |- ?X = _ -> injective ?Y => move=> _; let x := get_inv Y X in apply: (can_inj (g:=x)); move=> [val H1] end. Lemma R1_inj : injective R1. Proof. by inj_tac; repeat (destruct val => //=; first by apply/eqP). Qed. Lemma R2_inj : injective R2. Proof. by inj_tac; repeat (destruct val => //=; first by apply/eqP). Qed. Lemma R3_inj : injective R3. Proof. by inj_tac; repeat (destruct val => //=; first by apply/eqP). Qed. Definition r1 := (perm R1_inj). Definition r2 := (perm R2_inj). Definition r3 := (perm R3_inj). Definition id1 := (1 : {perm square}). Definition is_rot (r : {perm _}) := (r * r1 == r1 * r). Definition rot := [set r | is_rot r]. Lemma group_set_rot : group_set rot. Proof. apply/group_setP; split; first by rewrite /rot inE /is_rot mulg1 mul1g. move=> x1 y; rewrite /rot !inE /= /is_rot; move/eqP => hx1; move/eqP => hy. by rewrite -mulgA hy !mulgA hx1. Qed. Canonical rot_group := Group group_set_rot. Definition rotations := [set id1; r1; r2; r3]. Lemma rot_eq_c0 : forall r s : {perm square}, is_rot r -> is_rot s -> r c0 = s c0 -> r = s. Proof. rewrite /is_rot => r s; move/eqP => hr; move/eqP=> hs hrs; apply/permP => a. have ->: a = (r1 ^+ a) c0 by apply/eqP; case: a; do 4?case=> //=; rewrite ?permM !permE. by rewrite -!permM -!commuteX // !permM hrs. Qed. Lemma rot_r1 : forall r, is_rot r -> r = r1 ^+ (r c0). Proof. move=> r hr; apply: rot_eq_c0 => //; apply/eqP. by symmetry; apply: commuteX. by case: (r c0); do 4?case=> //=; rewrite ?permM !permE /=. Qed. Lemma rotations_is_rot : forall r, r \in rotations -> is_rot r. Proof. move=> r Dr; apply/eqP; apply/permP => a; rewrite !inE -!orbA !permM in Dr *. by case/or4P: Dr; move/eqP->; rewrite !permE //; case: a; do 4?case. Qed. Lemma rot_is_rot : rot = rotations. Proof. apply/setP=> r; apply/idP/idP; last by move/rotations_is_rot; rewrite inE. rewrite !inE => h. have -> : r = r1 ^+ (r c0) by apply: rot_eq_c0; rewrite // -rot_r1. have e2: 2 = r2 c0 by rewrite permE /=. have e3: 3 = r3 c0 by rewrite permE /=. case (r c0); do 4?[case] => // ?; rewrite ?(expg1, eqxx, orbT) //. by rewrite [nat_of_ord _]/= e2 -rot_r1 ?(eqxx, orbT, rotations_is_rot, inE). by rewrite [nat_of_ord _]/= e3 -rot_r1 ?(eqxx, orbT, rotations_is_rot, inE). Qed. (*symmetries*) Definition Sh (sc : square) : square := tnth [tuple c1; c0; c3; c2] sc. Lemma Sh_inj : injective Sh. Proof. by apply: (can_inj (g:= Sh)); case; do 4?case=> //=; move=> H; apply/eqP. Qed. Definition sh := (perm Sh_inj). Lemma sh_inv : sh^-1 = sh. Proof. apply: (mulIg sh); rewrite mulVg; apply/permP. by case; do 4?case=> //=; move=> H; rewrite !permE /= !permE; apply/eqP. Qed. Definition Sv (sc : square) : square := tnth [tuple c3; c2; c1; c0] sc. Lemma Sv_inj : injective Sv. Proof. by apply: (can_inj (g:= Sv)); case; do 4?case=> //=; move=> H; apply/eqP. Qed. Definition sv := (perm Sv_inj). Lemma sv_inv : sv^-1 = sv. Proof. apply: (mulIg sv); rewrite mulVg; apply/permP. by case; do 4?case=> //=; move=> H; rewrite !permE /= !permE; apply/eqP. Qed. Definition Sd1 (sc : square) : square := tnth [tuple c0; c3; c2; c1] sc. Lemma Sd1_inj : injective Sd1. Proof. by apply: can_inj Sd1 _; case; do 4?case=> //=; move=> H; apply/eqP. Qed. Definition sd1 := (perm Sd1_inj). Lemma sd1_inv : sd1^-1 = sd1. Proof. apply: (mulIg sd1); rewrite mulVg; apply/permP. by case; do 4?case=> //=; move=> H; rewrite !permE /= !permE; apply/eqP. Qed. Definition Sd2 (sc : square) : square := tnth [tuple c2; c1; c0; c3] sc. Lemma Sd2_inj : injective Sd2. Proof. by apply: can_inj Sd2 _; case; do 4?case=> //=; move=> H; apply/eqP. Qed. Definition sd2 := (perm Sd2_inj). Lemma sd2_inv : sd2^-1 = sd2. Proof. apply: (mulIg sd2); rewrite mulVg; apply/permP. by case; do 4?case=> //=; move=> H; rewrite !permE /= !permE; apply/eqP. Qed. Lemma ord_enum4 : enum 'I_4 = [:: c0; c1; c2; c3]. Proof. by apply: (inj_map val_inj); rewrite val_enum_ord. Qed. Lemma diff_id_sh : 1 != sh. Proof. by apply/eqP; move/(congr1 (fun p : {perm square} => p c0)); rewrite !permE. Qed. Definition isometries2 := [set 1; sh]. Lemma card_iso2 : #|isometries2| = 2. Proof. by rewrite cards2 diff_id_sh. Qed. Lemma group_set_iso2 : group_set isometries2. Proof. apply/group_setP; split => [|x y]; rewrite !inE ?eqxx //. do 2![case/orP; move/eqP->]; gsimpl; rewrite ?(eqxx, orbT) //. by rewrite -/sh -{1}sh_inv mulVg eqxx. Qed. Canonical iso2_group := Group group_set_iso2. Definition isometries := [set p | [|| p == 1, p == r1, p == r2, p == r3, p == sh, p == sv, p == sd1 | p == sd2 ]]. Definition opp (sc : square) := tnth [tuple c2; c3; c0; c1] sc. Definition is_iso (p : {perm square}) := forall ci, p (opp ci) = opp (p ci). Lemma isometries_iso : forall p, p \in isometries -> is_iso p. Proof. move=> p; rewrite inE. by do ?case/orP; move/eqP=> -> a; rewrite !permE; case: a; do 4?case. Qed. Ltac non_inj p a1 a2 heq1 heq2 := let h1:= fresh "h1" in (absurd (p a1 = p a2); first (by red => - h1; move: (perm_inj h1)); by rewrite heq1 heq2; apply/eqP). Ltac is_isoPtac p f e0 e1 e2 e3 := suff ->: p = f by [rewrite inE eqxx ?orbT]; let e := fresh "e" in apply/permP; do 5?[case] => // ?; [move: e0 | move: e1 | move: e2 | move: e3] => e; apply: etrans (congr1 p _) (etrans e _); apply/eqP; rewrite // permE. Lemma is_isoP : forall p, reflect (is_iso p) (p \in isometries). Proof. move=> p; apply: (iffP idP) => [|iso_p]; first exact: isometries_iso. move e1: (p c1) (iso_p c1) => k1; move e0: (p c0) (iso_p c0) k1 e1 => k0. case: k0 e0; do 4?[case] => //= ? e0 e2; do 5?[case] => //= ? e1 e3; try by [non_inj p c0 c1 e0 e1 | non_inj p c0 c3 e0 e3]. by is_isoPtac p id1 e0 e1 e2 e3. by is_isoPtac p sd1 e0 e1 e2 e3. by is_isoPtac p sh e0 e1 e2 e3. by is_isoPtac p r1 e0 e1 e2 e3. by is_isoPtac p sd2 e0 e1 e2 e3. by is_isoPtac p r2 e0 e1 e2 e3. by is_isoPtac p r3 e0 e1 e2 e3. by is_isoPtac p sv e0 e1 e2 e3. Qed. Lemma group_set_iso : group_set isometries. Proof. apply/group_setP; split; first by rewrite inE eqxx /=. by move=> x y hx hy; apply/is_isoP => ci; rewrite !permM !isometries_iso. Qed. Canonical iso_group := Group group_set_iso. Lemma card_rot : #|rot| = 4. Proof. rewrite -[4]/(size [:: id1; r1; r2; r3]) -(card_uniqP _). by apply: eq_card => x; rewrite rot_is_rot !inE -!orbA. by apply: map_uniq (fun p : {perm square} => p c0) _ _; rewrite /= !permE. Qed. Lemma group_set_rotations : group_set rotations. Proof. by rewrite -rot_is_rot group_set_rot. Qed. Canonical rotations_group := Group group_set_rotations. Notation col_squares := {ffun square -> colors}. Definition act_f (sc : col_squares) (p : {perm square}) : col_squares := [ffun z => sc (p^-1 z)]. Lemma act_f_1 : forall k, act_f k 1 = k. Proof. by move=> k; apply/ffunP=> a; rewrite ffunE invg1 permE. Qed. Lemma act_f_morph : forall k x y, act_f k (x * y) = act_f (act_f k x) y. Proof. by move=> k x y; apply/ffunP=> a; rewrite !ffunE invMg permE. Qed. Definition to := TotalAction act_f_1 act_f_morph. Definition square_coloring_number2 := #|orbit to isometries2 @: setT|. Definition square_coloring_number4 := #|orbit to rotations @: setT|. Definition square_coloring_number8 := #|orbit to isometries @: setT|. Lemma Fid : 'Fix_to(1) = setT. Proof. by apply/setP=> x /=; rewrite in_setT; apply/afix1P; apply: act1. Qed. Lemma card_Fid : #|'Fix_to(1)| = (n ^ 4)%N. Proof. rewrite -[4]card_ord -[n]card_ord -card_ffun_on Fid cardsE. by symmetry; apply: eq_card => f; apply/ffun_onP. Qed. Definition coin0 (sc : col_squares) : colors := sc c0. Definition coin1 (sc : col_squares) : colors := sc c1. Definition coin2 (sc : col_squares) : colors := sc c2. Definition coin3 (sc : col_squares) : colors := sc c3. Lemma eqperm_map : forall p1 p2 : col_squares, (p1 == p2) = all (fun s => p1 s == p2 s) [:: c0; c1; c2; c3]. Proof. move=> p1 p2; apply/eqP/allP=> [-> // | Ep12]; apply/ffunP=> x. by apply/eqP; apply Ep12; case: x; do 4!case=> //. Qed. Lemma F_Sh : 'Fix_to[sh] = [set x | (coin0 x == coin1 x) && (coin2 x == coin3 x)]. Proof. apply/setP=> x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f sh_inv !ffunE !permE /=. by rewrite eq_sym (eq_sym (x c3)) andbT andbA !andbb. Qed. Lemma F_Sv : 'Fix_to[sv] = [set x | (coin0 x == coin3 x) && (coin2 x == coin1 x)]. Proof. apply/setP=> x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f sv_inv !ffunE !permE /=. by rewrite eq_sym andbT andbC (eq_sym (x c1)) andbA -andbA !andbb andbC. Qed. Ltac inv_tac := apply: esym (etrans _ (mul1g _)); apply: canRL (mulgK _) _; let a := fresh "a" in apply/permP => a; apply/eqP; rewrite permM !permE; case: a; do 4?case. Lemma r1_inv : r1^-1 = r3. Proof. by inv_tac. Qed. Lemma r2_inv : r2^-1 = r2. Proof. by inv_tac. Qed. Lemma r3_inv : r3^-1 = r1. Proof. by inv_tac. Qed. Lemma F_r2 : 'Fix_to[r2] = [set x | (coin0 x == coin2 x) && (coin1 x == coin3 x)]. Proof. apply/setP=> x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f r2_inv !ffunE !permE /=. by rewrite eq_sym andbT andbCA andbC (eq_sym (x c3)) andbA -andbA !andbb andbC. Qed. Lemma F_r1 : 'Fix_to[r1] = [set x | (coin0 x == coin1 x)&&(coin1 x == coin2 x)&&(coin2 x == coin3 x)]. Proof. apply/setP=> x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f r1_inv !ffunE !permE andbC. by do 3![case E: {+}(_ == _); rewrite // {E}(eqP E)]; rewrite eqxx. Qed. Lemma F_r3 : 'Fix_to[r3] = [set x | (coin0 x == coin1 x)&&(coin1 x == coin2 x)&&(coin2 x == coin3 x)]. Proof. apply/setP=> x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f r3_inv !ffunE !permE /=. by do 3![case: eqVneq=> // <-]. Qed. Lemma card_n2 : forall x y z t : square, uniq [:: x; y; z; t] -> #|[set p : col_squares | (p x == p y) && (p z == p t)]| = (n ^ 2)%N. Proof. move=> x y z t Uxt; rewrite -[n]card_ord. pose f (p : col_squares) := (p x, p z); rewrite -(@card_in_image _ _ f). rewrite -mulnn -card_prod; apply: eq_card => [] [c d] /=; apply/imageP. rewrite (cat_uniq [::x; y]) in Uxt; case/and3P: Uxt => _. rewrite /= !orbF !andbT; case/norP; rewrite !inE => nxzt nyzt _. exists [ffun i => if pred2 x y i then c else d]. by rewrite inE !ffunE /= !eqxx orbT (negbTE nxzt) (negbTE nyzt) !eqxx. by rewrite {}/f !ffunE /= eqxx (negbTE nxzt). move=> p1 p2; rewrite !inE. case/andP=> p1y p1t; case/andP=> p2y p2t [px pz]. have eqp12: all (fun i => p1 i == p2 i) [:: x; y; z; t]. by rewrite /= -(eqP p1y) -(eqP p1t) -(eqP p2y) -(eqP p2t) px pz !eqxx. apply/ffunP=> i; apply/eqP; apply: (allP eqp12). by rewrite (subset_cardP _ (subset_predT _)) // (card_uniqP Uxt) card_ord. Qed. Lemma card_n : #|[set x | (coin0 x == coin1 x)&&(coin1 x == coin2 x)&& (coin2 x == coin3 x)]| = n. Proof. rewrite -[n]card_ord /coin0 /coin1 /coin2 /coin3. pose f (p : col_squares) := p c3; rewrite -(@card_in_image _ _ f). apply: eq_card => c /=; apply/imageP. exists ([ffun => c] : col_squares); last by rewrite /f ffunE. by rewrite /= inE !ffunE !eqxx. move=> p1 p2; rewrite /= !inE /f -!andbA => eqp1 eqp2 eqp12. apply/eqP; rewrite eqperm_map /= andbT. case/and3P: eqp1; do 3!move/eqP->; case/and3P: eqp2; do 3!move/eqP->. by rewrite !andbb eqp12. Qed. Lemma burnside_app2 : (square_coloring_number2 * 2 = n ^ 4 + n ^ 2)%N. Proof. rewrite (burnside_formula [:: id1; sh]) => [||p]; last first. - by rewrite !inE. - by rewrite /= inE diff_id_sh. by rewrite 2!big_cons big_nil addn0 {1}card_Fid F_Sh card_n2. Qed. Lemma burnside_app_rot : (square_coloring_number4 * 4 = n ^ 4 + n ^ 2 + 2 * n)%N. Proof. rewrite (burnside_formula [:: id1; r1; r2; r3]) => [||p]; last first. - by rewrite !inE !orbA. - by apply: map_uniq (fun p : {perm square} => p c0) _ _; rewrite /= !permE. rewrite !big_cons big_nil /= addn0 {1}card_Fid F_r1 F_r2 F_r3. by rewrite card_n card_n2 //=; ring. Qed. Lemma F_Sd1 : 'Fix_to[sd1] = [set x | coin1 x == coin3 x]. Proof. apply/setP => x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. rewrite /act_f sd1_inv !ffunE !permE /=. by rewrite !eqxx !andbT eq_sym /= andbb. Qed. Lemma card_n3 : forall x y : square, x != y -> #|[set k : col_squares | k x == k y]| = (n ^ 3)%N. Proof. move=> x y nxy; apply/eqP; case: (posnP n) => [n0|]. by rewrite n0; apply/existsP=> [] [p _]; case: (p c0) => i; rewrite n0. move/eqn_pmul2l <-; rewrite -expnS -card_Fid Fid cardsT. rewrite -{1}[n]card_ord -cardX. pose pk k := [ffun i => k (if i == y then x else i) : colors]. rewrite -(@card_image _ _ (fun k : col_squares => (k y, pk k))). apply/eqP; apply: eq_card => ck /=; rewrite inE /= [_ \in _]inE. apply/eqP/imageP; last first. by case=> k _ -> /=; rewrite !ffunE if_same eqxx. case: ck => c k /= kxy. exists [ffun i => if i == y then c else k i]; first by rewrite inE. rewrite !ffunE eqxx; congr (_, _); apply/ffunP=> i; rewrite !ffunE. case Eiy: (i == y); last by rewrite Eiy. by rewrite (negbTE nxy) (eqP Eiy). move=> k1 k2 [Eky Epk]; apply/ffunP=> i. have{Epk}: pk k1 i = pk k2 i by rewrite Epk. by rewrite !ffunE; case: eqP => // ->. Qed. Lemma F_Sd2 : 'Fix_to[sd2] = [set x | coin0 x == coin2 x]. Proof. apply/setP => x; rewrite (sameP afix1P eqP) !inE eqperm_map /=. by rewrite /act_f sd2_inv !ffunE !permE /= !eqxx !andbT eq_sym /= andbb. Qed. Lemma burnside_app_iso : (square_coloring_number8 * 8 = n ^ 4 + 2 * n ^ 3 + 3 * n ^ 2 + 2 * n)%N. Proof. pose iso_list := [:: id1; r1; r2; r3; sh; sv; sd1; sd2]. rewrite (burnside_formula iso_list) => [||p]; last first. - by rewrite /= !inE. - apply: map_uniq (fun p : {perm square} => (p c0, p c1)) _ _. by rewrite /= !permE. rewrite !big_cons big_nil {1}card_Fid F_r1 F_r2 F_r3 F_Sh F_Sv F_Sd1 F_Sd2. by rewrite card_n !card_n3 // !card_n2 //=; ring. Qed. End square_colouring. Section cube_colouring. Definition cube := 'I_6. Canonical cube_eqType := Eval hnf in [eqType of cube]. Canonical cube_choiceType := Eval hnf in [choiceType of cube]. Canonical cube_countType := Eval hnf in [countType of cube]. Canonical cube_finType := Eval hnf in [finType of cube]. Canonical cube_subType := Eval hnf in [subType of cube]. Canonical cube_subCountType := Eval hnf in [subCountType of cube]. Canonical cube_subFinType := Eval hnf in [subFinType of cube]. Definition mkFcube i : cube := Sub (i %% 6) (ltn_mod i 6). Definition F0 := mkFcube 0. Definition F1 := mkFcube 1. Definition F2 := mkFcube 2. Definition F3 := mkFcube 3. Definition F4 := mkFcube 4. Definition F5 := mkFcube 5. (* axial symetries*) Definition S05 := [:: F0; F4; F3; F2; F1; F5]. Definition S05f (sc : cube) : cube := tnth [tuple of S05] sc. Definition S14 := [:: F5; F1; F3; F2; F4; F0]. Definition S14f (sc : cube) : cube := tnth [tuple of S14] sc. Definition S23 := [:: F5; F4; F2; F3; F1; F0]. Definition S23f (sc : cube) : cube := tnth [tuple of S23] sc. (* rotations 90 *) Definition R05 := [:: F0; F2; F4; F1; F3; F5]. Definition R05f (sc : cube) : cube := tnth [tuple of R05] sc. Definition R50 := [:: F0; F3; F1; F4; F2; F5]. Definition R50f (sc : cube) : cube := tnth [tuple of R50] sc. Definition R14 := [:: F3; F1; F0; F5; F4; F2]. Definition R14f (sc : cube) : cube := tnth [tuple of R14] sc. Definition R41 := [:: F2; F1; F5; F0; F4; F3]. Definition R41f (sc : cube) : cube := tnth [tuple of R41] sc. Definition R23 := [:: F1; F5; F2; F3; F0; F4]. Definition R23f (sc : cube) : cube := tnth [tuple of R23] sc. Definition R32 := [:: F4; F0; F2; F3; F5; F1]. Definition R32f (sc : cube) : cube := tnth [tuple of R32] sc. (* rotations 120 *) Definition R024 := [:: F2; F5; F4; F1; F0; F3]. Definition R024f (sc : cube) : cube := tnth [tuple of R024] sc. Definition R042 := [:: F4; F3; F0; F5; F2; F1]. Definition R042f (sc : cube) : cube := tnth [tuple of R042] sc. Definition R012 := [:: F1; F2; F0; F5; F3; F4]. Definition R012f (sc : cube) : cube := tnth [tuple of R012] sc. Definition R021 := [:: F2; F0; F1; F4; F5; F3]. Definition R021f (sc : cube) : cube := tnth [tuple of R021] sc. Definition R031 := [:: F3; F0; F4; F1; F5; F2]. Definition R031f (sc : cube) : cube := tnth [tuple of R031] sc. Definition R013 := [:: F1; F3; F5; F0; F2; F4]. Definition R013f (sc : cube) : cube := tnth [tuple of R013] sc. Definition R043 := [:: F4; F2; F5; F0; F3; F1]. Definition R043f (sc : cube) : cube := tnth [tuple of R043] sc. Definition R034 := [:: F3; F5; F1; F4; F0; F2]. Definition R034f (sc : cube) : cube := tnth [tuple of R034] sc. (* last symmetries*) Definition S1 := [:: F5; F2; F1; F4; F3; F0]. Definition S1f (sc : cube) : cube := tnth [tuple of S1] sc. Definition S2 := [:: F5; F3; F4; F1; F2; F0]. Definition S2f (sc : cube) : cube := tnth [tuple of S2] sc. Definition S3 := [:: F1; F0; F3; F2; F5; F4]. Definition S3f (sc : cube) : cube := tnth [tuple of S3] sc. Definition S4 := [:: F4; F5; F3; F2; F0; F1]. Definition S4f (sc : cube) : cube := tnth [tuple of S4] sc. Definition S5 := [:: F2; F4; F0; F5; F1; F3]. Definition S5f (sc : cube) : cube := tnth [tuple of S5] sc. Definition S6 := [::F3; F4; F5; F0; F1; F2]. Definition S6f (sc : cube) : cube := tnth [tuple of S6] sc. Lemma S1_inv : involutive S1f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S2_inv : involutive S2f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S3_inv : involutive S3f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S4_inv : involutive S4f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S5_inv : involutive S5f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S6_inv : involutive S6f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma S05_inj : injective S05f. Proof. by apply: can_inj S05f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma S14_inj : injective S14f. Proof. by apply: can_inj S14f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma S23_inv : involutive S23f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Lemma R05_inj : injective R05f. Proof. by apply: can_inj R50f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R14_inj : injective R14f. Proof. by apply: can_inj R41f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R23_inj : injective R23f. Proof. by apply: can_inj R32f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R50_inj : injective R50f. Proof. by apply: can_inj R05f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R41_inj : injective R41f. Proof. by apply: can_inj R14f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R32_inj : injective R32f. Proof. by apply: can_inj R23f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R024_inj : injective R024f. Proof. by apply: can_inj R042f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R042_inj : injective R042f. Proof. by apply: can_inj R024f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R012_inj : injective R012f. Proof. by apply: can_inj R021f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R021_inj : injective R021f. Proof. by apply: can_inj R012f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R031_inj : injective R031f. Proof. by apply: can_inj R013f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R013_inj : injective R013f. Proof. by apply: can_inj R031f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R043_inj : injective R043f. Proof. by apply: can_inj R034f _ => z; apply/eqP; case: z; do 6?case. Qed. Lemma R034_inj : injective R034f. Proof. by apply: can_inj R043f _ => z; apply/eqP; case: z; do 6?case. Qed. Definition id3 := 1 : {perm cube}. Definition s05 := (perm S05_inj). Definition s14 : {perm cube}. Proof. apply: (@perm _ S14f); apply: can_inj S14f _ => z. by apply/eqP; case: z; do 6?case. Defined. Definition s23 := (perm (inv_inj S23_inv)). Definition r05 := (perm R05_inj). Definition r14 := (perm R14_inj). Definition r23 := (perm R23_inj). Definition r50 := (perm R50_inj). Definition r41 := (perm R41_inj). Definition r32 := (perm R32_inj). Definition r024 := (perm R024_inj). Definition r042 := (perm R042_inj). Definition r012 := (perm R012_inj). Definition r021 := (perm R021_inj). Definition r031 := (perm R031_inj). Definition r013 := (perm R013_inj). Definition r043 := (perm R043_inj). Definition r034 := (perm R034_inj). Definition s1 := (perm (inv_inj S1_inv)). Definition s2 := (perm (inv_inj S2_inv)). Definition s3 := (perm (inv_inj S3_inv)). Definition s4 := (perm (inv_inj S4_inv)). Definition s5 := (perm (inv_inj S5_inv)). Definition s6 := (perm (inv_inj S6_inv)). Definition dir_iso3 := [set p | [|| id3 == p, s05 == p, s14 == p, s23 == p, r05 == p, r14 == p, r23 == p, r50 == p, r41 == p, r32 == p, r024 == p, r042 == p, r012 == p, r021 == p, r031 == p, r013 == p, r043 == p, r034 == p, s1 == p, s2 == p, s3 == p, s4 == p, s5 == p | s6 == p]]. Definition dir_iso3l := [:: id3; s05; s14; s23; r05; r14; r23; r50; r41; r32; r024; r042; r012; r021; r031; r013; r043; r034; s1; s2; s3; s4; s5; s6]. Definition S0 := [:: F5; F4; F3; F2; F1; F0]. Definition S0f (sc : cube) : cube := tnth [tuple of S0] sc. Lemma S0_inv : involutive S0f. Proof. by move=> z; apply/eqP; case: z; do 6?case. Qed. Definition s0 := (perm (inv_inj S0_inv)). Definition is_iso3 (p : {perm cube}) := forall fi, p (s0 fi) = s0 (p fi). Lemma dir_iso_iso3 : forall p, p \in dir_iso3 -> is_iso3 p. Proof. move=> p; rewrite inE. by do ?case/orP; move/eqP=> <- a; rewrite !permE; case: a; do 6?case. Qed. Lemma iso3_ndir : forall p, p \in dir_iso3 -> is_iso3 (s0 * p). Proof. move=> p; rewrite inE. by do ?case/orP; move/eqP=> <- a; rewrite !(permM, permE); case: a; do 6?case. Qed. Definition sop (p : {perm cube}) : seq cube := fgraph (val p). Lemma sop_inj : injective sop. Proof. by move=> p1 p2 /val_inj/(can_inj fgraphK)/val_inj. Qed. Definition prod_tuple (t1 t2 : seq cube) := map (fun n : 'I_6 => nth F0 t2 n) t1. Lemma sop_spec x (n0 : 'I_6): nth F0 (sop x) n0 = x n0. Proof. by rewrite nth_fgraph_ord pvalE. Qed. Lemma prod_t_correct : forall (x y : {perm cube}) (i : cube), (x * y) i = nth F0 (prod_tuple (sop x) (sop y)) i. Proof. move=> x y i; rewrite permM -!sop_spec [RHS](nth_map F0) // size_tuple /=. by rewrite card_ord ltn_ord. Qed. Lemma sop_morph : {morph sop : x y / x * y >-> prod_tuple x y}. Proof. move=> x y; apply: (@eq_from_nth _ F0) => [|/= i]. by rewrite size_map !size_tuple. rewrite size_tuple card_ord => lti6. by rewrite -[i]/(val (Ordinal lti6)) sop_spec -prod_t_correct. Qed. Definition ecubes : seq cube := [:: F0; F1; F2; F3; F4; F5]. Lemma ecubes_def : ecubes = enum (@predT cube). Proof. by apply: (inj_map val_inj); rewrite val_enum_ord. Qed. Definition seq_iso_L := [:: [:: F0; F1; F2; F3; F4; F5]; S05; S14; S23; R05; R14; R23; R50; R41; R32; R024; R042; R012; R021; R031; R013; R043; R034; S1; S2; S3; S4; S5; S6]. Lemma seqs1 : forall f injf, sop (@perm _ f injf) = map f ecubes. Proof. move=> f ?; rewrite ecubes_def /sop /= -codom_ffun pvalE. by apply: eq_codom; apply: permE. Qed. Lemma Lcorrect : seq_iso_L == map sop [:: id3; s05; s14; s23; r05; r14; r23; r50; r41; r32; r024; r042; r012; r021; r031; r013; r043; r034; s1; s2; s3; s4; s5; s6]. Proof. by rewrite /= !seqs1. Qed. Lemma iso0_1 : dir_iso3 =i dir_iso3l. Proof. by move=> p; rewrite /= !inE /= -!(eq_sym p). Qed. Lemma L_iso : forall p, (p \in dir_iso3) = (sop p \in seq_iso_L). Proof. by move=> p; rewrite (eqP Lcorrect) mem_map ?iso0_1 //; apply: sop_inj. Qed. Lemma stable : forall x y, x \in dir_iso3 -> y \in dir_iso3 -> x * y \in dir_iso3. Proof. move=> x y; rewrite !L_iso sop_morph => Hx Hy. by move/sop: y Hy; apply/allP; move/sop: x Hx; apply/allP; vm_compute. Qed. Lemma iso_eq_F0_F1 : forall r s : {perm cube}, r \in dir_iso3 -> s \in dir_iso3 -> r F0 = s F0 -> r F1 = s F1 -> r = s. Proof. move=> r s; rewrite !L_iso => hr hs hrs0 hrs1; apply: sop_inj; apply/eqP. move/eqP: hrs0; apply/implyP; move/eqP: hrs1; apply/implyP; rewrite -!sop_spec. by move/sop: r hr; apply/allP; move/sop: s hs; apply/allP; vm_compute. Qed. Lemma ndir_s0p : forall p, p \in dir_iso3 -> s0 * p \notin dir_iso3. Proof. move=> p; rewrite !L_iso sop_morph seqs1. by move/sop: p; apply/allP; vm_compute. Qed. Definition indir_iso3l := map (mulg s0) dir_iso3l. Definition iso3l := dir_iso3l ++ indir_iso3l. Definition seq_iso3_L := map sop iso3l. Lemma eqperm : forall p1 p2 : {perm cube}, (p1 == p2) = all (fun s => p1 s == p2 s) ecubes. Proof. move=> p1 p2; apply/eqP/allP=> [-> // | Ep12]; apply/permP=> x. by apply/eqP; rewrite Ep12 // ecubes_def mem_enum. Qed. Lemma iso_eq_F0_F1_F2 : forall r s : {perm cube}, is_iso3 r -> is_iso3 s -> r F0 = s F0 -> r F1 = s F1 -> r F2 = s F2 -> r = s. Proof. move=> r s hr hs hrs0 hrs1 hrs2. have:= hrs0; have:= hrs1; have:= hrs2. have e23: F2 = s0 F3 by apply/eqP; rewrite permE /S0f (tnth_nth F0). have e14: F1 = s0 F4 by apply/eqP; rewrite permE /S0f (tnth_nth F0). have e05: F0 = s0 F5 by apply/eqP; rewrite permE /S0f (tnth_nth F0). rewrite e23 e14 e05; rewrite !hr !hs. move/perm_inj=> hrs3; move/perm_inj=> hrs4; move/perm_inj=> hrs5. by apply/eqP; rewrite eqperm /= hrs0 hrs1 hrs2 hrs3 hrs4 hrs5 !eqxx. Qed. Ltac iso_tac := let a := fresh "a" in apply/permP => a; apply/eqP; rewrite !permM !permE; case: a; do 6?case. Ltac inv_tac := apply: esym (etrans _ (mul1g _)); apply: canRL (mulgK _) _; iso_tac. Lemma dir_s0p : forall p, (s0 * p) \in dir_iso3 -> p \notin dir_iso3. Proof. move=> p Hs0p; move: (ndir_s0p Hs0p); rewrite mulgA. have e: (s0^-1=s0) by inv_tac. by rewrite -{1}e mulVg mul1g. Qed. Definition is_iso3b p := (p * s0 == s0 * p). Definition iso3 := [set p | is_iso3b p]. Lemma is_iso3P : forall p, reflect (is_iso3 p) (p \in iso3). Proof. move=> p; apply: (iffP idP); rewrite inE /iso3 /is_iso3b /is_iso3 => e. by move=> fi; rewrite -!permM (eqP e). by apply/eqP; apply/permP=> z; rewrite !permM (e z). Qed. Lemma group_set_iso3 : group_set iso3. Proof. apply/group_setP; split. by apply/is_iso3P => fi; rewrite -!permM mulg1 mul1g. move=> x1 y; rewrite /iso3 !inE /= /is_iso3. rewrite /is_iso3b. rewrite -mulgA. move/eqP => hx1; move/eqP => hy. rewrite hy !mulgA. by rewrite -hx1. Qed. Canonical iso_group3 := Group group_set_iso3. Lemma group_set_diso3 : group_set dir_iso3. Proof. apply/group_setP; split; first by rewrite inE eqxx /=. by apply: stable. Qed. Canonical diso_group3 := Group group_set_diso3. Lemma gen_diso3 : dir_iso3 = <<[set r05; r14]>>. Proof. apply/setP; apply/subset_eqP; apply/andP; split; first last. by rewrite gen_subG; apply/subsetP => x; rewrite !inE; case/orP; move/eqP ->; rewrite eqxx !orbT. apply/subsetP => x; rewrite !inE. have -> : s05 = r05 * r05 by iso_tac. have -> : s14 = r14 * r14 by iso_tac. have -> : s23 = r14 * r14 * r05 * r05 by iso_tac. have -> : r23 = r05 * r14 * r05 * r14 * r14 by iso_tac. have -> : r50 = r05 * r05 * r05 by iso_tac. have -> : r41 = r14 * r14 * r14 by iso_tac. have -> : r32 = r14 * r14 * r14 * r05* r14 by iso_tac. have -> : r024 = r05 * r14 * r14 * r14 by iso_tac. have -> : r042 = r14 * r05 * r05 * r05 by iso_tac. have -> : r012 = r14 * r05 by iso_tac. have -> : r021 = r05 * r14 * r05 * r05 by iso_tac. have -> : r031 = r05 * r14 by iso_tac. have -> : r013 = r05 * r05 * r14 * r05 by iso_tac. have -> : r043 = r14 * r14 * r14 * r05 by iso_tac. have -> : r034 = r05 * r05 * r05 * r14 by iso_tac. have -> : s1 = r14 * r14 * r05 by iso_tac. have -> : s2 = r05 * r14 * r14 by iso_tac. have -> : s3 = r05 * r14 * r05 by iso_tac. have -> : s4 = r05 * r14 * r14 * r14 * r05 by iso_tac. have -> : s5 = r14 * r05 * r05 by iso_tac. have -> : s6 = r05 * r05 * r14 by iso_tac. by do ?case/predU1P=> [<-|]; first exact: group1; last (move/eqP => <-); rewrite ?groupMl ?mem_gen // !inE eqxx ?orbT. Qed. Notation col_cubes := {ffun cube -> colors}. Definition act_g (sc : col_cubes) (p : {perm cube}) : col_cubes := [ffun z => sc (p^-1 z)]. Lemma act_g_1 : forall k, act_g k 1 = k. Proof. by move=> k; apply/ffunP=> a; rewrite ffunE invg1 permE. Qed. Lemma act_g_morph : forall k x y, act_g k (x * y) = act_g (act_g k x) y. Proof. by move=> k x y; apply/ffunP=> a; rewrite !ffunE invMg permE. Qed. Definition to_g := TotalAction act_g_1 act_g_morph. Definition cube_coloring_number24 := #|orbit to_g diso_group3 @: setT|. Lemma Fid3 : 'Fix_to_g[1] = setT. Proof. by apply/setP=> x /=; rewrite (sameP afix1P eqP) !inE act1 eqxx. Qed. Lemma card_Fid3 : #|'Fix_to_g[1]| = (n ^ 6)%N. Proof. rewrite -[6]card_ord -[n]card_ord -card_ffun_on Fid3 cardsT. by symmetry; apply: eq_card => ff; apply/ffun_onP. Qed. Definition col0 (sc : col_cubes) : colors := sc F0. Definition col1 (sc : col_cubes) : colors := sc F1. Definition col2 (sc : col_cubes) : colors := sc F2. Definition col3 (sc : col_cubes) : colors := sc F3. Definition col4 (sc : col_cubes) : colors := sc F4. Definition col5 (sc : col_cubes) : colors := sc F5. Lemma eqperm_map2 : forall p1 p2 : col_cubes, (p1 == p2) = all (fun s => p1 s == p2 s) [:: F0; F1; F2; F3; F4; F5]. Proof. move=> p1 p2; apply/eqP/allP=> [-> // | Ep12]; apply/ffunP=> x. by apply/eqP; apply Ep12; case: x; do 6?case. Qed. Notation infE := (sameP afix1P eqP). Lemma F_s05 : 'Fix_to_g[s05] = [set x | (col1 x == col4 x) && (col2 x == col3 x)]. Proof. have s05_inv: s05^-1=s05 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s05_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= andbT/col1/col2/col3/col4/col5/col0. by do 2![rewrite eq_sym; case: {+}(_ == _)=> //= ]. Qed. Lemma F_s14 : 'Fix_to_g[s14]= [set x | (col0 x == col5 x) && (col2 x == col3 x)]. Proof. have s14_inv: s14^-1=s14 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s14_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= andbT/col1/col2/col3/col4/col5/col0. by do 2![rewrite eq_sym; case: {+}(_ == _)=> //= ]. Qed. Lemma r05_inv : r05^-1 = r50. Proof. by inv_tac. Qed. Lemma r50_inv : r50^-1 = r05. Proof. by inv_tac. Qed. Lemma r14_inv : r14^-1 = r41. Proof. by inv_tac. Qed. Lemma r41_inv : r41^-1 = r14. Proof. by inv_tac. Qed. Lemma s23_inv : s23^-1 = s23. Proof. by inv_tac. Qed. Lemma F_s23 : 'Fix_to_g[s23] = [set x | (col0 x == col5 x) && (col1 x == col4 x)]. Proof. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s23_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= andbT/col1/col2/col3/col4/col5/col0. by do 2![rewrite eq_sym; case: {+}(_ == _)=> //=]. Qed. Lemma F_r05 : 'Fix_to_g[r05]= [set x | (col1 x == col2 x) && (col2 x == col3 x) && (col3 x == col4 x)]. Proof. apply sym_equal. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r05_inv !ffunE !permE /=. rewrite !eqxx /= !andbT /col1/col2/col3/col4/col5/col0. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r50 : 'Fix_to_g[r50]= [set x | (col1 x == col2 x) && (col2 x == col3 x) && (col3 x == col4 x)]. Proof. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r50_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= !andbT /col1/col2/col3/col4. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r23 : 'Fix_to_g[r23] = [set x | (col0 x == col1 x) && (col1 x == col4 x) && (col4 x == col5 x)]. Proof. have r23_inv: r23^-1 = r32 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r23_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= !andbT /col1/col0/col5/col4. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r32 : 'Fix_to_g[r32] = [set x | (col0 x == col1 x) && (col1 x == col4 x) && (col4 x == col5 x)]. Proof. have r32_inv: r32^-1 = r23 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r32_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= !andbT /col1/col0/col5/col4. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r14 : 'Fix_to_g[r14] = [set x | (col0 x == col2 x) && (col2 x == col3 x) && (col3 x == col5 x)]. Proof. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r14_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= !andbT /col2/col0/col5/col3. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r41 : 'Fix_to_g[r41] = [set x | (col0 x == col2 x) && (col2 x == col3 x) && (col3 x == col5 x)]. Proof. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r41_inv !ffunE !permE /=. apply sym_equal; rewrite !eqxx /= !andbT /col2/col0/col5/col3. by do 3![case: eqVneq; rewrite ?andbF // => <-]. Qed. Lemma F_r024 : 'Fix_to_g[r024] = [set x | (col0 x == col4 x) && (col4 x == col2 x) && (col1 x == col3 x) && (col3 x == col5 x) ]. Proof. have r024_inv: r024^-1 = r042 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r024_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r042 : 'Fix_to_g[r042] = [set x | (col0 x == col4 x) && (col4 x == col2 x) && (col1 x == col3 x) && (col3 x == col5 x)]. Proof. have r042_inv: r042^-1 = r024 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r042_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r012 : 'Fix_to_g[r012] = [set x | (col0 x == col2 x) && (col2 x == col1 x) && (col3 x == col4 x) && (col4 x == col5 x)]. Proof. have r012_inv: r012^-1 = r021 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r012_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r021 : 'Fix_to_g[r021] = [set x | (col0 x == col2 x) && (col2 x == col1 x) && (col3 x == col4 x) && (col4 x == col5 x)]. Proof. have r021_inv: r021^-1 = r012 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r021_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r031 : 'Fix_to_g[r031] = [set x | (col0 x == col3 x) && (col3 x == col1 x) && (col2 x == col4 x) && (col4 x == col5 x)]. Proof. have r031_inv: r031^-1 = r013 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r031_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r013 : 'Fix_to_g[r013] = [set x | (col0 x == col3 x) && (col3 x == col1 x) && (col2 x == col4 x) && (col4 x == col5 x)]. Proof. have r013_inv: r013^-1 = r031 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r013_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r043 : 'Fix_to_g[r043] = [set x | (col0 x == col4 x) && (col4 x == col3 x) && (col1 x == col2 x) && (col2 x == col5 x)]. Proof. have r043_inv: r043^-1 = r034 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r043_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_r034 : 'Fix_to_g[r034] = [set x | (col0 x == col4 x) && (col4 x == col3 x) && (col1 x == col2 x) && (col2 x == col5 x)]. Proof. have r034_inv: r034^-1 = r043 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g r034_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 4![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s1 : 'Fix_to_g[s1] = [set x | (col0 x == col5 x) && (col1 x == col2 x) && (col3 x == col4 x)]. Proof. have s1_inv: s1^-1 = s1 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s1_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s2 : 'Fix_to_g[s2] = [set x | (col0 x == col5 x) && (col1 x == col3 x) && (col2 x == col4 x)]. Proof. have s2_inv: s2^-1 = s2 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s2_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s3 : 'Fix_to_g[s3] = [set x | (col0 x == col1 x) && (col2 x == col3 x) && (col4 x == col5 x)]. Proof. have s3_inv: s3^-1 = s3 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s3_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s4 : 'Fix_to_g[s4] = [set x | (col0 x == col4 x) && (col1 x == col5 x) && (col2 x == col3 x)]. Proof. have s4_inv: s4^-1 = s4 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s4_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s5 : 'Fix_to_g[s5] = [set x | (col0 x == col2 x) && (col1 x == col4 x) && (col3 x == col5 x)]. Proof. have s5_inv: s5^-1 = s5 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s5_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma F_s6 : 'Fix_to_g[s6] = [set x | (col0 x == col3 x) && (col1 x == col4 x) && (col2 x == col5 x)]. Proof. have s6_inv: s6^-1 = s6 by inv_tac. apply/setP => x; rewrite infE !inE eqperm_map2 /= /act_g s6_inv !ffunE !permE /=. apply sym_equal; rewrite ?eqxx /= !andbT /col0/col1/col2/col3/col4/col5. by do 3![case: eqVneq=> E; rewrite ?andbF // ?{}E]. Qed. Lemma uniq4_uniq6 : forall x y z t : cube, uniq [:: x; y; z; t] -> exists u, exists v, uniq [:: x; y; z; t; u; v]. Proof. move=> x y z t Uxt; move: (cardC (mem [:: x; y; z; t])). rewrite card_ord (card_uniq_tuple Uxt) => hcard. have hcard2: #|predC (mem [:: x; y; z; t])| = 2. by apply: (@addnI 4); rewrite /injective hcard. have: #|predC (mem [:: x; y; z; t])| != 0 by rewrite hcard2. case/existsP=> u Hu; exists u. move: (cardC (mem [:: x; y; z; t; u])); rewrite card_ord => hcard5. have: #|[predC [:: x; y; z; t; u]]| !=0. rewrite -lt0n -(ltn_add2l #|[:: x; y; z; t; u]|) hcard5 addn0. by apply: (leq_ltn_trans (card_size [:: x; y; z; t; u])). case/existsP=> v; rewrite inE (mem_cat _ [:: _; _; _; _]). case/norP=> Hv Huv; exists v. rewrite (cat_uniq [:: x; y; z; t]) Uxt andTb. by rewrite -rev_uniq /= negb_or Hu orbF Hv Huv. Qed. Lemma card_n4 : forall x y z t : cube, uniq [:: x; y; z; t] -> #|[set p : col_cubes | (p x == p y) && (p z == p t)]| = (n ^ 4)%N. Proof. move=> x y z t Uxt. rewrite -[n]card_ord . case: (uniq4_uniq6 Uxt) => u; case=> v Uxv. pose ff (p : col_cubes) := (p x, p z, p u , p v). rewrite -(@card_in_image _ _ ff); first last. move=> p1 p2; rewrite !inE. case/andP=> p1y p1t; case/andP=> p2y p2t [px pz] pu pv. have eqp12: all (fun i => p1 i == p2 i) [:: x; y; z; t; u; v]. by rewrite /= -(eqP p1y) -(eqP p1t) -(eqP p2y) -(eqP p2t) px pz pu pv !eqxx. apply/ffunP=> i; apply/eqP; apply: (allP eqp12). by rewrite (subset_cardP _ (subset_predT _)) // (card_uniqP Uxv) card_ord. have ->:forall n, (n ^ 4)%N= (n*n*n*n)%N. by move=> n0; rewrite (expnD n0 2 2) -mulnn mulnA. rewrite -!card_prod; apply: eq_card => [] [[[c d]e ]g] /=; apply/imageP. rewrite (cat_uniq [::x; y; z; t]) in Uxv; case/and3P: Uxv => _ hasxt. rewrite /= !inE andbT. move/negbTE=> nuv . rewrite (cat_uniq [::x; y]) in Uxt; case/and3P: Uxt => _. rewrite /= !andbT orbF; case/norP; rewrite !inE => nxyz nxyt _. move: hasxt; rewrite /= !orbF; case/norP; rewrite !inE orbA. case/norP => nxyu nztu. rewrite orbA; case/norP=> nxyv nztv. exists [ffun i => if pred2 x y i then c else if pred2 z t i then d else if u==i then e else g]. rewrite !inE /= !ffunE //= !eqxx orbT //= !eqxx /= orbT. by rewrite (negbTE nxyz) (negbTE nxyt). rewrite {}/ff !ffunE /= !eqxx /=. rewrite (negbTE nxyz) (negbTE nxyu) (negbTE nztu) (negbTE nxyv) (negbTE nztv). by rewrite nuv. Qed. Lemma card_n3_3 : forall x y z t: cube, uniq [:: x; y; z; t] -> #|[set p : col_cubes | (p x == p y) && (p y == p z)&& (p z == p t)]| = (n ^ 3)%N. Proof. move=> x y z t Uxt; rewrite -[n]card_ord . case: (uniq4_uniq6 Uxt) => u; case=> v Uxv. pose ff (p : col_cubes) := (p x, p u , p v); rewrite -(@card_in_image _ _ ff); first last. move=> p1 p2; rewrite !inE. case/andP; case/andP => p1xy p1yz p1zt. case/andP; case/andP => p2xy p2yz p2zt [px pu] pv. have eqp12: all (fun i => p1 i == p2 i) [:: x; y; z; t; u; v]. by rewrite /= -(eqP p1zt) -(eqP p2zt) -(eqP p1yz) -(eqP p2yz) -(eqP p1xy) -(eqP p2xy) px pu pv !eqxx. apply/ffunP=> i; apply/eqP; apply: (allP eqp12). by rewrite (subset_cardP _ (subset_predT _)) // (card_uniqP Uxv) card_ord. have ->:forall n, (n ^ 3)%N= (n*n*n)%N. by move=> n0; rewrite (expnD n0 2 1) -mulnn expn1. rewrite -!card_prod; apply: eq_card => [] [[c d]e ] /=; apply/imageP. rewrite (cat_uniq [::x; y; z; t]) in Uxv; case/and3P: Uxv => _ hasxt. rewrite /uniq !inE !andbT; move/negbTE=> nuv. exists [ffun i => if (i \in [:: x; y; z; t]) then c else if u == i then d else e]. by rewrite /= !inE !ffunE !inE !eqxx !orbT !eqxx. rewrite {}/ff !ffunE !inE /= !eqxx /=; move: hasxt; rewrite nuv. by do 8![case E: ( _ == _ ); rewrite ?(eqP E)/= ?inE ?eqxx //= ?E {E}]. Qed. Lemma card_n2_3 : forall x y z t u v: cube, uniq [:: x; y; z; t; u; v] -> #|[set p : col_cubes | (p x == p y) && (p y == p z)&& (p t == p u ) && (p u== p v)]| = (n ^ 2)%N. Proof. move=> x y z t u v Uxv; rewrite -[n]card_ord . pose ff (p : col_cubes) := (p x, p t); rewrite -(@card_in_image _ _ ff); first last. move=> p1 p2; rewrite !inE. case/andP; case/andP; case/andP => p1xy p1yz p1tu p1uv. case/andP; case/andP; case/andP => p2xy p2yz p2tu p2uv [px pu]. have eqp12: all (fun i => p1 i == p2 i) [:: x; y; z; t; u; v]. by rewrite /= -(eqP p1yz) -(eqP p2yz) -(eqP p1xy) -(eqP p2xy) -(eqP p1uv) -(eqP p2uv) -(eqP p1tu) -(eqP p2tu) px pu !eqxx. apply/ffunP=> i; apply/eqP; apply: (allP eqp12). by rewrite (subset_cardP _ (subset_predT _)) // (card_uniqP Uxv) card_ord. have ->:forall n, (n ^ 2)%N= (n*n)%N by move=> n0; rewrite -mulnn . rewrite -!card_prod; apply: eq_card => [] [c d]/=; apply/imageP. rewrite (cat_uniq [::x; y; z]) in Uxv; case/and3P: Uxv => Uxt hasxt nuv . move: hasxt; rewrite /= !orbF; case/norP; rewrite !inE => nxyzt. case/norP => nxyzu nxyzv. exists [ffun i => if (i \in [:: x; y; z] ) then c else d]. rewrite !inE /= !ffunE !inE //= !eqxx !orbT !eqxx //=. by rewrite (negbTE nxyzt) (negbTE nxyzu)(negbTE nxyzv) !eqxx. by rewrite {}/ff !ffunE !inE /= !eqxx /= (negbTE nxyzt). Qed. Lemma card_n3s : forall x y z t u v: cube, uniq [:: x; y; z; t; u; v] -> #|[set p : col_cubes | (p x == p y) && (p z == p t)&& (p u == p v )]| = (n ^ 3)%N. Proof. move=> x y z t u v Uxv; rewrite -[n]card_ord . pose ff (p : col_cubes) := (p x, p z, p u). rewrite -(@card_in_image _ _ ff); first last. move=> p1 p2; rewrite !inE. case/andP; case/andP => p1xy p1zt p1uv. case/andP; case/andP => p2xy p2zt p2uv [px pz] pu. have eqp12: all (fun i => p1 i == p2 i) [:: x; y; z; t; u; v]. by rewrite /= -(eqP p1xy) -(eqP p2xy) -(eqP p1zt) -(eqP p2zt) -(eqP p1uv) -(eqP p2uv) px pz pu !eqxx. apply/ffunP=> i; apply/eqP; apply: (allP eqp12). by rewrite (subset_cardP _ (subset_predT _)) // (card_uniqP Uxv) card_ord. have ->:forall n, (n ^ 3)%N= (n*n*n)%N. by move=> n0; rewrite (expnD n0 2 1) -mulnn expn1. rewrite -!card_prod. apply: eq_card => [] [[c d]e ] /=; apply/imageP. rewrite (cat_uniq [::x; y; z; t]) in Uxv; case/and3P: Uxv => Uxt hasxt nuv . rewrite (cat_uniq [::x; y]) in Uxt; case/and3P: Uxt => _. rewrite /= !orbF !andbT; case/norP; rewrite !inE => nxyz nxyt _. move: hasxt; rewrite /= !orbF; case/norP; rewrite !inE orbA. case/norP => nxyu nztu. rewrite orbA; case/norP=> nxyv nztv. exists [ffun i => if (i \in [:: x; y] ) then c else if (i \in [:: z; t] ) then d else e]. rewrite !inE /= !ffunE !inE // !eqxx !orbT !eqxx //=. by rewrite (negbTE nxyz) (negbTE nxyt)(negbTE nxyu) (negbTE nztu) (negbTE nxyv) (negbTE nztv) !eqxx. rewrite {}/ff !ffunE !inE /= !eqxx /=. by rewrite (negbTE nxyz) (negbTE nxyu) (negbTE nztu). Qed. Lemma burnside_app_iso3 : (cube_coloring_number24 * 24 = n ^ 6 + 6 * n ^ 3 + 3 * n ^ 4 + 8 * (n ^ 2) + 6 * n ^ 3)%N. Proof. pose iso_list :=[::id3; s05; s14; s23; r05; r14; r23; r50; r41; r32; r024; r042; r012; r021; r031; r013; r043; r034; s1; s2; s3; s4; s5; s6]. rewrite (burnside_formula iso_list) => [||p]; last first. - by rewrite !inE /= !(eq_sym _ p). - apply: map_uniq (fun p : {perm cube} => (p F0, p F1)) _ _. have bsr:(fun p : {perm cube} => (p F0, p F1)) =1 (fun p => (nth F0 p F0, nth F0 p F1)) \o sop. by move=> x; rewrite /= -2!sop_spec. by rewrite (eq_map bsr) map_comp -(eqP Lcorrect); vm_compute. rewrite !big_cons big_nil {1}card_Fid3 /= F_s05 F_s14 F_s23 F_r05 F_r14 F_r23 F_r50 F_r41 F_r32 F_r024 F_r042 F_r012 F_r021 F_r031 F_r013 F_r043 F_r034 F_s1 F_s2 F_s3 F_s4 F_s5 F_s6. by rewrite !card_n4 // !card_n3_3 // !card_n2_3 // !card_n3s //; ring. Qed. End cube_colouring. End colouring. Corollary burnside_app_iso_3_3col: cube_coloring_number24 3 = 57. Proof. by apply/eqP; rewrite -(@eqn_pmul2r 24) // burnside_app_iso3. Qed. Corollary burnside_app_iso_2_4col: square_coloring_number8 4 = 55. Proof. by apply/eqP; rewrite -(@eqn_pmul2r 8) // burnside_app_iso. Qed. math-comp-mathcomp-1.12.0/mathcomp/solvable/center.v000066400000000000000000000577251375767750300224200ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype bigop finset fingroup morphism perm. From mathcomp Require Import automorphism quotient action gproduct gfunctor. From mathcomp Require Import cyclic. (******************************************************************************) (* Definition of the center of a group and of external central products: *) (* 'Z(G) == the center of the group G, i.e., 'C_G(G). *) (* cprod_by isoZ == the finGroupType for the central product of H and K *) (* with centers identified by the isomorphism gz on 'Z(H); *) (* here isoZ : isom 'Z(H) 'Z(K) gz. Note that the actual *) (* central product is [set: cprod_by isoZ]. *) (* cpairg1 isoZ == the isomorphism from H to cprod_by isoZ, isoZ as above. *) (* cpair1g isoZ == the isomorphism from K to cprod_by isoZ, isoZ as above. *) (* xcprod H K == the finGroupType for the external central product of H *) (* and K with identified centers, provided the dynamically *) (* tested condition 'Z(H) \isog 'Z(K) holds. *) (* ncprod H n == the finGroupType for the central product of n copies of *) (* H with their centers identified; [set: ncprod H 0] is *) (* isomorphic to 'Z(H). *) (* xcprodm cf eqf == the morphism induced on cprod_by isoZ, where as above *) (* isoZ : isom 'Z(H) 'Z(K) gz, by fH : {morphism H >-> rT} *) (* and fK : {morphism K >-> rT}, given both *) (* cf : fH @* H \subset 'C(fK @* K) and *) (* eqf : {in 'Z(H), fH =1 fK \o gz}. *) (* Following Aschbacher, we only provide external central products with *) (* identified centers, as these are well defined provided the local center *) (* isomorphism group of one of the subgroups is full. Nevertheless the *) (* entire construction could be carried out under the weaker assumption that *) (* gz is an isomorphism between subgroups of 'Z(H) and 'Z(K), and even the *) (* uniqueness theorem holds under the weaker assumption that gz map 'Z(H) to *) (* a characteristic subgroup of 'Z(K) not isomorphic to any other subgroup of *) (* 'Z(K), a condition that holds for example when K is cyclic, as in the *) (* structure theorem for p-groups of symplectic type. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Defs. Variable gT : finGroupType. Definition center (A : {set gT}) := 'C_A(A). Canonical center_group (G : {group gT}) : {group gT} := Eval hnf in [group of center G]. End Defs. Arguments center {gT} A%g. Notation "''Z' ( A )" := (center A) : group_scope. Notation "''Z' ( H )" := (center_group H) : Group_scope. Lemma morphim_center : GFunctor.pcontinuous (@center). Proof. by move=> gT rT G D f; apply: morphim_subcent. Qed. Canonical center_igFun := [igFun by fun _ _ => subsetIl _ _ & morphim_center]. Canonical center_gFun := [gFun by morphim_center]. Canonical center_pgFun := [pgFun by morphim_center]. Section Center. Variables gT : finGroupType. Implicit Type rT : finGroupType. Implicit Types (x y : gT) (A B : {set gT}) (G H K D : {group gT}). Lemma subcentP A B x : reflect (x \in A /\ centralises x B) (x \in 'C_A(B)). Proof. rewrite inE. case: (x \in A); last by right; case. by apply: (iffP centP) => [|[]]. Qed. Lemma subcent_sub A B : 'C_A(B) \subset 'N_A(B). Proof. by rewrite setIS ?cent_sub. Qed. Lemma subcent_norm G B : 'N_G(B) \subset 'N('C_G(B)). Proof. by rewrite normsI ?subIset ?normG // orbC cent_norm. Qed. Lemma subcent_normal G B : 'C_G(B) <| 'N_G(B). Proof. by rewrite /normal subcent_sub subcent_norm. Qed. Lemma subcent_char G H K : H \char G -> K \char G -> 'C_H(K) \char G. Proof. case/charP=> sHG chHG /charP[sKG chKG]; apply/charP. split=> [|f injf Gf]; first by rewrite subIset ?sHG. by rewrite injm_subcent ?chHG ?chKG. Qed. Lemma centerP A x : reflect (x \in A /\ centralises x A) (x \in 'Z(A)). Proof. exact: subcentP. Qed. Lemma center_sub A : 'Z(A) \subset A. Proof. exact: subsetIl. Qed. Lemma center1 : 'Z(1) = 1 :> {set gT}. Proof. exact: gF1. Qed. Lemma centerC A : {in A, centralised 'Z(A)}. Proof. by apply/centsP; rewrite centsC subsetIr. Qed. Lemma center_normal G : 'Z(G) <| G. Proof. exact: gFnormal. Qed. Lemma sub_center_normal H G : H \subset 'Z(G) -> H <| G. Proof. by rewrite subsetI centsC /normal => /andP[-> /cents_norm]. Qed. Lemma center_abelian G : abelian 'Z(G). Proof. by rewrite /abelian subIset // centsC subIset // subxx orbT. Qed. Lemma center_char G : 'Z(G) \char G. Proof. exact: gFchar. Qed. Lemma center_idP A : reflect ('Z(A) = A) (abelian A). Proof. exact: setIidPl. Qed. Lemma center_class_formula G : #|G| = #|'Z(G)| + \sum_(xG in [set x ^: G | x in G :\: 'C(G)]) #|xG|. Proof. by rewrite acts_sum_card_orbit ?cardsID // astabsJ normsD ?norms_cent ?normG. Qed. Lemma subcent1P A x y : reflect (y \in A /\ commute x y) (y \in 'C_A[x]). Proof. rewrite inE; case: (y \in A); last by right; case. by apply: (iffP cent1P) => [|[]]. Qed. Lemma subcent1_id x G : x \in G -> x \in 'C_G[x]. Proof. by move=> Gx; rewrite inE Gx; apply/cent1P. Qed. Lemma subcent1_sub x G : 'C_G[x] \subset G. Proof. exact: subsetIl. Qed. Lemma subcent1C x y G : x \in G -> y \in 'C_G[x] -> x \in 'C_G[y]. Proof. by move=> Gx /subcent1P[_ cxy]; apply/subcent1P. Qed. Lemma subcent1_cycle_sub x G : x \in G -> <[x]> \subset 'C_G[x]. Proof. by move=> Gx; rewrite cycle_subG ?subcent1_id. Qed. Lemma subcent1_cycle_norm x G : 'C_G[x] \subset 'N(<[x]>). Proof. by rewrite cents_norm // cent_gen cent_set1 subsetIr. Qed. Lemma subcent1_cycle_normal x G : x \in G -> <[x]> <| 'C_G[x]. Proof. by move=> Gx; rewrite /normal subcent1_cycle_norm subcent1_cycle_sub. Qed. (* Gorenstein. 1.3.4 *) Lemma cyclic_center_factor_abelian G : cyclic (G / 'Z(G)) -> abelian G. Proof. case/cyclicP=> a Ga; case: (cosetP a) => /= z Nz def_a. have G_Zz: G :=: 'Z(G) * <[z]>. rewrite -quotientK ?cycle_subG ?quotient_cycle //=. by rewrite -def_a -Ga quotientGK // center_normal. rewrite G_Zz abelianM cycle_abelian center_abelian centsC /= G_Zz. by rewrite subIset ?centS ?orbT ?mulG_subr. Qed. Lemma cyclic_factor_abelian H G : H \subset 'Z(G) -> cyclic (G / H) -> abelian G. Proof. move=> sHZ cycGH; apply: cyclic_center_factor_abelian. have /andP[_ nHG]: H <| G := sub_center_normal sHZ. have [f <-]:= homgP (homg_quotientS nHG (gFnorm _ G) sHZ). exact: morphim_cyclic cycGH. Qed. Section Injm. Variables (rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Hypothesis injf : 'injm f. Lemma injm_center G : G \subset D -> f @* 'Z(G) = 'Z(f @* G). Proof. exact: injm_subcent. Qed. End Injm. End Center. Arguments center_idP {gT A}. Lemma isog_center (aT rT : finGroupType) (G : {group aT}) (H : {group rT}) : G \isog H -> 'Z(G) \isog 'Z(H). Proof. exact: gFisog. Qed. Section Product. Variable gT : finGroupType. Implicit Types (A B C : {set gT}) (G H K : {group gT}). Lemma center_prod H K : K \subset 'C(H) -> 'Z(H) * 'Z(K) = 'Z(H * K). Proof. move=> cHK; apply/setP=> z; rewrite {3}/center centM !inE. have cKH: H \subset 'C(K) by rewrite centsC. apply/imset2P/and3P=> [[x y /setIP[Hx cHx] /setIP[Ky cKy] ->{z}]| []]. by rewrite imset2_f ?groupM // ?(subsetP cHK) ?(subsetP cKH). case/imset2P=> x y Hx Ky ->{z}. rewrite groupMr => [cHx|]; last exact: subsetP Ky. rewrite groupMl => [cKy|]; last exact: subsetP Hx. by exists x y; rewrite ?inE ?Hx ?Ky. Qed. Lemma center_cprod A B G : A \* B = G -> 'Z(A) \* 'Z(B) = 'Z(G). Proof. case/cprodP => [[H K -> ->] <- cHK]. rewrite cprodE ?center_prod //= subIset ?(subset_trans cHK) //. by rewrite centS ?center_sub. Qed. Lemma center_bigcprod I r P (F : I -> {set gT}) G : \big[cprod/1]_(i <- r | P i) F i = G -> \big[cprod/1]_(i <- r | P i) 'Z(F i) = 'Z(G). Proof. elim/big_ind2: _ G => [_ <-|A B C D IHA IHB G dG|_ _ G ->]; rewrite ?center1 //. case/cprodP: dG IHA IHB (dG) => [[H K -> ->] _ _] IHH IHK dG. by rewrite (IHH H) // (IHK K) // (center_cprod dG). Qed. Lemma cprod_center_id G : G \* 'Z(G) = G. Proof. by rewrite cprodE ?subsetIr // mulGSid ?center_sub. Qed. Lemma center_dprod A B G : A \x B = G -> 'Z(A) \x 'Z(B) = 'Z(G). Proof. case/dprodP=> [[H1 H2 -> ->] defG cH12 trH12]. move: defG; rewrite -cprodE // => /center_cprod/cprodP[_ /= <- cZ12]. by apply: dprodE; rewrite //= setIAC setIA -setIA trH12 (setIidPl _) ?sub1G. Qed. Lemma center_bigdprod I r P (F: I -> {set gT}) G : \big[dprod/1]_(i <- r | P i) F i = G -> \big[dprod/1]_(i <- r | P i) 'Z(F i) = 'Z(G). Proof. elim/big_ind2: _ G => [_ <-|A B C D IHA IHB G dG|_ _ G ->]; rewrite ?center1 //. case/dprodP: dG IHA IHB (dG) => [[H K -> ->] _ _ _] IHH IHK dG. by rewrite (IHH H) // (IHK K) // (center_dprod dG). Qed. Lemma Aut_cprod_full G H K : H \* K = G -> 'Z(H) = 'Z(K) -> Aut_in (Aut H) 'Z(H) \isog Aut 'Z(H) -> Aut_in (Aut K) 'Z(K) \isog Aut 'Z(K) -> Aut_in (Aut G) 'Z(G) \isog Aut 'Z(G). Proof. move=> defG eqZHK; have [_ defHK cHK] := cprodP defG. have defZ: 'Z(G) = 'Z(H) by rewrite -defHK -center_prod // eqZHK mulGid. have ziHK: H :&: K = 'Z(K). by apply/eqP; rewrite eqEsubset subsetI -{1 2}eqZHK !center_sub setIS. have AutZP := Aut_sub_fullP (@center_sub gT _). move/AutZP=> AutZHfull /AutZP AutZKfull; apply/AutZP=> g injg gZ. have [gH [def_gH ker_gH _ im_gH]] := domP g defZ. have [gK [def_gK ker_gK _ im_gK]] := domP g (etrans defZ eqZHK). have [injgH injgK]: 'injm gH /\ 'injm gK by rewrite ker_gH ker_gK. have [gHH gKK]: gH @* 'Z(H) = 'Z(H) /\ gK @* 'Z(K) = 'Z(K). by rewrite im_gH im_gK -eqZHK -defZ. have [|fH [injfH im_fH fHZ]] := AutZHfull gH injgH. by rewrite im_gH /= -defZ. have [|fK [injfK im_fK fKZ]] := AutZKfull gK injgK. by rewrite im_gK /= -eqZHK -defZ. have cfHK: fK @* K \subset 'C(fH @* H) by rewrite im_fH im_fK. have eq_fHK: {in H :&: K, fH =1 fK}. by move=> z; rewrite ziHK => Zz; rewrite fHZ ?fKZ /= ?eqZHK // def_gH def_gK. exists (cprodm_morphism defG cfHK eq_fHK). rewrite injm_cprodm injfH injfK im_cprodm im_fH im_fK defHK. rewrite -morphimIdom ziHK -eqZHK injm_center // im_fH eqxx. split=> //= z; rewrite {1}defZ => Zz; have [Hz _] := setIP Zz. by rewrite cprodmEl // fHZ // def_gH. Qed. End Product. Section CprodBy. Variables gTH gTK : finGroupType. Variables (H : {group gTH}) (K : {group gTK}) (gz : {morphism 'Z(H) >-> gTK}). Definition ker_cprod_by of isom 'Z(H) 'Z(K) gz := [set xy | let: (x, y) := xy in (x \in 'Z(H)) && (y == (gz x)^-1)]. Hypothesis isoZ : isom 'Z(H) 'Z(K) gz. Let kerHK := ker_cprod_by isoZ. Let injgz : 'injm gz. Proof. by case/isomP: isoZ. Qed. Let gzZ : gz @* 'Z(H) = 'Z(K). Proof. by case/isomP: isoZ. Qed. Let gzZchar : gz @* 'Z(H) \char 'Z(K). Proof. by rewrite gzZ. Qed. Let sgzZZ : gz @* 'Z(H) \subset 'Z(K) := char_sub gzZchar. Let sZH := center_sub H. Let sZK := center_sub K. Let sgzZG : gz @* 'Z(H) \subset K := subset_trans sgzZZ sZK. Lemma ker_cprod_by_is_group : group_set kerHK. Proof. apply/group_setP; rewrite inE /= group1 morph1 invg1 /=. split=> // [[x1 y1] [x2 y2]]. rewrite inE /= => /andP[Zx1 /eqP->]; have [_ cGx1] := setIP Zx1. rewrite inE /= => /andP[Zx2 /eqP->]; have [Gx2 _] := setIP Zx2. by rewrite inE /= groupM //= -invMg (centP cGx1) // morphM. Qed. Canonical ker_cprod_by_group := Group ker_cprod_by_is_group. Lemma ker_cprod_by_central : kerHK \subset 'Z(setX H K). Proof. rewrite -(center_dprod (setX_dprod H K)) -morphim_pairg1 -morphim_pair1g. rewrite -!injm_center ?subsetT ?injm_pair1g ?injm_pairg1 //=. rewrite morphim_pairg1 morphim_pair1g setX_dprod. apply/subsetP=> [[x y]]; rewrite inE => /andP[Zx /eqP->]. by rewrite inE /= Zx groupV (subsetP sgzZZ) ?mem_morphim. Qed. Fact cprod_by_key : unit. Proof. by []. Qed. Definition cprod_by_def := subFinGroupType [group of setX H K / kerHK]. Definition cprod_by := locked_with cprod_by_key cprod_by_def. Local Notation C := [set: FinGroup.arg_sort (FinGroup.base cprod_by)]. Definition in_cprod : gTH * gTK -> cprod_by := let: tt as k := cprod_by_key return _ -> locked_with k cprod_by_def in subg _ \o coset kerHK. Lemma in_cprodM : {in setX H K &, {morph in_cprod : u v / u * v}}. Proof. rewrite /in_cprod /cprod_by; case: cprod_by_key => /= u v Gu Gv. have nkerHKG := normal_norm (sub_center_normal ker_cprod_by_central). by rewrite -!morphM ?mem_quotient // (subsetP nkerHKG). Qed. Canonical in_cprod_morphism := Morphism in_cprodM. Lemma ker_in_cprod : 'ker in_cprod = kerHK. Proof. transitivity ('ker (subg [group of setX H K / kerHK] \o coset kerHK)). rewrite /ker /morphpre /= /in_cprod /cprod_by; case: cprod_by_key => /=. by rewrite ['N(_) :&: _]quotientGK ?sub_center_normal ?ker_cprod_by_central. by rewrite ker_comp ker_subg -kerE ker_coset. Qed. Lemma cpairg1_dom : H \subset 'dom (in_cprod \o @pairg1 gTH gTK). Proof. by rewrite -sub_morphim_pre ?subsetT // morphim_pairg1 setXS ?sub1G. Qed. Lemma cpair1g_dom : K \subset 'dom (in_cprod \o @pair1g gTH gTK). Proof. by rewrite -sub_morphim_pre ?subsetT // morphim_pair1g setXS ?sub1G. Qed. Definition cpairg1 := tag (restrmP _ cpairg1_dom). Definition cpair1g := tag (restrmP _ cpair1g_dom). Local Notation CH := (mfun cpairg1 @* gval H). Local Notation CK := (mfun cpair1g @* gval K). Lemma injm_cpairg1 : 'injm cpairg1. Proof. rewrite /cpairg1; case: restrmP => _ [_ -> _ _]. rewrite ker_comp ker_in_cprod; apply/subsetP=> x; rewrite 5!inE /=. by case/and3P=> _ Zx; rewrite inE eq_sym (inv_eq invgK) invg1 morph_injm_eq1. Qed. Let injH := injm_cpairg1. Lemma injm_cpair1g : 'injm cpair1g. Proof. rewrite /cpair1g; case: restrmP => _ [_ -> _ _]. rewrite ker_comp ker_in_cprod; apply/subsetP=> y; rewrite !inE /= morph1 invg1. by case/and3P. Qed. Let injK := injm_cpair1g. Lemma im_cpair_cent : CK \subset 'C(CH). Proof. rewrite /cpairg1 /cpair1g; do 2!case: restrmP => _ [_ _ _ -> //]. rewrite !morphim_comp morphim_cents // morphim_pair1g morphim_pairg1. by case/dprodP: (setX_dprod H K). Qed. Hint Resolve im_cpair_cent : core. Lemma im_cpair : CH * CK = C. Proof. rewrite /cpairg1 /cpair1g; do 2!case: restrmP => _ [_ _ _ -> //]. rewrite !morphim_comp -morphimMl morphim_pairg1 ?setXS ?sub1G //. rewrite morphim_pair1g setX_prod morphimEdom /= /in_cprod /cprod_by. by case: cprod_by_key; rewrite /= imset_comp imset_coset -morphimEdom im_subg. Qed. Lemma im_cpair_cprod : CH \* CK = C. Proof. by rewrite cprodE ?im_cpair. Qed. Lemma eq_cpairZ : {in 'Z(H), cpairg1 =1 cpair1g \o gz}. Proof. rewrite /cpairg1 /cpair1g => z1 Zz1; set z2 := gz z1. have Zz2: z2 \in 'Z(K) by rewrite (subsetP sgzZZ) ?mem_morphim. have [[Gz1 _] [/= Gz2 _]]:= (setIP Zz1, setIP Zz2). do 2![case: restrmP => f /= [df _ _ _]; rewrite {f}df]. apply/rcoset_kerP; rewrite ?inE ?group1 ?andbT //. by rewrite ker_in_cprod mem_rcoset inE /= invg1 mulg1 mul1g Zz1 /=. Qed. Lemma setI_im_cpair : CH :&: CK = 'Z(CH). Proof. apply/eqP; rewrite eqEsubset setIS //=. rewrite subsetI center_sub -injm_center //. rewrite (eq_in_morphim _ eq_cpairZ); first by rewrite morphim_comp morphimS. by rewrite !(setIidPr _) // -sub_morphim_pre. Qed. Lemma cpair1g_center : cpair1g @* 'Z(K) = 'Z(C). Proof. case/cprodP: (center_cprod im_cpair_cprod) => _ <- _. by rewrite injm_center // -setI_im_cpair mulSGid //= setIC setIS 1?centsC. Qed. (* Uses gzZ. *) Lemma cpair_center_id : 'Z(CH) = 'Z(CK). Proof. rewrite -!injm_center // -gzZ -morphim_comp; apply: eq_in_morphim eq_cpairZ. by rewrite !(setIidPr _) // -sub_morphim_pre. Qed. (* Uses gzZ. *) Lemma cpairg1_center : cpairg1 @* 'Z(H) = 'Z(C). Proof. by rewrite -cpair1g_center !injm_center // cpair_center_id. Qed. Section ExtCprodm. Variable rT : finGroupType. Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}). Hypothesis cfHK : fK @* K \subset 'C(fH @* H). Hypothesis eq_fHK : {in 'Z(H), fH =1 fK \o gz}. Let gH := ifactm fH injm_cpairg1. Let gK := ifactm fK injm_cpair1g. Lemma xcprodm_cent : gK @* CK \subset 'C(gH @* CH). Proof. by rewrite !im_ifactm. Qed. Lemma xcprodmI : {in CH :&: CK, gH =1 gK}. Proof. rewrite setI_im_cpair -injm_center // => fHx; case/morphimP=> x Gx Zx ->{fHx}. by rewrite {2}eq_cpairZ //= ?ifactmE ?eq_fHK //= (subsetP sgzZG) ?mem_morphim. Qed. Definition xcprodm := cprodm im_cpair_cprod xcprodm_cent xcprodmI. Canonical xcprod_morphism := [morphism of xcprodm]. Lemma xcprodmEl : {in H, forall x, xcprodm (cpairg1 x) = fH x}. Proof. by move=> x Hx; rewrite /xcprodm cprodmEl ?mem_morphim ?ifactmE. Qed. Lemma xcprodmEr : {in K, forall y, xcprodm (cpair1g y) = fK y}. Proof. by move=> y Ky; rewrite /xcprodm cprodmEr ?mem_morphim ?ifactmE. Qed. Lemma xcprodmE : {in H & K, forall x y, xcprodm (cpairg1 x * cpair1g y) = fH x * fK y}. Proof. by move=> x y Hx Ky; rewrite /xcprodm cprodmE ?mem_morphim ?ifactmE. Qed. Lemma im_xcprodm : xcprodm @* C = fH @* H * fK @* K. Proof. by rewrite -im_cpair morphim_cprodm // !im_ifactm. Qed. Lemma im_xcprodml A : xcprodm @* (cpairg1 @* A) = fH @* A. Proof. rewrite -!(morphimIdom _ A) morphim_cprodml ?morphimS ?subsetIl //. by rewrite morphim_ifactm ?subsetIl. Qed. Lemma im_xcprodmr A : xcprodm @* (cpair1g @* A) = fK @* A. Proof. rewrite -!(morphimIdom _ A) morphim_cprodmr ?morphimS ?subsetIl //. by rewrite morphim_ifactm ?subsetIl. Qed. Lemma injm_xcprodm : 'injm xcprodm = 'injm fH && 'injm fK. Proof. rewrite injm_cprodm !ker_ifactm !subG1 !morphim_injm_eq1 ?subsetIl // -!subG1. apply: andb_id2l => /= injfH; apply: andb_idr => _. rewrite !im_ifactm // -(morphimIdom gH) setI_im_cpair -injm_center //. rewrite morphim_ifactm // eqEsubset subsetI morphimS //=. rewrite {1}injm_center // setIS //=. rewrite (eq_in_morphim _ eq_fHK); first by rewrite morphim_comp morphimS. by rewrite !(setIidPr _) // -sub_morphim_pre. Qed. End ExtCprodm. (* Uses gzZchar. *) Lemma Aut_cprod_by_full : Aut_in (Aut H) 'Z(H) \isog Aut 'Z(H) -> Aut_in (Aut K) 'Z(K) \isog Aut 'Z(K) -> Aut_in (Aut C) 'Z(C) \isog Aut 'Z(C). Proof. move=> AutZinH AutZinK. have Cfull:= Aut_cprod_full im_cpair_cprod cpair_center_id. by rewrite Cfull // -injm_center // injm_Aut_full ?center_sub. Qed. Section Isomorphism. Let gzZ_lone (Y : {group gTK}) : Y \subset 'Z(K) -> gz @* 'Z(H) \isog Y -> gz @* 'Z(H) = Y. Proof. move=> sYZ isoY; apply/eqP. by rewrite eq_sym eqEcard (card_isog isoY) gzZ sYZ /=. Qed. Variables (rT : finGroupType) (GH GK G : {group rT}). Hypotheses (defG : GH \* GK = G) (ziGHK : GH :&: GK = 'Z(GH)). Hypothesis AutZHfull : Aut_in (Aut H) 'Z(H) \isog Aut 'Z(H). Hypotheses (isoGH : GH \isog H) (isoGK : GK \isog K). (* Uses gzZ_lone *) Lemma cprod_by_uniq : exists f : {morphism G >-> cprod_by}, [/\ isom G C f, f @* GH = CH & f @* GK = CK]. Proof. have [_ defGHK cGKH] := cprodP defG. have AutZinH := Aut_sub_fullP sZH AutZHfull. have [fH injfH defGH]:= isogP (isog_symr isoGH). have [fK injfK defGK]:= isogP (isog_symr isoGK). have sfHZfK: fH @* 'Z(H) \subset fK @* K. by rewrite injm_center //= defGH defGK -ziGHK subsetIr. have gzZ_id: gz @* 'Z(H) = invm injfK @* (fH @* 'Z(H)). apply: gzZ_lone => /=. rewrite injm_center // defGH -ziGHK sub_morphim_pre /= ?defGK ?subsetIr //. by rewrite setIC morphpre_invm injm_center // defGK setIS 1?centsC. rewrite -morphim_comp. apply: isog_trans (sub_isog _ _); first by rewrite isog_sym sub_isog. by rewrite -sub_morphim_pre. by rewrite !injm_comp ?injm_invm. have: 'dom (invm injfH \o fK \o gz) = 'Z(H). rewrite /dom /= -(morphpreIdom gz); apply/setIidPl. by rewrite -2?sub_morphim_pre // gzZ_id morphim_invmE morphpreK ?morphimS. case/domP=> gzH [def_gzH ker_gzH _ im_gzH]. have{ker_gzH} injgzH: 'injm gzH by rewrite ker_gzH !injm_comp ?injm_invm. have{AutZinH} [|gH [injgH gH_H def_gH]] := AutZinH _ injgzH. by rewrite im_gzH !morphim_comp /= gzZ_id !morphim_invmE morphpreK ?injmK. have: 'dom (fH \o gH) = H by rewrite /dom /= -{3}gH_H injmK. case/domP=> gfH [def_gfH ker_gfH _ im_gfH]. have{im_gfH} gfH_H: gfH @* H = GH by rewrite im_gfH morphim_comp gH_H. have cgfHfK: fK @* K \subset 'C(gfH @* H) by rewrite gfH_H defGK. have eq_gfHK: {in 'Z(H), gfH =1 fK \o gz}. move=> z Zz; rewrite def_gfH /= def_gH //= def_gzH /= invmK //. have {Zz}: gz z \in gz @* 'Z(H) by rewrite mem_morphim. rewrite gzZ_id morphim_invmE; case/morphpreP=> _. exact: (subsetP (morphimS _ _)). pose f := xcprodm cgfHfK eq_gfHK. have injf: 'injm f by rewrite injm_xcprodm ker_gfH injm_comp. have fCH: f @* CH = GH by rewrite im_xcprodml gfH_H. have fCK: f @* CK = GK by rewrite im_xcprodmr defGK. have fC: f @* C = G by rewrite im_xcprodm gfH_H defGK defGHK. have [f' [_ ker_f' _ im_f']] := domP (invm_morphism injf) fC. exists f'; rewrite -fCH -fCK !{1}im_f' !{1}morphim_invm ?subsetT //. by split=> //; apply/isomP; rewrite ker_f' injm_invm im_f' -fC im_invm. Qed. Lemma isog_cprod_by : G \isog C. Proof. by have [f [isoG _ _]] := cprod_by_uniq; apply: isom_isog isoG. Qed. End Isomorphism. End CprodBy. Section ExtCprod. Import finfun. Variables gTH gTK : finGroupType. Variables (H : {group gTH}) (K : {group gTK}). Let gt_ b := if b then gTK else gTH. Local Notation isob := ('Z(H) \isog 'Z(K)) (only parsing). Let G_ b := if b as b' return {group gt_ b'} then K else H. Lemma xcprod_subproof : {gz : {morphism 'Z(H) >-> gt_ isob} | isom 'Z(H) 'Z(G_ isob) gz}. Proof. case: (pickP [pred f : {ffun _} | misom 'Z(H) 'Z(K) f]) => [f isoZ | no_f]. rewrite (misom_isog isoZ); case/andP: isoZ => fM isoZ. by exists [morphism of morphm fM]. move/pred0P: no_f => not_isoZ; rewrite [isob](congr1 negb not_isoZ). by exists (idm_morphism _); apply/isomP; rewrite injm_idm im_idm. Qed. Definition xcprod := cprod_by (svalP xcprod_subproof). Inductive xcprod_spec : finGroupType -> Prop := XcprodSpec gz isoZ : xcprod_spec (@cprod_by gTH gTK H K gz isoZ). Lemma xcprodP : 'Z(H) \isog 'Z(K) -> xcprod_spec xcprod. Proof. by rewrite /xcprod => isoZ; move: xcprod_subproof; rewrite isoZ. Qed. Lemma isog_xcprod (rT : finGroupType) (GH GK G : {group rT}) : Aut_in (Aut H) 'Z(H) \isog Aut 'Z(H) -> GH \isog H -> GK \isog K -> GH \* GK = G -> 'Z(GH) = 'Z(GK) -> G \isog [set: xcprod]. Proof. move=> AutZinH isoGH isoGK defG eqZGHK; have [_ _ cGHK] := cprodP defG. have [|gz isoZ] := xcprodP. have [[fH injfH <-] [fK injfK <-]] := (isogP isoGH, isogP isoGK). rewrite -!injm_center -?(isog_transl _ (sub_isog _ _)) ?center_sub //=. by rewrite eqZGHK sub_isog ?center_sub. rewrite (isog_cprod_by _ defG) //. by apply/eqP; rewrite eqEsubset setIS // subsetI {2}eqZGHK !center_sub. Qed. End ExtCprod. Section IterCprod. Variables (gT : finGroupType) (G : {group gT}). Fixpoint ncprod_def n : finGroupType := if n is n'.+1 then xcprod G [set: ncprod_def n'] else [finGroupType of subg_of 'Z(G)]. Fact ncprod_key : unit. Proof. by []. Qed. Definition ncprod := locked_with ncprod_key ncprod_def. Local Notation G_ n := [set: gsort (ncprod n)]. Lemma ncprod0 : G_ 0 \isog 'Z(G). Proof. by rewrite [ncprod]unlock isog_sym isog_subg. Qed. Lemma center_ncprod0 : 'Z(G_ 0) = G_ 0. Proof. by apply: center_idP; rewrite (isog_abelian ncprod0) center_abelian. Qed. Lemma center_ncprod n : 'Z(G_ n) \isog 'Z(G). Proof. elim: n => [|n]; first by rewrite center_ncprod0 ncprod0. rewrite [ncprod]unlock=> /isog_symr/xcprodP[gz isoZ] /=. by rewrite -cpairg1_center isog_sym sub_isog ?center_sub ?injm_cpairg1. Qed. Lemma ncprodS n : xcprod_spec G [set: ncprod n] (ncprod n.+1). Proof. by have:= xcprodP (isog_symr (center_ncprod n)); rewrite [ncprod]unlock. Qed. Lemma ncprod1 : G_ 1 \isog G. Proof. case: ncprodS => gz isoZ; rewrite isog_sym /= -im_cpair. rewrite mulGSid /=; first by rewrite sub_isog ?injm_cpairg1. rewrite -{3}center_ncprod0 injm_center ?injm_cpair1g //. by rewrite -cpair_center_id center_sub. Qed. Lemma Aut_ncprod_full n : Aut_in (Aut G) 'Z(G) \isog Aut 'Z(G) -> Aut_in (Aut (G_ n)) 'Z(G_ n) \isog Aut 'Z(G_ n). Proof. move=> AutZinG; elim: n => [|n IHn]. by rewrite center_ncprod0; apply/Aut_sub_fullP=> // g injg gG0; exists g. by case: ncprodS => gz isoZ; apply: Aut_cprod_by_full. Qed. End IterCprod. math-comp-mathcomp-1.12.0/mathcomp/solvable/commutator.v000066400000000000000000000320721375767750300233160ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat fintype. From mathcomp Require Import bigop finset binomial fingroup morphism. From mathcomp Require Import automorphism quotient gfunctor. (******************************************************************************) (* This files contains the proofs of several key properties of commutators, *) (* including the Hall-Witt identity and the Three Subgroup Lemma. *) (* The definition and notation for both pointwise and set wise commutators *) (* ([~x, y, ...] and [~: A, B ,...], respectively) are given in fingroup.v *) (* This file defines the derived group series: *) (* G^`(0) == G *) (* G^`(n.+1) == [~: G^`(n), G^`(n)] *) (* as several classical results involve the (first) derived group G^`(1), *) (* such as the equivalence H <| G /\ G / H abelian <-> G^`(1) \subset H. *) (* The connection between the derived series and solvable groups will only be *) (* established in nilpotent.v, however. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Definition derived_at_rec n (gT : finGroupType) (A : {set gT}) := iter n (fun B => [~: B, B]) A. (* Note: 'nosimpl' MUST be used outside of a section -- the end of section *) (* "cooking" destroys it. *) Definition derived_at := nosimpl derived_at_rec. Arguments derived_at n%N {gT} A%g. Notation "G ^` ( n )" := (derived_at n G) : group_scope. Section DerivedBasics. Variables gT : finGroupType. Implicit Type A : {set gT}. Implicit Types G : {group gT}. Lemma derg0 A : A^`(0) = A. Proof. by []. Qed. Lemma derg1 A : A^`(1) = [~: A, A]. Proof. by []. Qed. Lemma dergSn n A : A^`(n.+1) = [~: A^`(n), A^`(n)]. Proof. by []. Qed. Lemma der_group_set G n : group_set G^`(n). Proof. by case: n => [|n]; apply: groupP. Qed. Canonical derived_at_group G n := Group (der_group_set G n). End DerivedBasics. Notation "G ^` ( n )" := (derived_at_group G n) : Group_scope. Section Basic_commutator_properties. Variable gT : finGroupType. Implicit Types x y z : gT. Lemma conjg_mulR x y : x ^ y = x * [~ x, y]. Proof. by rewrite mulKVg. Qed. Lemma conjg_Rmul x y : x ^ y = [~ y, x^-1] * x. Proof. by rewrite commgEr invgK mulgKV. Qed. Lemma commMgJ x y z : [~ x * y, z] = [~ x, z] ^ y * [~ y, z]. Proof. by rewrite !commgEr conjgM mulgA -conjMg mulgK. Qed. Lemma commgMJ x y z : [~ x, y * z] = [~ x, z] * [~ x, y] ^ z. Proof. by rewrite !commgEl conjgM -mulgA -conjMg mulKVg. Qed. Lemma commMgR x y z : [~ x * y, z] = [~ x, z] * [~ x, z, y] * [~ y, z]. Proof. by rewrite commMgJ conjg_mulR. Qed. Lemma commgMR x y z : [~ x, y * z] = [~ x, z] * [~ x, y] * [~ x, y, z]. Proof. by rewrite commgMJ conjg_mulR mulgA. Qed. Lemma Hall_Witt_identity x y z : [~ x, y^-1, z] ^ y * [~ y, z^-1, x] ^ z * [~ z, x^-1, y] ^ x = 1. Proof. (* gsimpl *) pose a x y z : gT := x * z * y ^ x. suffices{x y z} hw_aux x y z: [~ x, y^-1, z] ^ y = (a x y z)^-1 * (a y z x). by rewrite !hw_aux 2!mulgA !mulgK mulVg. by rewrite commgEr conjMg -conjgM -conjg_Rmul 2!invMg conjgE !mulgA. Qed. (* the following properties are useful for studying p-groups of class 2 *) Section LeftComm. Variables (i : nat) (x y : gT). Hypothesis cxz : commute x [~ x, y]. Lemma commVg : [~ x^-1, y] = [~ x, y]^-1. Proof. apply/eqP; rewrite commgEl eq_sym eq_invg_mul invgK mulgA -cxz. by rewrite -conjg_mulR -conjMg mulgV conj1g. Qed. Lemma commXg : [~ x ^+ i, y] = [~ x, y] ^+ i. Proof. elim: i => [|i' IHi]; first exact: comm1g. by rewrite !expgS commMgJ /conjg commuteX // mulKg IHi. Qed. End LeftComm. Section RightComm. Variables (i : nat) (x y : gT). Hypothesis cyz : commute y [~ x, y]. Let cyz' := commuteV cyz. Lemma commgV : [~ x, y^-1] = [~ x, y]^-1. Proof. by rewrite -invg_comm commVg -(invg_comm x y) ?invgK. Qed. Lemma commgX : [~ x, y ^+ i] = [~ x, y] ^+ i. Proof. by rewrite -invg_comm commXg -(invg_comm x y) ?expgVn ?invgK. Qed. End RightComm. Section LeftRightComm. Variables (i j : nat) (x y : gT). Hypotheses (cxz : commute x [~ x, y]) (cyz : commute y [~ x, y]). Lemma commXXg : [~ x ^+ i, y ^+ j] = [~ x, y] ^+ (i * j). Proof. by rewrite expgM commgX commXg //; apply: commuteX. Qed. Lemma expMg_Rmul : (y * x) ^+ i = y ^+ i * x ^+ i * [~ x, y] ^+ 'C(i, 2). Proof. rewrite -triangular_sum; symmetry. elim: i => [|k IHk] /=; first by rewrite big_geq ?mulg1. rewrite big_nat_recr //= addnC expgD !expgS -{}IHk !mulgA; congr (_ * _). by rewrite -!mulgA commuteX2 // -commgX // [mulg y]lock 3!mulgA -commgC. Qed. End LeftRightComm. End Basic_commutator_properties. (***** Set theoretic commutators *****) Section Commutator_properties. Variable gT : finGroupType. Implicit Type (rT : finGroupType) (A B C : {set gT}) (D G H K : {group gT}). Lemma commG1 A : [~: A, 1] = 1. Proof. by apply/commG1P; rewrite centsC sub1G. Qed. Lemma comm1G A : [~: 1, A] = 1. Proof. by rewrite commGC commG1. Qed. Lemma commg_sub A B : [~: A, B] \subset A <*> B. Proof. by rewrite comm_subG // (joing_subl, joing_subr). Qed. Lemma commg_norml G A : G \subset 'N([~: G, A]). Proof. apply/subsetP=> x Gx; rewrite inE -genJ gen_subG. apply/subsetP=> _ /imsetP[_ /imset2P[y z Gy Az ->] ->]. by rewrite -(mulgK [~ x, z] (_ ^ x)) -commMgJ !(mem_commg, groupMl, groupV). Qed. Lemma commg_normr G A : G \subset 'N([~: A, G]). Proof. by rewrite commGC commg_norml. Qed. Lemma commg_norm G H : G <*> H \subset 'N([~: G, H]). Proof. by rewrite join_subG ?commg_norml ?commg_normr. Qed. Lemma commg_normal G H : [~: G, H] <| G <*> H. Proof. by rewrite /(_ <| _) commg_sub commg_norm. Qed. Lemma normsRl A G B : A \subset G -> A \subset 'N([~: G, B]). Proof. by move=> sAG; apply: subset_trans (commg_norml G B). Qed. Lemma normsRr A G B : A \subset G -> A \subset 'N([~: B, G]). Proof. by move=> sAG; apply: subset_trans (commg_normr G B). Qed. Lemma commg_subr G H : ([~: G, H] \subset H) = (G \subset 'N(H)). Proof. rewrite gen_subG; apply/subsetP/subsetP=> [sRH x Gx | nGH xy]. rewrite inE; apply/subsetP=> _ /imsetP[y Ky ->]. by rewrite conjg_Rmul groupMr // sRH // imset2_f ?groupV. case/imset2P=> x y Gx Hy ->{xy}. by rewrite commgEr groupMr // memJ_norm (groupV, nGH). Qed. Lemma commg_subl G H : ([~: G, H] \subset G) = (H \subset 'N(G)). Proof. by rewrite commGC commg_subr. Qed. Lemma commg_subI A B G H : A \subset 'N_G(H) -> B \subset 'N_H(G) -> [~: A, B] \subset G :&: H. Proof. rewrite !subsetI -(gen_subG _ 'N(G)) -(gen_subG _ 'N(H)). rewrite -commg_subr -commg_subl; case/andP=> sAG sRH; case/andP=> sBH sRG. by rewrite (subset_trans _ sRG) ?(subset_trans _ sRH) ?commgSS ?subset_gen. Qed. Lemma quotient_cents2 A B K : A \subset 'N(K) -> B \subset 'N(K) -> (A / K \subset 'C(B / K)) = ([~: A, B] \subset K). Proof. move=> nKA nKB. by rewrite (sameP commG1P trivgP) /= -quotientR // quotient_sub1 // comm_subG. Qed. Lemma quotient_cents2r A B K : [~: A, B] \subset K -> (A / K) \subset 'C(B / K). Proof. move=> sABK; rewrite -2![_ / _]morphimIdom -!quotientE. by rewrite quotient_cents2 ?subsetIl ?(subset_trans _ sABK) ?commgSS ?subsetIr. Qed. Lemma sub_der1_norm G H : G^`(1) \subset H -> H \subset G -> G \subset 'N(H). Proof. by move=> sG'H sHG; rewrite -commg_subr (subset_trans _ sG'H) ?commgS. Qed. Lemma sub_der1_normal G H : G^`(1) \subset H -> H \subset G -> H <| G. Proof. by move=> sG'H sHG; rewrite /(H <| G) sHG sub_der1_norm. Qed. Lemma sub_der1_abelian G H : G^`(1) \subset H -> abelian (G / H). Proof. by move=> sG'H; apply: quotient_cents2r. Qed. Lemma der1_min G H : G \subset 'N(H) -> abelian (G / H) -> G^`(1) \subset H. Proof. by move=> nHG abGH; rewrite -quotient_cents2. Qed. Lemma der_abelian n G : abelian (G^`(n) / G^`(n.+1)). Proof. by rewrite sub_der1_abelian // der_subS. Qed. Lemma commg_normSl G H K : G \subset 'N(H) -> [~: G, H] \subset 'N([~: K, H]). Proof. by move=> nHG; rewrite normsRr // commg_subr. Qed. Lemma commg_normSr G H K : G \subset 'N(H) -> [~: H, G] \subset 'N([~: H, K]). Proof. by move=> nHG; rewrite !(commGC H) commg_normSl. Qed. Lemma commMGr G H K : [~: G, K] * [~: H, K] \subset [~: G * H , K]. Proof. by rewrite mul_subG ?commSg ?(mulG_subl, mulG_subr). Qed. Lemma commMG G H K : H \subset 'N([~: G, K]) -> [~: G * H , K] = [~: G, K] * [~: H, K]. Proof. move=> nRH; apply/eqP; rewrite eqEsubset commMGr andbT. have nRHK: [~: H, K] \subset 'N([~: G, K]) by rewrite comm_subG ?commg_normr. have defM := norm_joinEr nRHK; rewrite -defM gen_subG /=. apply/subsetP=> _ /imset2P[_ z /imset2P[x y Gx Hy ->] Kz ->]. by rewrite commMgJ {}defM mem_mulg ?memJ_norm ?mem_commg // (subsetP nRH). Qed. Lemma comm3G1P A B C : reflect {in A & B & C, forall h k l, [~ h, k, l] = 1} ([~: A, B, C] :==: 1). Proof. have R_C := sameP trivgP commG1P. rewrite -subG1 R_C gen_subG -{}R_C gen_subG. apply: (iffP subsetP) => [cABC x y z Ax By Cz | cABC xyz]. by apply/set1P; rewrite cABC // !imset2_f. by case/imset2P=> _ z /imset2P[x y Ax By ->] Cz ->; rewrite cABC. Qed. Lemma three_subgroup G H K : [~: G, H, K] :=: 1 -> [~: H, K, G] :=: 1-> [~: K, G, H] :=: 1. Proof. move/eqP/comm3G1P=> cGHK /eqP/comm3G1P cHKG. apply/eqP/comm3G1P=> x y z Kx Gy Hz; symmetry. rewrite -(conj1g y) -(Hall_Witt_identity y^-1 z x) invgK. by rewrite cGHK ?groupV // cHKG ?groupV // !conj1g !mul1g conjgKV. Qed. Lemma der1_joing_cycles (x y : gT) : let XY := <[x]> <*> <[y]> in let xy := [~ x, y] in xy \in 'C(XY) -> XY^`(1) = <[xy]>. Proof. rewrite joing_idl joing_idr /= -sub_cent1 => /norms_gen nRxy. apply/eqP; rewrite eqEsubset cycle_subG mem_commg ?mem_gen ?set21 ?set22 //. rewrite der1_min // quotient_gen -1?gen_subG // quotientU abelian_gen. rewrite /abelian subUset centU !subsetI andbC centsC -andbA -!abelianE. rewrite !quotient_abelian ?(abelianS (subset_gen _) (cycle_abelian _)) //=. by rewrite andbb quotient_cents2r ?genS // /commg_set imset2_set1l imset_set1. Qed. Lemma commgAC G x y z : x \in G -> y \in G -> z \in G -> commute y z -> abelian [~: [set x], G] -> [~ x, y, z] = [~ x, z, y]. Proof. move=> Gx Gy Gz cyz /centsP cRxG; pose cx' u := [~ x^-1, u]. have xR3 u v: [~ x, u, v] = x^-1 * (cx' u * cx' v) * x ^ (u * v). rewrite mulgA -conjg_mulR conjVg [cx' v]commgEl mulgA -invMg. by rewrite -mulgA conjgM -conjMg -!commgEl. suffices RxGcx' u: u \in G -> cx' u \in [~: [set x], G]. by rewrite !xR3 {}cyz; congr (_ * _ * _); rewrite cRxG ?RxGcx'. move=> Gu; suffices/groupMl <-: [~ x, u] ^ x^-1 \in [~: [set x], G]. by rewrite -commMgJ mulgV comm1g group1. by rewrite memJ_norm ?mem_commg ?set11 // groupV (subsetP (commg_normr _ _)). Qed. (* Aschbacher, exercise 3.6 (used in proofs of Aschbacher 24.7 and B & G 1.10 *) Lemma comm_norm_cent_cent H G K : H \subset 'N(G) -> H \subset 'C(K) -> G \subset 'N(K) -> [~: G, H] \subset 'C(K). Proof. move=> nGH /centsP cKH nKG; rewrite commGC gen_subG centsC. apply/centsP=> x Kx _ /imset2P[y z Hy Gz ->]; red. rewrite mulgA -[x * _]cKH ?groupV // -!mulgA; congr (_ * _). rewrite (mulgA x) (conjgC x) (conjgCV z) 3!mulgA; congr (_ * _). by rewrite -2!mulgA (cKH y) // -mem_conjg (normsP nKG). Qed. Lemma charR H K G : H \char G -> K \char G -> [~: H, K] \char G. Proof. case/charP=> sHG chH /charP[sKG chK]; apply/charP. by split=> [|f infj Gf]; [rewrite comm_subG | rewrite morphimR // chH // chK]. Qed. Lemma der_char n G : G^`(n) \char G. Proof. by elim: n => [|n IHn]; rewrite ?char_refl // dergSn charR. Qed. Lemma der_sub n G : G^`(n) \subset G. Proof. by rewrite char_sub ?der_char. Qed. Lemma der_norm n G : G \subset 'N(G^`(n)). Proof. by rewrite char_norm ?der_char. Qed. Lemma der_normal n G : G^`(n) <| G. Proof. by rewrite char_normal ?der_char. Qed. Lemma der_subS n G : G^`(n.+1) \subset G^`(n). Proof. by rewrite comm_subG. Qed. Lemma der_normalS n G : G^`(n.+1) <| G^`(n). Proof. by rewrite sub_der1_normal // der_subS. Qed. Lemma morphim_der rT D (f : {morphism D >-> rT}) n G : G \subset D -> f @* G^`(n) = (f @* G)^`(n). Proof. move=> sGD; elim: n => // n IHn. by rewrite !dergSn -IHn morphimR ?(subset_trans (der_sub n G)). Qed. Lemma dergS n G H : G \subset H -> G^`(n) \subset H^`(n). Proof. by move=> sGH; elim: n => // n IHn; apply: commgSS. Qed. Lemma quotient_der n G H : G \subset 'N(H) -> G^`(n) / H = (G / H)^`(n). Proof. exact: morphim_der. Qed. Lemma derJ G n x : (G :^ x)^`(n) = G^`(n) :^ x. Proof. by elim: n => //= n IHn; rewrite !dergSn IHn -conjsRg. Qed. Lemma derG1P G : reflect (G^`(1) = 1) (abelian G). Proof. exact: commG1P. Qed. End Commutator_properties. Arguments derG1P {gT G}. Lemma der_cont n : GFunctor.continuous (@derived_at n). Proof. by move=> aT rT G f; rewrite morphim_der. Qed. Canonical der_igFun n := [igFun by der_sub^~ n & der_cont n]. Canonical der_gFun n := [gFun by der_cont n]. Canonical der_mgFun n := [mgFun by dergS^~ n]. Lemma isog_der (aT rT : finGroupType) n (G : {group aT}) (H : {group rT}) : G \isog H -> G^`(n) \isog H^`(n). Proof. exact: gFisog. Qed. math-comp-mathcomp-1.12.0/mathcomp/solvable/cyclic.v000066400000000000000000001012371375767750300223720ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype bigop prime finset fingroup morphism. From mathcomp Require Import perm automorphism quotient gproduct ssralg. From mathcomp Require Import finalg zmodp poly. (******************************************************************************) (* Properties of cyclic groups. *) (* Definitions: *) (* Defined in fingroup.v: *) (* <[x]> == the cycle (cyclic group) generated by x. *) (* #[x] == the order of x, i.e., the cardinal of <[x]>. *) (* Defined in prime.v: *) (* totient n == Euler's totient function *) (* Definitions in this file: *) (* cyclic G <=> G is a cyclic group. *) (* metacyclic G <=> G is a metacyclic group (i.e., a cyclic extension of a *) (* cyclic group). *) (* generator G x <=> x is a generator of the (cyclic) group G. *) (* Zpm x == the isomorphism mapping the additive group of integers *) (* mod #[x] to the cyclic group <[x]>. *) (* cyclem x n == the endomorphism y |-> y ^+ n of <[x]>. *) (* Zp_unitm x == the isomorphism mapping the multiplicative group of the *) (* units of the ring of integers mod #[x] to the group of *) (* automorphisms of <[x]> (i.e., Aut <[x]>). *) (* Zp_unitm x maps u to cyclem x u. *) (* eltm dvd_y_x == the smallest morphism (with domain <[x]>) mapping x to *) (* y, given a proof dvd_y_x : #[y] %| #[x]. *) (* expg_invn G k == if coprime #|G| k, the inverse of exponent k in G. *) (* Basic results for these notions, plus the classical result that any finite *) (* group isomorphic to a subgroup of a field is cyclic, hence that Aut G is *) (* cyclic when G is of prime order. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope GRing.Theory. (***********************************************************************) (* Cyclic groups. *) (***********************************************************************) Section Cyclic. Variable gT : finGroupType. Implicit Types (a x y : gT) (A B : {set gT}) (G K H : {group gT}). Definition cyclic A := [exists x, A == <[x]>]. Lemma cyclicP A : reflect (exists x, A = <[x]>) (cyclic A). Proof. exact: exists_eqP. Qed. Lemma cycle_cyclic x : cyclic <[x]>. Proof. by apply/cyclicP; exists x. Qed. Lemma cyclic1 : cyclic [1 gT]. Proof. by rewrite -cycle1 cycle_cyclic. Qed. (***********************************************************************) (* Isomorphism with the additive group *) (***********************************************************************) Section Zpm. Variable a : gT. Definition Zpm (i : 'Z_#[a]) := a ^+ i. Lemma ZpmM : {in Zp #[a] &, {morph Zpm : x y / x * y}}. Proof. rewrite /Zpm; case: (eqVneq a 1) => [-> | nta] i j _ _. by rewrite !expg1n ?mulg1. by rewrite /= {3}Zp_cast ?order_gt1 // expg_mod_order expgD. Qed. Canonical Zpm_morphism := Morphism ZpmM. Lemma im_Zpm : Zpm @* Zp #[a] = <[a]>. Proof. apply/eqP; rewrite eq_sym eqEcard cycle_subG /= andbC morphimEdom. rewrite (leq_trans (leq_imset_card _ _)) ?card_Zp //= /Zp order_gt1. case: eqP => /= [a1 | _]; first by rewrite imset_set1 morph1 a1 set11. by apply/imsetP; exists 1%R; rewrite ?expg1 ?inE. Qed. Lemma injm_Zpm : 'injm Zpm. Proof. apply/injmP/dinjectiveP/card_uniqP. rewrite size_map -cardE card_Zp //= {7}/order -im_Zpm morphimEdom /=. by apply: eq_card => x; apply/imageP/imsetP=> [] [i Zp_i ->]; exists i. Qed. Lemma eq_expg_mod_order m n : (a ^+ m == a ^+ n) = (m == n %[mod #[a]]). Proof. have [->|] := eqVneq a 1; first by rewrite order1 !modn1 !expg1n eqxx. rewrite -order_gt1 => lt1a; have ZpT: Zp #[a] = setT by rewrite /Zp lt1a. have: injective Zpm by move=> i j; apply (injmP injm_Zpm); rewrite /= ZpT inE. move/inj_eq=> eqZ; symmetry; rewrite -(Zp_cast lt1a). by rewrite -[_ == _](eqZ (inZp m) (inZp n)) /Zpm /= Zp_cast ?expg_mod_order. Qed. Lemma Zp_isom : isom (Zp #[a]) <[a]> Zpm. Proof. by apply/isomP; rewrite injm_Zpm im_Zpm. Qed. Lemma Zp_isog : isog (Zp #[a]) <[a]>. Proof. exact: isom_isog Zp_isom. Qed. End Zpm. (***********************************************************************) (* Central and direct product of cycles *) (***********************************************************************) Lemma cyclic_abelian A : cyclic A -> abelian A. Proof. by case/cyclicP=> a ->; apply: cycle_abelian. Qed. Lemma cycleMsub a b : commute a b -> coprime #[a] #[b] -> <[a]> \subset <[a * b]>. Proof. move=> cab co_ab; apply/subsetP=> _ /cycleP[k ->]. apply/cycleP; exists (chinese #[a] #[b] k 0); symmetry. rewrite expgMn // -expg_mod_order chinese_modl // expg_mod_order. by rewrite /chinese addn0 -mulnA mulnCA expgM expg_order expg1n mulg1. Qed. Lemma cycleM a b : commute a b -> coprime #[a] #[b] -> <[a * b]> = <[a]> * <[b]>. Proof. move=> cab co_ab; apply/eqP; rewrite eqEsubset -(cent_joinEl (cents_cycle cab)). rewrite join_subG {3}cab !cycleMsub // 1?coprime_sym //. by rewrite -genM_join cycle_subG mem_gen // imset2_f ?cycle_id. Qed. Lemma cyclicM A B : cyclic A -> cyclic B -> B \subset 'C(A) -> coprime #|A| #|B| -> cyclic (A * B). Proof. move=> /cyclicP[a ->] /cyclicP[b ->]; rewrite cent_cycle cycle_subG => cab coab. by rewrite -cycleM ?cycle_cyclic //; apply/esym/cent1P. Qed. Lemma cyclicY K H : cyclic K -> cyclic H -> H \subset 'C(K) -> coprime #|K| #|H| -> cyclic (K <*> H). Proof. by move=> cycK cycH cKH coKH; rewrite cent_joinEr // cyclicM. Qed. (***********************************************************************) (* Order properties *) (***********************************************************************) Lemma order_dvdn a n : #[a] %| n = (a ^+ n == 1). Proof. by rewrite (eq_expg_mod_order a n 0) mod0n. Qed. Lemma order_inf a n : a ^+ n.+1 == 1 -> #[a] <= n.+1. Proof. by rewrite -order_dvdn; apply: dvdn_leq. Qed. Lemma order_dvdG G a : a \in G -> #[a] %| #|G|. Proof. by move=> Ga; apply: cardSg; rewrite cycle_subG. Qed. Lemma expg_cardG G a : a \in G -> a ^+ #|G| = 1. Proof. by move=> Ga; apply/eqP; rewrite -order_dvdn order_dvdG. Qed. Lemma expg_znat G x k : x \in G -> x ^+ (k%:R : 'Z_(#|G|))%R = x ^+ k. Proof. case: (eqsVneq G 1) => [-> /set1P-> | ntG Gx]; first by rewrite !expg1n. apply/eqP; rewrite val_Zp_nat ?cardG_gt1 // eq_expg_mod_order. by rewrite modn_dvdm ?order_dvdG. Qed. Lemma expg_zneg G x (k : 'Z_(#|G|)) : x \in G -> x ^+ (- k)%R = x ^- k. Proof. move=> Gx; apply/eqP; rewrite eq_sym eq_invg_mul -expgD. by rewrite -(expg_znat _ Gx) natrD natr_Zp natr_negZp subrr. Qed. Lemma nt_gen_prime G x : prime #|G| -> x \in G^# -> G :=: <[x]>. Proof. move=> Gpr /setD1P[]; rewrite -cycle_subG -cycle_eq1 => ntX sXG. apply/eqP; rewrite eqEsubset sXG andbT. by apply: contraR ntX => /(prime_TIg Gpr); rewrite (setIidPr sXG) => ->. Qed. Lemma nt_prime_order p x : prime p -> x ^+ p = 1 -> x != 1 -> #[x] = p. Proof. move=> p_pr xp ntx; apply/prime_nt_dvdP; rewrite ?order_eq1 //. by rewrite order_dvdn xp. Qed. Lemma orderXdvd a n : #[a ^+ n] %| #[a]. Proof. by apply: order_dvdG; apply: mem_cycle. Qed. Lemma orderXgcd a n : #[a ^+ n] = #[a] %/ gcdn #[a] n. Proof. apply/eqP; rewrite eqn_dvd; apply/andP; split. rewrite order_dvdn -expgM -muln_divCA_gcd //. by rewrite expgM expg_order expg1n. have [-> | n_gt0] := posnP n; first by rewrite gcdn0 divnn order_gt0 dvd1n. rewrite -(dvdn_pmul2r n_gt0) divn_mulAC ?dvdn_gcdl // dvdn_lcm. by rewrite order_dvdn mulnC expgM expg_order eqxx dvdn_mulr. Qed. Lemma orderXdiv a n : n %| #[a] -> #[a ^+ n] = #[a] %/ n. Proof. by case/dvdnP=> q defq; rewrite orderXgcd {2}defq gcdnC gcdnMl. Qed. Lemma orderXexp p m n x : #[x] = (p ^ n)%N -> #[x ^+ (p ^ m)] = (p ^ (n - m))%N. Proof. move=> ox; have [n_le_m | m_lt_n] := leqP n m. rewrite -(subnKC n_le_m) subnDA subnn expnD expgM -ox. by rewrite expg_order expg1n order1. rewrite orderXdiv ox ?dvdn_exp2l ?expnB ?(ltnW m_lt_n) //. by have:= order_gt0 x; rewrite ox expn_gt0 orbC -(ltn_predK m_lt_n). Qed. Lemma orderXpfactor p k n x : #[x ^+ (p ^ k)] = n -> prime p -> p %| n -> #[x] = (p ^ k * n)%N. Proof. move=> oxp p_pr dv_p_n. suffices pk_x: p ^ k %| #[x] by rewrite -oxp orderXdiv // mulnC divnK. rewrite pfactor_dvdn // leqNgt; apply: contraL dv_p_n => lt_x_k. rewrite -oxp -p'natE // -(subnKC (ltnW lt_x_k)) expnD expgM. rewrite (pnat_dvd (orderXdvd _ _)) // -p_part // orderXdiv ?dvdn_part //. by rewrite -{1}[#[x]](partnC p) // mulKn // part_pnat. Qed. Lemma orderXprime p n x : #[x ^+ p] = n -> prime p -> p %| n -> #[x] = (p * n)%N. Proof. exact: (@orderXpfactor p 1). Qed. Lemma orderXpnat m n x : #[x ^+ m] = n -> \pi(n).-nat m -> #[x] = (m * n)%N. Proof. move=> oxm n_m; have [m_gt0 _] := andP n_m. suffices m_x: m %| #[x] by rewrite -oxm orderXdiv // mulnC divnK. apply/dvdn_partP=> // p; rewrite mem_primes => /and3P[p_pr _ p_m]. have n_p: p \in \pi(n) by apply: (pnatP _ _ n_m). have p_oxm: p %| #[x ^+ (p ^ logn p m)]. apply: dvdn_trans (orderXdvd _ m`_p^'); rewrite -expgM -p_part ?partnC //. by rewrite oxm; rewrite mem_primes in n_p; case/and3P: n_p. by rewrite (orderXpfactor (erefl _) p_pr p_oxm) p_part // dvdn_mulr. Qed. Lemma orderM a b : commute a b -> coprime #[a] #[b] -> #[a * b] = (#[a] * #[b])%N. Proof. by move=> cab co_ab; rewrite -coprime_cardMg -?cycleM. Qed. Definition expg_invn A k := (egcdn k #|A|).1. Lemma expgK G k : coprime #|G| k -> {in G, cancel (expgn^~ k) (expgn^~ (expg_invn G k))}. Proof. move=> coGk x /order_dvdG Gx; apply/eqP. rewrite -expgM (eq_expg_mod_order _ _ 1) -(modn_dvdm 1 Gx). by rewrite -(chinese_modl coGk 1 0) /chinese mul1n addn0 modn_dvdm. Qed. Lemma cyclic_dprod K H G : K \x H = G -> cyclic K -> cyclic H -> cyclic G = coprime #|K| #|H| . Proof. case/dprodP=> _ defKH cKH tiKH cycK cycH; pose m := lcmn #|K| #|H|. apply/idP/idP=> [/cyclicP[x defG] | coKH]; last by rewrite -defKH cyclicM. rewrite /coprime -dvdn1 -(@dvdn_pmul2l m) ?lcmn_gt0 ?cardG_gt0 //. rewrite muln_lcm_gcd muln1 -TI_cardMg // defKH defG order_dvdn. have /mulsgP[y z Ky Hz ->]: x \in K * H by rewrite defKH defG cycle_id. rewrite -[1]mulg1 expgMn; last exact/commute_sym/(centsP cKH). apply/eqP; congr (_ * _); apply/eqP; rewrite -order_dvdn. exact: dvdn_trans (order_dvdG Ky) (dvdn_lcml _ _). exact: dvdn_trans (order_dvdG Hz) (dvdn_lcmr _ _). Qed. (***********************************************************************) (* Generator *) (***********************************************************************) Definition generator (A : {set gT}) a := A == <[a]>. Lemma generator_cycle a : generator <[a]> a. Proof. exact: eqxx. Qed. Lemma cycle_generator a x : generator <[a]> x -> x \in <[a]>. Proof. by move/(<[a]> =P _)->; apply: cycle_id. Qed. Lemma generator_order a b : generator <[a]> b -> #[a] = #[b]. Proof. by rewrite /order => /(<[a]> =P _)->. Qed. End Cyclic. Arguments cyclic {gT} A%g. Arguments generator {gT} A%g a%g. Arguments expg_invn {gT} A%g k%N. Arguments cyclicP {gT A}. Prenex Implicits cyclic Zpm. (* Euler's theorem *) Theorem Euler_exp_totient a n : coprime a n -> a ^ totient n = 1 %[mod n]. Proof. case: n => [|[|n']] //; [by rewrite !modn1 | set n := n'.+2] => co_a_n. have{co_a_n} Ua: coprime n (inZp a : 'I_n) by rewrite coprime_sym coprime_modl. have: FinRing.unit 'Z_n Ua ^+ totient n == 1. by rewrite -card_units_Zp // -order_dvdn order_dvdG ?inE. by rewrite -2!val_eqE unit_Zp_expg /= -/n modnXm => /eqP. Qed. Section Eltm. Variables (aT rT : finGroupType) (x : aT) (y : rT). Definition eltm of #[y] %| #[x] := fun x_i => y ^+ invm (injm_Zpm x) x_i. Hypothesis dvd_y_x : #[y] %| #[x]. Lemma eltmE i : eltm dvd_y_x (x ^+ i) = y ^+ i. Proof. apply/eqP; rewrite eq_expg_mod_order. have [x_le1 | x_gt1] := leqP #[x] 1. suffices: #[y] %| 1 by rewrite dvdn1 => /eqP->; rewrite !modn1. by rewrite (dvdn_trans dvd_y_x) // dvdn1 order_eq1 -cycle_eq1 trivg_card_le1. rewrite -(expg_znat i (cycle_id x)) invmE /=; last by rewrite /Zp x_gt1 inE. by rewrite val_Zp_nat // modn_dvdm. Qed. Lemma eltm_id : eltm dvd_y_x x = y. Proof. exact: (eltmE 1). Qed. Lemma eltmM : {in <[x]> &, {morph eltm dvd_y_x : x_i x_j / x_i * x_j}}. Proof. move=> _ _ /cycleP[i ->] /cycleP[j ->]. by apply/eqP; rewrite -expgD !eltmE expgD. Qed. Canonical eltm_morphism := Morphism eltmM. Lemma im_eltm : eltm dvd_y_x @* <[x]> = <[y]>. Proof. by rewrite morphim_cycle ?cycle_id //= eltm_id. Qed. Lemma ker_eltm : 'ker (eltm dvd_y_x) = <[x ^+ #[y]]>. Proof. apply/eqP; rewrite eq_sym eqEcard cycle_subG 3!inE mem_cycle /= eltmE. rewrite expg_order eqxx (orderE y) -im_eltm card_morphim setIid -orderE. by rewrite orderXdiv ?dvdn_indexg //= leq_divRL ?indexg_gt0 ?Lagrange ?subsetIl. Qed. Lemma injm_eltm : 'injm (eltm dvd_y_x) = (#[x] %| #[y]). Proof. by rewrite ker_eltm subG1 cycle_eq1 -order_dvdn. Qed. End Eltm. Section CycleSubGroup. Variable gT : finGroupType. (* Gorenstein, 1.3.1 (i) *) Lemma cycle_sub_group (a : gT) m : m %| #[a] -> [set H : {group gT} | H \subset <[a]> & #|H| == m] = [set <[a ^+ (#[a] %/ m)]>%G]. Proof. move=> m_dv_a; have m_gt0: 0 < m by apply: dvdn_gt0 m_dv_a. have oam: #|<[a ^+ (#[a] %/ m)]>| = m. apply/eqP; rewrite [#|_|]orderXgcd -(divnMr m_gt0) muln_gcdl divnK //. by rewrite gcdnC gcdnMr mulKn. apply/eqP; rewrite eqEsubset sub1set inE /= cycleX oam eqxx !andbT. apply/subsetP=> X; rewrite in_set1 inE -val_eqE /= eqEcard oam. case/andP=> sXa /eqP oX; rewrite oX leqnn andbT. apply/subsetP=> x Xx; case/cycleP: (subsetP sXa _ Xx) => k def_x. have: (x ^+ m == 1)%g by rewrite -oX -order_dvdn cardSg // gen_subG sub1set. rewrite {x Xx}def_x -expgM -order_dvdn -[#[a]](Lagrange sXa) -oX mulnC. rewrite dvdn_pmul2r // mulnK // => /dvdnP[i ->]. by rewrite mulnC expgM groupX // cycle_id. Qed. Lemma cycle_subgroup_char a (H : {group gT}) : H \subset <[a]> -> H \char <[a]>. Proof. move=> sHa; apply: lone_subgroup_char => // J sJa isoJH. have dvHa: #|H| %| #[a] by apply: cardSg. have{dvHa} /setP Huniq := esym (cycle_sub_group dvHa). move: (Huniq H) (Huniq J); rewrite !inE /=. by rewrite sHa sJa (card_isog isoJH) eqxx => /eqP<- /eqP<-. Qed. End CycleSubGroup. (***********************************************************************) (* Reflected boolean property and morphic image, injection, bijection *) (***********************************************************************) Section MorphicImage. Variables aT rT : finGroupType. Variables (D : {group aT}) (f : {morphism D >-> rT}) (x : aT). Hypothesis Dx : x \in D. Lemma morph_order : #[f x] %| #[x]. Proof. by rewrite order_dvdn -morphX // expg_order morph1. Qed. Lemma morph_generator A : generator A x -> generator (f @* A) (f x). Proof. by move/(A =P _)->; rewrite /generator morphim_cycle. Qed. End MorphicImage. Section CyclicProps. Variables gT : finGroupType. Implicit Types (aT rT : finGroupType) (G H K : {group gT}). Lemma cyclicS G H : H \subset G -> cyclic G -> cyclic H. Proof. move=> sHG /cyclicP[x defG]; apply/cyclicP. exists (x ^+ (#[x] %/ #|H|)); apply/congr_group/set1P. by rewrite -cycle_sub_group /order -defG ?cardSg // inE sHG eqxx. Qed. Lemma cyclicJ G x : cyclic (G :^ x) = cyclic G. Proof. apply/cyclicP/cyclicP=> [[y /(canRL (conjsgK x))] | [y ->]]. by rewrite -cycleJ; exists (y ^ x^-1). by exists (y ^ x); rewrite cycleJ. Qed. Lemma eq_subG_cyclic G H K : cyclic G -> H \subset G -> K \subset G -> (H :==: K) = (#|H| == #|K|). Proof. case/cyclicP=> x -> sHx sKx; apply/eqP/eqP=> [-> //| eqHK]. have def_GHx := cycle_sub_group (cardSg sHx); set GHx := [set _] in def_GHx. have []: H \in GHx /\ K \in GHx by rewrite -def_GHx !inE sHx sKx eqHK /=. by do 2!move/set1P->. Qed. Lemma cardSg_cyclic G H K : cyclic G -> H \subset G -> K \subset G -> (#|H| %| #|K|) = (H \subset K). Proof. move=> cycG sHG sKG; apply/idP/idP; last exact: cardSg. case/cyclicP: (cyclicS sKG cycG) => x defK; rewrite {K}defK in sKG *. case/dvdnP=> k ox; suffices ->: H :=: <[x ^+ k]> by apply: cycleX. apply/eqP; rewrite (eq_subG_cyclic cycG) ?(subset_trans (cycleX _ _)) //. rewrite -orderE orderXdiv orderE ox ?dvdn_mulr ?mulKn //. by have:= order_gt0 x; rewrite orderE ox; case k. Qed. Lemma sub_cyclic_char G H : cyclic G -> (H \char G) = (H \subset G). Proof. case/cyclicP=> x ->; apply/idP/idP => [/andP[] //|]. exact: cycle_subgroup_char. Qed. Lemma morphim_cyclic rT G H (f : {morphism G >-> rT}) : cyclic H -> cyclic (f @* H). Proof. move=> cycH; wlog sHG: H cycH / H \subset G. by rewrite -morphimIdom; apply; rewrite (cyclicS _ cycH, subsetIl) ?subsetIr. case/cyclicP: cycH sHG => x ->; rewrite gen_subG sub1set => Gx. by apply/cyclicP; exists (f x); rewrite morphim_cycle. Qed. Lemma quotient_cycle x H : x \in 'N(H) -> <[x]> / H = <[coset H x]>. Proof. exact: morphim_cycle. Qed. Lemma quotient_cyclic G H : cyclic G -> cyclic (G / H). Proof. exact: morphim_cyclic. Qed. Lemma quotient_generator x G H : x \in 'N(H) -> generator G x -> generator (G / H) (coset H x). Proof. by move=> Nx; apply: morph_generator. Qed. Lemma prime_cyclic G : prime #|G| -> cyclic G. Proof. case/primeP; rewrite ltnNge -trivg_card_le1. case/trivgPn=> x Gx ntx /(_ _ (order_dvdG Gx)). rewrite order_eq1 (negbTE ntx) => /eqnP oxG; apply/cyclicP. by exists x; apply/eqP; rewrite eq_sym eqEcard -oxG cycle_subG Gx leqnn. Qed. Lemma dvdn_prime_cyclic G p : prime p -> #|G| %| p -> cyclic G. Proof. move=> p_pr pG; case: (eqsVneq G 1) => [-> | ntG]; first exact: cyclic1. by rewrite prime_cyclic // (prime_nt_dvdP p_pr _ pG) -?trivg_card1. Qed. Lemma cyclic_small G : #|G| <= 3 -> cyclic G. Proof. rewrite 4!(ltnS, leq_eqVlt) -trivg_card_le1 orbA orbC. case/predU1P=> [-> | oG]; first exact: cyclic1. by apply: prime_cyclic; case/pred2P: oG => ->. Qed. End CyclicProps. Section IsoCyclic. Variables gT rT : finGroupType. Implicit Types (G H : {group gT}) (M : {group rT}). Lemma injm_cyclic G H (f : {morphism G >-> rT}) : 'injm f -> H \subset G -> cyclic (f @* H) = cyclic H. Proof. move=> injf sHG; apply/idP/idP; last exact: morphim_cyclic. by rewrite -{2}(morphim_invm injf sHG); apply: morphim_cyclic. Qed. Lemma isog_cyclic G M : G \isog M -> cyclic G = cyclic M. Proof. by case/isogP=> f injf <-; rewrite injm_cyclic. Qed. Lemma isog_cyclic_card G M : cyclic G -> isog G M = cyclic M && (#|M| == #|G|). Proof. move=> cycG; apply/idP/idP=> [isoGM | ]. by rewrite (card_isog isoGM) -(isog_cyclic isoGM) cycG /=. case/cyclicP: cycG => x ->{G} /andP[/cyclicP[y ->] /eqP oy]. by apply: isog_trans (isog_symr _) (Zp_isog y); rewrite /order oy Zp_isog. Qed. Lemma injm_generator G H (f : {morphism G >-> rT}) x : 'injm f -> x \in G -> H \subset G -> generator (f @* H) (f x) = generator H x. Proof. move=> injf Gx sHG; apply/idP/idP; last exact: morph_generator. rewrite -{2}(morphim_invm injf sHG) -{2}(invmE injf Gx). by apply: morph_generator; apply: mem_morphim. Qed. End IsoCyclic. (* Metacyclic groups. *) Section Metacyclic. Variable gT : finGroupType. Implicit Types (A : {set gT}) (G H : {group gT}). Definition metacyclic A := [exists H : {group gT}, [&& cyclic H, H <| A & cyclic (A / H)]]. Lemma metacyclicP A : reflect (exists H : {group gT}, [/\ cyclic H, H <| A & cyclic (A / H)]) (metacyclic A). Proof. exact: 'exists_and3P. Qed. Lemma metacyclic1 : metacyclic 1. Proof. by apply/existsP; exists 1%G; rewrite normal1 trivg_quotient !cyclic1. Qed. Lemma cyclic_metacyclic A : cyclic A -> metacyclic A. Proof. case/cyclicP=> x ->; apply/existsP; exists (<[x]>)%G. by rewrite normal_refl cycle_cyclic trivg_quotient cyclic1. Qed. Lemma metacyclicS G H : H \subset G -> metacyclic G -> metacyclic H. Proof. move=> sHG /metacyclicP[K [cycK nsKG cycGq]]; apply/metacyclicP. exists (H :&: K)%G; rewrite (cyclicS (subsetIr H K)) ?(normalGI sHG) //=. rewrite setIC (isog_cyclic (second_isog _)) ?(cyclicS _ cycGq) ?quotientS //. by rewrite (subset_trans sHG) ?normal_norm. Qed. End Metacyclic. Arguments metacyclic {gT} A%g. Arguments metacyclicP {gT A}. (* Automorphisms of cyclic groups. *) Section CyclicAutomorphism. Variable gT : finGroupType. Section CycleAutomorphism. Variable a : gT. Section CycleMorphism. Variable n : nat. Definition cyclem of gT := fun x : gT => x ^+ n. Lemma cyclemM : {in <[a]> & , {morph cyclem a : x y / x * y}}. Proof. by move=> x y ax ay; apply: expgMn; apply: (centsP (cycle_abelian a)). Qed. Canonical cyclem_morphism := Morphism cyclemM. End CycleMorphism. Section ZpUnitMorphism. Variable u : {unit 'Z_#[a]}. Lemma injm_cyclem : 'injm (cyclem (val u) a). Proof. apply/subsetP=> x /setIdP[ax]; rewrite !inE -order_dvdn. have [a1 | nta] := eqVneq a 1; first by rewrite a1 cycle1 inE in ax. rewrite -order_eq1 -dvdn1; move/eqnP: (valP u) => /= <-. by rewrite dvdn_gcd {2}Zp_cast ?order_gt1 // order_dvdG. Qed. Lemma im_cyclem : cyclem (val u) a @* <[a]> = <[a]>. Proof. apply/morphim_fixP=> //; first exact: injm_cyclem. by rewrite morphim_cycle ?cycle_id ?cycleX. Qed. Definition Zp_unitm := aut injm_cyclem im_cyclem. End ZpUnitMorphism. Lemma Zp_unitmM : {in units_Zp #[a] &, {morph Zp_unitm : u v / u * v}}. Proof. move=> u v _ _; apply: (eq_Aut (Aut_aut _ _)) => [|x a_x]. by rewrite groupM ?Aut_aut. rewrite permM !autE ?groupX //= /cyclem -expgM. rewrite -expg_mod_order modn_dvdm ?expg_mod_order //. case: (leqP #[a] 1) => [lea1 | lt1a]; last by rewrite Zp_cast ?order_dvdG. by rewrite card_le1_trivg // in a_x; rewrite (set1P a_x) order1 dvd1n. Qed. Canonical Zp_unit_morphism := Morphism Zp_unitmM. Lemma injm_Zp_unitm : 'injm Zp_unitm. Proof. have [a1 | nta] := eqVneq a 1. by rewrite subIset //= card_le1_trivg ?subxx // card_units_Zp a1 order1. apply/subsetP=> /= u /morphpreP[_ /set1P/= um1]. have{um1}: Zp_unitm u a == Zp_unitm 1 a by rewrite um1 morph1. rewrite !autE ?cycle_id // eq_expg_mod_order. by rewrite -[n in _ == _ %[mod n]]Zp_cast ?order_gt1 // !modZp inE. Qed. Lemma generator_coprime m : generator <[a]> (a ^+ m) = coprime #[a] m. Proof. rewrite /generator eq_sym eqEcard cycleX -/#[a] [#|_|]orderXgcd /=. apply/idP/idP=> [le_a_am|co_am]; last by rewrite (eqnP co_am) divn1. have am_gt0: 0 < gcdn #[a] m by rewrite gcdn_gt0 order_gt0. by rewrite /coprime eqn_leq am_gt0 andbT -(@leq_pmul2l #[a]) ?muln1 -?leq_divRL. Qed. Lemma im_Zp_unitm : Zp_unitm @* units_Zp #[a] = Aut <[a]>. Proof. rewrite morphimEdom; apply/setP=> f; pose n := invm (injm_Zpm a) (f a). apply/imsetP/idP=> [[u _ ->] | Af]; first exact: Aut_aut. have [a1 | nta] := eqVneq a 1. by rewrite a1 cycle1 Aut1 in Af; exists 1; rewrite // morph1 (set1P Af). have a_fa: <[a]> = <[f a]>. by rewrite -(autmE Af) -morphim_cycle ?im_autm ?cycle_id. have def_n: a ^+ n = f a. by rewrite -/(Zpm n) invmK // im_Zpm a_fa cycle_id. have co_a_n: coprime #[a].-2.+2 n. by rewrite {1}Zp_cast ?order_gt1 // -generator_coprime def_n; apply/eqP. exists (FinRing.unit 'Z_#[a] co_a_n); rewrite ?inE //. apply: eq_Aut (Af) (Aut_aut _ _) _ => x ax. rewrite autE //= /cyclem; case/cycleP: ax => k ->{x}. by rewrite -(autmE Af) morphX ?cycle_id //= autmE -def_n -!expgM mulnC. Qed. Lemma Zp_unit_isom : isom (units_Zp #[a]) (Aut <[a]>) Zp_unitm. Proof. by apply/isomP; rewrite ?injm_Zp_unitm ?im_Zp_unitm. Qed. Lemma Zp_unit_isog : isog (units_Zp #[a]) (Aut <[a]>). Proof. exact: isom_isog Zp_unit_isom. Qed. Lemma card_Aut_cycle : #|Aut <[a]>| = totient #[a]. Proof. by rewrite -(card_isog Zp_unit_isog) card_units_Zp. Qed. Lemma totient_gen : totient #[a] = #|[set x | generator <[a]> x]|. Proof. have [lea1 | lt1a] := leqP #[a] 1. rewrite /order card_le1_trivg // cards1 (@eq_card1 _ 1) // => x. by rewrite !inE -cycle_eq1 eq_sym. rewrite -(card_injm (injm_invm (injm_Zpm a))) /= ?im_Zpm; last first. by apply/subsetP=> x; rewrite inE; apply: cycle_generator. rewrite -card_units_Zp // cardsE card_sub morphim_invmE; apply: eq_card => /= d. by rewrite !inE /= qualifE /= /Zp lt1a inE /= generator_coprime {1}Zp_cast. Qed. Lemma Aut_cycle_abelian : abelian (Aut <[a]>). Proof. by rewrite -im_Zp_unitm morphim_abelian ?units_Zp_abelian. Qed. End CycleAutomorphism. Variable G : {group gT}. Lemma Aut_cyclic_abelian : cyclic G -> abelian (Aut G). Proof. by case/cyclicP=> x ->; apply: Aut_cycle_abelian. Qed. Lemma card_Aut_cyclic : cyclic G -> #|Aut G| = totient #|G|. Proof. by case/cyclicP=> x ->; apply: card_Aut_cycle. Qed. Lemma sum_ncycle_totient : \sum_(d < #|G|.+1) #|[set <[x]> | x in G & #[x] == d]| * totient d = #|G|. Proof. pose h (x : gT) : 'I_#|G|.+1 := inord #[x]. symmetry; rewrite -{1}sum1_card (partition_big h xpredT) //=. apply: eq_bigr => d _; set Gd := finset _. rewrite -sum_nat_const sum1dep_card -sum1_card (_ : finset _ = Gd); last first. apply/setP=> x; rewrite !inE; apply: andb_id2l => Gx. by rewrite /eq_op /= inordK // ltnS subset_leq_card ?cycle_subG. rewrite (partition_big_imset cycle) {}/Gd; apply: eq_bigr => C /=. case/imsetP=> x /setIdP[Gx /eqP <-] -> {C d}. rewrite sum1dep_card totient_gen; apply: eq_card => y; rewrite !inE /generator. move: Gx; rewrite andbC eq_sym -!cycle_subG /order. by case: eqP => // -> ->; rewrite eqxx. Qed. End CyclicAutomorphism. Lemma sum_totient_dvd n : \sum_(d < n.+1 | d %| n) totient d = n. Proof. case: n => [|[|n']]; try by rewrite big_mkcond !big_ord_recl big_ord0. set n := n'.+2; pose x1 : 'Z_n := 1%R. have ox1: #[x1] = n by rewrite /order -Zp_cycle card_Zp. rewrite -[rhs in _ = rhs]ox1 -[#[_]]sum_ncycle_totient [#|_|]ox1 big_mkcond /=. apply: eq_bigr => d _; rewrite -{2}ox1; case: ifP => [|ndv_dG]; last first. rewrite eq_card0 // => C; apply/imsetP=> [[x /setIdP[Gx oxd] _{C}]]. by rewrite -(eqP oxd) order_dvdG in ndv_dG. move/cycle_sub_group; set Gd := [set _] => def_Gd. rewrite (_ : _ @: _ = @gval _ @: Gd); first by rewrite imset_set1 cards1 mul1n. apply/setP=> C; apply/idP/imsetP=> [| [gC GdC ->{C}]]. case/imsetP=> x /setIdP[_ oxd] ->; exists <[x]>%G => //. by rewrite -def_Gd inE -Zp_cycle subsetT. have:= GdC; rewrite -def_Gd => /setIdP[_ /eqP <-]. by rewrite (set1P GdC) /= imset_f // inE eqxx (mem_cycle x1). Qed. Section FieldMulCyclic. (***********************************************************************) (* A classic application to finite multiplicative subgroups of fields. *) (***********************************************************************) Import GRing.Theory. Variables (gT : finGroupType) (G : {group gT}). Lemma order_inj_cyclic : {in G &, forall x y, #[x] = #[y] -> <[x]> = <[y]>} -> cyclic G. Proof. move=> ucG; apply: negbNE (contra _ (negbT (ltnn #|G|))) => ncG. rewrite -{2}[#|G|]sum_totient_dvd big_mkcond (bigD1 ord_max) ?dvdnn //=. rewrite -{1}[#|G|]sum_ncycle_totient (bigD1 ord_max) //= -addSn leq_add //. rewrite eq_card0 ?totient_gt0 ?cardG_gt0 // => C. apply/imsetP=> [[x /setIdP[Gx /eqP oxG]]]; case/cyclicP: ncG. by exists x; apply/eqP; rewrite eq_sym eqEcard cycle_subG Gx -oxG /=. elim/big_ind2: _ => // [m1 n1 m2 n2 | d _]; first exact: leq_add. set Gd := _ @: _; case: (set_0Vmem Gd) => [-> | [C]]; first by rewrite cards0. rewrite {}/Gd => /imsetP[x /setIdP[Gx /eqP <-] _ {C d}]. rewrite order_dvdG // (@eq_card1 _ <[x]>) ?mul1n // => C. apply/idP/eqP=> [|-> {C}]; last by rewrite imset_f // inE Gx eqxx. by case/imsetP=> y /setIdP[Gy /eqP/ucG->]. Qed. Lemma div_ring_mul_group_cyclic (R : unitRingType) (f : gT -> R) : f 1 = 1%R -> {in G &, {morph f : u v / u * v >-> (u * v)%R}} -> {in G^#, forall x, f x - 1 \in GRing.unit}%R -> abelian G -> cyclic G. Proof. move=> f1 fM f1P abelG. have fX n: {in G, {morph f : u / u ^+ n >-> (u ^+ n)%R}}. by case: n => // n x Gx; elim: n => //= n IHn; rewrite expgS fM ?groupX ?IHn. have fU x: x \in G -> f x \in GRing.unit. by move=> Gx; apply/unitrP; exists (f x^-1); rewrite -!fM ?groupV ?gsimp. apply: order_inj_cyclic => x y Gx Gy; set n := #[x] => yn. apply/eqP; rewrite eq_sym eqEcard -[#|_|]/n yn leqnn andbT cycle_subG /=. suff{y Gy yn} ->: <[x]> = G :&: [set z | #[z] %| n] by rewrite !inE Gy yn /=. apply/eqP; rewrite eqEcard subsetI cycle_subG {}Gx /= cardE; set rs := enum _. apply/andP; split; first by apply/subsetP=> y xy; rewrite inE order_dvdG. pose P : {poly R} := ('X^n - 1)%R; have n_gt0: n > 0 by apply: order_gt0. have szP: size P = n.+1 by rewrite size_addl size_polyXn ?size_opp ?size_poly1. rewrite -ltnS -szP -(size_map f) max_ring_poly_roots -?size_poly_eq0 ?{}szP //. apply/allP=> fy /mapP[y]; rewrite mem_enum !inE order_dvdn => /andP[Gy]. move/eqP=> yn1 ->{fy}; apply/eqP. by rewrite !(hornerE, hornerXn) -fX // yn1 f1 subrr. have: uniq rs by apply: enum_uniq. have: all (mem G) rs by apply/allP=> y; rewrite mem_enum; case/setIP. elim: rs => //= y rs IHrs /andP[Gy Grs] /andP[y_rs]; rewrite andbC. move/IHrs=> -> {IHrs}//; apply/allP=> _ /mapP[z rs_z ->]. have{Grs} Gz := allP Grs z rs_z; rewrite /diff_roots -!fM // (centsP abelG) //. rewrite eqxx -[f y]mul1r -(mulgKV y z) fM ?groupM ?groupV //=. rewrite -mulNr -mulrDl unitrMl ?fU ?f1P // !inE. by rewrite groupM ?groupV // andbT -eq_mulgV1; apply: contra y_rs; move/eqP <-. Qed. Lemma field_mul_group_cyclic (F : fieldType) (f : gT -> F) : {in G &, {morph f : u v / u * v >-> (u * v)%R}} -> {in G, forall x, f x = 1%R <-> x = 1} -> cyclic G. Proof. move=> fM f1P; have f1 : f 1 = 1%R by apply/f1P. apply: (div_ring_mul_group_cyclic f1 fM) => [x|]. case/setD1P=> x1 Gx; rewrite unitfE; apply: contra x1. by rewrite subr_eq0 => /eqP/f1P->. apply/centsP=> x Gx y Gy; apply/commgP/eqP. apply/f1P; rewrite ?fM ?groupM ?groupV //. by rewrite mulrCA -!fM ?groupM ?groupV // mulKg mulVg. Qed. End FieldMulCyclic. Lemma field_unit_group_cyclic (F : finFieldType) (G : {group {unit F}}) : cyclic G. Proof. apply: field_mul_group_cyclic FinRing.uval _ _ => // u _. by split=> /eqP ?; apply/eqP. Qed. Section PrimitiveRoots. Open Scope ring_scope. Import GRing.Theory. Lemma has_prim_root (F : fieldType) (n : nat) (rs : seq F) : n > 0 -> all n.-unity_root rs -> uniq rs -> size rs >= n -> has n.-primitive_root rs. Proof. move=> n_gt0 rsn1 Urs; rewrite leq_eqVlt ltnNge max_unity_roots // orbF eq_sym. move/eqP=> sz_rs; pose r := val (_ : seq_sub rs). have rn1 x: r x ^+ n = 1. by apply/eqP; rewrite -unity_rootE (allP rsn1) ?(valP x). have prim_r z: z ^+ n = 1 -> z \in rs. by move/eqP; rewrite -unity_rootE -(mem_unity_roots n_gt0). pose r' := SeqSub (prim_r _ _); pose sG_1 := r' _ (expr1n _ _). have sG_VP: r _ ^+ n.-1 ^+ n = 1. by move=> x; rewrite -exprM mulnC exprM rn1 expr1n. have sG_MP: (r _ * r _) ^+ n = 1 by move=> x y; rewrite exprMn !rn1 mul1r. pose sG_V := r' _ (sG_VP _); pose sG_M := r' _ (sG_MP _ _). have sG_Ag: associative sG_M by move=> x y z; apply: val_inj; rewrite /= mulrA. have sG_1g: left_id sG_1 sG_M by move=> x; apply: val_inj; rewrite /= mul1r. have sG_Vg: left_inverse sG_1 sG_V sG_M. by move=> x; apply: val_inj; rewrite /= -exprSr prednK ?rn1. pose sgT := BaseFinGroupType _ (FinGroup.Mixin sG_Ag sG_1g sG_Vg). pose gT := @FinGroupType sgT sG_Vg. have /cyclicP[x gen_x]: @cyclic gT setT. apply: (@field_mul_group_cyclic gT [set: _] F r) => // x _. by split=> [ri1 | ->]; first apply: val_inj. apply/hasP; exists (r x); first exact: (valP x). have [m prim_x dvdmn] := prim_order_exists n_gt0 (rn1 x). rewrite -((m =P n) _) // eqn_dvd {}dvdmn -sz_rs -(card_seq_sub Urs) -cardsT. rewrite gen_x (@order_dvdn gT) /(_ == _) /= -{prim_x}(prim_expr_order prim_x). by apply/eqP; elim: m => //= m IHm; rewrite exprS expgS /= -IHm. Qed. End PrimitiveRoots. (***********************************************************************) (* Cycles of prime order *) (***********************************************************************) Section AutPrime. Variable gT : finGroupType. Lemma Aut_prime_cycle_cyclic (a : gT) : prime #[a] -> cyclic (Aut <[a]>). Proof. move=> pr_a; have inj_um := injm_Zp_unitm a; have eq_a := Fp_Zcast pr_a. pose fm := cast_ord (esym eq_a) \o val \o invm inj_um. apply: (@field_mul_group_cyclic _ _ _ fm) => [f g Af Ag | f Af] /=. by apply: val_inj; rewrite /= morphM ?im_Zp_unitm //= eq_a. split=> [/= fm1 |->]; last by apply: val_inj; rewrite /= morph1. apply: (injm1 (injm_invm inj_um)); first by rewrite /= im_Zp_unitm. by do 2!apply: val_inj; move/(congr1 val): fm1. Qed. Lemma Aut_prime_cyclic (G : {group gT}) : prime #|G| -> cyclic (Aut G). Proof. move=> pr_G; case/cyclicP: (prime_cyclic pr_G) (pr_G) => x ->. exact: Aut_prime_cycle_cyclic. Qed. End AutPrime. math-comp-mathcomp-1.12.0/mathcomp/solvable/extraspecial.v000066400000000000000000001217141375767750300236120ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype bigop finset prime binomial. From mathcomp Require Import fingroup morphism perm automorphism presentation. From mathcomp Require Import quotient action commutator gproduct gfunctor. From mathcomp Require Import ssralg finalg zmodp cyclic pgroup center gseries. From mathcomp Require Import nilpotent sylow abelian finmodule matrix maximal. From mathcomp Require Import extremal. (******************************************************************************) (* This file contains the fine structure thorems for extraspecial p-groups. *) (* Together with the material in the maximal and extremal libraries, it *) (* completes the coverage of Aschbacher, section 23. *) (* We define canonical representatives for the group classes that cover the *) (* extremal p-groups (non-abelian p-groups with a cyclic maximal subgroup): *) (* 'Mod_m == the modular group of order m, for m = p ^ n, p prime and n >= 3. *) (* 'D_m == the dihedral group of order m, for m = 2n >= 4. *) (* 'Q_m == the generalized quaternion group of order m, for q = 2 ^ n >= 8. *) (* 'SD_m == the semi-dihedral group of order m, for m = 2 ^ n >= 16. *) (* In each case the notation is defined in the %type, %g and %G scopes, where *) (* it denotes a finGroupType, a full gset and the full group for that type. *) (* However each notation is only meaningful under the given conditions, in *) (* We construct and study the following extraspecial groups: *) (* p^{1+2} == if p is prime, an extraspecial group of order p^3 that has *) (* exponent p or 4, and p-rank 2: thus p^{1+2} is isomorphic to *) (* 'D_8 if p - 2, and NOT isomorphic to 'Mod_(p^3) if p is odd. *) (* p^{1+2*n} == the central product of n copies of p^{1+2}, thus of order *) (* p^(1+2*n) if p is a prime, and, when n > 0, a representative *) (* of the (unique) isomorphism class of extraspecial groups of *) (* order p^(1+2*n), of exponent p or 4, and p-rank n+1. *) (* 'D^n == an alternative (and preferred) notation for 2^{1+2*n}, which *) (* is isomorphic to the central product of n copies od 'D_8. *) (* 'D^n*Q == the central product of 'D^n with 'Q_8, thus isomorphic to *) (* all extraspecial groups of order 2 ^ (2 * n + 3) that are *) (* not isomorphic to 'D^n.+1 (or, equivalently, have 2-rank n). *) (* As in extremal.v, these notations are simultaneously defined in the %type, *) (* %g and %G scopes -- depending on the syntactic context, they denote either *) (* a finGroupType, the set, or the group of all its elements. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GroupScope GRing.Theory. Reserved Notation "p ^{1+2}" (at level 2, format "p ^{1+2}"). Reserved Notation "p ^{1+2* n }" (at level 2, n at level 2, format "p ^{1+2* n }"). Reserved Notation "''D^' n" (at level 8, n at level 2, format "''D^' n"). Reserved Notation "''D^' n * 'Q'" (at level 8, n at level 2, format "''D^' n * 'Q'"). Module Pextraspecial. Section Construction. Variable p : nat. Definition act ij (k : 'Z_p) := let: (i, j) := ij in (i + k * j, j). Lemma actP : is_action [set: 'Z_p] act. Proof. apply: is_total_action=> [] [i j] => [|k1 k2] /=; first by rewrite mul0r addr0. by rewrite mulrDl addrA. Qed. Canonical action := Action actP. Lemma gactP : is_groupAction [set: 'Z_p * 'Z_p] action. Proof. move=> k _ /=; rewrite inE. apply/andP; split; first by apply/subsetP=> ij _; rewrite inE. apply/morphicP=> /= [[i1 j1] [i2 j2] _ _]. by rewrite !permE /= mulrDr -addrA (addrCA i2) (addrA i1). Qed. Definition groupAction := GroupAction gactP. Fact gtype_key : unit. Proof. by []. Qed. Definition gtype := locked_with gtype_key (sdprod_groupType groupAction). Definition ngtype := ncprod [set: gtype]. End Construction. Definition ngtypeQ n := xcprod [set: ngtype 2 n] 'Q_8. End Pextraspecial. Notation "p ^{1+2}" := (Pextraspecial.gtype p) : type_scope. Notation "p ^{1+2}" := [set: gsort p^{1+2}] : group_scope. Notation "p ^{1+2}" := [set: gsort p^{1+2}]%G : Group_scope. Notation "p ^{1+2* n }" := (Pextraspecial.ngtype p n) : type_scope. Notation "p ^{1+2* n }" := [set: gsort p^{1+2*n}] : group_scope. Notation "p ^{1+2* n }" := [set: gsort p^{1+2*n}]%G : Group_scope. Notation "''D^' n" := (Pextraspecial.ngtype 2 n) : type_scope. Notation "''D^' n" := [set: gsort 'D^n] : group_scope. Notation "''D^' n" := [set: gsort 'D^n]%G : Group_scope. Notation "''D^' n * 'Q'" := (Pextraspecial.ngtypeQ n) : type_scope. Notation "''D^' n * 'Q'" := [set: gsort 'D^n*Q] : group_scope. Notation "''D^' n * 'Q'" := [set: gsort 'D^n*Q]%G : Group_scope. Section ExponentPextraspecialTheory. Variable p : nat. Hypothesis p_pr : prime p. Let p_gt1 := prime_gt1 p_pr. Let p_gt0 := ltnW p_gt1. Local Notation gtype := Pextraspecial.gtype. Local Notation actp := (Pextraspecial.groupAction p). Lemma card_pX1p2 : #|p^{1+2}| = (p ^ 3)%N. Proof. rewrite [@gtype _]unlock -(sdprod_card (sdprod_sdpair _)). rewrite !card_injm ?injm_sdpair1 ?injm_sdpair2 // !cardsT card_prod card_ord. by rewrite -mulnA Zp_cast. Qed. Lemma Grp_pX1p2 : p^{1+2} \isog Grp (x : y : (x ^+ p, y ^+ p, [~ x, y, x], [~ x, y, y])). Proof. rewrite [@gtype _]unlock; apply: intro_isoGrp => [|rT H]. apply/existsP; pose x := sdpair1 actp (0, 1)%R; pose y := sdpair2 actp 1%R. exists (x, y); rewrite /= !xpair_eqE; set z := [~ x, y]; set G := _ <*> _. have def_z: z = sdpair1 actp (1, 0)%R. rewrite [z]commgEl -sdpair_act ?inE //=. rewrite -morphV -?morphM ?inE //=; congr (sdpair1 _ (_, _)) => /=. by rewrite mulr1 mulKg. by rewrite mulVg. have def_xi i: x ^+ i = sdpair1 _ (0, i%:R)%R. rewrite -morphX ?inE //; congr (sdpair1 _ _). by apply/eqP; rewrite /eq_op /= !morphX ?inE ?expg1n //=. have def_yi i: y ^+ i = sdpair2 _ i%:R. by rewrite -morphX ?inE //. have def_zi i: z ^+ i = sdpair1 _ (i%:R, 0)%R. rewrite def_z -morphX ?inE //; congr (sdpair1 _ _). by apply/eqP; rewrite /eq_op /= !morphX ?inE ?expg1n ?andbT //=. rewrite def_xi def_yi char_Zp ?morph1 //. rewrite def_z -morphR ?inE // !commgEl -sdpair_act ?inE //= mulr0 addr0. rewrite mulVg -[_ * _]/(_ , _) /= !invg1 mulg1 !mul1g mulVg morph1 !andbT. have Gx: x \in G by rewrite -cycle_subG joing_subl. have Gy: y \in G by rewrite -cycle_subG joing_subr. rewrite eqEsubset subsetT -im_sdpair mulG_subG /= -/G; apply/andP; split. apply/subsetP=> u /morphimP[[i j] _ _ def_u]. suffices ->: u = z ^+ i * x ^+ j by rewrite groupMl groupX ?groupR. rewrite def_zi def_xi !natr_Zp -morphM ?inE // def_u. by congr (sdpair1 _ (_, _)); rewrite ?mulg1 ?mul1g. apply/subsetP=> v /morphimP[k _ _ def_v]. suffices ->: v = y ^+ k by rewrite groupX. by rewrite def_yi natr_Zp. case/existsP=> [[x y] /=]; set z := [~ x, y]. case/eqP=> defH xp yp /eqP/commgP czx /eqP/commgP czy. have zp: z ^+ p = 1 by rewrite -commXg // xp comm1g. pose f1 (ij : 'Z_p * 'Z_p) := let: (i, j) := ij in z ^+ i * x ^+ j. have f1M: {in setT &, {morph f1 : u v / u * v}}. case=> /= [i1 j1] [i2 j2] _ _ /=; rewrite {3 6}Zp_cast // !expg_mod //. rewrite !expgD !mulgA; congr (_ * _); rewrite -!mulgA; congr (_ * _). by apply: commuteX2. pose f2 (k : 'Z_p) := y ^+ k. have f2M: {in setT &, {morph f2 : u v / u * v}}. by move=> k1 k2 _ _; rewrite /f2 /= {3}Zp_cast // expg_mod // expgD. have actf: {in setT & setT, morph_act actp 'J (Morphism f1M) (Morphism f2M)}. case=> /= i j k _ _; rewrite modnDmr {4}Zp_cast // expg_mod // expgD. rewrite /f2 conjMg {1}/conjg (commuteX2 i k czy) mulKg -mulgA. congr (_ * _); rewrite (commuteX2 _ _ czx) mulnC expgM. by rewrite -commXg // -commgX ?mulKVg // commXg // /commute commuteX. apply/homgP; exists (xsdprod_morphism actf). apply/eqP; rewrite eqEsubset -{2}defH -genM_join gen_subG /= im_xsdprodm. have Hx: x \in H by rewrite -cycle_subG -defH joing_subl. have Hy: y \in H by rewrite -cycle_subG -defH joing_subr. rewrite mulG_subG -andbA; apply/and3P; split. - apply/subsetP=> _ /morphimP[[i j] _ _ -> /=]. by rewrite groupMl groupX ?groupR. - by apply/subsetP=> _ /morphimP[k _ _ ->]; rewrite groupX. rewrite mulgSS ?cycle_subG //= morphimEdom; apply/imsetP. by exists (0, 1)%R; rewrite ?inE //= mul1g. by exists 1%R; rewrite ?inE. Qed. Lemma pX1p2_pgroup : p.-group p^{1+2}. Proof. by rewrite /pgroup card_pX1p2 pnatX pnat_id. Qed. (* This is part of the existence half of Aschbacher ex. (8.7)(1) *) Lemma pX1p2_extraspecial : extraspecial p^{1+2}. Proof. apply: (p3group_extraspecial pX1p2_pgroup); last first. by rewrite card_pX1p2 pfactorK. case/existsP: (isoGrp_hom Grp_pX1p2) card_pX1p2 => [[x y]] /=. case/eqP=> <- xp yp _ _ oXY. apply: contraL (dvdn_cardMg <[x]> <[y]>) => cXY_XY. rewrite -cent_joinEl ?(sub_abelian_cent2 cXY_XY) ?joing_subl ?joing_subr //. rewrite oXY -!orderE pfactor_dvdn ?muln_gt0 ?order_gt0 // -leqNgt. rewrite -(pfactorK 2 p_pr) dvdn_leq_log ?expn_gt0 ?p_gt0 //. by rewrite dvdn_mul ?order_dvdn ?xp ?yp. Qed. (* This is part of the existence half of Aschbacher ex. (8.7)(1) *) Lemma exponent_pX1p2 : odd p -> exponent p^{1+2} %| p. Proof. move=> p_odd; have pG := pX1p2_pgroup. have ->: p^{1+2} = 'Ohm_1(p^{1+2}). apply/eqP; rewrite eqEsubset Ohm_sub andbT (OhmE 1 pG). case/existsP: (isoGrp_hom Grp_pX1p2) => [[x y]] /=. case/eqP=> <- xp yp _ _; rewrite joing_idl joing_idr genS //. by rewrite subsetI subset_gen subUset !sub1set !inE xp yp!eqxx. rewrite exponent_Ohm1_class2 ?card_pX1p2 ?oddX // nil_class2. by have [[_ ->] _ ] := pX1p2_extraspecial. Qed. (* This is the uniqueness half of Aschbacher ex. (8.7)(1) *) Lemma isog_pX1p2 (gT : finGroupType) (G : {group gT}) : extraspecial G -> exponent G %| p -> #|G| = (p ^ 3)%N -> G \isog p^{1+2}. Proof. move=> esG expGp oG; apply/(isoGrpP _ Grp_pX1p2). rewrite card_pX1p2; split=> //. have pG: p.-group G by rewrite /pgroup oG pnatX pnat_id. have oZ := card_center_extraspecial pG esG. have [x Gx notZx]: exists2 x, x \in G & x \notin 'Z(G). apply/subsetPn; rewrite proper_subn // properEcard center_sub oZ oG. by rewrite (ltn_exp2l 1 3). have ox: #[x] = p. by apply: nt_prime_order; rewrite ?(exponentP expGp) ?(group1_contra notZx). have [y Gy not_cxy]: exists2 y, y \in G & y \notin 'C[x]. by apply/subsetPn; rewrite sub_cent1; rewrite inE Gx in notZx. apply/existsP; exists (x, y) => /=; set z := [~ x, y]. have [[defPhiG defG'] _] := esG. have Zz: z \in 'Z(G) by rewrite -defG' mem_commg. have [Gz cGz] := setIP Zz; rewrite !xpair_eqE !(exponentP expGp) //. have [_ nZG] := andP (center_normal G). rewrite /commg /conjg !(centP cGz) // !mulKg mulVg !eqxx !andbT. have sXY_G: <[x]> <*> <[y]> \subset G by rewrite join_subG !cycle_subG Gx. have defZ: <[z]> = 'Z(G). apply/eqP; rewrite eqEcard cycle_subG Zz oZ /= -orderE. rewrite (nt_prime_order p_pr) ?(exponentP expGp) //. by rewrite (sameP commgP cent1P) cent1C. have sZ_XY: 'Z(G) \subset <[x]> <*> <[y]>. by rewrite -defZ cycle_subG groupR // mem_gen // inE cycle_id ?orbT. rewrite eqEcard sXY_G /= oG -(Lagrange sZ_XY) oZ leq_pmul2l //. rewrite -card_quotient ?(subset_trans sXY_G) //. rewrite quotientY ?quotient_cycle ?cycle_subG ?(subsetP nZG) //. have abelGz: p.-abelem (G / 'Z(G)) by rewrite -defPhiG Phi_quotient_abelem. have [cGzGz expGz] := abelemP p_pr abelGz. rewrite cent_joinEr ?(sub_abelian_cent2 cGzGz) ?cycle_subG ?mem_quotient //. have oZx: #|<[coset 'Z(G) x]>| = p. rewrite -orderE (nt_prime_order p_pr) ?expGz ?mem_quotient //. by apply: contra notZx; move/eqP=> Zx; rewrite coset_idr ?(subsetP nZG). rewrite TI_cardMg ?oZx -?orderE ?(nt_prime_order p_pr) ?expGz ?mem_quotient //. apply: contra not_cxy; move/eqP=> Zy. rewrite -cent_cycle (subsetP _ y (coset_idr _ Zy)) ?(subsetP nZG) //. by rewrite subIset ?centS ?orbT ?cycle_subG. rewrite prime_TIg ?oZx // cycle_subG; apply: contra not_cxy. case/cycleP=> i; rewrite -morphX ?(subsetP nZG) // => /rcoset_kercosetP. rewrite groupX ?(subsetP nZG) // cent1C => /(_ isT isT); apply: subsetP. rewrite mul_subG ?sub1set ?groupX ?cent1id //= -cent_cycle subIset // orbC. by rewrite centS ?cycle_subG. Qed. End ExponentPextraspecialTheory. Section GeneralExponentPextraspecialTheory. Variable p : nat. Lemma pX1p2id : p^{1+2*1} \isog p^{1+2}. Proof. exact: ncprod1. Qed. Lemma pX1p2S n : xcprod_spec p^{1+2} p^{1+2*n} p^{1+2*n.+1}%type. Proof. exact: ncprodS. Qed. Lemma card_pX1p2n n : prime p -> #|p^{1+2*n}| = (p ^ n.*2.+1)%N. Proof. move=> p_pr; have pG := pX1p2_pgroup p_pr. have oG := card_pX1p2 p_pr; have esG := pX1p2_extraspecial p_pr. have oZ := card_center_extraspecial pG esG. elim: n => [|n IHn]; first by rewrite (card_isog (ncprod0 _)) oZ. case: pX1p2S => gz isoZ; rewrite -im_cpair cardMg_divn setI_im_cpair. rewrite -injm_center ?{1}card_injm ?injm_cpairg1 ?injm_cpair1g ?center_sub //. by rewrite oG oZ IHn -expnD mulKn ?prime_gt0. Qed. Lemma pX1p2n_pgroup n : prime p -> p.-group p^{1+2*n}. Proof. by move=> p_pr; rewrite /pgroup card_pX1p2n // pnatX pnat_id. Qed. (* This is part of the existence half of Aschbacher (23.13) *) Lemma exponent_pX1p2n n : prime p -> odd p -> exponent p^{1+2*n} = p. Proof. move=> p_pr odd_p; apply: prime_nt_dvdP => //. rewrite -dvdn1 -trivg_exponent -cardG_gt1 card_pX1p2n //. by rewrite (ltn_exp2l 0) // prime_gt1. elim: n => [|n IHn]. by rewrite (dvdn_trans (exponent_dvdn _)) ?card_pX1p2n. case: pX1p2S => gz isoZ; rewrite -im_cpair /=. apply/exponentP=> xy; case/imset2P=> x y C1x C2y ->{xy}. rewrite expgMn; last by red; rewrite -(centsP (im_cpair_cent isoZ)). rewrite (exponentP _ y C2y) ?exponent_injm ?injm_cpair1g // mulg1. by rewrite (exponentP _ x C1x) ?exponent_injm ?injm_cpairg1 // exponent_pX1p2. Qed. (* This is part of the existence half of Aschbacher (23.13) and (23.14) *) Lemma pX1p2n_extraspecial n : prime p -> n > 0 -> extraspecial p^{1+2*n}. Proof. move=> p_pr; elim: n => [//|n IHn _]. have esG := pX1p2_extraspecial p_pr. have [n0 | n_gt0] := posnP n. by apply: isog_extraspecial esG; rewrite isog_sym n0 pX1p2id. case: pX1p2S (pX1p2n_pgroup n.+1 p_pr) => gz isoZ pGn. apply: (cprod_extraspecial pGn (im_cpair_cprod isoZ) (setI_im_cpair isoZ)). by apply: injm_extraspecial esG; rewrite ?injm_cpairg1. by apply: injm_extraspecial (IHn n_gt0); rewrite ?injm_cpair1g. Qed. (* This is Aschbacher (23.12) *) Lemma Ohm1_extraspecial_odd (gT : finGroupType) (G : {group gT}) : p.-group G -> extraspecial G -> odd #|G| -> let Y := 'Ohm_1(G) in [/\ exponent Y = p, #|G : Y| %| p & Y != G -> exists E : {group gT}, [/\ #|G : Y| = p, #|E| = p \/ extraspecial E, exists2 X : {group gT}, #|X| = p & X \x E = Y & exists M : {group gT}, [/\ M \isog 'Mod_(p ^ 3), M \* E = G & M :&: E = 'Z(M)]]]. Proof. move=> pG esG oddG Y; have [spG _] := esG. have [defPhiG defG'] := spG; set Z := 'Z(G) in defPhiG defG'. have{spG} expG: exponent G %| p ^ 2 by apply: exponent_special. have p_pr := extraspecial_prime pG esG. have p_gt1 := prime_gt1 p_pr; have p_gt0 := ltnW p_gt1. have oZ: #|Z| = p := card_center_extraspecial pG esG. have nsZG: Z <| G := center_normal G; have [sZG nZG] := andP nsZG. have nsYG: Y <| G := Ohm_normal 1 G; have [sYG nYG] := andP nsYG. have ntZ: Z != 1 by rewrite -cardG_gt1 oZ. have sZY: Z \subset Y. by apply: contraR ntZ => ?; rewrite -(setIidPl sZG) TI_Ohm1 ?prime_TIg ?oZ. have ntY: Y != 1 by apply: subG1_contra ntZ. have p_odd: odd p by rewrite -oZ (oddSg sZG). have expY: exponent Y %| p by rewrite exponent_Ohm1_class2 // nil_class2 defG'. rewrite (prime_nt_dvdP p_pr _ expY) -?dvdn1 -?trivg_exponent //. have [-> | neYG] := eqVneq Y G; first by rewrite indexgg dvd1n; split. have sG1Z: 'Mho^1(G) \subset Z by rewrite -defPhiG (Phi_joing pG) joing_subr. have Z_Gp: {in G, forall x, x ^+ p \in Z}. by move=> x Gx; rewrite /= (subsetP sG1Z) ?(Mho_p_elt 1) ?(mem_p_elt pG). have{expG} oY': {in G :\: Y, forall u, #[u] = (p ^ 2)%N}. move=> u /setDP[Gu notYu]; apply/eqP. have [k ou] := p_natP (mem_p_elt pG Gu). rewrite eqn_dvd order_dvdn (exponentP expG) // eqxx ou dvdn_Pexp2l // ltnNge. apply: contra notYu => k_le_1; rewrite [Y](OhmE _ pG) mem_gen // !inE Gu /=. by rewrite -order_dvdn ou dvdn_exp2l. have isoMod3 (M : {group gT}): M \subset G -> ~~ abelian M -> ~~ (M \subset Y) -> #|M| = (p ^ 3)%N -> M \isog 'Mod_(p ^ 3). - move=> sMG not_cMM /subsetPn[u Mu notYu oM]. have pM := pgroupS sMG pG; have sUM: <[u]> \subset M by rewrite cycle_subG. have Y'u: u \in G :\: Y by rewrite inE notYu (subsetP sMG). have iUM: #|M : <[u]>| = p by rewrite -divgS // oM expnS -(oY' u) ?mulnK. have cM := maximal_cycle_extremal pM not_cMM (cycle_cyclic u) sUM iUM. rewrite (sameP eqP (prime_oddPn p_pr)) p_odd orbF in cM. rewrite /extremal_class oM pdiv_pfactor // pfactorK //= in cM. by do 3!case: ifP => // _ in cM. have iYG: #|G : Y| = p. have [V maxV sYV]: {V : {group gT} | maximal V G & Y \subset V}. by apply: maxgroup_exists; rewrite properEneq neYG. have [sVG [u Gu notVu]] := properP (maxgroupp maxV). without loss [v Vv notYv]: / exists2 v, v \in V & v \notin Y. have [->| ] := eqVneq Y V; first by rewrite (p_maximal_index pG). by rewrite eqEsubset sYV => not_sVY; apply; apply/subsetPn. pose U := <[u]> <*> <[v]>; have Gv := subsetP sVG v Vv. have sUG: U \subset G by rewrite join_subG !cycle_subG Gu. have Uu: u \in U by rewrite -cycle_subG joing_subl. have Uv: v \in U by rewrite -cycle_subG joing_subr. have not_sUY: ~~ (U \subset Y) by apply/subsetPn; exists v. have sU1U: 'Ohm_1(U) \subset U := Ohm_sub 1 _. have sU1Y: 'Ohm_1(U) \subset Y := OhmS 1 sUG. suffices defUV: U :&: V = 'Ohm_1(U). by rewrite (subsetP sU1Y) // -defUV inE Uv in notYv. suffices iU1U: #|U : 'Ohm_1(U)| = p. have: maximal 'Ohm_1(U) U by rewrite p_index_maximal ?Ohm_sub ?iU1U. case/maxgroupP=> _; apply; rewrite /= -/U. by apply/properP; split; last exists u; rewrite ?subsetIl ?inE ?Uu. by rewrite subsetI Ohm_sub (subset_trans sU1Y). apply/prime_nt_dvdP=> //. by apply: contra not_sUY; rewrite /U; move/eqP; move/(index1g sU1U)=> <-. have ov: #[v] = (p ^ 2)%N by rewrite oY' // inE notYv. have sZv: Z \subset <[v]>. suffices defZ: <[v ^+ p]> == Z by rewrite -(eqP defZ) cycleX. by rewrite eqEcard cycle_subG Z_Gp //= oZ -orderE (orderXexp 1 ov). have nvG: G \subset 'N(<[v]>) by rewrite sub_der1_norm ?cycle_subG // defG'. have [cUU | not_cUU] := orP (orbN (abelian U)). rewrite -divgS ?Ohm_sub // -(mul_card_Ohm_Mho_abelian 1 cUU) /= -/U. by rewrite mulKn ?cardG_gt0 //= -oZ cardSg ?(subset_trans (MhoS 1 sUG)). have oU: #|U| = (p ^ 3)%N. have nvu := subsetP nvG u Gu; have nvU := subset_trans sUG nvG. rewrite -(Lagrange (joing_subr _ _)) -orderE ov mulnC; congr (_ * _)%N. rewrite -card_quotient //= quotientYidr ?cycle_subG //=. rewrite quotient_cycle // -orderE; apply: nt_prime_order => //. by rewrite -morphX //= coset_id // (subsetP sZv) // Z_Gp. have svV: <[v]> \subset V by rewrite cycle_subG. by apply: contra notVu; move/eqP=> v_u; rewrite (subsetP svV) // coset_idr. have isoU := isoMod3 _ sUG not_cUU not_sUY oU; rewrite /= -/U in isoU. have [//|[x y] genU modU] := generators_modular_group p_pr _ isoU. case/modular_group_structure: genU => // _ _ _ _. case: eqP (p_odd) => [[-> //] | _ _]; case/(_ 1%N)=> // _ oU1. by rewrite -divgS // oU oU1 mulnK // muln_gt0 p_gt0. have iC1U (U : {group gT}) x: U \subset G -> x \in G :\: 'C(U) -> #|U : 'C_U[x]| = p. - move=> sUG /setDP[Gx not_cUx]; apply/prime_nt_dvdP=> //. apply: contra not_cUx; rewrite -sub_cent1 => /eqP sUCx. by rewrite -(index1g _ sUCx) ?subsetIl ?subsetIr. rewrite -(@dvdn_pmul2l (#|U| * #|'C_G[x]|)) ?muln_gt0 ?cardG_gt0 //. have maxCx: maximal 'C_G[x] G. rewrite cent1_extraspecial_maximal //; apply: contra not_cUx. by rewrite inE Gx; apply: subsetP (centS sUG) _. rewrite {1}mul_cardG setIA (setIidPl sUG) -(p_maximal_index pG maxCx) -!mulnA. rewrite !Lagrange ?subsetIl // mulnC dvdn_pmul2l //. have [sCxG nCxG] := andP (p_maximal_normal pG maxCx). by rewrite -norm_joinEl ?cardSg ?join_subG ?(subset_trans sUG). have oCG (U : {group gT}): Z \subset U -> U \subset G -> #|'C_G(U)| = (p * #|G : U|)%N. - have [m] := ubnP #|U|; elim: m U => // m IHm U leUm sZU sUG. have [<- | neZU] := eqVneq Z U. by rewrite -oZ Lagrange // (setIidPl _) // centsC subsetIr. have{neZU} [x Gx not_cUx]: exists2 x, x \in G & x \notin 'C(U). by apply/subsetPn; rewrite eqEsubset sZU subsetI sUG centsC in neZU. pose W := 'C_U[x]; have iWU: #|U : W| = p by rewrite iC1U // inE not_cUx. have maxW: maximal W U by rewrite p_index_maximal ?subsetIl ?iWU. have ltWU: W \proper U by apply: maxgroupp maxW. have [sWU [u Uu notWu]] := properP ltWU. have defU: W * <[u]> = U. have nsWU: W <| U := p_maximal_normal (pgroupS sUG pG) maxW. by rewrite (mulg_normal_maximal nsWU) ?cycle_subG. have sWG := subset_trans sWU sUG. have sZW: Z \subset W. by rewrite subsetI sZU -cent_set1 subIset ?centS ?orbT ?sub1set. have iCW_CU: #|'C_G(W) : 'C_G(U)| = p. rewrite -defU centM cent_cycle setIA /= -/W. rewrite iC1U ?subsetIl ?setIS ?centS // inE andbC (subsetP sUG) //=. rewrite -sub_cent1; apply/subsetPn; exists x. by rewrite inE Gx -sub_cent1 subsetIr. by rewrite -defU centM cent_cycle inE -sub_cent1 subsetIr in not_cUx. apply/eqP; rewrite -(eqn_pmul2r p_gt0) -{1}iCW_CU Lagrange ?setIS ?centS //. rewrite IHm ?(leq_trans (proper_card ltWU)) //= -/W. by rewrite -(Lagrange_index sUG sWU) iWU mulnA. have oCY: #|'C_G(Y)| = (p ^ 2)%N by rewrite oCG // iYG. have [x cYx notZx]: exists2 x, x \in 'C_G(Y) & x \notin Z. apply/subsetPn; rewrite proper_subn // properEcard setIS ?centS //=. by rewrite oZ oCY (ltn_exp2l 1 2). have{cYx} [Gx cYx] := setIP cYx; have nZx := subsetP nZG x Gx. have defCx: 'C_G[x] = Y. apply/eqP; rewrite eq_sym eqEcard subsetI sYG sub_cent1 cYx /=. rewrite -(leq_pmul2r p_gt0) -{2}iYG -(iC1U G x) ?Lagrange ?subsetIl //. by rewrite !inE Gx ?andbT in notZx *. have Yx: x \in Y by rewrite -defCx inE Gx cent1id. have ox: #[x] = p. by apply: nt_prime_order; rewrite ?(exponentP expY) // (group1_contra notZx). have defCy: 'C_G(Y) = Z * <[x]>. apply/eqP; rewrite eq_sym eqEcard mulG_subG setIS ?centS //=. rewrite cycle_subG inE Gx cYx oCY TI_cardMg ?oZ -?orderE ?ox //=. by rewrite setIC prime_TIg -?orderE ?ox ?cycle_subG. have abelYt: p.-abelem (Y / Z). by rewrite (abelemS (quotientS _ sYG)) //= -/Z -defPhiG Phi_quotient_abelem. have Yxt: coset Z x \in Y / Z by rewrite mem_quotient. have{Yxt} [Et [sEtYt oEt defYt]] := p_abelem_split1 abelYt Yxt. have nsZY: Z <| Y := normalS sZY sYG nsZG. have [E defEt sZE sEY] := inv_quotientS nsZY sEtYt. have{defYt} [_ defYt _ tiXEt] := dprodP defYt. have defY: <[x]> \x E = Y. have nZX: <[x]> \subset 'N(Z) by rewrite cycle_subG. have TIxE: <[x]> :&: E = 1. rewrite prime_TIg -?orderE ?ox // -(quotientSGK _ sZE) ?quotient_cycle //. rewrite (sameP setIidPl eqP) eq_sym -defEt tiXEt -quotient_cycle //. by rewrite -subG1 quotient_sub1 // cycle_subG. rewrite dprodE //; last 1 first. by rewrite cent_cycle (subset_trans sEY) //= -/Y -defCx subsetIr. rewrite -[Y](quotientGK nsZY) -defYt cosetpreM -quotient_cycle //. rewrite quotientK // -(normC nZX) defEt quotientGK ?(normalS _ sEY) //. by rewrite -mulgA (mulSGid sZE). have sEG := subset_trans sEY sYG; have nZE := subset_trans sEG nZG. have defZE: 'Z(E) = Z. apply/eqP; rewrite eqEsubset andbC subsetI sZE subIset ?centS ?orbT //. rewrite -quotient_sub1 ?subIset ?nZE //= -tiXEt defEt subsetI andbC. rewrite quotientS ?center_sub //= -quotient_cycle //. rewrite -(quotientMidl _ <[x]>) /= -defCy quotientS // /Y. by case/dprodP: defY => _ <- _ _; rewrite centM setIA cent_cycle defCx setSI. have pE := pgroupS sEG pG. rewrite iYG; split=> // _; exists E. split=> //; first 2 [by exists [group of <[x]>]]. have:= sZE; rewrite subEproper; case/predU1P=> [<- | ltZE]; [by left | right]. split; rewrite /special defZE ?oZ // (Phi_joing pE). have defE': E^`(1) = Z. have sE'Z: E^`(1) \subset Z by rewrite -defG' dergS. apply/eqP; rewrite eqEcard sE'Z -(prime_nt_dvdP _ _ (cardSg sE'Z)) ?oZ //=. rewrite -trivg_card1 (sameP eqP commG1P). by rewrite /proper sZE /= -/Z -defZE subsetI subxx in ltZE. split=> //; rewrite -defE'; apply/joing_idPl. by rewrite /= defE' -defPhiG (Phi_joing pG) joingC sub_gen ?subsetU ?MhoS. have iEG: #|G : E| = (p ^ 2)%N. apply/eqP; rewrite -(@eqn_pmul2l #|E|) // Lagrange // -(Lagrange sYG) iYG. by rewrite -(dprod_card defY) -mulnA mulnCA -orderE ox. pose M := 'C_G(E); exists [group of M] => /=. have sMG: M \subset G := subsetIl _ _; have pM: p.-group M := pgroupS sMG pG. have sZM: Z \subset M by rewrite setIS ?centS. have oM: #|M| = (p ^ 3)%N by rewrite oCG ?iEG. have defME: M * E = G. apply/eqP; rewrite eqEcard mulG_subG sMG sEG /= -(leq_pmul2r p_gt0). rewrite -{2}oZ -defZE /('Z(E)) -{2}(setIidPr sEG) setIAC -mul_cardG /= -/M. by rewrite -(Lagrange sEG) mulnAC -mulnA mulnC iEG oM. have defZM: 'Z(M) = Z. apply/eqP; rewrite eqEsubset andbC subsetI sZM subIset ?centS ?orbT //=. by rewrite /Z /('Z(G)) -{2}defME centM setIA setIAC. rewrite cprodE 1?centsC ?subsetIr //. rewrite defME setIAC (setIidPr sEG) defZM isoMod3 //. rewrite abelianE (sameP setIidPl eqP) eqEcard subsetIl /= -/('Z(M)) -/M. by rewrite defZM oZ oM (leq_exp2l 3 1). by apply: contra neYG => sMY; rewrite eqEsubset sYG -defME mulG_subG sMY. Qed. (* This is the uniqueness half of Aschbacher (23.13); the proof incorporates *) (* in part the proof that symplectic spaces are hyperbolic (19.16). *) Lemma isog_pX1p2n n (gT : finGroupType) (G : {group gT}) : prime p -> extraspecial G -> #|G| = (p ^ n.*2.+1)%N -> exponent G %| p -> G \isog p^{1+2*n}. Proof. move=> p_pr esG oG expG; have p_gt1 := prime_gt1 p_pr. have not_le_p3_p: ~~ (p ^ 3 <= p) by rewrite (leq_exp2l 3 1). have pG: p.-group G by rewrite /pgroup oG pnatX pnat_id. have oZ := card_center_extraspecial pG esG. have{pG esG} [Es p3Es defG] := extraspecial_structure pG esG. set Z := 'Z(G) in oZ defG p3Es. elim: Es {+}G => [|E Es IHs] S in n oG expG p3Es defG *. rewrite big_nil cprod1g in defG; rewrite -defG. have ->: n = 0%N. apply: double_inj; apply/eqP. by rewrite -eqSS -(eqn_exp2l _ _ p_gt1) -oG -defG oZ. by rewrite isog_cyclic_card prime_cyclic ?oZ ?card_pX1p2n //=. rewrite big_cons -cprodA in defG; rewrite /= -andbA in p3Es. have [[_ T _ defT] defET cTE] := cprodP defG; rewrite defT in defET cTE defG. move: p3Es => /and3P[/eqP oE /eqP defZE /IHs{}IHs]. have not_cEE: ~~ abelian E. by apply: contra not_le_p3_p => cEE; rewrite -oE -oZ -defZE (center_idP _). have sES: E \subset S by rewrite -defET mulG_subl. have sTS: T \subset S by rewrite -defET mulG_subr. have expE: exponent E %| p by apply: dvdn_trans (exponentS sES) expG. have expT: exponent T %| p by apply: dvdn_trans (exponentS sTS) expG. have{expE not_cEE} isoE: E \isog p^{1+2}. apply: isog_pX1p2 => //. by apply: card_p3group_extraspecial p_pr oE _; rewrite defZE. have sZT: 'Z(E) \subset T. by case/cprodP: defT => [[U _ -> _] <- _]; rewrite defZE mulG_subr. case def_n: n => [|n']. case/negP: not_le_p3_p; rewrite def_n in oG; rewrite -oE -[p]oG. exact: subset_leq_card. have zI_ET: E :&: T = 'Z(E). by apply/eqP; rewrite eqEsubset subsetI sZT subsetIl setIS // centsC. have{n def_n oG} oT: #|T| = (p ^ n'.*2.+1)%N. apply/eqP; rewrite -(eqn_pmul2l (cardG_gt0 E)) mul_cardG zI_ET defET. by rewrite defZE oE oG oZ -expnSr -expnD def_n. have{IHs oT expT defT Es} isoT: T \isog p^{1+2*n'} by rewrite IHs. case: pX1p2S => gz isoZ; rewrite (isog_cprod_by _ defG) //. exact: Aut_extraspecial_full (pX1p2_pgroup p_pr) (pX1p2_extraspecial p_pr). Qed. End GeneralExponentPextraspecialTheory. Lemma isog_2X1p2 : 2^{1+2} \isog 'D_8. Proof. have pr2: prime 2 by []; have oG := card_pX1p2 pr2; rewrite -[8]oG. case/existsP: (isoGrp_hom (Grp_pX1p2 pr2)) => [[x y]] /=. rewrite -/2^{1+2}; case/eqP=> defG x2 y2 _ _. have not_oG_2: ~~ (#|2^{1+2}| %| 2) by rewrite oG. have ox: #[x] = 2. apply: nt_prime_order => //; apply: contra not_oG_2 => x1. by rewrite -defG (eqP x1) cycle1 joing1G order_dvdn y2. have oy: #[y] = 2. apply: nt_prime_order => //; apply: contra not_oG_2 => y1. by rewrite -defG (eqP y1) cycle1 joingG1 order_dvdn x2. rewrite -defG joing_idl joing_idr involutions_gen_dihedral //. apply: contra not_oG_2 => eq_xy; rewrite -defG (eqP eq_xy) (joing_idPl _) //. by rewrite -orderE oy. Qed. Lemma Q8_extraspecial : extraspecial 'Q_8. Proof. have gt32: 3 > 2 by []; have isoQ: 'Q_8 \isog 'Q_(2 ^ 3) by apply: isog_refl. have [[x y] genQ _] := generators_quaternion gt32 isoQ. have [_ [defQ' defPhiQ _ _]] := quaternion_structure gt32 genQ isoQ. case=> defZ oZ _ _ _ _ _; split; last by rewrite oZ. by split; rewrite ?defPhiQ defZ. Qed. Lemma DnQ_P n : xcprod_spec 'D^n 'Q_8 ('D^n*Q)%type. Proof. have pQ: 2.-group 'Q_(2 ^ 3) by rewrite /pgroup card_quaternion. have{pQ} oZQ := card_center_extraspecial pQ Q8_extraspecial. suffices oZDn: #|'Z('D^n)| = 2. by apply: xcprodP; rewrite isog_cyclic_card ?prime_cyclic ?oZQ ?oZDn. have [-> | n_gt0] := posnP n; first by rewrite center_ncprod0 card_pX1p2n. have pr2: prime 2 by []; have pDn := pX1p2n_pgroup n pr2. exact: card_center_extraspecial (pX1p2n_extraspecial pr2 n_gt0). Qed. Lemma card_DnQ n : #|'D^n*Q| = (2 ^ n.+1.*2.+1)%N. Proof. have oQ: #|'Q_(2 ^ 3)| = 8 by rewrite card_quaternion. have pQ: 2.-group 'Q_8 by rewrite /pgroup oQ. case: DnQ_P => gz isoZ. rewrite -im_cpair cardMg_divn setI_im_cpair cpair_center_id. rewrite -injm_center 3?{1}card_injm ?injm_cpairg1 ?injm_cpair1g ?center_sub //. rewrite oQ card_pX1p2n // (card_center_extraspecial pQ Q8_extraspecial). by rewrite -muln_divA // mulnC -(expnD 2 2). Qed. Lemma DnQ_pgroup n : 2.-group 'D^n*Q. Proof. by rewrite /pgroup card_DnQ pnatX. Qed. (* Final part of the existence half of Aschbacher (23.14). *) Lemma DnQ_extraspecial n : extraspecial 'D^n*Q. Proof. case: DnQ_P (DnQ_pgroup n) => gz isoZ pDnQ. have [injDn injQ] := (injm_cpairg1 isoZ, injm_cpair1g isoZ). have [n0 | n_gt0] := posnP n. rewrite -im_cpair mulSGid; first exact: injm_extraspecial Q8_extraspecial. apply/setIidPl; rewrite setI_im_cpair -injm_center //=. by congr (_ @* _); rewrite n0 center_ncprod0. apply: (cprod_extraspecial pDnQ (im_cpair_cprod isoZ) (setI_im_cpair _)). exact: injm_extraspecial (pX1p2n_extraspecial _ _). exact: injm_extraspecial Q8_extraspecial. Qed. (* A special case of the uniqueness half of Achsbacher (23.14). *) Lemma card_isog8_extraspecial (gT : finGroupType) (G : {group gT}) : #|G| = 8 -> extraspecial G -> (G \isog 'D_8) || (G \isog 'Q_8). Proof. move=> oG esG; have pG: 2.-group G by rewrite /pgroup oG. apply/norP=> [[notG_D8 notG_Q8]]. have not_extG: extremal_class G = NotExtremal. by rewrite /extremal_class oG andFb (negPf notG_D8) (negPf notG_Q8). have [x Gx ox] := exponent_witness (pgroup_nil pG). pose X := <[x]>; have cycX: cyclic X := cycle_cyclic x. have sXG: X \subset G by rewrite cycle_subG. have iXG: #|G : X| = 2. by rewrite -divgS // oG -orderE -ox exponent_2extraspecial. have not_cGG := extraspecial_nonabelian esG. have:= maximal_cycle_extremal pG not_cGG cycX sXG iXG. by rewrite /extremal2 not_extG. Qed. (* The uniqueness half of Achsbacher (23.14). The proof incorporates in part *) (* the proof that symplectic spces are hyperbolic (Aschbacher (19.16)), and *) (* the determination of quadratic spaces over 'F_2 (21.2); however we use *) (* the second part of exercise (8.4) to avoid resorting to Witt's lemma and *) (* Galois theory as in (20.9) and (21.1). *) Lemma isog_2extraspecial (gT : finGroupType) (G : {group gT}) n : #|G| = (2 ^ n.*2.+1)%N -> extraspecial G -> G \isog 'D^n \/ G \isog 'D^n.-1*Q. Proof. elim: n G => [|n IHn] G oG esG. case/negP: (extraspecial_nonabelian esG). by rewrite cyclic_abelian ?prime_cyclic ?oG. have pG: 2.-group G by rewrite /pgroup oG pnatX. have oZ:= card_center_extraspecial pG esG. have: 'Z(G) \subset 'Ohm_1(G). apply/subsetP=> z Zz; rewrite (OhmE _ pG) mem_gen //. by rewrite !inE -order_dvdn -oZ order_dvdG ?(subsetP (center_sub G)). rewrite subEproper; case/predU1P=> [defG1 | ltZG1]. have [n' n'_gt2 isoG]: exists2 n', n' > 2 & G \isog 'Q_(2 ^ n'). apply/quaternion_classP; apply/eqP. have not_cycG: ~~ cyclic G. by apply: contra (extraspecial_nonabelian esG); apply: cyclic_abelian. move: oZ; rewrite defG1; move/prime_Ohm1P; rewrite (negPf not_cycG) /=. by apply=> //; apply: contra not_cycG; move/eqP->; apply: cyclic1. have [n0 n'3]: n = 0%N /\ n' = 3. have [[x y] genG _] := generators_quaternion n'_gt2 isoG. have n'3: n' = 3. have [_ [_ _ oG' _] _ _ _] := quaternion_structure n'_gt2 genG isoG. apply/eqP; rewrite -(subnKC (ltnW n'_gt2)) subn2 !eqSS -(@eqn_exp2l 2) //. by rewrite -oG' -oZ; case: esG => [[_ ->]]. by move/eqP: oG; have [-> _ _ _] := genG; rewrite n'3 eqn_exp2l //; case n. right; rewrite (isog_trans isoG) // n'3 n0 /=. case: DnQ_P => z isoZ; rewrite -im_cpair mulSGid ?sub_isog ?injm_cpair1g //. apply/setIidPl; rewrite setI_im_cpair -injm_center ?injm_cpairg1 //. by rewrite center_ncprod0. case/andP: ltZG1 => _; rewrite (OhmE _ pG) gen_subG. case/subsetPn=> x; case/LdivP=> Gx x2 notZx. have ox: #[x] = 2 by apply: nt_prime_order (group1_contra notZx). have Z'x: x \in G :\: 'Z(G) by rewrite inE notZx. have [E [R [[oE oR] [defG ziER]]]] := split1_extraspecial pG esG Z'x. case=> defZE defZR [esE Ex] esR. have isoE: E \isog 2^{1+2}. apply: isog_trans (isog_symr isog_2X1p2). case/orP: (card_isog8_extraspecial oE esE) => // isoE; case/negP: notZx. have gt32: 3 > 2 by []. have [[y z] genE _] := generators_quaternion gt32 isoE. have [_ _ [defZx _ eq_y2 _ _] _ _] := quaternion_structure gt32 genE isoE. by rewrite (eq_y2 x) // -cycle_subG -defZx defZE. rewrite oG doubleS 2!expnS divnMl ?mulKn // in oR. case: ifP esR => [_ defR | _ esR]. have ->: n = 0%N by move/eqP: oR; rewrite defR oZ (eqn_exp2l 1) //; case n. left; apply: isog_trans (isog_symr (ncprod1 _)). by rewrite -defG defR -defZE cprod_center_id. have AutZin2_1p2: Aut_in (Aut 2^{1+2}) 'Z(2^{1+2}) \isog Aut 'Z(2^{1+2}). exact: Aut_extraspecial_full (pX1p2_pgroup _) (pX1p2_extraspecial _). have [isoR | isoR] := IHn R oR esR. by left; case: pX1p2S => gz isoZ; rewrite (isog_cprod_by _ defG). have n_gt0: n > 0. have pR: 2.-group R by rewrite /pgroup oR pnatX. have:= min_card_extraspecial pR esR. by rewrite oR leq_exp2l // ltnS (leq_double 1). case: DnQ_P isoR => gR isoZR /=; rewrite isog_sym; case/isogP=> fR injfR im_fR. have [injDn injQ] := (injm_cpairg1 isoZR, injm_cpair1g isoZR). pose Dn1 := cpairg1 isoZR @* 'D^n.-1; pose Q := cpair1g isoZR @* 'Q_8. have defR: fR @* Dn1 \* fR @* Q = R. rewrite cprodE ?morphim_cents ?im_cpair_cent //. by rewrite -morphimMl ?subsetT ?im_cpair. rewrite -defR cprodA in defG. have [[Dn _ defDn _] _ _] := cprodP defG; rewrite defDn in defG. have isoDn: Dn \isog 'D^n. rewrite -(prednK n_gt0); case: pX1p2S => gz isoZ. rewrite (isog_cprod_by _ defDn) //; last 1 first. by rewrite isog_sym (isog_trans _ (sub_isog _ _)) ?subsetT // sub_isog. rewrite /= -morphimIim im_fR setIA ziER; apply/setIidPl. rewrite defZE -defZR -{1}im_fR -injm_center // morphimS //. by rewrite -cpairg1_center morphimS // center_sub. right; case: DnQ_P => gz isoZ; rewrite (isog_cprod_by _ defG) //; first 1 last. - exact: Aut_extraspecial_full (pX1p2n_pgroup _ _) (pX1p2n_extraspecial _ _). - by rewrite isog_sym (isog_trans _ (sub_isog _ _)) ?subsetT // sub_isog. rewrite /= -morphimIim; case/cprodP: defDn => _ defDn cDn1E. rewrite setICA setIA -defDn -group_modr ?morphimS ?subsetT //. rewrite /= im_fR (setIC R) ziER -center_prod // defZE -defZR. rewrite mulSGid /=; last first. by rewrite -{1}im_fR -injm_center // -cpairg1_center !morphimS ?center_sub. rewrite -injm_center ?subsetT // -injmI // setI_im_cpair. by rewrite -injm_center // cpairg1_center injm_center // im_fR mulGid. Qed. (* The first concluding remark of Aschbacher (23.14). *) Lemma rank_Dn n : 'r_2('D^n) = n.+1. Proof. elim: n => [|n IHn]; first by rewrite p_rank_abelem ?prime_abelem ?card_pX1p2n. have oDDn: #|'D^n.+1| = (2 ^ n.+1.*2.+1)%N by apply: card_pX1p2n. have esDDn: extraspecial 'D^n.+1 by apply: pX1p2n_extraspecial. do [case: pX1p2S => gz isoZ; set DDn := [set: _]] in oDDn esDDn *. have pDDn: 2.-group DDn by rewrite /pgroup oDDn pnatX. apply/eqP; rewrite eqn_leq; apply/andP; split. have [E EprE]:= p_rank_witness 2 [group of DDn]. have [sEDDn abelE <-] := pnElemP EprE; have [pE cEE _]:= and3P abelE. rewrite -(@leq_exp2l 2) // -p_part part_pnat_id // -leq_sqr -expnM -mulnn. rewrite muln2 doubleS expnS -oDDn -(@leq_pmul2r #|'C_DDn(E)|) ?cardG_gt0 //. rewrite {1}(card_subcent_extraspecial pDDn) // mulnCA -mulnA Lagrange //=. rewrite mulnAC mulnA leq_pmul2r ?cardG_gt0 // setTI. have ->: (2 * #|'C(E)| = #|'Z(DDn)| * #|'C(E)|)%N. by rewrite (card_center_extraspecial pDDn). by rewrite leq_mul ?subset_leq_card ?subsetIl. have [inj1 injn] := (injm_cpairg1 isoZ, injm_cpair1g isoZ). pose D := cpairg1 isoZ @* 2^{1+2}; pose Dn := cpair1g isoZ @* 'D^n. have [E EprE] := p_rank_witness 2 [group of Dn]. rewrite injm_p_rank //= IHn in EprE; have [sEDn abelE dimE]:= pnElemP EprE. have [x [Dx ox] notDnx]: exists x, [/\ x \in D, #[x] = 2 & x \notin Dn]. have isoD: D \isog 'D_(2 ^ 3). by rewrite isog_sym -(isog_transl _ isog_2X1p2) sub_isog. have [//| [x y] genD [oy _]] := generators_2dihedral _ isoD. have [_ _ _ X'y] := genD; case/setDP: X'y; rewrite /= -/D => Dy notXy. exists y; split=> //; apply: contra notXy => Dny. case/dihedral2_structure: genD => // _ _ _ _ [defZD _ _ _ _]. by rewrite (subsetP (cycleX x 2)) // -defZD -setI_im_cpair inE Dy. have def_xE: <[x]> \x E = <[x]> <*> E. rewrite dprodEY ?prime_TIg -?orderE ?ox //. by rewrite (centSS sEDn _ (im_cpair_cent _)) ?cycle_subG. by rewrite cycle_subG (contra (subsetP sEDn x)). apply/p_rank_geP; exists (<[x]> <*> E)%G. rewrite 2!inE subsetT (dprod_abelem _ def_xE) abelE -(dprod_card def_xE). by rewrite prime_abelem -?orderE ?ox //= lognM ?cardG_gt0 ?dimE. Qed. (* The second concluding remark of Aschbacher (23.14). *) Lemma rank_DnQ n : 'r_2('D^n*Q) = n.+1. Proof. have pDnQ: 2.-group 'D^n*Q := DnQ_pgroup n. have esDnQ: extraspecial 'D^n*Q := DnQ_extraspecial n. do [case: DnQ_P => gz isoZ; set DnQ := setT] in pDnQ esDnQ *. suffices [E]: exists2 E, E \in 'E*_2(DnQ) & logn 2 #|E| = n.+1. by rewrite (pmaxElem_extraspecial pDnQ esDnQ); case/pnElemP=> _ _ <-. have oZ: #|'Z(DnQ)| = 2 by apply: card_center_extraspecial. pose Dn := cpairg1 isoZ @* 'D^n; pose Q := cpair1g isoZ @* 'Q_8. have [injDn injQ] := (injm_cpairg1 isoZ, injm_cpair1g isoZ). have [E EprE]:= p_rank_witness 2 [group of Dn]. have [sEDn abelE dimE] := pnElemP EprE; have [pE cEE eE]:= and3P abelE. rewrite injm_p_rank // rank_Dn in dimE; exists E => //. have sZE: 'Z(DnQ) \subset E. have maxE := subsetP (p_rankElem_max _ _) E EprE. have abelZ: 2.-abelem 'Z(DnQ) by rewrite prime_abelem ?oZ. rewrite -(Ohm1_id abelZ) (OhmE _ (abelem_pgroup abelZ)) gen_subG. rewrite -(pmaxElem_LdivP _ maxE) // setSI //=. by rewrite -cpairg1_center injm_center // setIS ?centS. have scE: 'C_Dn(E) = E. apply/eqP; rewrite eq_sym eqEcard subsetI sEDn -abelianE cEE /=. have [n0 | n_gt0] := posnP n. rewrite subset_leq_card // subIset // (subset_trans _ sZE) //. by rewrite -cpairg1_center morphimS // n0 center_ncprod0. have pDn: 2.-group Dn by rewrite morphim_pgroup ?pX1p2n_pgroup. have esDn: extraspecial Dn. exact: injm_extraspecial (pX1p2n_extraspecial _ _). rewrite dvdn_leq ?cardG_gt0 // (card_subcent_extraspecial pDn) //=. rewrite -injm_center // cpairg1_center (setIidPl sZE) oZ. rewrite -(dvdn_pmul2l (cardG_gt0 E)) mulnn mulnCA Lagrange //. rewrite card_injm ?card_pX1p2n // -expnS pfactor_dvdn ?expn_gt0 ?cardG_gt0 //. by rewrite lognX dimE mul2n. apply/pmaxElemP; split=> [|F E2F sEF]; first by rewrite inE subsetT abelE. have{E2F} [_ abelF] := pElemP E2F; have [pF cFF eF] := and3P abelF. apply/eqP; rewrite eqEsubset sEF andbT; apply/subsetP=> x Fx. have DnQx: x \in Dn * Q by rewrite im_cpair inE. have{DnQx} [y z Dn_y Qz def_x]:= imset2P DnQx. have{Dn_y} Ey: y \in E. have cEz: z \in 'C(E). by rewrite (subsetP (centS sEDn)) // (subsetP (im_cpair_cent _)). rewrite -scE inE Dn_y -(groupMr _ cEz) -def_x (subsetP (centS sEF)) //. by rewrite (subsetP cFF). rewrite def_x groupMl // (subsetP sZE) // -cpair1g_center injm_center //= -/Q. have: z \in 'Ohm_1(Q). rewrite (OhmE 1 (pgroupS (subsetT Q) pDnQ)) mem_gen // !inE Qz /=. rewrite -[z](mulKg y) -def_x (exponentP eF) ?groupM //. by rewrite groupV (subsetP sEF). have isoQ: Q \isog 'Q_(2 ^ 3) by rewrite isog_sym sub_isog. have [//|[u v] genQ _] := generators_quaternion _ isoQ. by case/quaternion_structure: genQ => // _ _ [-> _ _ [-> _] _] _ _. Qed. (* The final concluding remark of Aschbacher (23.14). *) Lemma not_isog_Dn_DnQ n : ~~ ('D^n \isog 'D^n.-1*Q). Proof. case: n => [|n] /=; first by rewrite isogEcard card_pX1p2n // card_DnQ andbF. apply: contraL (leqnn n.+1) => isoDn1DnQ. by rewrite -ltnNge -rank_Dn (isog_p_rank isoDn1DnQ) rank_DnQ. Qed. math-comp-mathcomp-1.12.0/mathcomp/solvable/extremal.v000066400000000000000000003574201375767750300227540ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import choice fintype bigop finset prime binomial. From mathcomp Require Import fingroup morphism perm automorphism presentation. From mathcomp Require Import quotient action commutator gproduct gfunctor. From mathcomp Require Import ssralg finalg zmodp cyclic pgroup center gseries. From mathcomp Require Import nilpotent sylow abelian finmodule matrix maximal. (******************************************************************************) (* This file contains the definition and properties of extremal p-groups; *) (* it covers and is mostly based on the beginning of Aschbacher, section 23, *) (* as well as several exercises of this section. *) (* We define canonical representatives for the group classes that cover the *) (* extremal p-groups (non-abelian p-groups with a cyclic maximal subgroup): *) (* 'Mod_m == the modular group of order m, for m = p ^ n, p prime and n >= 3. *) (* 'D_m == the dihedral group of order m, for m = 2n >= 4. *) (* 'Q_m == the generalized quaternion group of order m, for m = 2 ^ n >= 8. *) (* 'SD_m == the semi-dihedral group of order m, for m = 2 ^ n >= 16. *) (* In each case the notation is defined in the %type, %g and %G scopes, where *) (* it denotes a finGroupType, a full gset and the full group for that type. *) (* However each notation is only meaningful under the given conditions, in *) (* 'D_m is only an extremal group for m = 2 ^ n >= 8, and 'D_8 = 'Mod_8 (they *) (* are, in fact, beta-convertible). *) (* We also define *) (* extremal_generators G p n (x, y) <-> G has order p ^ n, x in G has order *) (* p ^ n.-1, and y is in G \ <[x]>: thus <[x]> has index p in G, *) (* so if p is prime, <[x]> is maximal in G, G is generated by x *) (* and y, and G is extremal or abelian. *) (* extremal_class G == the class of extremal groups G belongs to: one of *) (* ModularGroup, Dihedral, Quaternion, SemiDihedral or NotExtremal. *) (* extremal2 G <=> extremal_class G is one of Dihedral, Quaternion, or *) (* SemiDihedral; this allows 'D_4 and 'D_8, but excludes 'Mod_(2^n) *) (* for n > 3. *) (* modular_group_generators p n (x, y) <-> y has order p and acts on x via *) (* x ^ y = x ^+ (p ^ n.-2).+1. This is the complement to *) (* extremal_generators G p n (x, y) for modular groups. *) (* We provide cardinality, presentation, generator and structure theorems for *) (* each class of extremal group. The extremal_generators predicate is used to *) (* supply structure theorems with all the required data about G; this is *) (* completed by an isomorphism assumption (e.g., G \isog 'D_(2 ^ n)), and *) (* sometimes other properties (e.g., #[y] == 2 in the semidihedral case). The *) (* generators assumption can be deduced generically from the isomorphism *) (* assumption, or it can be proved manually for a specific choice of x and y. *) (* The extremal_class function is used to formulate synthetic theorems that *) (* cover several classes of extremal groups (e.g., Aschbacher ex. 8.3). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GroupScope GRing.Theory. Reserved Notation "''Mod_' m" (at level 8, m at level 2, format "''Mod_' m"). Reserved Notation "''D_' m" (at level 8, m at level 2, format "''D_' m"). Reserved Notation "''SD_' m" (at level 8, m at level 2, format "''SD_' m"). Reserved Notation "''Q_' m" (at level 8, m at level 2, format "''Q_' m"). Module Extremal. Section Construction. Variables q p e : nat. (* Construct the semi-direct product of 'Z_q by 'Z_p with 1%R ^ 1%R = e%R, *) (* if possible, i.e., if p, q > 1 and there is s \in Aut 'Z_p such that *) (* #[s] %| p and s 1%R = 1%R ^+ e. *) Let a : 'Z_p := Zp1. Let b : 'Z_q := Zp1. Local Notation B := <[b]>. Definition aut_of := odflt 1 [pick s in Aut B | p > 1 & (#[s] %| p) && (s b == b ^+ e)]. Lemma aut_dvdn : #[aut_of] %| #[a]. Proof. rewrite order_Zp1 /aut_of; case: pickP => [s | _]; last by rewrite order1. by case/and4P=> _ p_gt1 p_s _; rewrite Zp_cast. Qed. Definition act_morphism := eltm_morphism aut_dvdn. Definition base_act := ([Aut B] \o act_morphism)%gact. Lemma act_dom : <[a]> \subset act_dom base_act. Proof. rewrite cycle_subG 2!inE cycle_id /= eltm_id /aut_of. by case: pickP => [op /andP[] | _] //=; rewrite group1. Qed. Definition gact := (base_act \ act_dom)%gact. Fact gtype_key : unit. Proof. by []. Qed. Definition gtype := locked_with gtype_key (sdprod_groupType gact). Hypotheses (p_gt1 : p > 1) (q_gt1 : q > 1). Lemma card : #|[set: gtype]| = (p * q)%N. Proof. rewrite [gtype]unlock -(sdprod_card (sdprod_sdpair _)). rewrite !card_injm ?injm_sdpair1 ?injm_sdpair2 //. by rewrite mulnC -!orderE !order_Zp1 !Zp_cast. Qed. Lemma Grp : (exists s, [/\ s \in Aut B, #[s] %| p & s b = b ^+ e]) -> [set: gtype] \isog Grp (x : y : (x ^+ q, y ^+ p, x ^ y = x ^+ e)). Proof. rewrite [gtype]unlock => [[s [AutBs dvd_s_p sb]]]. have memB: _ \in B by move=> c; rewrite -Zp_cycle inE. have Aa: a \in <[a]> by rewrite !cycle_id. have [oa ob]: #[a] = p /\ #[b] = q by rewrite !order_Zp1 !Zp_cast. have def_s: aut_of = s. rewrite /aut_of; case: pickP => /= [t | ]; last first. by move/(_ s); case/and4P; rewrite sb. case/and4P=> AutBt _ _ tb; apply: (eq_Aut AutBt) => // b_i. case/cycleP=> i ->; rewrite -(autmE AutBt) -(autmE AutBs) !morphX //=. by rewrite !autmE // sb (eqP tb). apply: intro_isoGrp => [|gT G]. apply/existsP; exists (sdpair1 _ b, sdpair2 _ a); rewrite /= !xpair_eqE. rewrite -!morphim_cycle ?norm_joinEr ?im_sdpair ?im_sdpair_norm ?eqxx //=. rewrite -!order_dvdn !order_injm ?injm_sdpair1 ?injm_sdpair2 // oa ob !dvdnn. by rewrite -sdpair_act // [act _ _ _]apermE /= eltm_id -morphX // -sb -def_s. case/existsP=> -[x y] /= /eqP[defG xq1 yp1 xy]. have fxP: #[x] %| #[b] by rewrite order_dvdn ob xq1. have fyP: #[y] %| #[a] by rewrite order_dvdn oa yp1. have fP: {in <[b]> & <[a]>, morph_act gact 'J (eltm fxP) (eltm fyP)}. move=> bj ai; case/cycleP=> j ->{bj}; case/cycleP=> i ->{ai}. rewrite /= !eltmE def_s gactX ?groupX // conjXg morphX //=; congr (_ ^+ j). rewrite /autact /= apermE; elim: i {j} => /= [|i IHi]. by rewrite perm1 eltm_id conjg1. rewrite !expgS permM sb -(autmE (groupX i AutBs)) !morphX //= {}IHi. by rewrite -conjXg -xy -conjgM. apply/homgP; exists (xsdprod_morphism fP). rewrite im_xsdprodm !morphim_cycle //= !eltm_id -norm_joinEr //. by rewrite norms_cycle xy mem_cycle. Qed. End Construction. End Extremal. Section SpecializeExtremals. Import Extremal. Variable m : nat. Let p := pdiv m. Let q := m %/ p. Definition modular_gtype := gtype q p (q %/ p).+1. Definition dihedral_gtype := gtype q 2 q.-1. Definition semidihedral_gtype := gtype q 2 (q %/ p).-1. Definition quaternion_kernel := <<[set u | u ^+ 2 == 1] :\: [set u ^+ 2 | u in [set: gtype q 4 q.-1]]>>. Definition quaternion_gtype := locked_with gtype_key (coset_groupType quaternion_kernel). End SpecializeExtremals. Notation "''Mod_' m" := (modular_gtype m) : type_scope. Notation "''Mod_' m" := [set: gsort 'Mod_m] : group_scope. Notation "''Mod_' m" := [set: gsort 'Mod_m]%G : Group_scope. Notation "''D_' m" := (dihedral_gtype m) : type_scope. Notation "''D_' m" := [set: gsort 'D_m] : group_scope. Notation "''D_' m" := [set: gsort 'D_m]%G : Group_scope. Notation "''SD_' m" := (semidihedral_gtype m) : type_scope. Notation "''SD_' m" := [set: gsort 'SD_m] : group_scope. Notation "''SD_' m" := [set: gsort 'SD_m]%G : Group_scope. Notation "''Q_' m" := (quaternion_gtype m) : type_scope. Notation "''Q_' m" := [set: gsort 'Q_m] : group_scope. Notation "''Q_' m" := [set: gsort 'Q_m]%G : Group_scope. Section ExtremalTheory. Implicit Types (gT : finGroupType) (p q m n : nat). (* This is Aschbacher (23.3), with the isomorphism made explicit, and a *) (* slightly reworked case analysis on the prime and exponent; in particular *) (* the inverting involution is available for all non-trivial p-cycles. *) Lemma cyclic_pgroup_Aut_structure gT p (G : {group gT}) : p.-group G -> cyclic G -> G :!=: 1 -> let q := #|G| in let n := (logn p q).-1 in let A := Aut G in let P := 'O_p(A) in let F := 'O_p^'(A) in exists m : {perm gT} -> 'Z_q, [/\ [/\ {in A & G, forall a x, x ^+ m a = a x}, m 1 = 1%R /\ {in A &, {morph m : a b / a * b >-> (a * b)%R}}, {in A &, injective m} /\ image m A =i GRing.unit, forall k, {in A, {morph m : a / a ^+ k >-> (a ^+ k)%R}} & {in A, {morph m : a / a^-1 >-> (a^-1)%R}}], [/\ abelian A, cyclic F, #|F| = p.-1 & [faithful F, on 'Ohm_1(G) | [Aut G]]] & if n == 0%N then A = F else exists t, [/\ t \in A, #[t] = 2, m t = - 1%R & if odd p then [/\ cyclic A /\ cyclic P, exists s, [/\ s \in A, #[s] = (p ^ n)%N, m s = p.+1%:R & P = <[s]>] & exists s0, [/\ s0 \in A, #[s0] = p, m s0 = (p ^ n).+1%:R & 'Ohm_1(P) = <[s0]>]] else if n == 1%N then A = <[t]> else exists s, [/\ s \in A, #[s] = (2 ^ n.-1)%N, m s = 5%:R, <[s]> \x <[t]> = A & exists s0, [/\ s0 \in A, #[s0] = 2, m s0 = (2 ^ n).+1%:R, m (s0 * t) = (2 ^ n).-1%:R & 'Ohm_1(<[s]>) = <[s0]>]]]]. Proof. move=> pG cycG ntG q n0 A P F; have [p_pr p_dvd_G [n oG]] := pgroup_pdiv pG ntG. have [x0 defG] := cyclicP cycG; have Gx0: x0 \in G by rewrite defG cycle_id. rewrite {1}/q oG pfactorK //= in n0 *; rewrite {}/n0. have [p_gt1 min_p] := primeP p_pr; have p_gt0 := ltnW p_gt1. have q_gt1: q > 1 by rewrite cardG_gt1. have cAA: abelian A := Aut_cyclic_abelian cycG; have nilA := abelian_nil cAA. have oA: #|A| = (p.-1 * p ^ n)%N. by rewrite card_Aut_cyclic // oG totient_pfactor. have [sylP hallF]: p.-Sylow(A) P /\ p^'.-Hall(A) F. by rewrite !nilpotent_pcore_Hall. have [defPF tiPF]: P * F = A /\ P :&: F = 1. by case/dprodP: (nilpotent_pcoreC p nilA). have oP: #|P| = (p ^ n)%N. by rewrite (card_Hall sylP) oA p_part logn_Gauss ?coprimenP ?pfactorK. have oF: #|F| = p.-1. apply/eqP; rewrite -(@eqn_pmul2l #|P|) ?cardG_gt0 // -TI_cardMg // defPF. by rewrite oA oP mulnC. have [m' [inj_m' defA def_m']]: exists m' : {morphism units_Zp q >-> {perm gT}}, [/\ 'injm m', m' @* setT = A & {in G, forall x u, m' u x = x ^+ val u}]. - rewrite /A /q defG; exists (Zp_unit_morphism x0). by have [->]:= isomP (Zp_unit_isom x0); split=> // y Gy u; rewrite permE Gy. pose m (a : {perm gT}) : 'Z_q := val (invm inj_m' a). have{def_m'} def_m: {in A & G, forall a x, x ^+ m a = a x}. by move=> a x Aa Gx /=; rewrite -{2}[a](invmK inj_m') ?defA ?def_m'. have m1: m 1 = 1%R by rewrite /m morph1. have mM: {in A &, {morph m : a b / a * b >-> (a * b)%R}}. by move=> a b Aa Ab; rewrite /m morphM ?defA. have mX k: {in A, {morph m : a / a ^+ k >-> (a ^+ k)%R}}. by elim: k => // k IHk a Aa; rewrite expgS exprS mM ?groupX ?IHk. have inj_m: {in A &, injective m}. apply: can_in_inj (fun u => m' (insubd (1 : {unit 'Z_q}) u)) _ => a Aa. by rewrite valKd invmK ?defA. have{defA} im_m: image m A =i GRing.unit. move=> u; apply/imageP/idP=> [[a Aa ->]| Uu]; first exact: valP. exists (m' (Sub u Uu)) => /=; first by rewrite -defA mem_morphim ?inE. by rewrite /m invmE ?inE. have mV: {in A, {morph m : a / a^-1 >-> (a^-1)%R}}. move=> a Aa /=; rewrite -div1r; apply: canRL (mulrK (valP _)) _. by rewrite -mM ?groupV ?mulVg. have inv_m (u : 'Z_q) : coprime q u -> {a | a \in A & m a = u}. rewrite -?unitZpE // natr_Zp -im_m => m_u. by exists (iinv m_u); [apply: mem_iinv | rewrite f_iinv]. have [cycF ffulF]: cyclic F /\ [faithful F, on 'Ohm_1(G) | [Aut G]]. have Um0 a: ((m a)%:R : 'F_p) \in GRing.unit. have: m a \in GRing.unit by apply: valP. by rewrite -{1}[m a]natr_Zp unitFpE ?unitZpE // {1}/q oG coprime_pexpl. pose fm0 a := FinRing.unit 'F_p (Um0 a). have natZqp u: (u%:R : 'Z_q)%:R = u %:R :> 'F_p. by rewrite val_Zp_nat // -Fp_nat_mod // modn_dvdm ?Fp_nat_mod. have m0M: {in A &, {morph fm0 : a b / a * b}}. move=> a b Aa Ab; apply: val_inj; rewrite /= -natrM mM //. by rewrite -[(_ * _)%R]Zp_nat natZqp. pose m0 : {morphism A >-> {unit 'F_p}} := Morphism m0M. have im_m0: m0 @* A = [set: {unit 'F_p}]. apply/setP=> [[/= u Uu]]; rewrite in_setT morphimEdom; apply/imsetP. have [|a Aa m_a] := inv_m u%:R. by rewrite {1}[q]oG coprime_pexpl // -unitFpE // natZqp natr_Zp. by exists a => //; apply: val_inj; rewrite /= m_a natZqp natr_Zp. have [x1 defG1]: exists x1, 'Ohm_1(G) = <[x1]>. by apply/cyclicP; apply: cyclicS (Ohm_sub _ _) cycG. have ox1: #[x1] = p by rewrite orderE -defG1 (Ohm1_cyclic_pgroup_prime _ pG). have Gx1: x1 \in G by rewrite -cycle_subG -defG1 Ohm_sub. have ker_m0: 'ker m0 = 'C('Ohm_1(G) | [Aut G]). apply/setP=> a; rewrite inE in_setI; apply: andb_id2l => Aa. rewrite 3!inE /= -2!val_eqE /= val_Fp_nat // [1 %% _]modn_small // defG1. apply/idP/subsetP=> [ma1 x1i | ma1]. case/cycleP=> i ->{x1i}; rewrite inE gactX // -[_ a]def_m //. by rewrite -(expg_mod_order x1) ox1 (eqP ma1). have:= ma1 x1 (cycle_id x1); rewrite inE -[_ a]def_m //. by rewrite (eq_expg_mod_order x1 _ 1) ox1 (modn_small p_gt1). have card_units_Fp: #|[set: {unit 'F_p}]| = p.-1. by rewrite card_units_Zp // pdiv_id // (@totient_pfactor p 1) ?muln1. have ker_m0_P: 'ker m0 = P. apply: nilpotent_Hall_pcore nilA _. rewrite pHallE -(card_Hall sylP) oP subsetIl /=. rewrite -(@eqn_pmul2r #|m0 @* A|) ?cardG_gt0 //; apply/eqP. rewrite -{1}(card_isog (first_isog _)) card_quotient ?ker_norm //. by rewrite Lagrange ?subsetIl // oA im_m0 mulnC card_units_Fp. have inj_m0: 'ker_F m0 \subset [1] by rewrite setIC ker_m0_P tiPF. split; last by rewrite /faithful -ker_m0. have isogF: F \isog [set: {unit 'F_p}]. have sFA: F \subset A by apply: pcore_sub. apply/isogP; exists (restrm_morphism sFA m0); first by rewrite ker_restrm. apply/eqP; rewrite eqEcard subsetT card_injm ?ker_restrm //= oF. by rewrite card_units_Fp. rewrite (isog_cyclic isogF) pdiv_id // -ox1 (isog_cyclic (Zp_unit_isog x1)). by rewrite Aut_prime_cyclic // -orderE ox1. exists m; split=> {im_m mV}//; have [n0 | n_gt0] := posnP n. by apply/eqP; rewrite eq_sym eqEcard pcore_sub oF oA n0 muln1 /=. have [t At mt]: {t | t \in A & m t = -1}. apply: inv_m; rewrite /= Zp_cast // coprime_modr modn_small // subn1. by rewrite coprimenP // ltnW. have ot: #[t] = 2. apply/eqP; rewrite eqn_leq order_gt1 dvdn_leq ?order_dvdn //=. apply/eqP; move/(congr1 m); apply/eqP; rewrite mt m1 eq_sym -subr_eq0. rewrite opprK -val_eqE /= Zp_cast ?modn_small // /q oG ltnW //. by rewrite (leq_trans (_ : 2 ^ 2 <= p ^ 2)) ?leq_sqr ?leq_exp2l. by apply/eqP; apply: inj_m; rewrite ?groupX ?group1 ?mX // mt -signr_odd. exists t; split=> //. case G4: (~~ odd p && (n == 1%N)). case: (even_prime p_pr) G4 => [p2 | -> //]; rewrite p2 /=; move/eqP=> n1. rewrite n1 /=; apply/eqP; rewrite eq_sym eqEcard cycle_subG At /=. by rewrite -orderE oA ot p2 n1. pose e0 : nat := ~~ odd p. have{inv_m} [s As ms]: {s | s \in A & m s = (p ^ e0.+1).+1%:R}. apply: inv_m; rewrite val_Zp_nat // coprime_modr /q oG coprime_pexpl //. by rewrite -(@coprime_pexpl e0.+1) // coprimenS. have lt_e0_n: e0 < n. by rewrite /e0; case: (~~ _) G4 => //=; rewrite ltn_neqAle eq_sym => ->. pose s0 := s ^+ (p ^ (n - e0.+1)). have [ms0 os0]: m s0 = (p ^ n).+1%:R /\ #[s0] = p. have m_se e: exists2 k, k = 1 %[mod p] & m (s ^+ (p ^ e)) = (k * p ^ (e + e0.+1)).+1%:R. - elim: e => [|e [k k1 IHe]]; first by exists 1%N; rewrite ?mul1n. rewrite expnSr expgM mX ?groupX // {}IHe -natrX -(add1n (k * _)). rewrite expnDn -(prednK p_gt0) 2!big_ord_recl /= prednK // !exp1n bin1. rewrite bin0 muln1 mul1n mulnCA -expnS (addSn e). set f := (e + _)%N; set sum := (\sum_i _)%N. exists (sum %/ p ^ f.+2 * p + k)%N; first by rewrite modnMDl. rewrite -(addnC k) mulnDl -mulnA -expnS divnK // {}/sum. apply big_ind => [||[i _] /= _]; [exact: dvdn0 | exact: dvdn_add |]. rewrite exp1n mul1n /bump !add1n expnMn mulnCA dvdn_mull // -expnM. case: (ltnP f.+1 (f * i.+2)) => [le_f_fi|]. by rewrite dvdn_mull ?dvdn_exp2l. rewrite {1}mulnS -(addn1 f) leq_add2l {}/f addnS /e0. case: i e => [] // [] //; case odd_p: (odd p) => //= _. by rewrite bin2odd // mulnAC dvdn_mulr. have [[|d]] := m_se (n - e0.+1)%N; first by rewrite mod0n modn_small. move/eqP; rewrite -/s0 eqn_mod_dvd ?subn1 //=; case/dvdnP=> f -> {d}. rewrite subnK // mulSn -mulnA -expnS -addSn natrD natrM -oG char_Zp //. rewrite mulr0 addr0 => m_s0; split => //. have [d _] := m_se (n - e0)%N; rewrite -subnSK // expnSr expgM -/s0. rewrite addSn subnK // -oG mulrS natrM char_Zp // {d}mulr0 addr0. move/eqP; rewrite -m1 (inj_in_eq inj_m) ?group1 ?groupX // -order_dvdn. move/min_p; rewrite order_eq1; case/predU1P=> [s0_1 | ]; last by move/eqP. move/eqP: m_s0; rewrite eq_sym s0_1 m1 -subr_eq0 mulrSr addrK -val_eqE /=. have pf_gt0: p ^ _ > 0 by move=> e; rewrite expn_gt0 p_gt0. by rewrite val_Zp_nat // /q oG [_ == _]pfactor_dvdn // pfactorK ?ltnn. have os: #[s] = (p ^ (n - e0))%N. have: #[s] %| p ^ (n - e0). by rewrite order_dvdn -subnSK // expnSr expgM -order_dvdn os0. case/dvdn_pfactor=> // d; rewrite leq_eqVlt. case/predU1P=> [-> // | lt_d os]; case/idPn: (p_gt1); rewrite -os0. by rewrite order_gt1 negbK -order_dvdn os dvdn_exp2l // -ltnS -subSn. have p_s: p.-elt s by rewrite /p_elt os pnatX ?pnat_id. have defS1: 'Ohm_1(<[s]>) = <[s0]>. apply/eqP; rewrite eq_sym eqEcard cycle_subG -orderE os0. rewrite (Ohm1_cyclic_pgroup_prime _ p_s) ?cycle_cyclic ?leqnn ?cycle_eq1 //=. rewrite (OhmE _ p_s) mem_gen ?groupX //= !inE mem_cycle //. by rewrite -order_dvdn os0 ?dvdnn. by apply/eqP=> s1; rewrite -os0 /s0 s1 expg1n order1 in p_gt1. case: (even_prime p_pr) => [p2 | oddp]; last first. rewrite {+}/e0 oddp subn0 in s0 os0 ms0 os ms defS1 *. have [f defF] := cyclicP cycF; have defP: P = <[s]>. apply/eqP; rewrite eq_sym eqEcard -orderE oP os leqnn andbT. by rewrite cycle_subG (mem_normal_Hall sylP) ?pcore_normal. rewrite defP; split; last 1 [by exists s | by exists s0; rewrite ?groupX]. rewrite -defPF defP defF -cycleM ?cycle_cyclic // /order. by red; rewrite (centsP cAA) // -cycle_subG -defF pcore_sub. by rewrite -defF -defP (pnat_coprime (pcore_pgroup _ _) (pcore_pgroup _ _)). rewrite {+}/e0 p2 subn1 /= in s0 os0 ms0 os ms G4 defS1 lt_e0_n *. rewrite G4; exists s; split=> //; last first. exists s0; split; rewrite ?groupX //; apply/eqP; rewrite mM ?groupX //. rewrite ms0 mt eq_sym mulrN1 -subr_eq0 opprK -natrD -addSnnS. by rewrite prednK ?expn_gt0 // addnn -mul2n -expnS -p2 -oG char_Zp. suffices TIst: <[s]> :&: <[t]> = 1. rewrite dprodE //; last by rewrite (sub_abelian_cent2 cAA) ?cycle_subG. apply/eqP; rewrite eqEcard mulG_subG !cycle_subG As At oA. by rewrite TI_cardMg // -!orderE os ot p2 mul1n /= -expnSr prednK. rewrite setIC; apply: prime_TIg; first by rewrite -orderE ot. rewrite cycle_subG; apply/negP=> St. have: t \in <[s0]>. by rewrite -defS1 (OhmE _ p_s) mem_gen // !inE St -order_dvdn ot p2. have ->: <[s0]> = [set 1; s0]. apply/eqP; rewrite eq_sym eqEcard subUset !sub1set group1 cycle_id /=. by rewrite -orderE cards2 eq_sym -order_gt1 os0. rewrite !inE -order_eq1 ot /=; move/eqP; move/(congr1 m); move/eqP. rewrite mt ms0 eq_sym -subr_eq0 opprK -mulrSr. rewrite -val_eqE [val _]val_Zp_nat //= /q oG p2 modn_small //. by rewrite -addn3 expnS mul2n -addnn leq_add2l (ltn_exp2l 1). Qed. Definition extremal_generators gT (A : {set gT}) p n xy := let: (x, y) := xy in [/\ #|A| = (p ^ n)%N, x \in A, #[x] = (p ^ n.-1)%N & y \in A :\: <[x]>]. Lemma extremal_generators_facts gT (G : {group gT}) p n x y : prime p -> extremal_generators G p n (x, y) -> [/\ p.-group G, maximal <[x]> G, <[x]> <| G, <[x]> * <[y]> = G & <[y]> \subset 'N(<[x]>)]. Proof. move=> p_pr [oG Gx ox] /setDP[Gy notXy]. have pG: p.-group G by rewrite /pgroup oG pnatX pnat_id. have maxX: maximal <[x]> G. rewrite p_index_maximal -?divgS ?cycle_subG // -orderE oG ox. case: (n) oG => [|n' _]; last by rewrite -expnB ?subSnn ?leqnSn ?prime_gt0. move/eqP; rewrite -trivg_card1; case/trivgPn. by exists y; rewrite // (group1_contra notXy). have nsXG := p_maximal_normal pG maxX; split=> //. by apply: mulg_normal_maximal; rewrite ?cycle_subG. by rewrite cycle_subG (subsetP (normal_norm nsXG)). Qed. Section ModularGroup. Variables p n : nat. Let m := (p ^ n)%N. Let q := (p ^ n.-1)%N. Let r := (p ^ n.-2)%N. Hypotheses (p_pr : prime p) (n_gt2 : n > 2). Let p_gt1 := prime_gt1 p_pr. Let p_gt0 := ltnW p_gt1. Let def_n := esym (subnKC n_gt2). Let def_p : pdiv m = p. Proof. by rewrite /m def_n pdiv_pfactor. Qed. Let def_q : m %/ p = q. Proof. by rewrite /m /q def_n expnS mulKn. Qed. Let def_r : q %/ p = r. Proof. by rewrite /r /q def_n expnS mulKn. Qed. Let ltqm : q < m. Proof. by rewrite ltn_exp2l // def_n. Qed. Let ltrq : r < q. Proof. by rewrite ltn_exp2l // def_n. Qed. Let r_gt0 : 0 < r. Proof. by rewrite expn_gt0 ?p_gt0. Qed. Let q_gt1 : q > 1. Proof. exact: leq_ltn_trans r_gt0 ltrq. Qed. Lemma card_modular_group : #|'Mod_(p ^ n)| = (p ^ n)%N. Proof. by rewrite Extremal.card def_p ?def_q // -expnS def_n. Qed. Lemma Grp_modular_group : 'Mod_(p ^ n) \isog Grp (x : y : (x ^+ q, y ^+ p, x ^ y = x ^+ r.+1)). Proof. rewrite /modular_gtype def_p def_q def_r; apply: Extremal.Grp => //. set B := <[_]>; have Bb: Zp1 \in B by apply: cycle_id. have oB: #|B| = q by rewrite -orderE order_Zp1 Zp_cast. have cycB: cyclic B by rewrite cycle_cyclic. have pB: p.-group B by rewrite /pgroup oB pnatX ?pnat_id. have ntB: B != 1 by rewrite -cardG_gt1 oB. have [] := cyclic_pgroup_Aut_structure pB cycB ntB. rewrite oB pfactorK //= -/B -(expg_znat r.+1 Bb) oB => mB [[def_mB _ _ _ _] _]. rewrite {1}def_n /= => [[t [At ot mBt]]]. have [p2 | ->] := even_prime p_pr; last first. by case=> _ _ [s [As os mBs _]]; exists s; rewrite os -mBs def_mB. rewrite {1}p2 /= -2!eqSS -addn2 -2!{1}subn1 -subnDA subnK 1?ltnW //. case: eqP => [n3 _ | _ [_ [_ _ _ _ [s [As os mBs _ _]{t At ot mBt}]]]]. by exists t; rewrite At ot -def_mB // mBt /q /r p2 n3. by exists s; rewrite As os -def_mB // mBs /r p2. Qed. Definition modular_group_generators gT (xy : gT * gT) := let: (x, y) := xy in #[y] = p /\ x ^ y = x ^+ r.+1. Lemma generators_modular_group gT (G : {group gT}) : G \isog 'Mod_m -> exists2 xy, extremal_generators G p n xy & modular_group_generators xy. Proof. case/(isoGrpP _ Grp_modular_group); rewrite card_modular_group // -/m => oG. case/existsP=> -[x y] /= /eqP[defG xq yp xy]. rewrite norm_joinEr ?norms_cycle ?xy ?mem_cycle // in defG. have [Gx Gy]: x \in G /\ y \in G. by apply/andP; rewrite -!cycle_subG -mulG_subG defG. have notXy: y \notin <[x]>. apply: contraL ltqm; rewrite -cycle_subG -oG -defG; move/mulGidPl->. by rewrite -leqNgt dvdn_leq ?(ltnW q_gt1) // order_dvdn xq. have oy: #[y] = p by apply: nt_prime_order (group1_contra notXy). exists (x, y) => //=; split; rewrite ?inE ?notXy //. apply/eqP; rewrite -(eqn_pmul2r p_gt0) -expnSr -{1}oy (ltn_predK n_gt2) -/m. by rewrite -TI_cardMg ?defG ?oG // setIC prime_TIg ?cycle_subG // -orderE oy. Qed. (* This is an adaptation of Aschbacher, exercise 8.2: *) (* - We allow an alternative to the #[x] = p ^ n.-1 condition that meshes *) (* better with the modular_Grp lemma above. *) (* - We state explicitly some "obvious" properties of G, namely that G is *) (* the non-abelian semi-direct product <[x]> ><| <[y]> and that y ^+ j *) (* acts on <[x]> via z |-> z ^+ (j * p ^ n.-2).+1 *) (* - We also give the values of the 'Mho^k(G). *) (* - We corrected a pair of typos. *) Lemma modular_group_structure gT (G : {group gT}) x y : extremal_generators G p n (x, y) -> G \isog 'Mod_m -> modular_group_generators (x, y) -> let X := <[x]> in [/\ [/\ X ><| <[y]> = G, ~~ abelian G & {in X, forall z j, z ^ (y ^+ j) = z ^+ (j * r).+1}], [/\ 'Z(G) = <[x ^+ p]>, 'Phi(G) = 'Z(G) & #|'Z(G)| = r], [/\ G^`(1) = <[x ^+ r]>, #|G^`(1)| = p & nil_class G = 2], forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (p ^ k)]> & if (p, n) == (2, 3) then 'Ohm_1(G) = G else forall k, 0 < k < n.-1 -> <[x ^+ (p ^ (n - k.+1))]> \x <[y]> = 'Ohm_k(G) /\ #|'Ohm_k(G)| = (p ^ k.+1)%N]. Proof. move=> genG isoG [oy xy] X. have [oG Gx ox /setDP[Gy notXy]] := genG; rewrite -/m -/q in ox oG. have [pG _ nsXG defXY nXY] := extremal_generators_facts p_pr genG. have [sXG nXG] := andP nsXG; have sYG: <[y]> \subset G by rewrite cycle_subG. have n1_gt1: n.-1 > 1 by [rewrite def_n]; have n1_gt0 := ltnW n1_gt1. have def_n1 := prednK n1_gt0. have def_m: (q * p)%N = m by rewrite -expnSr /m def_n. have notcxy: y \notin 'C[x]. apply: contraL (introT eqP xy); move/cent1P=> cxy. rewrite /conjg -cxy // eq_mulVg1 expgS !mulKg -order_dvdn ox. by rewrite pfactor_dvdn ?expn_gt0 ?p_gt0 // pfactorK // -ltnNge prednK. have tiXY: <[x]> :&: <[y]> = 1. rewrite setIC prime_TIg -?orderE ?oy //; apply: contra notcxy. by rewrite cycle_subG; apply: subsetP; rewrite cycle_subG cent1id. have notcGG: ~~ abelian G. by rewrite -defXY abelianM !cycle_abelian cent_cycle cycle_subG. have cXpY: <[y]> \subset 'C(<[x ^+ p]>). rewrite cent_cycle cycle_subG cent1C (sameP cent1P commgP) /commg conjXg xy. by rewrite -expgM mulSn expgD mulKg -expnSr def_n1 -/q -ox expg_order. have oxp: #[x ^+ p] = r by rewrite orderXdiv ox ?dvdn_exp //. have [sZG nZG] := andP (center_normal G). have defZ: 'Z(G) = <[x ^+ p]>. apply/eqP; rewrite eq_sym eqEcard subsetI -{2}defXY centM subsetI cent_cycle. rewrite 2!cycle_subG !groupX ?cent1id //= centsC cXpY /= -orderE oxp leqNgt. apply: contra notcGG => gtZr; apply: cyclic_center_factor_abelian. rewrite (dvdn_prime_cyclic p_pr) // card_quotient //. rewrite -(dvdn_pmul2l (cardG_gt0 'Z(G))) Lagrange // oG -def_m dvdn_pmul2r //. case/p_natP: (pgroupS sZG pG) gtZr => k ->. by rewrite ltn_exp2l // def_n1; apply: dvdn_exp2l. have Zxr: x ^+ r \in 'Z(G) by rewrite /r def_n expnS expgM defZ mem_cycle. have rxy: [~ x, y] = x ^+ r by rewrite /commg xy expgS mulKg. have defG': G^`(1) = <[x ^+ r]>. case/setIP: Zxr => _; rewrite -rxy -defXY -(norm_joinEr nXY). exact: der1_joing_cycles. have oG': #|G^`(1)| = p. by rewrite defG' -orderE orderXdiv ox /q -def_n1 ?dvdn_exp2l // expnS mulnK. have sG'Z: G^`(1) \subset 'Z(G) by rewrite defG' cycle_subG. have nil2_G: nil_class G = 2. by apply/eqP; rewrite eqn_leq andbC ltnNge nil_class1 notcGG nil_class2. have XYp: {in X & <[y]>, forall z t, (z * t) ^+ p \in z ^+ p *: <[x ^+ r ^+ 'C(p, 2)]>}. - move=> z t Xz Yt; have Gz := subsetP sXG z Xz; have Gt := subsetP sYG t Yt. have Rtz: [~ t, z] \in G^`(1) by apply: mem_commg. have cGtz: [~ t, z] \in 'C(G) by case/setIP: (subsetP sG'Z _ Rtz). rewrite expMg_Rmul /commute ?(centP cGtz) //. have ->: t ^+ p = 1 by apply/eqP; rewrite -order_dvdn -oy order_dvdG. rewrite defG' in Rtz; case/cycleP: Rtz => i ->. by rewrite mem_lcoset mulg1 mulKg expgAC mem_cycle. have defMho: 'Mho^1(G) = <[x ^+ p]>. apply/eqP; rewrite eqEsubset cycle_subG (Mho_p_elt 1) ?(mem_p_elt pG) //. rewrite andbT (MhoE 1 pG) gen_subG -defXY; apply/subsetP=> ztp. case/imsetP=> zt; case/imset2P=> z t Xz Yt -> -> {zt ztp}. apply: subsetP (XYp z t Xz Yt); case/cycleP: Xz => i ->. by rewrite expgAC mul_subG ?sub1set ?mem_cycle //= -defZ cycle_subG groupX. split=> //; try exact: extend_cyclic_Mho. - rewrite sdprodE //; split=> // z; case/cycleP=> i ->{z} j. rewrite conjXg -expgM mulnC expgM actX; congr (_ ^+ i). elim: j {i} => //= j ->; rewrite conjXg xy -!expgM mulnS mulSn addSn. rewrite addnA -mulSn -addSn expgD mulnCA (mulnC j). rewrite {3}/r def_n expnS mulnA -expnSr def_n1 -/q -ox -mulnA expgM. by rewrite expg_order expg1n mulg1. - by rewrite (Phi_joing pG) defMho -defZ (joing_idPr _) ?defZ. have G1y: y \in 'Ohm_1(G). by rewrite (OhmE _ pG) mem_gen // !inE Gy -order_dvdn oy /=. case: eqP => [[p2 n3] | notG8 k]; last case/andP=> k_gt0 lt_k_n1. apply/eqP; rewrite eqEsubset Ohm_sub -{1}defXY mulG_subG !cycle_subG. rewrite G1y -(groupMr _ G1y) /= (OhmE _ pG) mem_gen // !inE groupM //. rewrite /q /r p2 n3 in oy ox xy *. by rewrite expgS -mulgA -{1}(invg2id oy) -conjgE xy -expgS -order_dvdn ox. have le_k_n2: k <= n.-2 by rewrite -def_n1 in lt_k_n1. suffices{lt_k_n1} defGk: <[x ^+ (p ^ (n - k.+1))]> \x <[y]> = 'Ohm_k(G). split=> //; case/dprodP: defGk => _ <- _ tiXkY; rewrite expnSr TI_cardMg //. rewrite -!orderE oy (subnDA 1) subn1 orderXdiv ox ?dvdn_exp2l ?leq_subr //. by rewrite /q -{1}(subnK (ltnW lt_k_n1)) expnD mulKn // expn_gt0 p_gt0. suffices{k k_gt0 le_k_n2} defGn2: <[x ^+ p]> \x <[y]> = 'Ohm_(n.-2)(G). have:= Ohm_dprod k defGn2; have p_xp := mem_p_elt pG (groupX p Gx). rewrite (Ohm_p_cycle _ p_xp) (Ohm_p_cycle _ (mem_p_elt pG Gy)) oxp oy. rewrite pfactorK ?(pfactorK 1) // (eqnP k_gt0) expg1 -expgM -expnS. rewrite -subSn // -subSS def_n1 def_n => -> /=; rewrite subnSK // subn2. by apply/eqP; rewrite eqEsubset OhmS ?Ohm_sub //= -{1}Ohm_id OhmS ?Ohm_leq. rewrite dprodEY //=; last by apply/trivgP; rewrite -tiXY setSI ?cycleX. apply/eqP; rewrite eqEsubset join_subG !cycle_subG /= [in y \in _]def_n. rewrite (subsetP (Ohm_leq G (ltn0Sn _)) y) //= (OhmE _ pG) -/r. rewrite mem_gen /=; last by rewrite !inE -order_dvdn oxp groupX /=. rewrite gen_subG /= cent_joinEr // -defXY; apply/subsetP=> uv; case/setIP. case/imset2P=> u v Xu Yv ->{uv}; rewrite /r inE def_n expnS expgM. case/lcosetP: (XYp u v Xu Yv) => _ /cycleP[j ->] ->. case/cycleP: Xu => i ->{u}; rewrite -!(expgM, expgD) -order_dvdn ox. rewrite (mulnC r) /r {1}def_n expnSr mulnA -mulnDl -mulnA -expnS. rewrite subnSK // subn2 /q -def_n1 expnS dvdn_pmul2r // dvdn_addl. by case/dvdnP=> k ->; rewrite mulnC expgM mem_mulg ?mem_cycle. case: (ltngtP n 3) => [|n_gt3|n3]; first by rewrite ltnNge n_gt2. by rewrite -subnSK // expnSr mulnA dvdn_mull. case: (even_prime p_pr) notG8 => [-> | oddp _]; first by rewrite n3. by rewrite bin2odd // -!mulnA dvdn_mulr. Qed. End ModularGroup. (* Basic properties of dihedral groups; these will be refined for dihedral *) (* 2-groups in the section on extremal 2-groups. *) Section DihedralGroup. Variable q : nat. Hypothesis q_gt1 : q > 1. Let m := q.*2. Let def2 : pdiv m = 2. Proof. apply/eqP; rewrite /m -mul2n eqn_leq pdiv_min_dvd ?dvdn_mulr //. by rewrite prime_gt1 // pdiv_prime // (@leq_pmul2l 2 1) ltnW. Qed. Let def_q : m %/ pdiv m = q. Proof. by rewrite def2 divn2 half_double. Qed. Section Dihedral_extension. Variable p : nat. Hypotheses (p_gt1 : p > 1) (even_p : 2 %| p). Local Notation ED := [set: gsort (Extremal.gtype q p q.-1)]. Lemma card_ext_dihedral : #|ED| = (p./2 * m)%N. Proof. by rewrite Extremal.card // /m -mul2n -divn2 mulnA divnK. Qed. Lemma Grp_ext_dihedral : ED \isog Grp (x : y : (x ^+ q, y ^+ p, x ^ y = x^-1)). Proof. suffices isoED: ED \isog Grp (x : y : (x ^+ q, y ^+ p, x ^ y = x ^+ q.-1)). move=> gT G; rewrite isoED. apply: eq_existsb => [[x y]] /=; rewrite !xpair_eqE. congr (_ && _); apply: andb_id2l; move/eqP=> xq1; congr (_ && (_ == _)). by apply/eqP; rewrite eq_sym eq_invg_mul -expgS (ltn_predK q_gt1) xq1. have unitrN1 : - 1 \in GRing.unit by move=> R; rewrite unitrN unitr1. pose uN1 := FinRing.unit ('Z_#[Zp1 : 'Z_q]) (unitrN1 _). apply: Extremal.Grp => //; exists (Zp_unitm uN1). rewrite Aut_aut order_injm ?injm_Zp_unitm ?in_setT //; split=> //. by rewrite (dvdn_trans _ even_p) // order_dvdn -val_eqE /= mulrNN. apply/eqP; rewrite autE ?cycle_id // eq_expg_mod_order /=. by rewrite order_Zp1 !Zp_cast // !modn_mod (modn_small q_gt1) subn1. Qed. End Dihedral_extension. Lemma card_dihedral : #|'D_m| = m. Proof. by rewrite /('D_m)%type def_q card_ext_dihedral ?mul1n. Qed. Lemma Grp_dihedral : 'D_m \isog Grp (x : y : (x ^+ q, y ^+ 2, x ^ y = x^-1)). Proof. by rewrite /('D_m)%type def_q; apply: Grp_ext_dihedral. Qed. Lemma Grp'_dihedral : 'D_m \isog Grp (x : y : (x ^+ 2, y ^+ 2, (x * y) ^+ q)). Proof. move=> gT G; rewrite Grp_dihedral; apply/existsP/existsP=> [] [[x y]] /=. case/eqP=> <- xq1 y2 xy; exists (x * y, y); rewrite !xpair_eqE /= eqEsubset. rewrite !join_subG !joing_subr !cycle_subG -{3}(mulgK y x) /=. rewrite 2?groupM ?groupV ?mem_gen ?inE ?cycle_id ?orbT //= -mulgA expgS. by rewrite {1}(conjgC x) xy -mulgA mulKg -(expgS y 1) y2 mulg1 xq1 !eqxx. case/eqP=> <- x2 y2 xyq; exists (x * y, y); rewrite !xpair_eqE /= eqEsubset. rewrite !join_subG !joing_subr !cycle_subG -{3}(mulgK y x) /=. rewrite 2?groupM ?groupV ?mem_gen ?inE ?cycle_id ?orbT //= xyq y2 !eqxx /=. by rewrite eq_sym eq_invg_mul !mulgA mulgK -mulgA -!(expgS _ 1) x2 y2 mulg1. Qed. End DihedralGroup. Lemma involutions_gen_dihedral gT (x y : gT) : let G := <<[set x; y]>> in #[x] = 2 -> #[y] = 2 -> x != y -> G \isog 'D_#|G|. Proof. move=> G ox oy ne_x_y; pose q := #[x * y]. have q_gt1: q > 1 by rewrite order_gt1 -eq_invg_mul invg_expg ox. have homG: G \homg 'D_q.*2. rewrite Grp'_dihedral //; apply/existsP; exists (x, y); rewrite /= !xpair_eqE. by rewrite joing_idl joing_idr -{1}ox -oy !expg_order !eqxx. suff oG: #|G| = q.*2 by rewrite oG isogEcard oG card_dihedral ?leqnn ?andbT. have: #|G| %| q.*2 by rewrite -card_dihedral ?card_homg. have Gxy: <[x * y]> \subset G. by rewrite cycle_subG groupM ?mem_gen ?set21 ?set22. have[k oG]: exists k, #|G| = (k * q)%N by apply/dvdnP; rewrite cardSg. rewrite oG -mul2n dvdn_pmul2r ?order_gt0 ?dvdn_divisors // !inE /=. case/pred2P=> [k1 | -> //]; case/negP: ne_x_y. have cycG: cyclic G. apply/cyclicP; exists (x * y); apply/eqP. by rewrite eq_sym eqEcard Gxy oG k1 mul1n leqnn. have: <[x]> == <[y]>. by rewrite (eq_subG_cyclic cycG) ?genS ?subsetUl ?subsetUr -?orderE ?ox ?oy. by rewrite eqEcard cycle_subG /= cycle2g // !inE -order_eq1 ox; case/andP. Qed. Lemma Grp_2dihedral n : n > 1 -> 'D_(2 ^ n) \isog Grp (x : y : (x ^+ (2 ^ n.-1), y ^+ 2, x ^ y = x^-1)). Proof. move=> n_gt1; rewrite -(ltn_predK n_gt1) expnS mul2n /=. by apply: Grp_dihedral; rewrite (ltn_exp2l 0) // -(subnKC n_gt1). Qed. Lemma card_2dihedral n : n > 1 -> #|'D_(2 ^ n)| = (2 ^ n)%N. Proof. move=> n_gt1; rewrite -(ltn_predK n_gt1) expnS mul2n /= card_dihedral //. by rewrite (ltn_exp2l 0) // -(subnKC n_gt1). Qed. Lemma card_semidihedral n : n > 3 -> #|'SD_(2 ^ n)| = (2 ^ n)%N. Proof. move=> n_gt3. rewrite /('SD__)%type -(subnKC (ltnW (ltnW n_gt3))) pdiv_pfactor //. by rewrite // !expnS !mulKn -?expnS ?Extremal.card //= (ltn_exp2l 0). Qed. Lemma Grp_semidihedral n : n > 3 -> 'SD_(2 ^ n) \isog Grp (x : y : (x ^+ (2 ^ n.-1), y ^+ 2, x ^ y = x ^+ (2 ^ n.-2).-1)). Proof. move=> n_gt3. rewrite /('SD__)%type -(subnKC (ltnW (ltnW n_gt3))) pdiv_pfactor //. rewrite !expnS !mulKn // -!expnS /=; set q := (2 ^ _)%N. have q_gt1: q > 1 by rewrite (ltn_exp2l 0). apply: Extremal.Grp => //; set B := <[_]>. have oB: #|B| = q by rewrite -orderE order_Zp1 Zp_cast. have pB: 2.-group B by rewrite /pgroup oB pnatX. have ntB: B != 1 by rewrite -cardG_gt1 oB. have [] := cyclic_pgroup_Aut_structure pB (cycle_cyclic _) ntB. rewrite oB /= pfactorK //= -/B => m [[def_m _ _ _ _] _]. rewrite -{1 2}(subnKC n_gt3) => [[t [At ot _ [s [_ _ _ defA]]]]]. case/dprodP: defA => _ defA cst _. have{cst defA} cAt: t \in 'C(Aut B). rewrite -defA centM inE -sub_cent1 -cent_cycle centsC cst /=. by rewrite cent_cycle cent1id. case=> s0 [As0 os0 _ def_s0t _]; exists (s0 * t). rewrite -def_m ?groupM ?cycle_id // def_s0t !Zp_expg !mul1n valZpK Zp_nat. rewrite order_dvdn expgMn /commute 1?(centP cAt) // -{1}os0 -{1}ot. by rewrite !expg_order mul1g. Qed. Section Quaternion. Variable n : nat. Hypothesis n_gt2 : n > 2. Let m := (2 ^ n)%N. Let q := (2 ^ n.-1)%N. Let r := (2 ^ n.-2)%N. Let GrpQ := 'Q_m \isog Grp (x : y : (x ^+ q, y ^+ 2 = x ^+ r, x ^ y = x^-1)). Let defQ : #|'Q_m| = m /\ GrpQ. Proof. have q_gt1 : q > 1 by rewrite (ltn_exp2l 0) // -(subnKC n_gt2). have def_m : (2 * q)%N = m by rewrite -expnS (ltn_predK n_gt2). have def_q : m %/ pdiv m = q by rewrite /m -(ltn_predK n_gt2) pdiv_pfactor // expnS mulKn. have r_gt1 : r > 1 by rewrite (ltn_exp2l 0) // -(subnKC n_gt2). have def2r : (2 * r)%N = q by rewrite -expnS /q -(subnKC n_gt2). rewrite /GrpQ [@quaternion_gtype _]unlock /quaternion_kernel {}def_q. set B := [set: _]; have: B \homg Grp (u : v : (u ^+ q, v ^+ 4, u ^ v = u^-1)). by rewrite -Grp_ext_dihedral ?homg_refl. have: #|B| = (q * 4)%N by rewrite card_ext_dihedral // mulnC -muln2 -mulnA. rewrite {}/B; move: (Extremal.gtype q 4 _) => gT. set B := [set: gT] => oB; set K := _ :\: _. case/existsP=> -[u v] /= /eqP[defB uq v4 uv]. have nUV: <[v]> \subset 'N(<[u]>) by rewrite norms_cycle uv groupV cycle_id. rewrite norm_joinEr // in defB. have le_ou: #[u] <= q by rewrite dvdn_leq ?expn_gt0 // order_dvdn uq. have le_ov: #[v] <= 4 by rewrite dvdn_leq // order_dvdn v4. have tiUV: <[u]> :&: <[v]> = 1 by rewrite cardMg_TI // defB oB leq_mul. have{le_ou le_ov} [ou ov]: #[u] = q /\ #[v] = 4. have:= esym (leqif_mul (leqif_eq le_ou) (leqif_eq le_ov)).2. by rewrite -TI_cardMg // defB -oB eqxx eqn0Ngt cardG_gt0; do 2!case: eqP=> //. have sdB: <[u]> ><| <[v]> = B by rewrite sdprodE. have uvj j: u ^ (v ^+ j) = (if odd j then u^-1 else u). elim: j => [|j IHj]; first by rewrite conjg1. by rewrite expgS conjgM uv conjVg IHj (fun_if invg) invgK if_neg. have sqrB i j: (u ^+ i * v ^+ j) ^+ 2 = (if odd j then v ^+ 2 else u ^+ i.*2). rewrite expgS; case: ifP => odd_j. rewrite {1}(conjgC (u ^+ i)) conjXg uvj odd_j expgVn -mulgA mulKg. rewrite -expgD addnn -(odd_double_half j) odd_j doubleD addnC /=. by rewrite -(expg_mod _ v4) -!muln2 -mulnA modnMDl. rewrite {2}(conjgC (u ^+ i)) conjXg uvj odd_j mulgA -(mulgA (u ^+ i)). rewrite -expgD addnn -(odd_double_half j) odd_j -2!mul2n mulnA. by rewrite expgM v4 expg1n mulg1 -expgD addnn. pose w := u ^+ r * v ^+ 2. have Kw: w \in K. rewrite !inE sqrB /= -mul2n def2r uq eqxx andbT -defB. apply/imsetP=> [[_]] /imset2P[_ _ /cycleP[i ->] /cycleP[j ->] ->]. apply/eqP; rewrite sqrB; case: ifP => _. rewrite eq_mulgV1 mulgK -order_dvdn ou pfactor_dvdn ?expn_gt0 ?pfactorK //. by rewrite -ltnNge -(subnKC n_gt2). rewrite (canF_eq (mulKg _)); apply/eqP=> def_v2. suffices: v ^+ 2 \in <[u]> :&: <[v]> by rewrite tiUV inE -order_dvdn ov. by rewrite inE {1}def_v2 groupM ?groupV !mem_cycle. have ow: #[w] = 2. case/setDP: Kw; rewrite inE -order_dvdn dvdn_divisors // !inE /= order_eq1. by case/orP=> /eqP-> // /imsetP[]; exists 1; rewrite ?inE ?expg1n. have defK: K = [set w]. apply/eqP; rewrite eqEsubset sub1set Kw andbT subDset setUC. apply/subsetP=> uivj; have: uivj \in B by rewrite inE. rewrite -{1}defB => /imset2P[_ _ /cycleP[i ->] /cycleP[j ->] ->] {uivj}. rewrite !inE sqrB; set b := odd j; rewrite -[j]odd_double_half -/b. case: b; rewrite -order_dvdn ?ov // ou -def2r -mul2n dvdn_pmul2l //. case/dvdnP=> k ->{i}; apply/orP. rewrite add0n -[j./2]odd_double_half addnC doubleD -!muln2 -mulnA. rewrite -(expg_mod_order v) ov modnMDl; case: (odd _); last first. right; rewrite mulg1 /r -(subnKC n_gt2) expnSr mulnA expgM. by apply: imset_f; rewrite inE. rewrite (inj_eq (mulIg _)) -expg_mod_order ou -[k]odd_double_half. rewrite addnC -muln2 mulnDl -mulnA def2r modnMDl -ou expg_mod_order. case: (odd k); [left | right]; rewrite ?mul1n ?mul1g //. by apply/imsetP; exists v; rewrite ?inE. have nKB: 'N(<>) = B. apply/setP=> b; rewrite !inE -genJ genS // {1}defK conjg_set1 sub1set. have:= Kw; rewrite !inE -!order_dvdn orderJ ow !andbT; apply: contra. case/imsetP=> z _ def_wb; apply/imsetP; exists (z ^ b^-1); rewrite ?inE //. by rewrite -conjXg -def_wb conjgK. rewrite -im_quotient card_quotient // nKB -divgS ?subsetT //. split; first by rewrite oB defK -orderE ow (mulnA q 2 2) mulnK // mulnC. apply: intro_isoGrp => [|rT H]. apply/existsP; exists (coset _ u, coset _ v); rewrite /= !xpair_eqE. rewrite -!morphX -?morphJ -?morphV /= ?nKB ?in_setT // uq uv morph1 !eqxx. rewrite -/B -defB -norm_joinEr // quotientY ?nKB ?subsetT //= andbT. rewrite !quotient_cycle /= ?nKB ?in_setT ?eqxx //=. by rewrite -(coset_kerl _ (mem_gen Kw)) -mulgA -expgD v4 mulg1. case/existsP=> -[x y] /= /eqP[defH xq y2 xy]. have ox: #[x] %| #[u] by rewrite ou order_dvdn xq. have oy: #[y] %| #[v]. by rewrite ov order_dvdn (expgM y 2 2) y2 -expgM mulnC def2r xq. have actB: {in <[u]> & <[v]>, morph_act 'J 'J (eltm ox) (eltm oy)}. move=> _ _ /cycleP[i ->] /cycleP[j ->] /=. rewrite conjXg uvj fun_if if_arg fun_if expgVn morphV ?mem_cycle //= !eltmE. rewrite -expgVn -if_arg -fun_if conjXg; congr (_ ^+ i). rewrite -{2}[j]odd_double_half addnC expgD -mul2n expgM y2. rewrite -expgM conjgM (conjgE x) commuteX // mulKg. by case: (odd j); rewrite ?conjg1. pose f := sdprodm sdB actB. have Kf: 'ker (coset <>) \subset 'ker f. rewrite ker_coset defK cycle_subG /= ker_sdprodm. apply/imset2P; exists (u ^+ r) (v ^+ 2); first exact: mem_cycle. by rewrite inE mem_cycle /= !eltmE y2. by apply: canRL (mulgK _) _; rewrite -mulgA -expgD v4 mulg1. have Df: 'dom f \subset 'dom (coset <>) by rewrite /dom nKB subsetT. apply/homgP; exists (factm_morphism Kf Df); rewrite morphim_factm /= -/B. rewrite -{2}defB morphim_sdprodm // !morphim_cycle ?cycle_id //= !eltm_id. by rewrite -norm_joinEr // norms_cycle xy groupV cycle_id. Qed. Lemma card_quaternion : #|'Q_m| = m. Proof. by case defQ. Qed. Lemma Grp_quaternion : GrpQ. Proof. by case defQ. Qed. End Quaternion. Lemma eq_Mod8_D8 : 'Mod_8 = 'D_8. Proof. by []. Qed. Section ExtremalStructure. Variables (gT : finGroupType) (G : {group gT}) (n : nat). Implicit Type H : {group gT}. Let m := (2 ^ n)%N. Let q := (2 ^ n.-1)%N. Let q_gt0: q > 0. Proof. by rewrite expn_gt0. Qed. Let r := (2 ^ n.-2)%N. Let r_gt0: r > 0. Proof. by rewrite expn_gt0. Qed. Let def2qr : n > 1 -> [/\ 2 * q = m, 2 * r = q, q < m & r < q]%N. Proof. by rewrite /q /m /r; move/subnKC=> <-; rewrite !ltn_exp2l ?expnS. Qed. Lemma generators_2dihedral : n > 1 -> G \isog 'D_m -> exists2 xy, extremal_generators G 2 n xy & let: (x, y) := xy in #[y] = 2 /\ x ^ y = x^-1. Proof. move=> n_gt1; have [def2q _ ltqm _] := def2qr n_gt1. case/(isoGrpP _ (Grp_2dihedral n_gt1)); rewrite card_2dihedral // -/ m => oG. case/existsP=> -[x y] /=; rewrite -/q => /eqP[defG xq y2 xy]. have{} defG: <[x]> * <[y]> = G. by rewrite -norm_joinEr // norms_cycle xy groupV cycle_id. have notXy: y \notin <[x]>. apply: contraL ltqm => Xy; rewrite -leqNgt -oG -defG mulGSid ?cycle_subG //. by rewrite dvdn_leq // order_dvdn xq. have oy: #[y] = 2 by apply: nt_prime_order (group1_contra notXy). have ox: #[x] = q. apply: double_inj; rewrite -muln2 -oy -mul2n def2q -oG -defG TI_cardMg //. by rewrite setIC prime_TIg ?cycle_subG // -orderE oy. exists (x, y) => //=. by rewrite oG ox !inE notXy -!cycle_subG /= -defG mulG_subl mulG_subr. Qed. Lemma generators_semidihedral : n > 3 -> G \isog 'SD_m -> exists2 xy, extremal_generators G 2 n xy & let: (x, y) := xy in #[y] = 2 /\ x ^ y = x ^+ r.-1. Proof. move=> n_gt3; have [def2q _ ltqm _] := def2qr (ltnW (ltnW n_gt3)). case/(isoGrpP _ (Grp_semidihedral n_gt3)). rewrite card_semidihedral // -/m => oG. case/existsP=> -[x y] /=; rewrite -/q -/r => /eqP[defG xq y2 xy]. have{} defG: <[x]> * <[y]> = G. by rewrite -norm_joinEr // norms_cycle xy mem_cycle. have notXy: y \notin <[x]>. apply: contraL ltqm => Xy; rewrite -leqNgt -oG -defG mulGSid ?cycle_subG //. by rewrite dvdn_leq // order_dvdn xq. have oy: #[y] = 2 by apply: nt_prime_order (group1_contra notXy). have ox: #[x] = q. apply: double_inj; rewrite -muln2 -oy -mul2n def2q -oG -defG TI_cardMg //. by rewrite setIC prime_TIg ?cycle_subG // -orderE oy. exists (x, y) => //=. by rewrite oG ox !inE notXy -!cycle_subG /= -defG mulG_subl mulG_subr. Qed. Lemma generators_quaternion : n > 2 -> G \isog 'Q_m -> exists2 xy, extremal_generators G 2 n xy & let: (x, y) := xy in [/\ #[y] = 4, y ^+ 2 = x ^+ r & x ^ y = x^-1]. Proof. move=> n_gt2; have [def2q def2r ltqm _] := def2qr (ltnW n_gt2). case/(isoGrpP _ (Grp_quaternion n_gt2)); rewrite card_quaternion // -/m => oG. case/existsP=> -[x y] /=; rewrite -/q -/r => /eqP[defG xq y2 xy]. have{} defG: <[x]> * <[y]> = G. by rewrite -norm_joinEr // norms_cycle xy groupV cycle_id. have notXy: y \notin <[x]>. apply: contraL ltqm => Xy; rewrite -leqNgt -oG -defG mulGSid ?cycle_subG //. by rewrite dvdn_leq // order_dvdn xq. have ox: #[x] = q. apply/eqP; rewrite eqn_leq dvdn_leq ?order_dvdn ?xq //=. rewrite -(leq_pmul2r (order_gt0 y)) mul_cardG defG oG -def2q mulnAC mulnC. rewrite leq_pmul2r // dvdn_leq ?muln_gt0 ?cardG_gt0 // order_dvdn expgM. by rewrite -order_dvdn order_dvdG //= inE {1}y2 !mem_cycle. have oy2: #[y ^+ 2] = 2 by rewrite y2 orderXdiv ox -def2r ?dvdn_mull ?mulnK. exists (x, y) => /=; last by rewrite (orderXprime oy2). by rewrite oG !inE notXy -!cycle_subG /= -defG mulG_subl mulG_subr. Qed. Variables x y : gT. Implicit Type M : {group gT}. Let X := <[x]>. Let Y := <[y]>. Let yG := y ^: G. Let xyG := (x * y) ^: G. Let My := <>. Let Mxy := <>. Theorem dihedral2_structure : n > 1 -> extremal_generators G 2 n (x, y) -> G \isog 'D_m -> [/\ [/\ X ><| Y = G, {in G :\: X, forall t, #[t] = 2} & {in X & G :\: X, forall z t, z ^ t = z^-1}], [/\ G ^`(1) = <[x ^+ 2]>, 'Phi(G) = G ^`(1), #|G^`(1)| = r & nil_class G = n.-1], 'Ohm_1(G) = G /\ (forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (2 ^ k)]>), [/\ yG :|: xyG = G :\: X, [disjoint yG & xyG] & forall M, maximal M G = pred3 X My Mxy M] & if n == 2 then (2.-abelem G : Prop) else [/\ 'Z(G) = <[x ^+ r]>, #|'Z(G)| = 2, My \isog 'D_q, Mxy \isog 'D_q & forall U, cyclic U -> U \subset G -> #|G : U| = 2 -> U = X]]. Proof. move=> n_gt1 genG isoG; have [def2q def2r ltqm ltrq] := def2qr n_gt1. have [oG Gx ox X'y] := genG; rewrite -/m -/q -/X in oG ox X'y. case/extremal_generators_facts: genG; rewrite -/X // => pG maxX nsXG defXY nXY. have [sXG nXG]:= andP nsXG; have [Gy notXy]:= setDP X'y. have ox2: #[x ^+ 2] = r by rewrite orderXdiv ox -def2r ?dvdn_mulr ?mulKn. have oxr: #[x ^+ r] = 2 by rewrite orderXdiv ox -def2r ?dvdn_mull ?mulnK. have [[u v] [_ Gu ou U'v] [ov uv]] := generators_2dihedral n_gt1 isoG. have defUv: <[u]> :* v = G :\: <[u]>. apply: rcoset_index2; rewrite -?divgS ?cycle_subG //. by rewrite oG -orderE ou -def2q mulnK. have invUV: {in <[u]> & <[u]> :* v, forall z t, z ^ t = z^-1}. move=> z t; case/cycleP=> i ->; case/rcosetP=> z'; case/cycleP=> j -> ->{z t}. by rewrite conjgM {2}/conjg commuteX2 // mulKg conjXg uv expgVn. have oU': {in <[u]> :* v, forall t, #[t] = 2}. move=> t Uvt; apply: nt_prime_order => //; last first. by case: eqP Uvt => // ->; rewrite defUv !inE group1. case/rcosetP: Uvt => z Uz ->{t}; rewrite expgS {1}(conjgC z) -mulgA. by rewrite invUV ?rcoset_refl // mulKg -(expgS v 1) -ov expg_order. have defU: n > 2 -> {in G, forall z, #[z] = q -> <[z]> = <[u]>}. move=> n_gt2 z Gz oz; apply/eqP; rewrite eqEcard -!orderE oz cycle_subG. apply: contraLR n_gt2; rewrite ou leqnn andbT -(ltn_predK n_gt1) => notUz. by rewrite ltnS -(@ltn_exp2l 2) // -/q -oz oU' // defUv inE notUz. have n2_abelG: (n > 2) || 2.-abelem G. rewrite ltn_neqAle eq_sym n_gt1; case: eqP => //= n2. apply/abelemP=> //; split=> [|z Gz]. by apply: (p2group_abelian pG); rewrite oG pfactorK ?n2. case Uz: (z \in <[u]>); last by rewrite -expg_mod_order oU' // defUv inE Uz. apply/eqP; rewrite -order_dvdn (dvdn_trans (order_dvdG Uz)) // -orderE. by rewrite ou /q n2. have{oU'} oX': {in G :\: X, forall t, #[t] = 2}. have [n_gt2 | abelG] := orP n2_abelG; first by rewrite [X]defU // -defUv. move=> t /setDP[Gt notXt]; apply: nt_prime_order (group1_contra notXt) => //. by case/abelemP: abelG => // _ ->. have{invUV} invXX': {in X & G :\: X, forall z t, z ^ t = z^-1}. have [n_gt2 | abelG] := orP n2_abelG; first by rewrite [X]defU // -defUv. have [//|cGG oG2] := abelemP _ abelG. move=> t z Xt /setDP[Gz _]; apply/eqP; rewrite eq_sym eq_invg_mul. by rewrite /conjg -(centsP cGG z) // ?mulKg ?[t * t]oG2 ?(subsetP sXG). have nXiG k: G \subset 'N(<[x ^+ k]>). apply: char_norm_trans nXG. by rewrite cycle_subgroup_char // cycle_subG mem_cycle. have memL i: x ^+ (2 ^ i) \in 'L_i.+1(G). elim: i => // i IHi; rewrite -groupV expnSr expgM invMg. by rewrite -{2}(invXX' _ y) ?mem_cycle ?cycle_id ?mem_commg. have defG': G^`(1) = <[x ^+ 2]>. apply/eqP; rewrite eqEsubset cycle_subG (memL 1%N) ?der1_min //=. rewrite (p2group_abelian (quotient_pgroup _ pG)) ?card_quotient //=. rewrite -divgS ?cycle_subG ?groupX // oG -orderE ox2. by rewrite -def2q -def2r mulnA mulnK. have defG1: 'Mho^1(G) = <[x ^+ 2]>. apply/eqP; rewrite (MhoE _ pG) eqEsubset !gen_subG sub1set andbC. rewrite mem_gen; last exact: imset_f. apply/subsetP=> z2; case/imsetP=> z Gz ->{z2}. case Xz: (z \in X); last by rewrite -{1}(oX' z) ?expg_order ?group1 // inE Xz. by case/cycleP: Xz => i ->; rewrite expgAC mem_cycle. have defPhi: 'Phi(G) = <[x ^+ 2]>. by rewrite (Phi_joing pG) defG' defG1 (joing_idPl _). have def_tG: {in G :\: X, forall t, t ^: G = <[x ^+ 2]> :* t}. move=> t X't; have [Gt notXt] := setDP X't. have defJt: {in X, forall z, t ^ z = z ^- 2 * t}. move=> z Xz; rewrite /= invMg -mulgA (conjgC _ t). by rewrite (invXX' _ t) ?groupV ?invgK. have defGt: X * <[t]> = G by rewrite (mulg_normal_maximal nsXG) ?cycle_subG. apply/setP=> tz; apply/imsetP/rcosetP=> [[t'z] | [z]]. rewrite -defGt -normC ?cycle_subG ?(subsetP nXG) //. case/imset2P=> _ z /cycleP[j ->] Xz -> -> {tz t'z}. exists (z ^- 2); last by rewrite conjgM {2}/conjg commuteX // mulKg defJt. case/cycleP: Xz => i ->{z}. by rewrite groupV -expgM mulnC expgM mem_cycle. case/cycleP=> i -> -> {z tz}; exists (x ^- i); first by rewrite groupV groupX. by rewrite defJt ?groupV ?mem_cycle // expgVn invgK expgAC. have defMt: {in G :\: X, forall t, <[x ^+ 2]> ><| <[t]> = <>}. move=> t X't; have [Gt notXt] := setDP X't. rewrite sdprodEY ?cycle_subG ?(subsetP (nXiG 2)) //; first 1 last. rewrite setIC prime_TIg -?orderE ?oX' // cycle_subG. by apply: contra notXt; apply: subsetP; rewrite cycleX. apply/eqP; have: t \in <> by rewrite mem_gen ?class_refl. rewrite def_tG // eqEsubset join_subG !cycle_subG !gen_subG => tGt. rewrite tGt -(groupMr _ tGt) mem_gen ?mem_mulg ?cycle_id ?set11 //=. by rewrite mul_subG ?joing_subl // -gen_subG joing_subr. have oMt: {in G :\: X, forall t, #|<>| = q}. move=> t X't /=; rewrite -(sdprod_card (defMt t X't)) -!orderE ox2 oX' //. by rewrite mulnC. have sMtG: {in G :\: X, forall t, <> \subset G}. by move=> t; case/setDP=> Gt _; rewrite gen_subG class_subG. have maxMt: {in G :\: X, forall t, maximal <> G}. move=> t X't /=; rewrite p_index_maximal -?divgS ?sMtG ?oMt //. by rewrite oG -def2q mulnK. have X'xy: x * y \in G :\: X by rewrite !inE !groupMl ?cycle_id ?notXy. have ti_yG_xyG: [disjoint yG & xyG]. apply/pred0P=> t; rewrite /= /yG /xyG !def_tG //; apply/andP=> [[yGt]]. rewrite rcoset_sym (rcoset_eqP yGt) mem_rcoset mulgK; move/order_dvdG. by rewrite -orderE ox2 ox gtnNdvd. have s_tG_X': {in G :\: X, forall t, t ^: G \subset G :\: X}. by move=> t X't /=; rewrite class_sub_norm // normsD ?normG. have defX': yG :|: xyG = G :\: X. apply/eqP; rewrite eqEcard subUset !s_tG_X' //= -(leq_add2l q) -{1}ox orderE. rewrite -/X -{1}(setIidPr sXG) cardsID oG -def2q mul2n -addnn leq_add2l. rewrite -(leq_add2r #|yG :&: xyG|) cardsUI disjoint_setI0 // cards0 addn0. by rewrite /yG /xyG !def_tG // !card_rcoset addnn -mul2n -orderE ox2 def2r. split. - by rewrite ?sdprodE // setIC // prime_TIg ?cycle_subG // -orderE ?oX'. - rewrite defG'; split=> //. apply/eqP; rewrite eqn_leq (leq_trans (nil_class_pgroup pG)); last first. by rewrite oG pfactorK // geq_max leqnn -(subnKC n_gt1). rewrite -(subnKC n_gt1) subn2 ltnNge. rewrite (sameP (lcn_nil_classP _ (pgroup_nil pG)) eqP). by apply/trivgPn; exists (x ^+ r); rewrite ?memL // -order_gt1 oxr. - split; last exact: extend_cyclic_Mho. have sX'G1: {subset G :\: X <= 'Ohm_1(G)}. move=> t X't; have [Gt _] := setDP X't. by rewrite (OhmE 1 pG) mem_gen // !inE Gt -(oX' t) //= expg_order. apply/eqP; rewrite eqEsubset Ohm_sub -{1}defXY mulG_subG !cycle_subG. by rewrite -(groupMr _ (sX'G1 y X'y)) !sX'G1. - split=> //= H; apply/idP/idP=> [maxH |]; last first. by case/or3P=> /eqP->; rewrite ?maxMt. have [sHG nHG]:= andP (p_maximal_normal pG maxH). have oH: #|H| = q. apply: double_inj; rewrite -muln2 -(p_maximal_index pG maxH) Lagrange //. by rewrite oG -mul2n. rewrite !(eq_sym (gval H)) -eq_sym !eqEcard oH -orderE ox !oMt // !leqnn. case sHX: (H \subset X) => //=; case/subsetPn: sHX => t Ht notXt. have: t \in yG :|: xyG by rewrite defX' inE notXt (subsetP sHG). rewrite !andbT !gen_subG /yG /xyG. by case/setUP; move/class_eqP <-; rewrite !class_sub_norm ?Ht ?orbT. rewrite eqn_leq n_gt1; case: leqP n2_abelG => //= n_gt2 _. have ->: 'Z(G) = <[x ^+ r]>. apply/eqP; rewrite eqEcard andbC -orderE oxr -{1}(setIidPr (center_sub G)). rewrite cardG_gt1 /= meet_center_nil ?(pgroup_nil pG) //; last first. by rewrite -cardG_gt1 oG (leq_trans _ ltqm). apply/subsetP=> t; case/setIP=> Gt cGt. case X't: (t \in G :\: X). move/eqP: (invXX' _ _ (cycle_id x) X't). rewrite /conjg -(centP cGt) // mulKg eq_sym eq_invg_mul -order_eq1 ox2. by rewrite (eqn_exp2l _ 0) // -(subnKC n_gt2). move/idPn: X't; rewrite inE Gt andbT negbK => Xt. have:= Ohm_p_cycle 1 (mem_p_elt pG Gx); rewrite ox pfactorK // subn1 => <-. rewrite (OhmE _ (pgroupS sXG pG)) mem_gen // !inE Xt /=. by rewrite -eq_invg_mul -(invXX' _ y) // /conjg (centP cGt) // mulKg. have isoMt: {in G :\: X, forall t, <> \isog 'D_q}. have n1_gt1: n.-1 > 1 by rewrite -(subnKC n_gt2). move=> t X't /=; rewrite isogEcard card_2dihedral ?oMt // leqnn andbT. rewrite Grp_2dihedral //; apply/existsP; exists (x ^+ 2, t) => /=. have [_ <- nX2T _] := sdprodP (defMt t X't); rewrite norm_joinEr //. rewrite -/q -/r !xpair_eqE eqxx -expgM def2r -ox -{1}(oX' t X't). by rewrite !expg_order !eqxx /= invXX' ?mem_cycle. rewrite !isoMt //; split=> // C; case/cyclicP=> z ->{C} sCG iCG. rewrite [X]defU // defU -?cycle_subG //. by apply: double_inj; rewrite -muln2 -iCG Lagrange // oG -mul2n. Qed. Theorem quaternion_structure : n > 2 -> extremal_generators G 2 n (x, y) -> G \isog 'Q_m -> [/\ [/\ pprod X Y = G, {in G :\: X, forall t, #[t] = 4} & {in X & G :\: X, forall z t, z ^ t = z^-1}], [/\ G ^`(1) = <[x ^+ 2]>, 'Phi(G) = G ^`(1), #|G^`(1)| = r & nil_class G = n.-1], [/\ 'Z(G) = <[x ^+ r]>, #|'Z(G)| = 2, forall u, u \in G -> #[u] = 2 -> u = x ^+ r, 'Ohm_1(G) = <[x ^+ r]> /\ 'Ohm_2(G) = G & forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (2 ^ k)]>], [/\ yG :|: xyG = G :\: X /\ [disjoint yG & xyG] & forall M, maximal M G = pred3 X My Mxy M] & n > 3 -> [/\ My \isog 'Q_q, Mxy \isog 'Q_q & forall U, cyclic U -> U \subset G -> #|G : U| = 2 -> U = X]]. Proof. move=> n_gt2 genG isoG; have [def2q def2r ltqm ltrq] := def2qr (ltnW n_gt2). have [oG Gx ox X'y] := genG; rewrite -/m -/q -/X in oG ox X'y. case/extremal_generators_facts: genG; rewrite -/X // => pG maxX nsXG defXY nXY. have [sXG nXG]:= andP nsXG; have [Gy notXy]:= setDP X'y. have oxr: #[x ^+ r] = 2 by rewrite orderXdiv ox -def2r ?dvdn_mull ?mulnK. have ox2: #[x ^+ 2] = r by rewrite orderXdiv ox -def2r ?dvdn_mulr ?mulKn. have [[u v] [_ Gu ou U'v] [ov v2 uv]] := generators_quaternion n_gt2 isoG. have defUv: <[u]> :* v = G :\: <[u]>. apply: rcoset_index2; rewrite -?divgS ?cycle_subG //. by rewrite oG -orderE ou -def2q mulnK. have invUV: {in <[u]> & <[u]> :* v, forall z t, z ^ t = z^-1}. move=> z t; case/cycleP=> i ->; case/rcosetP=> ?; case/cycleP=> j -> ->{z t}. by rewrite conjgM {2}/conjg commuteX2 // mulKg conjXg uv expgVn. have U'2: {in <[u]> :* v, forall t, t ^+ 2 = u ^+ r}. move=> t; case/rcosetP=> z Uz ->; rewrite expgS {1}(conjgC z) -mulgA. by rewrite invUV ?rcoset_refl // mulKg -(expgS v 1) v2. have our: #[u ^+ r] = 2 by rewrite orderXdiv ou -/q -def2r ?dvdn_mull ?mulnK. have def_ur: {in G, forall t, #[t] = 2 -> t = u ^+ r}. move=> t Gt /= ot; case Ut: (t \in <[u]>); last first. move/eqP: ot; rewrite eqn_dvd order_dvdn -order_eq1 U'2 ?our //. by rewrite defUv inE Ut. have p2u: 2.-elt u by rewrite /p_elt ou pnatX. have: t \in 'Ohm_1(<[u]>). by rewrite (OhmE _ p2u) mem_gen // !inE Ut -order_dvdn ot. rewrite (Ohm_p_cycle _ p2u) ou pfactorK // subn1 -/r cycle_traject our !inE. by rewrite -order_eq1 ot /= mulg1; move/eqP. have defU: n > 3 -> {in G, forall z, #[z] = q -> <[z]> = <[u]>}. move=> n_gt3 z Gz oz; apply/eqP; rewrite eqEcard -!orderE oz cycle_subG. rewrite ou leqnn andbT; apply: contraLR n_gt3 => notUz. rewrite -(ltn_predK n_gt2) ltnS -(@ltn_exp2l 2) // -/q -oz. by rewrite (@orderXprime _ 2 2) // U'2 // defUv inE notUz. have def_xr: x ^+ r = u ^+ r by apply: def_ur; rewrite ?groupX. have X'2: {in G :\: X, forall t, t ^+ 2 = u ^+ r}. case: (ltngtP n 3) => [|n_gt3|n3 t]; first by rewrite ltnNge n_gt2. by rewrite /X defU // -defUv. case/setDP=> Gt notXt. case Ut: (t \in <[u]>); last by rewrite U'2 // defUv inE Ut. rewrite [t ^+ 2]def_ur ?groupX //. have:= order_dvdG Ut; rewrite -orderE ou /q n3 dvdn_divisors ?inE //=. rewrite order_eq1 (negbTE (group1_contra notXt)) /=. case/pred2P=> oz; last by rewrite orderXdiv oz. by rewrite [t]def_ur // -def_xr mem_cycle in notXt. have oX': {in G :\: X, forall z, #[z] = 4}. by move=> t X't /=; rewrite (@orderXprime _ 2 2) // X'2. have defZ: 'Z(G) = <[x ^+ r]>. apply/eqP; rewrite eqEcard andbC -orderE oxr -{1}(setIidPr (center_sub G)). rewrite cardG_gt1 /= meet_center_nil ?(pgroup_nil pG) //; last first. by rewrite -cardG_gt1 oG (leq_trans _ ltqm). apply/subsetP=> z; case/setIP=> Gz cGz; have [Gv _]:= setDP U'v. case Uvz: (z \in <[u]> :* v). move/eqP: (invUV _ _ (cycle_id u) Uvz). rewrite /conjg -(centP cGz) // mulKg eq_sym eq_invg_mul -(order_dvdn _ 2). by rewrite ou pfactor_dvdn // -(subnKC n_gt2). move/idPn: Uvz; rewrite defUv inE Gz andbT negbK def_xr => Uz. have p_u: 2.-elt u := mem_p_elt pG Gu. suff: z \in 'Ohm_1(<[u]>) by rewrite (Ohm_p_cycle 1 p_u) ou pfactorK // subn1. rewrite (OhmE _ p_u) mem_gen // !inE Uz /= -eq_invg_mul. by rewrite -(invUV _ v) ?rcoset_refl // /conjg (centP cGz) ?mulKg. have{invUV} invXX': {in X & G :\: X, forall z t, z ^ t = z^-1}. case: (ltngtP n 3) => [|n_gt3|n3 t z Xt]; first by rewrite ltnNge n_gt2. by rewrite /X defU // -defUv. case/setDP=> Gz notXz; rewrite /q /r n3 /= in oxr ox. suff xz: x ^ z = x^-1 by case/cycleP: Xt => i ->; rewrite conjXg xz expgVn. have: x ^ z \in X by rewrite memJ_norm ?cycle_id ?(subsetP nXG). rewrite invg_expg /X cycle_traject ox !inE /= !mulg1 -order_eq1 orderJ ox /=. case/or3P; move/eqP=> //; last by move/(congr1 order); rewrite orderJ ox oxr. move/conjg_fixP; rewrite (sameP commgP cent1P) cent1C -cent_cycle -/X => cXz. have defXz: X * <[z]> = G by rewrite (mulg_normal_maximal nsXG) ?cycle_subG. have: z \in 'Z(G) by rewrite inE Gz -defXz centM inE cXz cent_cycle cent1id. by rewrite defZ => Xr_z; rewrite (subsetP (cycleX x r)) in notXz. have nXiG k: G \subset 'N(<[x ^+ k]>). apply: char_norm_trans nXG. by rewrite cycle_subgroup_char // cycle_subG mem_cycle. have memL i: x ^+ (2 ^ i) \in 'L_i.+1(G). elim: i => // i IHi; rewrite -groupV expnSr expgM invMg. by rewrite -{2}(invXX' _ y) ?mem_cycle ?cycle_id ?mem_commg. have defG': G^`(1) = <[x ^+ 2]>. apply/eqP; rewrite eqEsubset cycle_subG (memL 1%N) ?der1_min //=. rewrite (p2group_abelian (quotient_pgroup _ pG)) ?card_quotient //=. rewrite -divgS ?cycle_subG ?groupX // oG -orderE ox2. by rewrite -def2q -def2r mulnA mulnK. have defG1: 'Mho^1(G) = <[x ^+ 2]>. apply/eqP; rewrite (MhoE _ pG) eqEsubset !gen_subG sub1set andbC. rewrite mem_gen; last exact: imset_f. apply/subsetP=> z2; case/imsetP=> z Gz ->{z2}. case Xz: (z \in X). by case/cycleP: Xz => i ->; rewrite -expgM mulnC expgM mem_cycle. rewrite (X'2 z) ?inE ?Xz // -def_xr. by rewrite /r -(subnKC n_gt2) expnS expgM mem_cycle. have defPhi: 'Phi(G) = <[x ^+ 2]>. by rewrite (Phi_joing pG) defG' defG1 (joing_idPl _). have def_tG: {in G :\: X, forall t, t ^: G = <[x ^+ 2]> :* t}. move=> t X't; have [Gt notXt] := setDP X't. have defJt: {in X, forall z, t ^ z = z ^- 2 * t}. move=> z Xz; rewrite /= invMg -mulgA (conjgC _ t). by rewrite (invXX' _ t) ?groupV ?invgK. have defGt: X * <[t]> = G by rewrite (mulg_normal_maximal nsXG) ?cycle_subG. apply/setP=> tz; apply/imsetP/rcosetP=> [[t'z] | [z]]. rewrite -defGt -normC ?cycle_subG ?(subsetP nXG) //. case/imset2P=> t' z; case/cycleP=> j -> Xz -> -> {tz t'z t'}. exists (z ^- 2); last by rewrite conjgM {2}/conjg commuteX // mulKg defJt. case/cycleP: Xz => i ->{z}. by rewrite groupV -expgM mulnC expgM mem_cycle. case/cycleP=> i -> -> {z tz}; exists (x ^- i); first by rewrite groupV groupX. by rewrite defJt ?groupV ?mem_cycle // expgVn invgK -!expgM mulnC. have defMt: {in G :\: X, forall t, <[x ^+ 2]> <*> <[t]> = <>}. move=> t X't; have [Gt notXt] := setDP X't. apply/eqP; have: t \in <> by rewrite mem_gen ?class_refl. rewrite def_tG // eqEsubset join_subG !cycle_subG !gen_subG => tGt. rewrite tGt -(groupMr _ tGt) mem_gen ?mem_mulg ?cycle_id ?set11 //=. by rewrite mul_subG ?joing_subl // -gen_subG joing_subr. have sMtG: {in G :\: X, forall t, <> \subset G}. by move=> t; case/setDP=> Gt _; rewrite gen_subG class_subG. have oMt: {in G :\: X, forall t, #|<>| = q}. move=> t X't; have [Gt notXt] := setDP X't. rewrite -defMt // -(Lagrange (joing_subl _ _)) -orderE ox2 -def2r mulnC. congr (_ * r)%N; rewrite -card_quotient /=; last first. by rewrite defMt // (subset_trans _ (nXiG 2)) ?sMtG. rewrite joingC quotientYidr ?(subset_trans _ (nXiG 2)) ?cycle_subG //. rewrite quotient_cycle ?(subsetP (nXiG 2)) //= -defPhi. rewrite -orderE (abelem_order_p (Phi_quotient_abelem pG)) ?mem_quotient //. apply: contraNneq notXt; move/coset_idr; move/implyP=> /=. by rewrite defPhi ?(subsetP (nXiG 2)) //; apply: subsetP; apply: cycleX. have maxMt: {in G :\: X, forall t, maximal <> G}. move=> t X't; rewrite /= p_index_maximal -?divgS ?sMtG ?oMt //. by rewrite oG -def2q mulnK. have X'xy: x * y \in G :\: X by rewrite !inE !groupMl ?cycle_id ?notXy. have ti_yG_xyG: [disjoint yG & xyG]. apply/pred0P=> t; rewrite /= /yG /xyG !def_tG //; apply/andP=> [[yGt]]. rewrite rcoset_sym (rcoset_eqP yGt) mem_rcoset mulgK; move/order_dvdG. by rewrite -orderE ox2 ox gtnNdvd. have s_tG_X': {in G :\: X, forall t, t ^: G \subset G :\: X}. by move=> t X't /=; rewrite class_sub_norm // normsD ?normG. have defX': yG :|: xyG = G :\: X. apply/eqP; rewrite eqEcard subUset !s_tG_X' //= -(leq_add2l q) -{1}ox orderE. rewrite -/X -{1}(setIidPr sXG) cardsID oG -def2q mul2n -addnn leq_add2l. rewrite -(leq_add2r #|yG :&: xyG|) cardsUI disjoint_setI0 // cards0 addn0. by rewrite /yG /xyG !def_tG // !card_rcoset addnn -mul2n -orderE ox2 def2r. rewrite pprodE //; split=> // [|||n_gt3]. - rewrite defG'; split=> //; apply/eqP; rewrite eqn_leq. rewrite (leq_trans (nil_class_pgroup pG)); last first. by rewrite oG pfactorK // -(subnKC n_gt2). rewrite -(subnKC (ltnW n_gt2)) subn2 ltnNge. rewrite (sameP (lcn_nil_classP _ (pgroup_nil pG)) eqP). by apply/trivgPn; exists (x ^+ r); rewrite ?memL // -order_gt1 oxr. - rewrite {2}def_xr defZ; split=> //; last exact: extend_cyclic_Mho. split; apply/eqP; last first. have sX'G2: {subset G :\: X <= 'Ohm_2(G)}. move=> z X'z; have [Gz _] := setDP X'z. by rewrite (OhmE 2 pG) mem_gen // !inE Gz -order_dvdn oX'. rewrite eqEsubset Ohm_sub -{1}defXY mulG_subG !cycle_subG. by rewrite -(groupMr _ (sX'G2 y X'y)) !sX'G2. rewrite eqEsubset (OhmE 1 pG) cycle_subG gen_subG andbC. rewrite mem_gen ?inE ?groupX -?order_dvdn ?oxr //=. apply/subsetP=> t; case/setIP=> Gt; rewrite inE -order_dvdn /=. rewrite dvdn_divisors ?inE //= order_eq1. case/pred2P=> [->|]; first exact: group1. by move/def_ur=> -> //; rewrite def_xr cycle_id. - split=> //= H; apply/idP/idP=> [maxH |]; last first. by case/or3P=> /eqP->; rewrite ?maxMt. have [sHG nHG]:= andP (p_maximal_normal pG maxH). have oH: #|H| = q. apply: double_inj; rewrite -muln2 -(p_maximal_index pG maxH) Lagrange //. by rewrite oG -mul2n. rewrite !(eq_sym (gval H)) -eq_sym !eqEcard oH -orderE ox !oMt // !leqnn. case sHX: (H \subset X) => //=; case/subsetPn: sHX => z Hz notXz. have: z \in yG :|: xyG by rewrite defX' inE notXz (subsetP sHG). rewrite !andbT !gen_subG /yG /xyG. by case/setUP=> /class_eqP <-; rewrite !class_sub_norm ?Hz ?orbT. have isoMt: {in G :\: X, forall z, <> \isog 'Q_q}. have n1_gt2: n.-1 > 2 by rewrite -(subnKC n_gt3). move=> z X'z /=; rewrite isogEcard card_quaternion ?oMt // leqnn andbT. rewrite Grp_quaternion //; apply/existsP; exists (x ^+ 2, z) => /=. rewrite defMt // -/q -/r !xpair_eqE -!expgM def2r -order_dvdn ox dvdnn. rewrite -expnS prednK; last by rewrite -subn2 subn_gt0. by rewrite X'2 // def_xr !eqxx /= invXX' ?mem_cycle. rewrite !isoMt //; split=> // C; case/cyclicP=> z ->{C} sCG iCG. rewrite [X]defU // defU -?cycle_subG //. by apply: double_inj; rewrite -muln2 -iCG Lagrange // oG -mul2n. Qed. Theorem semidihedral_structure : n > 3 -> extremal_generators G 2 n (x, y) -> G \isog 'SD_m -> #[y] = 2 -> [/\ [/\ X ><| Y = G, #[x * y] = 4 & {in X & G :\: X, forall z t, z ^ t = z ^+ r.-1}], [/\ G ^`(1) = <[x ^+ 2]>, 'Phi(G) = G ^`(1), #|G^`(1)| = r & nil_class G = n.-1], [/\ 'Z(G) = <[x ^+ r]>, #|'Z(G)| = 2, 'Ohm_1(G) = My /\ 'Ohm_2(G) = G & forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (2 ^ k)]>], [/\ yG :|: xyG = G :\: X /\ [disjoint yG & xyG] & forall H, maximal H G = pred3 X My Mxy H] & [/\ My \isog 'D_q, Mxy \isog 'Q_q & forall U, cyclic U -> U \subset G -> #|G : U| = 2 -> U = X]]. Proof. move=> n_gt3 genG isoG oy. have [def2q def2r ltqm ltrq] := def2qr (ltnW (ltnW n_gt3)). have [oG Gx ox X'y] := genG; rewrite -/m -/q -/X in oG ox X'y. case/extremal_generators_facts: genG; rewrite -/X // => pG maxX nsXG defXY nXY. have [sXG nXG]:= andP nsXG; have [Gy notXy]:= setDP X'y. have ox2: #[x ^+ 2] = r by rewrite orderXdiv ox -def2r ?dvdn_mulr ?mulKn. have oxr: #[x ^+ r] = 2 by rewrite orderXdiv ox -def2r ?dvdn_mull ?mulnK. have [[u v] [_ Gu ou U'v] [ov uv]] := generators_semidihedral n_gt3 isoG. have defUv: <[u]> :* v = G :\: <[u]>. apply: rcoset_index2; rewrite -?divgS ?cycle_subG //. by rewrite oG -orderE ou -def2q mulnK. have invUV: {in <[u]> & <[u]> :* v, forall z t, z ^ t = z ^+ r.-1}. move=> z t; case/cycleP=> i ->; case/rcosetP=> ?; case/cycleP=> j -> ->{z t}. by rewrite conjgM {2}/conjg commuteX2 // mulKg conjXg uv -!expgM mulnC. have [vV yV]: v^-1 = v /\ y^-1 = y by rewrite !invg_expg ov oy. have defU: {in G, forall z, #[z] = q -> <[z]> = <[u]>}. move=> z Gz /= oz; apply/eqP; rewrite eqEcard -!orderE oz ou leqnn andbT. apply: contraLR (n_gt3) => notUz; rewrite -leqNgt -(ltn_predK n_gt3) ltnS. rewrite -(@dvdn_Pexp2l 2) // -/q -{}oz order_dvdn expgM (expgS z). have{Gz notUz} [z' Uz' ->{z}]: exists2 z', z' \in <[u]> & z = z' * v. by apply/rcosetP; rewrite defUv inE -cycle_subG notUz Gz. rewrite {2}(conjgC z') invUV ?rcoset_refl // mulgA -{2}vV mulgK -expgS. by rewrite prednK // -expgM mulnC def2r -order_dvdn /q -ou order_dvdG. have{invUV} invXX': {in X & G :\: X, forall z t, z ^ t = z ^+ r.-1}. by rewrite /X defU -?defUv. have xy2: (x * y) ^+ 2 = x ^+ r. rewrite expgS {2}(conjgC x) invXX' ?cycle_id // mulgA -{2}yV mulgK -expgS. by rewrite prednK. have oxy: #[x * y] = 4 by rewrite (@orderXprime _ 2 2) ?xy2. have r_gt2: r > 2 by rewrite (ltn_exp2l 1) // -(subnKC n_gt3). have coXr1: coprime #[x] (2 ^ (n - 3)).-1. rewrite ox coprimeXl // -(@coprime_pexpl (n - 3)) ?coprimenP ?subn_gt0 //. by rewrite expn_gt0. have def2r1: (2 * (2 ^ (n - 3)).-1).+1 = r.-1. rewrite -!subn1 mulnBr -expnS [_.+1]subnSK ?(ltn_exp2l 0) //. by rewrite /r -(subnKC n_gt3). have defZ: 'Z(G) = <[x ^+ r]>. apply/eqP; rewrite eqEcard andbC -orderE oxr -{1}(setIidPr (center_sub G)). rewrite cardG_gt1 /= meet_center_nil ?(pgroup_nil pG) //; last first. by rewrite -cardG_gt1 oG (leq_trans _ ltqm). apply/subsetP=> z /setIP[Gz cGz]. case X'z: (z \in G :\: X). move/eqP: (invXX' _ _ (cycle_id x) X'z). rewrite /conjg -(centP cGz) // mulKg -def2r1 eq_mulVg1 expgS mulKg mulnC. rewrite -order_dvdn Gauss_dvdr // order_dvdn -order_eq1. by rewrite ox2 -(subnKC r_gt2). move/idPn: X'z; rewrite inE Gz andbT negbK => Xz. have:= Ohm_p_cycle 1 (mem_p_elt pG Gx); rewrite ox pfactorK // subn1 => <-. rewrite (OhmE _ (mem_p_elt pG Gx)) mem_gen // !inE Xz /=. rewrite -(expgK coXr1 Xz) -!expgM mulnCA -order_dvdn dvdn_mull //. rewrite mulnC order_dvdn -(inj_eq (mulgI z)) -expgS mulg1 def2r1. by rewrite -(invXX' z y) // /conjg (centP cGz) ?mulKg. have nXiG k: G \subset 'N(<[x ^+ k]>). apply: char_norm_trans nXG. by rewrite cycle_subgroup_char // cycle_subG mem_cycle. have memL i: x ^+ (2 ^ i) \in 'L_i.+1(G). elim: i => // i IHi; rewrite -(expgK coXr1 (mem_cycle _ _)) groupX //. rewrite -expgM expnSr -mulnA expgM -(mulKg (x ^+ (2 ^ i)) (_ ^+ _)). by rewrite -expgS def2r1 -(invXX' _ y) ?mem_cycle ?mem_commg. have defG': G^`(1) = <[x ^+ 2]>. apply/eqP; rewrite eqEsubset cycle_subG (memL 1%N) ?der1_min //=. rewrite (p2group_abelian (quotient_pgroup _ pG)) ?card_quotient //=. rewrite -divgS ?cycle_subG ?groupX // oG -orderE ox2. by rewrite -def2q -def2r mulnA mulnK. have defG1: 'Mho^1(G) = <[x ^+ 2]>. apply/eqP; rewrite (MhoE _ pG) eqEsubset !gen_subG sub1set andbC. rewrite mem_gen; last exact: imset_f. apply/subsetP=> z2; case/imsetP=> z Gz ->{z2}. case Xz: (z \in X). by case/cycleP: Xz => i ->; rewrite -expgM mulnC expgM mem_cycle. have{Xz Gz} [xi Xxi ->{z}]: exists2 xi, xi \in X & z = xi * y. have Uvy: y \in <[u]> :* v by rewrite defUv -(defU x). apply/rcosetP; rewrite /X defU // (rcoset_eqP Uvy) defUv. by rewrite inE -(defU x) ?Xz. rewrite expn1 expgS {2}(conjgC xi) -{2}[y]/(y ^+ 2.-1) -{1}oy -invg_expg. rewrite mulgA mulgK invXX' // -expgS prednK // /r -(subnKC n_gt3) expnS. by case/cycleP: Xxi => i ->; rewrite -expgM mulnCA expgM mem_cycle. have defPhi: 'Phi(G) = <[x ^+ 2]>. by rewrite (Phi_joing pG) defG' defG1 (joing_idPl _). have def_tG: {in G :\: X, forall t, t ^: G = <[x ^+ 2]> :* t}. move=> t X't; have [Gt notXt] := setDP X't. have defJt: {in X, forall z, t ^ z = z ^+ r.-2 * t}. move=> z Xz /=; rewrite -(mulKg z (z ^+ _)) -expgS -subn2. have X'tV: t^-1 \in G :\: X by rewrite inE !groupV notXt. by rewrite subnSK 1?ltnW // subn1 -(invXX' _ t^-1) // -mulgA -conjgCV. have defGt: X * <[t]> = G by rewrite (mulg_normal_maximal nsXG) ?cycle_subG. apply/setP=> tz; apply/imsetP/rcosetP=> [[t'z] | [z]]. rewrite -defGt -normC ?cycle_subG ?(subsetP nXG) //. case/imset2P=> t' z; case/cycleP=> j -> Xz -> -> {t' t'z tz}. exists (z ^+ r.-2); last first. by rewrite conjgM {2}/conjg commuteX // mulKg defJt. case/cycleP: Xz => i ->{z}. by rewrite -def2r1 -expgM mulnCA expgM mem_cycle. case/cycleP=> i -> -> {z tz}. exists (x ^+ (i * expg_invn X (2 ^ (n - 3)).-1)); first by rewrite groupX. rewrite defJt ?mem_cycle // -def2r1 -!expgM. by rewrite mulnAC mulnA mulnC muln2 !expgM expgK ?mem_cycle. have defMt: {in G :\: X, forall t, <[x ^+ 2]> <*> <[t]> = <>}. move=> t X't; have [Gt notXt] := setDP X't. apply/eqP; have: t \in <> by rewrite mem_gen ?class_refl. rewrite def_tG // eqEsubset join_subG !cycle_subG !gen_subG => tGt. rewrite tGt -(groupMr _ tGt) mem_gen ?mem_mulg ?cycle_id ?set11 //=. by rewrite mul_subG ?joing_subl // -gen_subG joing_subr. have sMtG: {in G :\: X, forall t, <> \subset G}. by move=> t; case/setDP=> Gt _; rewrite gen_subG class_subG. have oMt: {in G :\: X, forall t, #|<>| = q}. move=> t X't; have [Gt notXt] := setDP X't. rewrite -defMt // -(Lagrange (joing_subl _ _)) -orderE ox2 -def2r mulnC. congr (_ * r)%N; rewrite -card_quotient /=; last first. by rewrite defMt // (subset_trans _ (nXiG 2)) ?sMtG. rewrite joingC quotientYidr ?(subset_trans _ (nXiG 2)) ?cycle_subG //. rewrite quotient_cycle ?(subsetP (nXiG 2)) //= -defPhi -orderE. rewrite (abelem_order_p (Phi_quotient_abelem pG)) ?mem_quotient //. apply: contraNneq notXt; move/coset_idr; move/implyP=> /=. by rewrite /= defPhi (subsetP (nXiG 2)) //; apply: subsetP; apply: cycleX. have maxMt: {in G :\: X, forall t, maximal <> G}. move=> t X't /=; rewrite p_index_maximal -?divgS ?sMtG ?oMt //. by rewrite oG -def2q mulnK. have X'xy: x * y \in G :\: X by rewrite !inE !groupMl ?cycle_id ?notXy. have ti_yG_xyG: [disjoint yG & xyG]. apply/pred0P=> t; rewrite /= /yG /xyG !def_tG //; apply/andP=> [[yGt]]. rewrite rcoset_sym (rcoset_eqP yGt) mem_rcoset mulgK; move/order_dvdG. by rewrite -orderE ox2 ox gtnNdvd. have s_tG_X': {in G :\: X, forall t, t ^: G \subset G :\: X}. by move=> t X't /=; rewrite class_sub_norm // normsD ?normG. have defX': yG :|: xyG = G :\: X. apply/eqP; rewrite eqEcard subUset !s_tG_X' //= -(leq_add2l q) -{1}ox orderE. rewrite -/X -{1}(setIidPr sXG) cardsID oG -def2q mul2n -addnn leq_add2l. rewrite -(leq_add2r #|yG :&: xyG|) cardsUI disjoint_setI0 // cards0 addn0. by rewrite /yG /xyG !def_tG // !card_rcoset addnn -mul2n -orderE ox2 def2r. split. - by rewrite sdprodE // setIC prime_TIg ?cycle_subG // -orderE oy. - rewrite defG'; split=> //. apply/eqP; rewrite eqn_leq (leq_trans (nil_class_pgroup pG)); last first. by rewrite oG pfactorK // -(subnKC n_gt3). rewrite -(subnKC (ltnW (ltnW n_gt3))) subn2 ltnNge. rewrite (sameP (lcn_nil_classP _ (pgroup_nil pG)) eqP). by apply/trivgPn; exists (x ^+ r); rewrite ?memL // -order_gt1 oxr. - rewrite defZ; split=> //; last exact: extend_cyclic_Mho. split; apply/eqP; last first. have sX'G2: {subset G :\: X <= 'Ohm_2(G)}. move=> t X't; have [Gt _] := setDP X't; rewrite -defX' in X't. rewrite (OhmE 2 pG) mem_gen // !inE Gt -order_dvdn. by case/setUP: X't; case/imsetP=> z _ ->; rewrite orderJ ?oy ?oxy. rewrite eqEsubset Ohm_sub -{1}defXY mulG_subG !cycle_subG. by rewrite -(groupMr _ (sX'G2 y X'y)) !sX'G2. rewrite eqEsubset andbC gen_subG class_sub_norm ?gFnorm //. rewrite (OhmE 1 pG) mem_gen ?inE ?Gy -?order_dvdn ?oy // gen_subG /= -/My. apply/subsetP=> t; rewrite !inE; case/andP=> Gt t2. have pX := pgroupS sXG pG. case Xt: (t \in X). have: t \in 'Ohm_1(X) by rewrite (OhmE 1 pX) mem_gen // !inE Xt. apply: subsetP; rewrite (Ohm_p_cycle 1 pX) ox pfactorK //. rewrite -(subnKC n_gt3) expgM (subset_trans (cycleX _ _)) //. by rewrite /My -defMt ?joing_subl. have{Xt}: t \in yG :|: xyG by rewrite defX' inE Xt. case/setUP; first exact: mem_gen. by case/imsetP=> z _ def_t; rewrite -order_dvdn def_t orderJ oxy in t2. - split=> //= H; apply/idP/idP=> [maxH |]; last first. by case/or3P=> /eqP->; rewrite ?maxMt. have [sHG nHG]:= andP (p_maximal_normal pG maxH). have oH: #|H| = q. apply: double_inj; rewrite -muln2 -(p_maximal_index pG maxH) Lagrange //. by rewrite oG -mul2n. rewrite !(eq_sym (gval H)) -eq_sym !eqEcard oH -orderE ox !oMt // !leqnn. case sHX: (H \subset X) => //=; case/subsetPn: sHX => t Ht notXt. have: t \in yG :|: xyG by rewrite defX' inE notXt (subsetP sHG). rewrite !andbT !gen_subG /yG /xyG. by case/setUP=> /class_eqP <-; rewrite !class_sub_norm ?Ht ?orbT. have n1_gt2: n.-1 > 2 by [rewrite -(subnKC n_gt3)]; have n1_gt1 := ltnW n1_gt2. rewrite !isogEcard card_2dihedral ?card_quaternion ?oMt // leqnn !andbT. have invX2X': {in G :\: X, forall t, x ^+ 2 ^ t == x ^- 2}. move=> t X't; rewrite /= invXX' ?mem_cycle // eq_sym eq_invg_mul -expgS. by rewrite prednK // -order_dvdn ox2. rewrite Grp_2dihedral ?Grp_quaternion //; split=> [||C]. - apply/existsP; exists (x ^+ 2, y); rewrite /= defMt // !xpair_eqE. by rewrite -!expgM def2r -!order_dvdn ox oy dvdnn eqxx /= invX2X'. - apply/existsP; exists (x ^+ 2, x * y); rewrite /= defMt // !xpair_eqE. rewrite -!expgM def2r -order_dvdn ox xy2 dvdnn eqxx invX2X' //=. by rewrite andbT /r -(subnKC n_gt3). case/cyclicP=> z ->{C} sCG iCG; rewrite [X]defU // defU -?cycle_subG //. by apply: double_inj; rewrite -muln2 -iCG Lagrange // oG -mul2n. Qed. End ExtremalStructure. Section ExtremalClass. Variables (gT : finGroupType) (G : {group gT}). Inductive extremal_group_type := ModularGroup | Dihedral | SemiDihedral | Quaternion | NotExtremal. Definition index_extremal_group_type c := match c with | ModularGroup => 0 | Dihedral => 1 | SemiDihedral => 2 | Quaternion => 3 | NotExtremal => 4 end%N. Definition enum_extremal_groups := [:: ModularGroup; Dihedral; SemiDihedral; Quaternion]. Lemma cancel_index_extremal_groups : cancel index_extremal_group_type (nth NotExtremal enum_extremal_groups). Proof. by case. Qed. Local Notation extgK := cancel_index_extremal_groups. Import choice. Definition extremal_group_eqMixin := CanEqMixin extgK. Canonical extremal_group_eqType := EqType _ extremal_group_eqMixin. Definition extremal_group_choiceMixin := CanChoiceMixin extgK. Canonical extremal_group_choiceType := ChoiceType _ extremal_group_choiceMixin. Definition extremal_group_countMixin := CanCountMixin extgK. Canonical extremal_group_countType := CountType _ extremal_group_countMixin. Lemma bound_extremal_groups (c : extremal_group_type) : pickle c < 6. Proof. by case: c. Qed. Definition extremal_group_finMixin := Finite.CountMixin bound_extremal_groups. Canonical extremal_group_finType := FinType extremal_group_type extremal_group_finMixin. Definition extremal_class (A : {set gT}) := let m := #|A| in let p := pdiv m in let n := logn p m in if (n > 1) && (A \isog 'D_(2 ^ n)) then Dihedral else if (n > 2) && (A \isog 'Q_(2 ^ n)) then Quaternion else if (n > 3) && (A \isog 'SD_(2 ^ n)) then SemiDihedral else if (n > 2) && (A \isog 'Mod_(p ^ n)) then ModularGroup else NotExtremal. Definition extremal2 A := extremal_class A \in behead enum_extremal_groups. Lemma dihedral_classP : extremal_class G = Dihedral <-> (exists2 n, n > 1 & G \isog 'D_(2 ^ n)). Proof. rewrite /extremal_class; split=> [ | [n n_gt1 isoG]]. by move: (logn _ _) => n; do 4?case: ifP => //; case/andP; exists n. rewrite (card_isog isoG) card_2dihedral // -(ltn_predK n_gt1) pdiv_pfactor //. by rewrite pfactorK // (ltn_predK n_gt1) n_gt1 isoG. Qed. Lemma quaternion_classP : extremal_class G = Quaternion <-> (exists2 n, n > 2 & G \isog 'Q_(2 ^ n)). Proof. rewrite /extremal_class; split=> [ | [n n_gt2 isoG]]. by move: (logn _ _) => n; do 4?case: ifP => //; case/andP; exists n. rewrite (card_isog isoG) card_quaternion // -(ltn_predK n_gt2) pdiv_pfactor //. rewrite pfactorK // (ltn_predK n_gt2) n_gt2 isoG. case: andP => // [[n_gt1 isoGD]]. have [[x y] genG [oy _ _]]:= generators_quaternion n_gt2 isoG. have [_ _ _ X'y] := genG. by case/dihedral2_structure: genG oy => // [[_ ->]]. Qed. Lemma semidihedral_classP : extremal_class G = SemiDihedral <-> (exists2 n, n > 3 & G \isog 'SD_(2 ^ n)). Proof. rewrite /extremal_class; split=> [ | [n n_gt3 isoG]]. by move: (logn _ _) => n; do 4?case: ifP => //; case/andP; exists n. rewrite (card_isog isoG) card_semidihedral //. rewrite -(ltn_predK n_gt3) pdiv_pfactor // pfactorK // (ltn_predK n_gt3) n_gt3. have [[x y] genG [oy _]]:= generators_semidihedral n_gt3 isoG. have [_ Gx _ X'y]:= genG. case: andP => [[n_gt1 isoGD]|_]. have [[_ oxy _ _] _ _ _]:= semidihedral_structure n_gt3 genG isoG oy. case: (dihedral2_structure n_gt1 genG isoGD) oxy => [[_ ->]] //. by rewrite !inE !groupMl ?cycle_id in X'y *. case: andP => // [[n_gt2 isoGQ]|]; last by rewrite isoG. by case: (quaternion_structure n_gt2 genG isoGQ) oy => [[_ ->]]. Qed. Lemma odd_not_extremal2 : odd #|G| -> ~~ extremal2 G. Proof. rewrite /extremal2 /extremal_class; case: logn => // n'. case: andP => [[n_gt1 isoG] | _]. by rewrite (card_isog isoG) card_2dihedral ?oddX. case: andP => [[n_gt2 isoG] | _]. by rewrite (card_isog isoG) card_quaternion ?oddX. case: andP => [[n_gt3 isoG] | _]. by rewrite (card_isog isoG) card_semidihedral ?oddX. by case: ifP. Qed. Lemma modular_group_classP : extremal_class G = ModularGroup <-> (exists2 p, prime p & exists2 n, n >= (p == 2) + 3 & G \isog 'Mod_(p ^ n)). Proof. rewrite /extremal_class; split=> [ | [p p_pr [n n_gt23 isoG]]]. move: (pdiv _) => p; set n := logn p _; do 4?case: ifP => //. case/andP=> n_gt2 isoG _ _; rewrite ltnW //= => not_isoG _. exists p; first by move: n_gt2; rewrite /n lognE; case (prime p). exists n => //; case: eqP => // p2; rewrite ltn_neqAle; case: eqP => // n3. by case/idP: not_isoG; rewrite p2 -n3 in isoG *. have n_gt2 := leq_trans (leq_addl _ _) n_gt23; have n_gt1 := ltnW n_gt2. have n_gt0 := ltnW n_gt1; have def_n := prednK n_gt0. have [[x y] genG mod_xy] := generators_modular_group p_pr n_gt2 isoG. case/modular_group_structure: (genG) => // _ _ [_ _ nil2G] _ _. have [oG _ _ _] := genG; have [oy _] := mod_xy. rewrite oG -def_n pdiv_pfactor // def_n pfactorK // n_gt1 n_gt2 {}isoG /=. case: (ltngtP p 2) => [|p_gt2|p2]; first by rewrite ltnNge prime_gt1. rewrite !(isog_sym G) !isogEcard card_2dihedral ?card_quaternion //= oG. rewrite leq_exp2r // leqNgt p_gt2 !andbF; case: and3P=> // [[n_gt3 _]]. by rewrite card_semidihedral // leq_exp2r // leqNgt p_gt2. rewrite p2 in genG oy n_gt23; rewrite n_gt23. have: nil_class G <> n.-1. by apply/eqP; rewrite neq_ltn -ltnS nil2G def_n n_gt23. case: ifP => [isoG | _]; first by case/dihedral2_structure: genG => // _ []. case: ifP => [isoG | _]; first by case/quaternion_structure: genG => // _ []. by case: ifP => // isoG; case/semidihedral_structure: genG => // _ []. Qed. End ExtremalClass. Theorem extremal2_structure (gT : finGroupType) (G : {group gT}) n x y : let cG := extremal_class G in let m := (2 ^ n)%N in let q := (2 ^ n.-1)%N in let r := (2 ^ n.-2)%N in let X := <[x]> in let yG := y ^: G in let xyG := (x * y) ^: G in let My := <> in let Mxy := <> in extremal_generators G 2 n (x, y) -> extremal2 G -> (cG == SemiDihedral) ==> (#[y] == 2) -> [/\ [/\ (if cG == Quaternion then pprod X <[y]> else X ><| <[y]>) = G, if cG == SemiDihedral then #[x * y] = 4 else {in G :\: X, forall z, #[z] = (if cG == Dihedral then 2 else 4)}, if cG != Quaternion then True else {in G, forall z, #[z] = 2 -> z = x ^+ r} & {in X & G :\: X, forall t z, t ^ z = (if cG == SemiDihedral then t ^+ r.-1 else t^-1)}], [/\ G ^`(1) = <[x ^+ 2]>, 'Phi(G) = G ^`(1), #|G^`(1)| = r & nil_class G = n.-1], [/\ if n > 2 then 'Z(G) = <[x ^+ r]> /\ #|'Z(G)| = 2 else 2.-abelem G, 'Ohm_1(G) = (if cG == Quaternion then <[x ^+ r]> else if cG == SemiDihedral then My else G), 'Ohm_2(G) = G & forall k, k > 0 -> 'Mho^k(G) = <[x ^+ (2 ^ k)]>], [/\ yG :|: xyG = G :\: X, [disjoint yG & xyG] & forall H : {group gT}, maximal H G = (gval H \in pred3 X My Mxy)] & if n <= (cG == Quaternion) + 2 then True else [/\ forall U, cyclic U -> U \subset G -> #|G : U| = 2 -> U = X, if cG == Quaternion then My \isog 'Q_q else My \isog 'D_q, extremal_class My = (if cG == Quaternion then cG else Dihedral), if cG == Dihedral then Mxy \isog 'D_q else Mxy \isog 'Q_q & extremal_class Mxy = (if cG == Dihedral then cG else Quaternion)]]. Proof. move=> cG m q r X yG xyG My Mxy genG; have [oG _ _ _] := genG. have logG: logn (pdiv #|G|) #|G| = n by rewrite oG pfactorKpdiv. rewrite /extremal2 -/cG; do [rewrite {1}/extremal_class /= {}logG] in cG *. case: ifP => [isoG | _] in cG * => [_ _ /=|]. case/andP: isoG => n_gt1 isoG. have:= dihedral2_structure n_gt1 genG isoG; rewrite -/X -/q -/r -/yG -/xyG. case=> [[defG oX' invXX'] nilG [defOhm defMho] maxG defZ]. rewrite eqn_leq n_gt1 andbT add0n in defZ *; split=> //. split=> //; first by case: leqP defZ => // _ []. by apply/eqP; rewrite eqEsubset Ohm_sub -{1}defOhm Ohm_leq. case: leqP defZ => // n_gt2 [_ _ isoMy isoMxy defX]. have n1_gt1: n.-1 > 1 by rewrite -(subnKC n_gt2). by split=> //; apply/dihedral_classP; exists n.-1. case: ifP => [isoG | _] in cG * => [_ _ /=|]. case/andP: isoG => n_gt2 isoG; rewrite n_gt2 add1n. have:= quaternion_structure n_gt2 genG isoG; rewrite -/X -/q -/r -/yG -/xyG. case=> [[defG oX' invXX'] nilG [defZ oZ def2 [-> ->] defMho]]. case=> [[-> ->] maxG] isoM; split=> //. case: leqP isoM => // n_gt3 [//|isoMy isoMxy defX]. have n1_gt2: n.-1 > 2 by rewrite -(subnKC n_gt3). by split=> //; apply/quaternion_classP; exists n.-1. do [case: ifP => [isoG | _]; last by case: ifP] in cG * => /= _; move/eqnP=> oy. case/andP: isoG => n_gt3 isoG; rewrite (leqNgt n) (ltnW n_gt3) /=. have n1_gt2: n.-1 > 2 by rewrite -(subnKC n_gt3). have:= semidihedral_structure n_gt3 genG isoG oy. rewrite -/X -/q -/r -/yG -/xyG -/My -/Mxy. case=> [[defG oxy invXX'] nilG [defZ oZ [-> ->] defMho] [[defX' tiX'] maxG]]. case=> isoMy isoMxy defX; do 2!split=> //. by apply/dihedral_classP; exists n.-1; first apply: ltnW. by apply/quaternion_classP; exists n.-1. Qed. (* This is Aschbacher (23.4). *) Lemma maximal_cycle_extremal gT p (G X : {group gT}) : p.-group G -> ~~ abelian G -> cyclic X -> X \subset G -> #|G : X| = p -> (extremal_class G == ModularGroup) || (p == 2) && extremal2 G. Proof. move=> pG not_cGG cycX sXG iXG; rewrite /extremal2; set cG := extremal_class G. have [|p_pr _ _] := pgroup_pdiv pG. by case: eqP not_cGG => // ->; rewrite abelian1. have p_gt1 := prime_gt1 p_pr; have p_gt0 := ltnW p_gt1. have [n oG] := p_natP pG; have n_gt2: n > 2. apply: contraR not_cGG; rewrite -leqNgt => n_le2. by rewrite (p2group_abelian pG) // oG pfactorK. have def_n := subnKC n_gt2; have n_gt1 := ltnW n_gt2; have n_gt0 := ltnW n_gt1. pose q := (p ^ n.-1)%N; pose r := (p ^ n.-2)%N. have q_gt1: q > 1 by rewrite (ltn_exp2l 0) // -(subnKC n_gt2). have r_gt0: r > 0 by rewrite expn_gt0 p_gt0. have def_pr: (p * r)%N = q by rewrite /q /r -def_n. have oX: #|X| = q by rewrite -(divg_indexS sXG) oG iXG /q -def_n mulKn. have ntX: X :!=: 1 by rewrite -cardG_gt1 oX. have maxX: maximal X G by rewrite p_index_maximal ?iXG. have nsXG: X <| G := p_maximal_normal pG maxX; have [_ nXG] := andP nsXG. have cXX: abelian X := cyclic_abelian cycX. have scXG: 'C_G(X) = X. apply/eqP; rewrite eqEsubset subsetI sXG -abelianE cXX !andbT. apply: contraR not_cGG; case/subsetPn=> y; case/setIP=> Gy cXy notXy. rewrite -!cycle_subG in Gy notXy; rewrite -(mulg_normal_maximal nsXG _ Gy) //. by rewrite abelianM cycle_abelian cyclic_abelian ?cycle_subG. have [x defX] := cyclicP cycX; have pX := pgroupS sXG pG. have Xx: x \in X by [rewrite defX cycle_id]; have Gx := subsetP sXG x Xx. have [ox p_x]: #[x] = q /\ p.-elt x by rewrite defX in pX oX. pose Z := <[x ^+ r]>. have defZ: Z = 'Ohm_1(X) by rewrite defX (Ohm_p_cycle _ p_x) ox subn1 pfactorK. have oZ: #|Z| = p by rewrite -orderE orderXdiv ox -def_pr ?dvdn_mull ?mulnK. have cGZ: Z \subset 'C(G). have nsZG: Z <| G by rewrite defZ gFnormal_trans. move/implyP: (meet_center_nil (pgroup_nil pG) nsZG). rewrite -cardG_gt1 oZ p_gt1 setIA (setIidPl (normal_sub nsZG)). by apply: contraR; move/prime_TIg=> -> //; rewrite oZ. have X_Gp y: y \in G -> y ^+ p \in X. move=> Gy; have nXy: y \in 'N(X) := subsetP nXG y Gy. rewrite coset_idr ?groupX // morphX //; apply/eqP. by rewrite -order_dvdn -iXG -card_quotient // order_dvdG ?mem_quotient. have [y X'y]: exists2 y, y \in G :\: X & (p == 2) + 3 <= n /\ x ^ y = x ^+ r.+1 \/ p = 2 /\ x * x ^ y \in Z. - have [y Gy notXy]: exists2 y, y \in G & y \notin X. by apply/subsetPn; rewrite proper_subn ?(maxgroupp maxX). have nXy: y \in 'N(X) := subsetP nXG y Gy; pose ay := conj_aut X y. have oay: #[ay] = p. apply: nt_prime_order => //. by rewrite -morphX // mker // ker_conj_aut (subsetP cXX) ?X_Gp. rewrite (sameP eqP (kerP _ nXy)) ker_conj_aut. by apply: contra notXy => cXy; rewrite -scXG inE Gy. have [m []]:= cyclic_pgroup_Aut_structure pX cycX ntX. set Ap := 'O_p(_); case=> def_m [m1 _] [m_inj _] _ _ _. have sylAp: p.-Sylow(Aut X) Ap. by rewrite nilpotent_pcore_Hall // abelian_nil // Aut_cyclic_abelian. have Ap1ay: ay \in 'Ohm_1(Ap). rewrite (OhmE _ (pcore_pgroup _ _)) mem_gen // !inE -order_dvdn oay dvdnn. rewrite (mem_normal_Hall sylAp) ?pcore_normal ?Aut_aut //. by rewrite /p_elt oay pnat_id. rewrite {1}oX pfactorK // -{1}def_n /=. have [p2 | odd_p] := even_prime p_pr; last first. rewrite (sameP eqP (prime_oddPn p_pr)) odd_p n_gt2. case=> _ [_ _ _] [_ _ [s [As os m_s defAp1]]]. have [j def_s]: exists j, s = ay ^+ j. apply/cycleP; rewrite -cycle_subG subEproper eq_sym eqEcard -!orderE. by rewrite -defAp1 cycle_subG Ap1ay oay os leqnn . exists (y ^+ j); last first. left; rewrite -(norm_conj_autE _ Xx) ?groupX // morphX // -def_s. by rewrite -def_m // m_s expg_znat // oX pfactorK ?eqxx. rewrite -scXG !inE groupX //= andbT -ker_conj_aut !inE morphX // -def_s. rewrite andbC -(inj_in_eq m_inj) ?group1 // m_s m1 oX pfactorK // -/r. rewrite mulrSr -subr_eq0 addrK -val_eqE /= val_Zp_nat //. by rewrite [_ == 0%N]dvdn_Pexp2l // -def_n ltnn. rewrite {1}p2 /= => [[t [At ot m_t]]]; rewrite {1}oX pfactorK // -{1}def_n. rewrite eqSS subn_eq0 => defA; exists y; rewrite ?inE ?notXy //. rewrite p2 -(norm_conj_autE _ Xx) //= -/ay -def_m ?Aut_aut //. case Tay: (ay \in <[t]>). rewrite cycle2g // !inE -order_eq1 oay p2 /= in Tay. by right; rewrite (eqP Tay) m_t expg_zneg // mulgV group1. case: leqP defA => [_ defA|le3n [a [Aa _ _ defA [s [As os m_s m_st defA1]]]]]. by rewrite -defA Aut_aut in Tay. have: ay \in [set s; s * t]. have: ay \in 'Ohm_1(Aut X) := subsetP (OhmS 1 (pcore_sub _ _)) ay Ap1ay. case/dprodP: (Ohm_dprod 1 defA) => _ <- _ _. rewrite defA1 (@Ohm_p_cycle _ _ 2) /p_elt ot //= expg1 cycle2g //. by rewrite mulUg mul1g inE Tay cycle2g // mulgU mulg1 mulg_set1. case/set2P=> ->; [left | right]. by rewrite ?le3n m_s expg_znat // oX pfactorK // -p2. by rewrite m_st expg_znat // oX pfactorK // -p2 -/r -expgS prednK ?cycle_id. have [Gy notXy] := setDP X'y; have nXy := subsetP nXG y Gy. have defG j: <[x]> <*> <[x ^+ j * y]> = G. rewrite -defX -genM_join. by rewrite (mulg_normal_maximal nsXG) ?cycle_subG ?groupMl ?groupX ?genGid. have[i def_yp]: exists i, y ^- p = x ^+ i. by apply/cycleP; rewrite -defX groupV X_Gp. have p_i: p %| i. apply: contraR notXy; rewrite -prime_coprime // => co_p_j. have genX: generator X (y ^- p). by rewrite def_yp defX generator_coprime ox coprimeXl. rewrite -scXG (setIidPl _) // centsC ((X :=P: _) genX) cycle_subG groupV. rewrite /= -(defG 0%N) mul1g centY inE -defX (subsetP cXX) ?X_Gp //. by rewrite (subsetP (cycle_abelian y)) ?mem_cycle. case=> [[n_gt23 xy] | [p2 Z_xxy]]. suffices ->: cG = ModularGroup by []; apply/modular_group_classP. exists p => //; exists n => //; rewrite isogEcard card_modular_group //. rewrite oG leqnn andbT Grp_modular_group // -/q -/r. have{i def_yp p_i} [i def_yp]: exists i, y ^- p = x ^+ i ^+ p. by case/dvdnP: p_i => j def_i; exists j; rewrite -expgM -def_i. have Zyx: [~ y, x] \in Z. by rewrite -groupV invg_comm commgEl xy expgS mulKg cycle_id. have def_yxj j: [~ y, x ^+ j] = [~ y, x] ^+ j. by rewrite commgX /commute ?(centsP cGZ _ Zyx). have Zyxj j: [~ y, x ^+ j] \in Z by rewrite def_yxj groupX. have x_xjy j: x ^ (x ^+ j * y) = x ^+ r.+1. by rewrite conjgM {2}/conjg commuteX //= mulKg. have [cyxi | not_cyxi] := eqVneq ([~ y, x ^+ i] ^+ 'C(p, 2)) 1. apply/existsP; exists (x, x ^+ i * y); rewrite /= !xpair_eqE. rewrite defG x_xjy -order_dvdn ox dvdnn !eqxx andbT /=. rewrite expMg_Rmul /commute ?(centsP cGZ _ (Zyxj _)) ?groupX // cyxi. by rewrite -def_yp -mulgA mulKg. have [p2 | odd_p] := even_prime p_pr; last first. by rewrite -order_dvdn bin2odd ?dvdn_mulr // -oZ order_dvdG in not_cyxi. have def_yxi: [~ y, x ^+ i] = x ^+ r. have:= Zyxj i; rewrite /Z cycle_traject orderE oZ p2 !inE mulg1. by case/pred2P=> // cyxi; rewrite cyxi p2 eqxx in not_cyxi. apply/existsP; exists (x, x ^+ (i + r %/ 2) * y); rewrite /= !xpair_eqE. rewrite defG x_xjy -order_dvdn ox dvdnn !eqxx andbT /=. rewrite expMg_Rmul /commute ?(centsP cGZ _ (Zyxj _)) ?groupX // def_yxj. rewrite -expgM mulnDl addnC !expgD (expgM x i) -def_yp mulgKV. rewrite -def_yxj def_yxi p2 mulgA -expgD in n_gt23 *. rewrite -expg_mod_order ox /q /r p2 -(subnKC n_gt23) mulnC !expnS mulKn //. rewrite addnn -mul2n modnn mul1g -order_dvdn dvdn_mulr //. by rewrite -p2 -oZ order_dvdG. have{i def_yp p_i} Zy2: y ^+ 2 \in Z. rewrite defZ (OhmE _ pX) -groupV -p2 def_yp mem_gen // !inE groupX //= p2. rewrite expgS -{2}def_yp -(mulKg y y) -conjgE -conjXg -conjVg def_yp conjXg. rewrite -expgMn //; last by apply: (centsP cXX); rewrite ?memJ_norm. by rewrite -order_dvdn (dvdn_trans (order_dvdG Z_xxy)) ?oZ. rewrite !cycle_traject !orderE oZ p2 !inE !mulg1 /= in Z_xxy Zy2 *. rewrite -eq_invg_mul eq_sym -[r]prednK // expgS (inj_eq (mulgI _)) in Z_xxy. case/pred2P: Z_xxy => xy; last first. suffices ->: cG = SemiDihedral by []; apply/semidihedral_classP. have n_gt3: n > 3. case: ltngtP notXy => // [|n3]; first by rewrite ltnNge n_gt2. rewrite -scXG inE Gy defX cent_cycle; case/cent1P; red. by rewrite (conjgC x) xy /r p2 -n3. exists n => //; rewrite isogEcard card_semidihedral // oG p2 leqnn andbT. rewrite Grp_semidihedral //; apply/existsP=> /=. case/pred2P: Zy2 => y2; [exists (x, y) | exists (x, x * y)]. by rewrite /= -{1}[y]mul1g (defG 0%N) y2 xy -p2 -/q -ox expg_order. rewrite /= (defG 1%N) conjgM {2}/conjg mulKg -p2 -/q -ox expg_order -xy. rewrite !xpair_eqE !eqxx /= andbT p2 expgS {2}(conjgC x) xy mulgA -(mulgA x). rewrite [y * y]y2 -expgS -expgD addSnnS prednK // addnn -mul2n -p2 def_pr. by rewrite -ox expg_order. case/pred2P: Zy2 => y2. suffices ->: cG = Dihedral by []; apply/dihedral_classP. exists n => //; rewrite isogEcard card_2dihedral // oG p2 leqnn andbT. rewrite Grp_2dihedral //; apply/existsP; exists (x, y) => /=. by rewrite /= -{1}[y]mul1g (defG 0%N) y2 xy -p2 -/q -ox expg_order. suffices ->: cG = Quaternion by []; apply/quaternion_classP. exists n => //; rewrite isogEcard card_quaternion // oG p2 leqnn andbT. rewrite Grp_quaternion //; apply/existsP; exists (x, y) => /=. by rewrite /= -{1}[y]mul1g (defG 0%N) y2 xy -p2 -/q -ox expg_order. Qed. (* This is Aschbacher (23.5) *) Lemma cyclic_SCN gT p (G U : {group gT}) : p.-group G -> U \in 'SCN(G) -> ~~ abelian G -> cyclic U -> [/\ p = 2, #|G : U| = 2 & extremal2 G] \/ exists M : {group gT}, [/\ M :=: 'C_G('Mho^1(U)), #|M : U| = p, extremal_class M = ModularGroup, 'Ohm_1(M)%G \in 'E_p^2(G) & 'Ohm_1(M) \char G]. Proof. move=> pG /SCN_P[nsUG scUG] not_cGG cycU; have [sUG nUG] := andP nsUG. have [cUU pU] := (cyclic_abelian cycU, pgroupS sUG pG). have ltUG: ~~ (G \subset U). by apply: contra not_cGG => sGU; apply: abelianS cUU. have ntU: U :!=: 1. by apply: contraNneq ltUG => U1; rewrite -scUG subsetIidl U1 cents1. have [p_pr _ [n oU]] := pgroup_pdiv pU ntU. have p_gt1 := prime_gt1 p_pr; have p_gt0 := ltnW p_gt1. have [u defU] := cyclicP cycU; have Uu: u \in U by rewrite defU cycle_id. have Gu := subsetP sUG u Uu; have p_u := mem_p_elt pG Gu. have defU1: 'Mho^1(U) = <[u ^+ p]> by rewrite defU (Mho_p_cycle _ p_u). have modM1 (M : {group gT}): [/\ U \subset M, #|M : U| = p & extremal_class M = ModularGroup] -> M :=: 'C_M('Mho^1(U)) /\ 'Ohm_1(M)%G \in 'E_p^2(M). - case=> sUM iUM /modular_group_classP[q q_pr {n oU}[n n_gt23 isoM]]. have n_gt2: n > 2 by apply: leq_trans (leq_addl _ _) n_gt23. have def_n: n = (n - 3).+3 by rewrite -{1}(subnKC n_gt2). have oM: #|M| = (q ^ n)%N by rewrite (card_isog isoM) card_modular_group. have pM: q.-group M by rewrite /pgroup oM pnatX pnat_id. have def_q: q = p; last rewrite {q q_pr}def_q in oM pM isoM n_gt23. by apply/eqP; rewrite eq_sym [p == q](pgroupP pM) // -iUM dvdn_indexg. have [[x y] genM modM] := generators_modular_group p_pr n_gt2 isoM. case/modular_group_structure: genM => // _ [defZ _ oZ] _ defMho. have ->: 'Mho^1(U) = 'Z(M). apply/eqP; rewrite eqEcard oZ defZ -(defMho 1%N) ?MhoS //= defU1 -orderE. suff ou: #[u] = (p * p ^ n.-2)%N by rewrite orderXdiv ou ?dvdn_mulr ?mulKn. by rewrite orderE -defU -(divg_indexS sUM) iUM oM def_n mulKn. case: eqP => [[p2 n3] | _ defOhm]; first by rewrite p2 n3 in n_gt23. have{defOhm} [|defM1 oM1] := defOhm 1%N; first by rewrite def_n. split; rewrite ?(setIidPl _) //; first by rewrite centsC subsetIr. rewrite inE oM1 pfactorK // andbT inE Ohm_sub abelem_Ohm1 //. exact: (card_p2group_abelian p_pr oM1). have ou: #[u] = (p ^ n.+1)%N by rewrite defU in oU. pose Gs := G / U; have pGs: p.-group Gs by rewrite quotient_pgroup. have ntGs: Gs != 1 by rewrite -subG1 quotient_sub1. have [_ _ [[|k] oGs]] := pgroup_pdiv pGs ntGs. have iUG: #|G : U| = p by rewrite -card_quotient ?oGs. case: (predU1P (maximal_cycle_extremal _ _ _ _ iUG)) => // [modG | ext2G]. by right; exists G; case: (modM1 G) => // <- ->; rewrite Ohm_char. by left; case: eqP ext2G => // <-. pose M := 'C_G('Mho^1(U)); right; exists [group of M]. have sMG: M \subset G by apply: subsetIl. have [pM nUM] := (pgroupS sMG pG, subset_trans sMG nUG). have sUM: U \subset M by rewrite subsetI sUG sub_abelian_cent ?Mho_sub. pose A := Aut U; have cAA: abelian A by rewrite Aut_cyclic_abelian. have sylAp: p.-Sylow(A) 'O_p(A) by rewrite nilpotent_pcore_Hall ?abelian_nil. have [f [injf sfGsA fG]]: exists f : {morphism Gs >-> {perm gT}}, [/\ 'injm f, f @* Gs \subset A & {in G, forall y, f (coset U y) u = u ^ y}]. - have [] := first_isom_loc [morphism of conj_aut U] nUG. rewrite ker_conj_aut scUG /= -/Gs => f injf im_f. exists f; rewrite im_f ?Aut_conj_aut //. split=> // y Gy; have nUy := subsetP nUG y Gy. suffices ->: f (coset U y) = conj_aut U y by rewrite norm_conj_autE. by apply: set1_inj; rewrite -!morphim_set1 ?mem_quotient // im_f ?sub1set. have cGsGs: abelian Gs by rewrite -(injm_abelian injf) // (abelianS sfGsA). have p_fGs: p.-group (f @* Gs) by rewrite morphim_pgroup. have sfGsAp: f @* Gs \subset 'O_p(A) by rewrite (sub_Hall_pcore sylAp). have [a [fGa oa au n_gt01 cycGs]]: exists a, [/\ a \in f @* Gs, #[a] = p, a u = u ^+ (p ^ n).+1, (p == 2) + 1 <= n & cyclic Gs \/ p = 2 /\ (exists2 c, c \in f @* Gs & c u = u^-1)]. - have [m [[def_m _ _ _ _] _]] := cyclic_pgroup_Aut_structure pU cycU ntU. have ->: logn p #|U| = n.+1 by rewrite oU pfactorK. rewrite /= -/A; case: posnP => [_ defA | n_gt0 [c [Ac oc m_c defA]]]. have:= cardSg sfGsAp; rewrite (card_Hall sylAp) /= -/A defA card_injm //. by rewrite oGs (part_p'nat (pcore_pgroup _ _)) pfactor_dvdn // logn1. have [p2 | odd_p] := even_prime p_pr; last first. case: eqP => [-> // | _] in odd_p *; rewrite odd_p in defA. have [[cycA _] _ [a [Aa oa m_a defA1]]] := defA. exists a; rewrite -def_m // oa m_a expg_znat //. split=> //; last by left; rewrite -(injm_cyclic injf) ?(cyclicS sfGsA). have: f @* Gs != 1 by rewrite morphim_injm_eq1. rewrite -cycle_subG; apply: contraR => not_sfGs_a. by rewrite -(setIidPl sfGsAp) TI_Ohm1 // defA1 setIC prime_TIg -?orderE ?oa. do [rewrite {1}p2 /= eqn_leq n_gt0; case: leqP => /= [_ | n_gt1]] in defA. have:= cardSg sfGsAp; rewrite (card_Hall sylAp) /= -/A defA -orderE oc p2. by rewrite card_injm // oGs p2 pfactor_dvdn // p_part. have{defA} [s [As os _ defA [a [Aa oa m_a _ defA1]]]] := defA; exists a. have fGs_a: a \in f @* Gs. suffices: f @* Gs :&: <[s]> != 1. apply: contraR => not_fGs_a; rewrite TI_Ohm1 // defA1 setIC. by rewrite prime_TIg -?orderE ?oa // cycle_subG. have: (f @* Gs) * <[s]> \subset A by rewrite mulG_subG cycle_subG sfGsA. move/subset_leq_card; apply: contraL; move/eqP; move/TI_cardMg->. rewrite -(dprod_card defA) -ltnNge mulnC -!orderE ltn_pmul2r // oc. by rewrite card_injm // oGs p2 (ltn_exp2l 1%N). rewrite -def_m // oa m_a expg_znat // p2; split=> //. rewrite abelian_rank1_cyclic // (rank_pgroup pGs) //. rewrite -(injm_p_rank injf) // p_rank_abelian 1?morphim_abelian //= p2 -/Gs. case: leqP => [|fGs1_gt1]; [by left | right]. split=> //; exists c; last by rewrite -def_m // m_c expg_zneg. have{} defA1: <[a]> \x <[c]> = 'Ohm_1(Aut U). by rewrite -(Ohm_dprod 1 defA) defA1 (@Ohm_p_cycle 1 _ 2) /p_elt oc. have def_fGs1: 'Ohm_1(f @* Gs) = 'Ohm_1(A). apply/eqP; rewrite eqEcard OhmS // -(dprod_card defA1) -!orderE oa oc. by rewrite dvdn_leq ?(@pfactor_dvdn 2 2) ?cardG_gt0. rewrite (subsetP (Ohm_sub 1 _)) // def_fGs1 -cycle_subG. by case/dprodP: defA1 => _ <- _ _; rewrite mulG_subr. have n_gt0: n > 0 := leq_trans (leq_addl _ _) n_gt01. have [ys Gys _ def_a] := morphimP fGa. have oys: #[ys] = p by rewrite -(order_injm injf) // -def_a oa. have defMs: M / U = <[ys]>. apply/eqP; rewrite eq_sym eqEcard -orderE oys cycle_subG; apply/andP; split. have [y nUy Gy /= def_ys] := morphimP Gys. rewrite def_ys mem_quotient //= inE Gy defU1 cent_cycle cent1C. rewrite (sameP cent1P commgP) commgEl conjXg -fG //= -def_ys -def_a au. by rewrite -expgM mulSn expgD mulKg -expnSr -ou expg_order. rewrite card_quotient // -(setIidPr sUM) -scUG setIA (setIidPl sMG). rewrite defU cent_cycle index_cent1 -(card_imset _ (mulgI u^-1)) -imset_comp. have <-: #|'Ohm_1(U)| = p. rewrite defU (Ohm_p_cycle 1 p_u) -orderE (orderXexp _ ou) ou pfactorK //. by rewrite subKn. rewrite (OhmE 1 pU) subset_leq_card ?sub_gen //. apply/subsetP=> _ /imsetP[z /setIP[/(subsetP nUG) nUz cU1z] ->]. have Uv' := groupVr Uu; have Uuz: u ^ z \in U by rewrite memJ_norm. rewrite !inE groupM // expgMn /commute 1?(centsP cUU u^-1) //= expgVn -conjXg. by rewrite (sameP commgP cent1P) cent1C -cent_cycle -defU1. have iUM: #|M : U| = p by rewrite -card_quotient ?defMs. have not_cMM: ~~ abelian M. apply: contraL p_pr => cMM; rewrite -iUM -indexgI /= -/M. by rewrite (setIidPl _) ?indexgg // -scUG subsetI sMG sub_abelian_cent. have modM: extremal_class M = ModularGroup. have sU1Z: 'Mho^1(U) \subset 'Z(M). by rewrite subsetI gFsub_trans // centsC subsetIr. have /maximal_cycle_extremal/predU1P[] //= := iUM; rewrite -/M. case/andP=> /eqP-p2 ext2M; rewrite p2 add1n in n_gt01. suffices{sU1Z}: #|'Z(M)| = 2. move/eqP; rewrite eqn_leq leqNgt (leq_trans _ (subset_leq_card sU1Z)) //. by rewrite defU1 -orderE (orderXexp 1 ou) subn1 p2 (ltn_exp2l 1). move: ext2M; rewrite /extremal2 !inE orbC -orbA; case/or3P; move/eqP. - case/semidihedral_classP=> m m_gt3 isoM. have [[x z] genM [oz _]] := generators_semidihedral m_gt3 isoM. by case/semidihedral_structure: genM => // _ _ []. - case/quaternion_classP=> m m_gt2 isoM. have [[x z] genM _] := generators_quaternion m_gt2 isoM. by case/quaternion_structure: genM => // _ _ []. case/dihedral_classP=> m m_gt1 isoM. have [[x z] genM _] := generators_2dihedral m_gt1 isoM. case/dihedral2_structure: genM not_cMM => // _ _ _ _. by case: (m == 2) => [|[]//]; move/abelem_abelian->. split=> //. have [//|_] := modM1 [group of M]; rewrite !inE -andbA /=. by case/andP=> /subset_trans->. have{cycGs} [cycGs | [p2 [c fGs_c u_c]]] := cycGs. suffices ->: 'Ohm_1(M) = 'Ohm_1(G) by apply: Ohm_char. suffices sG1M: 'Ohm_1(G) \subset M. by apply/eqP; rewrite eqEsubset -{2}(Ohm_id 1 G) !OhmS. rewrite -(quotientSGK _ sUM) ?(subset_trans (Ohm_sub _ G)) //= defMs. suffices ->: <[ys]> = 'Ohm_1(Gs) by rewrite morphim_Ohm. apply/eqP; rewrite eqEcard -orderE cycle_subG /= {1}(OhmE 1 pGs) /=. rewrite mem_gen ?inE ?Gys -?order_dvdn oys //=. rewrite -(part_pnat_id (pgroupS (Ohm_sub _ _) pGs)) p_part (leq_exp2l _ 1) //. by rewrite -p_rank_abelian -?rank_pgroup -?abelian_rank1_cyclic. suffices charU1: 'Mho^1(U) \char G^`(1). by rewrite gFchar_trans // subcent_char ?(char_trans charU1) ?gFchar. suffices sUiG': 'Mho^1(U) \subset G^`(1). have /cyclicP[zs cycG']: cyclic G^`(1) by rewrite (cyclicS _ cycU) ?der1_min. by rewrite cycG' in sUiG' *; apply: cycle_subgroup_char. rewrite defU1 cycle_subG p2 -groupV invMg -{2}u_c. by have [_ _ /morphimP[z _ Gz ->] ->] := morphimP fGs_c; rewrite fG ?mem_commg. Qed. (* This is Aschbacher, exercise (8.4) *) Lemma normal_rank1_structure gT p (G : {group gT}) : p.-group G -> (forall X : {group gT}, X <| G -> abelian X -> cyclic X) -> cyclic G \/ [&& p == 2, extremal2 G & (#|G| >= 16) || (G \isog 'Q_8)]. Proof. move=> pG dn_G_1. have [cGG | not_cGG] := boolP (abelian G); first by left; rewrite dn_G_1. have [X maxX]: {X | [max X | X <| G & abelian X]}. by apply: ex_maxgroup; exists 1%G; rewrite normal1 abelian1. have cycX: cyclic X by rewrite dn_G_1; case/andP: (maxgroupp maxX). have scX: X \in 'SCN(G) := max_SCN pG maxX. have [[p2 _ cG] | [M [_ _ _]]] := cyclic_SCN pG scX not_cGG cycX; last first. rewrite 2!inE -andbA => /and3P[sEG abelE dimE_2] charE. have:= dn_G_1 _ (char_normal charE) (abelem_abelian abelE). by rewrite (abelem_cyclic abelE) (eqP dimE_2). have [n oG] := p_natP pG; right; rewrite p2 cG /= in oG *. rewrite oG (@leq_exp2l 2 4) //. rewrite /extremal2 /extremal_class oG pfactorKpdiv // in cG. case: andP cG => [[n_gt1 isoG] _ | _]; last first. by case: (ltngtP 3 n) => //= <-; do 2?case: ifP. have [[x y] genG _] := generators_2dihedral n_gt1 isoG. have [_ _ _ [_ _ maxG]] := dihedral2_structure n_gt1 genG isoG. rewrite 2!ltn_neqAle n_gt1 !(eq_sym _ n). case: eqP => [_ abelG| _]; first by rewrite (abelem_abelian abelG) in not_cGG. case: eqP => // -> [_ _ isoY _ _]; set Y := <<_>> in isoY. have nxYG: Y <| G by rewrite (p_maximal_normal pG) // maxG !inE eqxx orbT. have [// | [u v] genY _] := generators_2dihedral _ isoY. case/dihedral2_structure: (genY) => //= _ _ _ _ abelY. have:= dn_G_1 _ nxYG (abelem_abelian abelY). by rewrite (abelem_cyclic abelY); case: genY => ->. Qed. (* Replacement for Section 4 proof. *) Lemma odd_pgroup_rank1_cyclic gT p (G : {group gT}) : p.-group G -> odd #|G| -> cyclic G = ('r_p(G) <= 1). Proof. move=> pG oddG; rewrite -rank_pgroup //; apply/idP/idP=> [cycG | dimG1]. by rewrite -abelian_rank1_cyclic ?cyclic_abelian. have [X nsXG cXX|//|] := normal_rank1_structure pG; last first. by rewrite (negPf (odd_not_extremal2 oddG)) andbF. by rewrite abelian_rank1_cyclic // (leq_trans (rankS (normal_sub nsXG))). Qed. (* This is the second part of Aschbacher, exercise (8.4). *) Lemma prime_Ohm1P gT p (G : {group gT}) : p.-group G -> G :!=: 1 -> reflect (#|'Ohm_1(G)| = p) (cyclic G || (p == 2) && (extremal_class G == Quaternion)). Proof. move=> pG ntG; have [p_pr p_dvd_G _] := pgroup_pdiv pG ntG. apply: (iffP idP) => [|oG1p]. case/orP=> [cycG|]; first exact: Ohm1_cyclic_pgroup_prime. case/andP=> /eqP p2 /eqP/quaternion_classP[n n_gt2 isoG]. rewrite p2; have [[x y]] := generators_quaternion n_gt2 isoG. by case/quaternion_structure=> // _ _ [<- oZ _ [->]]. have [X nsXG cXX|-> //|]:= normal_rank1_structure pG. have [sXG _] := andP nsXG; have pX := pgroupS sXG pG. rewrite abelian_rank1_cyclic // (rank_pgroup pX) p_rank_abelian //. rewrite -{2}(pfactorK 1 p_pr) -{3}oG1p dvdn_leq_log ?cardG_gt0 //. by rewrite cardSg ?OhmS. case/and3P=> /eqP p2; rewrite p2 (orbC (cyclic G)) /extremal2. case cG: (extremal_class G) => //; case: notF. case/dihedral_classP: cG => n n_gt1 isoG. have [[x y] genG _] := generators_2dihedral n_gt1 isoG. have [oG _ _ _] := genG; case/dihedral2_structure: genG => // _ _ [defG1 _] _. by case/idPn: n_gt1; rewrite -(@ltn_exp2l 2) // -oG -defG1 oG1p p2. case/semidihedral_classP: cG => n n_gt3 isoG. have [[x y] genG [oy _]] := generators_semidihedral n_gt3 isoG. case/semidihedral_structure: genG => // _ _ [_ _ [defG1 _] _] _ [isoG1 _ _]. case/idPn: (n_gt3); rewrite -(ltn_predK n_gt3) ltnS -leqNgt -(@leq_exp2l 2) //. rewrite -card_2dihedral //; last by rewrite -(subnKC n_gt3). by rewrite -(card_isog isoG1) /= -defG1 oG1p p2. Qed. (* This is Aschbacher (23.9) *) Theorem symplectic_type_group_structure gT p (G : {group gT}) : p.-group G -> (forall X : {group gT}, X \char G -> abelian X -> cyclic X) -> exists2 E : {group gT}, E :=: 1 \/ extraspecial E & exists R : {group gT}, [/\ cyclic R \/ [/\ p = 2, extremal2 R & #|R| >= 16], E \* R = G & E :&: R = 'Z(E)]. Proof. move=> pG sympG; have [H [charH]] := Thompson_critical pG. have sHG := char_sub charH; have pH := pgroupS sHG pG. set U := 'Z(H) => sPhiH_U sHG_U defU; set Z := 'Ohm_1(U). have sZU: Z \subset U by rewrite Ohm_sub. have charU: U \char G := gFchar_trans _ charH. have cUU: abelian U := center_abelian H. have cycU: cyclic U by apply: sympG. have pU: p.-group U := pgroupS (char_sub charU) pG. have cHU: U \subset 'C(H) by rewrite subsetIr. have cHsHs: abelian (H / Z). rewrite sub_der1_abelian //= (OhmE _ pU) genS //= -/U. apply/subsetP=> _ /imset2P[h k Hh Hk ->]. have Uhk: [~ h, k] \in U by rewrite (subsetP sHG_U) ?mem_commg ?(subsetP sHG). rewrite inE Uhk inE -commXg; last by red; rewrite -(centsP cHU). apply/commgP; red; rewrite (centsP cHU) // (subsetP sPhiH_U) //. by rewrite (Phi_joing pH) mem_gen // inE orbC (Mho_p_elt 1) ?(mem_p_elt pH). have nsZH: Z <| H by rewrite sub_center_normal. have [K /=] := inv_quotientS nsZH (Ohm_sub 1 (H / Z)); fold Z => defKs sZK sKH. have nsZK: Z <| K := normalS sZK sKH nsZH; have [_ nZK] := andP nsZK. have abelKs: p.-abelem (K / Z) by rewrite -defKs Ohm1_abelem ?quotient_pgroup. have charK: K \char G. have charZ: Z \char H := gFchar_trans _ (center_char H). rewrite (char_trans _ charH) // (char_from_quotient nsZK) //. by rewrite -defKs Ohm_char. have cycZK: cyclic 'Z(K) by rewrite sympG ?center_abelian ?gFchar_trans. have [cKK | not_cKK] := orP (orbN (abelian K)). have defH: U = H. apply: center_idP; apply: cyclic_factor_abelian (Ohm_sub 1 _) _. rewrite /= -/Z abelian_rank1_cyclic //. have cKsKs: abelian (K / Z) by rewrite -defKs (abelianS (Ohm_sub 1 _)). have cycK: cyclic K by rewrite -(center_idP cKK). by rewrite -rank_Ohm1 defKs -abelian_rank1_cyclic ?quotient_cyclic. have scH: H \in 'SCN(G) by apply/SCN_P; rewrite defU char_normal. have [cGG | not_cGG] := orP (orbN (abelian G)). exists 1%G; [by left | exists G; rewrite cprod1g (setIidPl _) ?sub1G //]. by split; first left; rewrite ?center1 // sympG ?char_refl. have cycH: cyclic H by rewrite -{}defH. have [[p2 _ cG2]|[M [_ _ _]]] := cyclic_SCN pG scH not_cGG cycH; last first. do 2![case/setIdP] => _ abelE dimE_2 charE. have:= sympG _ charE (abelem_abelian abelE). by rewrite (abelem_cyclic abelE) (eqP dimE_2). have [n oG] := p_natP pG; rewrite p2 in oG. have [n_gt3 | n_le3] := ltnP 3 n. exists 1%G; [by left | exists G; rewrite cprod1g (setIidPl _) ?sub1G //]. by split; first right; rewrite ?center1 // oG (@leq_exp2l 2 4). have esG: extraspecial G. by apply: (p3group_extraspecial pG); rewrite // p2 oG pfactorK. exists G; [by right | exists ('Z(G))%G; rewrite cprod_center_id setIA setIid]. by split=> //; left; rewrite prime_cyclic; case: esG. have ntK: K :!=: 1 by apply: contra not_cKK => /eqP->; apply: abelian1. have [p_pr _ _] := pgroup_pdiv (pgroupS sKH pH) ntK. have p_gt1 := prime_gt1 p_pr; have p_gt0 := ltnW p_gt1. have oZ: #|Z| = p. apply: Ohm1_cyclic_pgroup_prime => //=; apply: contra ntK; move/eqP. by move/(trivg_center_pgroup pH)=> GH; rewrite -subG1 -GH. have sZ_ZK: Z \subset 'Z(K). by rewrite subsetI sZK gFsub_trans // subIset ?centS ?orbT. have sZsKs: 'Z(K) / Z \subset K / Z by rewrite quotientS ?center_sub. have [Es /= splitKs] := abelem_split_dprod abelKs sZsKs. have [_ /= defEsZs cEsZs tiEsZs] := dprodP splitKs. have sEsKs: Es \subset K / Z by rewrite -defEsZs mulG_subr. have [E defEs sZE sEK] := inv_quotientS nsZK sEsKs; rewrite /= -/Z in defEs sZE. have [nZE nZ_ZK] := (subset_trans sEK nZK, subset_trans (center_sub K) nZK). have defK: 'Z(K) * E = K. rewrite -(mulSGid sZ_ZK) -mulgA -quotientK ?mul_subG ?quotientMl //. by rewrite -defEs defEsZs quotientGK. have defZE: 'Z(E) = Z. have cEZK: 'Z(K) \subset 'C(E) by rewrite subIset // orbC centS. have cE_Z: E \subset 'C(Z) by rewrite centsC (subset_trans sZ_ZK). apply/eqP; rewrite eqEsubset andbC subsetI sZE centsC cE_Z /=. rewrite -quotient_sub1 ?subIset ?nZE //= -/Z -tiEsZs subsetI defEs. rewrite !quotientS ?center_sub //= subsetI subIset ?sEK //=. by rewrite -defK centM setSI // centsC. have sEH := subset_trans sEK sKH; have pE := pgroupS sEH pH. have esE: extraspecial E. split; last by rewrite defZE oZ. have sPhiZ: 'Phi(E) \subset Z. rewrite -quotient_sub1 ?gFsub_trans ?(quotient_Phi pE) //. rewrite subG1 (trivg_Phi (quotient_pgroup _ pE)) /= -defEs. by rewrite (abelemS sEsKs) //= -defKs Ohm1_abelem ?quotient_pgroup. have sE'Phi: E^`(1) \subset 'Phi(E) by rewrite (Phi_joing pE) joing_subl. have ntE': E^`(1) != 1. rewrite (sameP eqP commG1P) -abelianE; apply: contra not_cKK => cEE. by rewrite -defK mulGSid ?center_abelian // -(center_idP cEE) defZE. have defE': E^`(1) = Z. apply/eqP; rewrite eqEcard (subset_trans sE'Phi) //= oZ. have [_ _ [n ->]] := pgroup_pdiv (pgroupS (der_sub _ _) pE) ntE'. by rewrite (leq_exp2l 1) ?prime_gt1. by split; rewrite defZE //; apply/eqP; rewrite eqEsubset sPhiZ -defE'. have [spE _] := esE; have [defPhiE defE'] := spE. have{defE'} sEG_E': [~: E, G] \subset E^`(1). rewrite defE' defZE /Z (OhmE _ pU) commGC genS //. apply/subsetP=> _ /imset2P[g e Gg Ee ->]. have He: e \in H by rewrite (subsetP sKH) ?(subsetP sEK). have Uge: [~ g, e] \in U by rewrite (subsetP sHG_U) ?mem_commg. rewrite inE Uge inE -commgX; last by red; rewrite -(centsP cHU). have sZ_ZG: Z \subset 'Z(G). have charZ: Z \char G := gFchar_trans _ charU. have/implyP:= meet_center_nil (pgroup_nil pG) (char_normal charZ). rewrite -cardG_gt1 oZ prime_gt1 //=; apply: contraR => not_sZ_ZG. by rewrite prime_TIg ?oZ. have: e ^+ p \in 'Z(G). rewrite (subsetP sZ_ZG) // -defZE -defPhiE (Phi_joing pE) mem_gen //. by rewrite inE orbC (Mho_p_elt 1) ?(mem_p_elt pE). by case/setIP=> _ /centP cGep; apply/commgP; red; rewrite cGep. have sEG: E \subset G := subset_trans sEK (char_sub charK). set R := 'C_G(E). have{sEG_E'} defG: E \* R = G by apply: (critical_extraspecial pG). have [_ defER cRE] := cprodP defG. have defH: E \* 'C_H(E) = H by rewrite -(setIidPr sHG) setIAC (cprod_modl defG). have{defH} [_ defH cRH_E] := cprodP defH. have cRH_RH: abelian 'C_H(E). have sZ_ZRH: Z \subset 'Z('C_H(E)). rewrite subsetI -{1}defZE setSI //= (subset_trans sZU) // centsC. by rewrite subIset // centsC cHU. rewrite (cyclic_factor_abelian sZ_ZRH) //= -/Z. have defHs: Es \x ('C_H(E) / Z) = H / Z. rewrite defEs dprodE ?quotient_cents // -?quotientMl ?defH -?quotientGI //=. by rewrite setIA (setIidPl sEH) ['C_E(E)]defZE trivg_quotient. have:= Ohm_dprod 1 defHs; rewrite /= defKs (Ohm1_id (abelemS sEsKs abelKs)). rewrite dprodC; case/dprodP=> _ defEsRHs1 cRHs1Es tiRHs1Es. have sRHsHs: 'C_H(E) / Z \subset H / Z by rewrite quotientS ?subsetIl. have cRHsRHs: abelian ('C_H(E) / Z) by apply: abelianS cHsHs. have pHs: p.-group (H / Z) by rewrite quotient_pgroup. rewrite abelian_rank1_cyclic // (rank_pgroup (pgroupS sRHsHs pHs)). rewrite p_rank_abelian // -(leq_add2r (logn p #|Es|)) -lognM ?cardG_gt0 //. rewrite -TI_cardMg // defEsRHs1 /= -defEsZs TI_cardMg ?lognM ?cardG_gt0 //. by rewrite leq_add2r -abelem_cyclic ?(abelemS sZsKs) // quotient_cyclic. have{cRH_RH} defRH: 'C_H(E) = U. apply/eqP; rewrite eqEsubset andbC setIS ?centS // subsetI subsetIl /=. by rewrite -{2}defH centM subsetI subsetIr. have scUR: 'C_R(U) = U by rewrite -setIA -{1}defRH -centM defH. have sUR: U \subset R by rewrite -defRH setSI. have tiER: E :&: R = 'Z(E) by rewrite setIA (setIidPl (subset_trans sEH sHG)). have [cRR | not_cRR] := boolP (abelian R). exists E; [by right | exists [group of R]; split=> //; left]. by rewrite /= -(setIidPl (sub_abelian_cent cRR sUR)) scUR. have{} scUR: [group of U] \in 'SCN(R). by apply/SCN_P; rewrite (normalS sUR (subsetIl _ _)) // char_normal. have pR: p.-group R := pgroupS (subsetIl _ _) pG. have [R_le_3 | R_gt_3] := leqP (logn p #|R|) 3. have esR: extraspecial R := p3group_extraspecial pR not_cRR R_le_3. have esG: extraspecial G := cprod_extraspecial pG defG tiER esE esR. exists G; [by right | exists ('Z(G))%G; rewrite cprod_center_id setIA setIid]. by split=> //; left; rewrite prime_cyclic; case: esG. have [[p2 _ ext2R] | [M []]] := cyclic_SCN pR scUR not_cRR cycU. exists E; [by right | exists [group of R]; split=> //; right]. by rewrite dvdn_leq ?(@pfactor_dvdn 2 4) ?cardG_gt0 // -{2}p2. rewrite /= -/R => defM iUM modM _ _; pose N := 'C_G('Mho^1(U)). have charZN2: 'Z('Ohm_2(N)) \char G by rewrite !(gFchar_trans, subcent_char). have:= sympG _ charZN2 (center_abelian _). rewrite abelian_rank1_cyclic ?center_abelian // leqNgt; case/negP. have defN: E \* M = N. rewrite defM (cprod_modl defG) // centsC gFsub_trans //= -/U. by rewrite -defRH subsetIr. case/modular_group_classP: modM => q q_pr [n n_gt23 isoM]. have{n_gt23} n_gt2 := leq_trans (leq_addl _ _) n_gt23. have n_gt1 := ltnW n_gt2; have n_gt0 := ltnW n_gt1. have [[x y] genM modM] := generators_modular_group q_pr n_gt2 isoM. have{q_pr} defq: q = p; last rewrite {q}defq in genM modM isoM. have: p %| #|M| by rewrite -iUM dvdn_indexg. by have [-> _ _ _] := genM; rewrite Euclid_dvdX // dvdn_prime2 //; case: eqP. have [oM Mx ox X'y] := genM; have [My _] := setDP X'y; have [oy _] := modM. have [sUM sMR]: U \subset M /\ M \subset R. by rewrite defM subsetI sUR subsetIl centsC gFsub_trans. have oU1: #|'Mho^1(U)| = (p ^ n.-2)%N. have oU: #|U| = (p ^ n.-1)%N. by rewrite -(divg_indexS sUM) iUM oM -subn1 expnB. case/cyclicP: cycU pU oU => u -> p_u ou. by rewrite (Mho_p_cycle 1 p_u) -orderE (orderXexp 1 ou) subn1. have sZU1: Z \subset 'Mho^1(U). rewrite -(cardSg_cyclic cycU) ?gFsub // oZ oU1. by rewrite -(subnKC n_gt2) expnS dvdn_mulr. case/modular_group_structure: genM => // _ [defZM _ oZM] _ _. have:= n_gt2; rewrite leq_eqVlt eq_sym !xpair_eqE andbC. case: eqP => [n3 _ _ | _ /= n_gt3 defOhmM]. have eqZU1: Z = 'Mho^1(U) by apply/eqP; rewrite eqEcard sZU1 oZ oU1 n3 /=. rewrite (setIidPl _) in defM; first by rewrite -defM oM n3 pfactorK in R_gt_3. by rewrite -eqZU1 subIset ?centS ?orbT. have{defOhmM} [|defM2 _] := defOhmM 2; first by rewrite -subn1 ltn_subRL. do [set xpn3 := x ^+ _; set X2 := <[_]>] in defM2. have oX2: #|X2| = (p ^ 2)%N. by rewrite -orderE (orderXexp _ ox) -{1}(subnKC n_gt2) addSn addnK. have sZX2: Z \subset X2. have cycXp: cyclic <[x ^+ p]> := cycle_cyclic _. rewrite -(cardSg_cyclic cycXp) /=; first by rewrite oZ oX2 dvdn_mull. rewrite -defZM subsetI (subset_trans (Ohm_sub _ _)) //=. by rewrite (subset_trans sZU1) // centsC defM subsetIr. by rewrite /xpn3 -subnSK //expnS expgM cycleX. have{defM2} [_ /= defM2 cYX2 tiX2Y] := dprodP defM2. have{defN} [_ defN cME] := cprodP defN. have cEM2: E \subset 'C('Ohm_2(M)). by rewrite centsC (subset_trans _ cME) ?centS ?Ohm_sub. have [cEX2 cYE]: X2 \subset 'C(E) /\ E \subset 'C(<[y]>). by apply/andP; rewrite centsC -subsetI -centM defM2. have pN: p.-group N := pgroupS (subsetIl _ _) pG. have defN2: (E <*> X2) \x <[y]> = 'Ohm_2(N). rewrite dprodE ?centY ?subsetI 1?centsC ?cYE //=; last first. rewrite -cycle_subG in My; rewrite joingC cent_joinEl //= -/X2. rewrite -(setIidPr My) setIA -group_modl ?cycle_subG ?groupX //. by rewrite mulGSid // (subset_trans _ sZX2) // -defZE -tiER setIS. apply/eqP; rewrite cent_joinEr // -mulgA defM2 eqEsubset mulG_subG. rewrite OhmS ?andbT; last by rewrite -defN mulG_subr. have expE: exponent E %| p ^ 2 by rewrite exponent_special ?(pgroupS sEG). rewrite /= (OhmE 2 pN) sub_gen /=; last 1 first. by rewrite subsetI -defN mulG_subl sub_LdivT expE. rewrite -cent_joinEl // -genM_join genS // -defN. apply/subsetP=> _ /setIP[/imset2P[e z Ee Mz ->]]. rewrite inE expgMn; last by red; rewrite -(centsP cME). rewrite (exponentP expE) // mul1g => zp2; rewrite mem_mulg //=. by rewrite (OhmE 2 (pgroupS sMR pR)) mem_gen // !inE Mz. have{defN2} defZN2: X2 \x <[y]> = 'Z('Ohm_2(N)). rewrite -[X2](mulSGid sZX2) /= -/Z -defZE -(center_dprod defN2). do 2!rewrite -{1}(center_idP (cycle_abelian _)) -/X2; congr (_ \x _). by case/cprodP: (center_cprod (cprodEY cEX2)). have{defZN2} strZN2: \big[dprod/1]_(z <- [:: xpn3; y]) <[z]> = 'Z('Ohm_2(N)). by rewrite unlock /= dprodg1. rewrite -size_abelian_type ?center_abelian //. have pZN2: p.-group 'Z('Ohm_2(N)) by rewrite (pgroupS _ pN) // subIset ?Ohm_sub. rewrite (perm_size (abelian_type_pgroup pZN2 strZN2 _)) //= !inE. rewrite !(eq_sym 1) -!order_eq1 oy orderE oX2. by rewrite (eqn_exp2l 2 0) // (eqn_exp2l 1 0). Qed. End ExtremalTheory. math-comp-mathcomp-1.12.0/mathcomp/solvable/finmodule.v000066400000000000000000000655201375767750300231120ustar00rootroot00000000000000(* (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 bigop ssralg finset fingroup. From mathcomp Require Import morphism perm finalg action gproduct commutator. From mathcomp Require Import cyclic. (******************************************************************************) (* This file regroups constructions and results that are based on the most *) (* primitive version of representation theory -- viewing an abelian group as *) (* the additive group of a (finite) Z-module. This includes the Gaschutz *) (* splitting and transitivity theorem, from which we will later derive the *) (* Schur-Zassenhaus theorem and the elementary abelian special case of *) (* Maschke's theorem, the coprime abelian centraliser/commutator trivial *) (* intersection theorem, which is used to show that p-groups under coprime *) (* action factor into special groups, and the construction of the transfer *) (* homomorphism and its expansion relative to a cycle, from which we derive *) (* the Higman Focal Subgroup and the Burnside Normal Complement theorems. *) (* The definitions and lemmas for the finite Z-module induced by an abelian *) (* are packaged in an auxiliary FiniteModule submodule: they should not be *) (* needed much outside this file, which contains all the results that exploit *) (* this construction. *) (* FiniteModule defines the Z[N(A)]-module associated with a finite abelian *) (* abelian group A, given a proof (abelA : abelian A) : *) (* fmod_of abelA == the type of elements of the module (similar to but *) (* distinct from [subg A]). *) (* fmod abelA x == the injection of x into fmod_of abelA if x \in A, else 0 *) (* fmval u == the projection of u : fmod_of abelA onto A *) (* u ^@ x == the action of x \in 'N(A) on u : fmod_of abelA *) (* The transfer morphism is be constructed from a morphism f : H >-> rT, and *) (* a group G, along with the two assumptions sHG : H \subset G and *) (* abfH : abelian (f @* H): *) (* transfer sGH abfH == the function gT -> FiniteModule.fmod_of abfH that *) (* implements the transfer morphism induced by f on G. *) (* The Lemma transfer_indep states that the transfer morphism can be expanded *) (* using any transversal of the partition HG := rcosets H G of G. *) (* Further, for any g \in G, HG :* <[g]> is also a partition of G (Lemma *) (* rcosets_cycle_partition), and for any transversal X of HG :* <[g]> the *) (* function r mapping x : gT to rcosets (H :* x) <[g]> is (constructively) a *) (* bijection from X to the <[g]>-orbit partition of HG, and Lemma *) (* transfer_cycle_expansion gives a simplified expansion of the transfer *) (* morphism. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope GRing.Theory FinRing.Theory. Local Open Scope ring_scope. Module FiniteModule. Reserved Notation "u ^@ x" (at level 31, left associativity). Inductive fmod_of (gT : finGroupType) (A : {group gT}) (abelA : abelian A) := Fmod x & x \in A. Bind Scope ring_scope with fmod_of. Section OneFinMod. Let f2sub (gT : finGroupType) (A : {group gT}) (abA : abelian A) := fun u : fmod_of abA => let : Fmod x Ax := u in Subg Ax : FinGroup.arg_sort _. Local Coercion f2sub : fmod_of >-> FinGroup.arg_sort. Variables (gT : finGroupType) (A : {group gT}) (abelA : abelian A). Local Notation fmodA := (fmod_of abelA). Implicit Types (x y z : gT) (u v w : fmodA). Let sub2f (s : [subg A]) := Fmod abelA (valP s). Definition fmval u := val (f2sub u). Canonical fmod_subType := [subType for fmval]. Local Notation valA := (@val _ _ fmod_subType) (only parsing). Definition fmod_eqMixin := Eval hnf in [eqMixin of fmodA by <:]. Canonical fmod_eqType := Eval hnf in EqType fmodA fmod_eqMixin. Definition fmod_choiceMixin := [choiceMixin of fmodA by <:]. Canonical fmod_choiceType := Eval hnf in ChoiceType fmodA fmod_choiceMixin. Definition fmod_countMixin := [countMixin of fmodA by <:]. Canonical fmod_countType := Eval hnf in CountType fmodA fmod_countMixin. Canonical fmod_subCountType := Eval hnf in [subCountType of fmodA]. Definition fmod_finMixin := [finMixin of fmodA by <:]. Canonical fmod_finType := Eval hnf in FinType fmodA fmod_finMixin. Canonical fmod_subFinType := Eval hnf in [subFinType of fmodA]. Definition fmod x := sub2f (subg A x). Definition actr u x := if x \in 'N(A) then fmod (fmval u ^ x) else u. Definition fmod_opp u := sub2f u^-1. Definition fmod_add u v := sub2f (u * v). Fact fmod_add0r : left_id (sub2f 1) fmod_add. Proof. by move=> u; apply: val_inj; apply: mul1g. Qed. Fact fmod_addrA : associative fmod_add. Proof. by move=> u v w; apply: val_inj; apply: mulgA. Qed. Fact fmod_addNr : left_inverse (sub2f 1) fmod_opp fmod_add. Proof. by move=> u; apply: val_inj; apply: mulVg. Qed. Fact fmod_addrC : commutative fmod_add. Proof. by case=> x Ax [y Ay]; apply: val_inj; apply: (centsP abelA). Qed. Definition fmod_zmodMixin := ZmodMixin fmod_addrA fmod_addrC fmod_add0r fmod_addNr. Canonical fmod_zmodType := Eval hnf in ZmodType fmodA fmod_zmodMixin. Canonical fmod_finZmodType := Eval hnf in [finZmodType of fmodA]. Canonical fmod_baseFinGroupType := Eval hnf in [baseFinGroupType of fmodA for +%R]. Canonical fmod_finGroupType := Eval hnf in [finGroupType of fmodA for +%R]. Lemma fmodP u : val u \in A. Proof. exact: valP. Qed. Lemma fmod_inj : injective fmval. Proof. exact: val_inj. Qed. Lemma congr_fmod u v : u = v -> fmval u = fmval v. Proof. exact: congr1. Qed. Lemma fmvalA : {morph valA : x y / x + y >-> (x * y)%g}. Proof. by []. Qed. Lemma fmvalN : {morph valA : x / - x >-> x^-1%g}. Proof. by []. Qed. Lemma fmval0 : valA 0 = 1%g. Proof. by []. Qed. Canonical fmval_morphism := @Morphism _ _ setT fmval (in2W fmvalA). Definition fmval_sum := big_morph fmval fmvalA fmval0. Lemma fmvalZ n : {morph valA : x / x *+ n >-> (x ^+ n)%g}. Proof. by move=> u; rewrite /= morphX ?inE. Qed. Lemma fmodKcond x : val (fmod x) = if x \in A then x else 1%g. Proof. by rewrite /= /fmval /= val_insubd. Qed. Lemma fmodK : {in A, cancel fmod val}. Proof. exact: subgK. Qed. Lemma fmvalK : cancel val fmod. Proof. by case=> x Ax; apply: val_inj; rewrite /fmod /= sgvalK. Qed. Lemma fmod1 : fmod 1 = 0. Proof. by rewrite -fmval0 fmvalK. Qed. Lemma fmodM : {in A &, {morph fmod : x y / (x * y)%g >-> x + y}}. Proof. by move=> x y Ax Ay /=; apply: val_inj; rewrite /fmod morphM. Qed. Canonical fmod_morphism := Morphism fmodM. Lemma fmodX n : {in A, {morph fmod : x / (x ^+ n)%g >-> x *+ n}}. Proof. exact: morphX. Qed. Lemma fmodV : {morph fmod : x / x^-1%g >-> - x}. Proof. move=> x; apply: val_inj; rewrite fmvalN !fmodKcond groupV. by case: (x \in A); rewrite ?invg1. Qed. Lemma injm_fmod : 'injm fmod. Proof. by apply/injmP=> x y Ax Ay []; move/val_inj; apply: (injmP (injm_subg A)). Qed. Notation "u ^@ x" := (actr u x) : ring_scope. Lemma fmvalJcond u x : val (u ^@ x) = if x \in 'N(A) then val u ^ x else val u. Proof. by case: ifP => Nx; rewrite /actr Nx ?fmodK // memJ_norm ?fmodP. Qed. Lemma fmvalJ u x : x \in 'N(A) -> val (u ^@ x) = val u ^ x. Proof. by move=> Nx; rewrite fmvalJcond Nx. Qed. Lemma fmodJ x y : y \in 'N(A) -> fmod (x ^ y) = fmod x ^@ y. Proof. move=> Ny; apply: val_inj; rewrite fmvalJ ?fmodKcond ?memJ_norm //. by case: ifP => // _; rewrite conj1g. Qed. Fact actr_is_action : is_action 'N(A) actr. Proof. split=> [a u v eq_uv_a | u a b Na Nb]. case Na: (a \in 'N(A)); last by rewrite /actr Na in eq_uv_a. by apply: val_inj; apply: (conjg_inj a); rewrite -!fmvalJ ?eq_uv_a. by apply: val_inj; rewrite !fmvalJ ?groupM ?conjgM. Qed. Canonical actr_action := Action actr_is_action. Notation "''M'" := actr_action (at level 8) : action_scope. Lemma act0r x : 0 ^@ x = 0. Proof. by rewrite /actr conj1g morph1 if_same. Qed. Lemma actAr x : {morph actr^~ x : u v / u + v}. Proof. by move=> u v; apply: val_inj; rewrite !(fmvalA, fmvalJcond) conjMg; case: ifP. Qed. Definition actr_sum x := big_morph _ (actAr x) (act0r x). Lemma actNr x : {morph actr^~ x : u / - u}. Proof. by move=> u; apply: (addrI (u ^@ x)); rewrite -actAr !subrr act0r. Qed. Lemma actZr x n : {morph actr^~ x : u / u *+ n}. Proof. by move=> u; elim: n => [|n IHn]; rewrite ?act0r // !mulrS actAr IHn. Qed. Fact actr_is_groupAction : is_groupAction setT 'M. Proof. move=> a Na /=; rewrite inE; apply/andP; split. by apply/subsetP=> u _; rewrite inE. by apply/morphicP=> u v _ _; rewrite !permE /= actAr. Qed. Canonical actr_groupAction := GroupAction actr_is_groupAction. Notation "''M'" := actr_groupAction (at level 8) : groupAction_scope. Lemma actr1 u : u ^@ 1 = u. Proof. exact: act1. Qed. Lemma actrM : {in 'N(A) &, forall x y u, u ^@ (x * y) = u ^@ x ^@ y}. Proof. by move=> x y Nx Ny /= u; apply: val_inj; rewrite !fmvalJ ?conjgM ?groupM. Qed. Lemma actrK x : cancel (actr^~ x) (actr^~ x^-1%g). Proof. move=> u; apply: val_inj; rewrite !fmvalJcond groupV. by case: ifP => -> //; rewrite conjgK. Qed. Lemma actrKV x : cancel (actr^~ x^-1%g) (actr^~ x). Proof. by move=> u; rewrite /= -{2}(invgK x) actrK. Qed. End OneFinMod. Bind Scope ring_scope with fmod_of. Prenex Implicits fmval fmod actr. Notation "u ^@ x" := (actr u x) : ring_scope. Notation "''M'" := actr_action (at level 8) : action_scope. Notation "''M'" := actr_groupAction : groupAction_scope. End FiniteModule. Canonical FiniteModule.fmod_subType. Canonical FiniteModule.fmod_eqType. Canonical FiniteModule.fmod_choiceType. Canonical FiniteModule.fmod_countType. Canonical FiniteModule.fmod_finType. Canonical FiniteModule.fmod_subCountType. Canonical FiniteModule.fmod_subFinType. Canonical FiniteModule.fmod_zmodType. Canonical FiniteModule.fmod_finZmodType. Canonical FiniteModule.fmod_baseFinGroupType. Canonical FiniteModule.fmod_finGroupType. Arguments FiniteModule.fmodK {gT A} abelA [x] Ax. Arguments FiniteModule.fmvalK {gT A abelA} x. Arguments FiniteModule.actrK {gT A abelA} x. Arguments FiniteModule.actrKV {gT A abelA} x. (* Still allow ring notations, but give priority to groups now. *) Import FiniteModule GroupScope. Section Gaschutz. Variables (gT : finGroupType) (G H P : {group gT}). Implicit Types K L : {group gT}. Hypotheses (nsHG : H <| G) (sHP : H \subset P) (sPG : P \subset G). Hypotheses (abelH : abelian H) (coHiPG : coprime #|H| #|G : P|). Let sHG := normal_sub nsHG. Let nHG := subsetP (normal_norm nsHG). Let m := (expg_invn H #|G : P|). Implicit Types a b : fmod_of abelH. Local Notation fmod := (fmod abelH). Theorem Gaschutz_split : [splits G, over H] = [splits P, over H]. Proof. apply/splitsP/splitsP=> [[K /complP[tiHK eqHK]] | [Q /complP[tiHQ eqHQ]]]. exists (K :&: P)%G; rewrite inE setICA (setIidPl sHP) setIC tiHK eqxx. by rewrite group_modl // eqHK (sameP eqP setIidPr). have sQP: Q \subset P by rewrite -eqHQ mulG_subr. pose rP x := repr (P :* x); pose pP x := x * (rP x)^-1. have PpP x: pP x \in P by rewrite -mem_rcoset rcoset_repr rcoset_refl. have rPmul x y: x \in P -> rP (x * y) = rP y. by move=> Px; rewrite /rP rcosetM rcoset_id. pose pQ x := remgr H Q x; pose rH x := pQ (pP x) * rP x. have pQhq: {in H & Q, forall h q, pQ (h * q) = q} by apply: remgrMid. have pQmul: {in P &, {morph pQ : x y / x * y}}. by apply: remgrM; [apply/complP | apply: normalS (nsHG)]. have HrH x: rH x \in H :* x. by rewrite rcoset_sym mem_rcoset invMg mulgA mem_divgr // eqHQ PpP. have GrH x: x \in G -> rH x \in G. move=> Gx; case/rcosetP: (HrH x) => y Hy ->. by rewrite groupM // (subsetP sHG). have rH_Pmul x y: x \in P -> rH (x * y) = pQ x * rH y. by move=> Px; rewrite /rH mulgA -pQmul; first by rewrite /pP rPmul ?mulgA. have rH_Hmul h y: h \in H -> rH (h * y) = rH y. by move=> Hh; rewrite rH_Pmul ?(subsetP sHP) // -(mulg1 h) pQhq ?mul1g. pose mu x y := fmod ((rH x * rH y)^-1 * rH (x * y)). pose nu y := (\sum_(Px in rcosets P G) mu (repr Px) y)%R. have rHmul: {in G &, forall x y, rH (x * y) = rH x * rH y * val (mu x y)}. move=> x y Gx Gy; rewrite /= fmodK ?mulKVg // -mem_lcoset lcoset_sym. rewrite -norm_rlcoset; last by rewrite nHG ?GrH ?groupM. by rewrite (rcoset_eqP (HrH _)) -rcoset_mul ?nHG ?GrH // mem_mulg. have actrH a x: x \in G -> (a ^@ rH x = a ^@ x)%R. move=> Gx; apply: val_inj; rewrite /= !fmvalJ ?nHG ?GrH //. case/rcosetP: (HrH x) => b /(fmodK abelH) <- ->; rewrite conjgM. by congr (_ ^ _); rewrite conjgE -fmvalN -!fmvalA (addrC a) addKr. have mu_Pmul x y z: x \in P -> mu (x * y) z = mu y z. move=> Px; congr fmod; rewrite -mulgA !(rH_Pmul x) ?rPmul //. by rewrite -mulgA invMg -mulgA mulKg. have mu_Hmul x y z: x \in G -> y \in H -> mu x (y * z) = mu x z. move=> Gx Hy; congr fmod; rewrite (mulgA x) (conjgCV x) -mulgA 2?rH_Hmul //. by rewrite -mem_conjg (normP _) ?nHG. have{mu_Hmul} nu_Hmul y z: y \in H -> nu (y * z) = nu z. move=> Hy; apply: eq_bigr => _ /rcosetsP[x Gx ->]; apply: mu_Hmul y z _ Hy. by rewrite -(groupMl _ (subsetP sPG _ (PpP x))) mulgKV. have cocycle_mu: {in G & &, forall x y z, mu (x * y)%g z + mu x y ^@ z = mu y z + mu x (y * z)%g}%R. - move=> x y z Gx Gy Gz; apply: val_inj. apply: (mulgI (rH x * rH y * rH z)). rewrite -(actrH _ _ Gz) addrC fmvalA fmvalJ ?nHG ?GrH //. rewrite mulgA -(mulgA _ (rH z)) -conjgC mulgA -!rHmul ?groupM //. by rewrite mulgA -mulgA -2!(mulgA (rH x)) -!rHmul ?groupM. move: mu => mu in rHmul mu_Pmul cocycle_mu nu nu_Hmul. have{cocycle_mu} cocycle_nu: {in G &, forall y z, nu z + nu y ^@ z = mu y z *+ #|G : P| + nu (y * z)%g}%R. - move=> y z Gy Gz; rewrite /= (actr_sum z) /=. have ->: (nu z = \sum_(Px in rcosets P G) mu (repr Px * y)%g z)%R. rewrite /nu (reindex_acts _ (actsRs_rcosets P G) Gy) /=. apply: eq_bigr => _ /rcosetsP[x Gx /= ->]. rewrite rcosetE -rcosetM. case: repr_rcosetP=> p1 Pp1; case: repr_rcosetP=> p2 Pp2. by rewrite -mulgA [x * y]lock !mu_Pmul. rewrite -sumr_const -!big_split /=; apply: eq_bigr => _ /rcosetsP[x Gx ->]. rewrite -cocycle_mu //; case: repr_rcosetP => p1 Pp1. by rewrite groupMr // (subsetP sPG). move: nu => nu in nu_Hmul cocycle_nu. pose f x := rH x * val (nu x *+ m)%R. have{cocycle_nu} fM: {in G &, {morph f : x y / x * y}}. move=> x y Gx Gy; rewrite /f ?rHmul // -3!mulgA; congr (_ * _). rewrite (mulgA _ (rH y)) (conjgC _ (rH y)) -mulgA; congr (_ * _). rewrite -fmvalJ ?actrH ?nHG ?GrH // -!fmvalA actZr -mulrnDl. rewrite -(addrC (nu y)) cocycle_nu // mulrnDl !fmvalA; congr (_ * _). by rewrite !fmvalZ expgK ?fmodP. exists (Morphism fM @* G)%G; apply/complP; split. apply/trivgP/subsetP=> x /setIP[Hx /morphimP[y _ Gy eq_x]]. apply/set1P; move: Hx; rewrite {x}eq_x /= groupMr ?subgP //. rewrite -{1}(mulgKV y (rH y)) groupMl -?mem_rcoset // => Hy. by rewrite -(mulg1 y) /f nu_Hmul // rH_Hmul //; apply: (morph1 (Morphism fM)). apply/setP=> x; apply/mulsgP/idP=> [[h y Hh fy ->{x}] | Gx]. rewrite groupMl; last exact: (subsetP sHG). case/morphimP: fy => z _ Gz ->{h Hh y}. by rewrite /= /f groupMl ?GrH // (subsetP sHG) ?fmodP. exists (x * (f x)^-1) (f x); last first; first by rewrite mulgKV. by apply/morphimP; exists x. rewrite -groupV invMg invgK -mulgA (conjgC (val _)) mulgA. by rewrite groupMl -(mem_rcoset, mem_conjg) // (normP _) ?nHG ?fmodP. Qed. Theorem Gaschutz_transitive : {in [complements to H in G] &, forall K L, K :&: P = L :&: P -> exists2 x, x \in H & L :=: K :^ x}. Proof. move=> K L /=; set Q := K :&: P => /complP[tiHK eqHK] cpHL QeqLP. have [trHL eqHL] := complP cpHL. pose nu x := fmod (divgr H L x^-1). have sKG: {subset K <= G} by apply/subsetP; rewrite -eqHK mulG_subr. have sLG: {subset L <= G} by apply/subsetP; rewrite -eqHL mulG_subr. have val_nu x: x \in G -> val (nu x) = divgr H L x^-1. by move=> Gx; rewrite fmodK // mem_divgr // eqHL groupV. have nu_cocycle: {in G &, forall x y, nu (x * y)%g = nu x ^@ y + nu y}%R. move=> x y Gx Gy; apply: val_inj; rewrite fmvalA fmvalJ ?nHG //. rewrite !val_nu ?groupM // /divgr conjgE !mulgA mulgK. by rewrite !(invMg, remgrM cpHL) ?groupV ?mulgA. have nuL x: x \in L -> nu x = 0%R. move=> Lx; apply: val_inj; rewrite val_nu ?sLG //. by rewrite /divgr remgr_id ?groupV ?mulgV. exists (fmval ((\sum_(X in rcosets Q K) nu (repr X)) *+ m)). exact: fmodP. apply/eqP; rewrite eq_sym eqEcard; apply/andP; split; last first. by rewrite cardJg -(leq_pmul2l (cardG_gt0 H)) -!TI_cardMg // eqHL eqHK. apply/subsetP=> _ /imsetP[x Kx ->]; rewrite conjgE mulgA (conjgC _ x). have Gx: x \in G by rewrite sKG. rewrite conjVg -mulgA -fmvalJ ?nHG // -fmvalN -fmvalA (_ : _ + _ = nu x)%R. by rewrite val_nu // mulKVg groupV mem_remgr // eqHL groupV. rewrite actZr -!mulNrn -mulrnDl actr_sum. rewrite addrC (reindex_acts _ (actsRs_rcosets _ K) Kx) -sumrB /= -/Q. rewrite (eq_bigr (fun _ => nu x)) => [|_ /imsetP[y Ky ->]]; last first. rewrite !rcosetE -rcosetM QeqLP. case: repr_rcosetP => z /setIP[Lz _]; case: repr_rcosetP => t /setIP[Lt _]. rewrite !nu_cocycle ?groupM ?(sKG y) // ?sLG //. by rewrite (nuL z) ?(nuL t) // !act0r !add0r addrC addKr. apply: val_inj; rewrite sumr_const !fmvalZ. rewrite -{2}(expgK coHiPG (fmodP (nu x))); congr (_ ^+ _ ^+ _). rewrite -[#|_|]divgS ?subsetIl // -(divnMl (cardG_gt0 H)). rewrite -!TI_cardMg //; last by rewrite setIA setIAC (setIidPl sHP). by rewrite group_modl // eqHK (setIidPr sPG) divgS. Qed. End Gaschutz. (* This is the TI part of B & G, Proposition 1.6(d). *) (* We go with B & G rather than Aschbacher and will derive 1.6(e) from (d), *) (* rather than the converse, because the derivation of 24.6 from 24.3 in *) (* Aschbacher requires a separate reduction to p-groups to yield 1.6(d), *) (* making it altogether longer than the direct Gaschutz-style proof. *) (* This Lemma is used in maximal.v for the proof of Aschbacher 24.7. *) Lemma coprime_abel_cent_TI (gT : finGroupType) (A G : {group gT}) : A \subset 'N(G) -> coprime #|G| #|A| -> abelian G -> 'C_[~: G, A](A) = 1. Proof. move=> nGA coGA abG; pose f x := val (\sum_(a in A) fmod abG x ^@ a)%R. have fM: {in G &, {morph f : x y / x * y}}. move=> x y Gx Gy /=; rewrite -fmvalA -big_split /=; congr (fmval _). by apply: eq_bigr => a Aa; rewrite fmodM // actAr. have nfA x a: a \in A -> f (x ^ a) = f x. move=> Aa; rewrite {2}/f (reindex_inj (mulgI a)) /=; congr (fmval _). apply: eq_big => [b | b Ab]; first by rewrite groupMl. by rewrite -!fmodJ ?groupM ?(subsetP nGA) // conjgM. have kerR: [~: G, A] \subset 'ker (Morphism fM). rewrite gen_subG; apply/subsetP=> xa; case/imset2P=> x a Gx Aa -> {xa}. have Gxa: x ^ a \in G by rewrite memJ_norm ?(subsetP nGA). rewrite commgEl; apply/kerP; rewrite (groupM, morphM) ?(groupV, morphV) //=. by rewrite nfA ?mulVg. apply/trivgP; apply/subsetP=> x /setIP[Rx cAx]; apply/set1P. have Gx: x \in G by apply: subsetP Rx; rewrite commg_subl. rewrite -(expgK coGA Gx) (_ : x ^+ _ = 1) ?expg1n //. rewrite -(fmodK abG Gx) -fmvalZ -(mker (subsetP kerR x Rx)); congr fmval. rewrite -GRing.sumr_const; apply: eq_bigr => a Aa. by rewrite -fmodJ ?(subsetP nGA) // /conjg (centP cAx) // mulKg. Qed. Section Transfer. Variables (gT aT : finGroupType) (G H : {group gT}). Variable alpha : {morphism H >-> aT}. Hypotheses (sHG : H \subset G) (abelA : abelian (alpha @* H)). Local Notation HG := (rcosets (gval H) (gval G)). Fact transfer_morph_subproof : H \subset alpha @*^-1 (alpha @* H). Proof. by rewrite -sub_morphim_pre. Qed. Let fmalpha := restrm transfer_morph_subproof (fmod abelA \o alpha). Let V (rX : {set gT} -> gT) g := \sum_(Hx in rcosets H G) fmalpha (rX Hx * g * (rX (Hx :* g))^-1). Definition transfer g := V repr g. (* This is Aschbacher (37.2). *) Lemma transferM : {in G &, {morph transfer : x y / (x * y)%g >-> x + y}}. Proof. move=> s t Gs Gt /=. rewrite [transfer t](reindex_acts 'Rs _ Gs) ?actsRs_rcosets //= -big_split /=. apply: eq_bigr => _ /rcosetsP[x Gx ->]; rewrite !rcosetE -!rcosetM. rewrite -zmodMgE -morphM -?mem_rcoset; first by rewrite !mulgA mulgKV rcosetM. by rewrite rcoset_repr rcosetM mem_rcoset mulgK mem_repr_rcoset. by rewrite rcoset_repr (rcosetM _ _ t) mem_rcoset mulgK mem_repr_rcoset. Qed. Canonical transfer_morphism := Morphism transferM. (* This is Aschbacher (37.1). *) Lemma transfer_indep X (rX := transversal_repr 1 X) : is_transversal X HG G -> {in G, transfer =1 V rX}. Proof. move=> trX g Gg; have mem_rX := repr_mem_pblock trX 1; rewrite -/rX in mem_rX. apply: (addrI (\sum_(Hx in HG) fmalpha (repr Hx * (rX Hx)^-1))). rewrite {1}(reindex_acts 'Rs _ Gg) ?actsRs_rcosets // -!big_split /=. apply: eq_bigr => _ /rcosetsP[x Gx ->]; rewrite !rcosetE -!rcosetM. case: repr_rcosetP => h1 Hh1; case: repr_rcosetP => h2 Hh2. have: H :* (x * g) \in rcosets H G by rewrite -rcosetE imset_f ?groupM. have: H :* x \in rcosets H G by rewrite -rcosetE imset_f. case/mem_rX/rcosetP=> h3 Hh3 -> /mem_rX/rcosetP[h4 Hh4 ->]. rewrite -!(mulgA h1) -!(mulgA h2) -!(mulgA h3) !(mulKVg, invMg). by rewrite addrC -!zmodMgE -!morphM ?groupM ?groupV // -!mulgA !mulKg. Qed. Section FactorTransfer. Variable g : gT. Hypothesis Gg : g \in G. Let sgG : <[g]> \subset G. Proof. by rewrite cycle_subG. Qed. Let H_g_rcosets x : {set {set gT}} := rcosets (H :* x) <[g]>. Let n_ x := #|<[g]> : H :* x|. Lemma mulg_exp_card_rcosets x : x * (g ^+ n_ x) \in H :* x. Proof. rewrite /n_ /indexg -orbitRs -porbit_actperm ?inE //. rewrite -{2}(iter_porbit (actperm 'Rs g) (H :* x)) -permX -morphX ?inE //. by rewrite actpermE //= rcosetE -rcosetM rcoset_refl. Qed. Let HGg : {set {set {set gT}}} := orbit 'Rs <[g]> @: HG. Let partHG : partition HG G := rcosets_partition sHG. Let actsgHG : [acts <[g]>, on HG | 'Rs]. Proof. exact: subset_trans sgG (actsRs_rcosets H G). Qed. Let partHGg : partition HGg HG := orbit_partition actsgHG. Let injHGg : {in HGg &, injective cover}. Proof. by have [] := partition_partition partHG partHGg. Qed. Let defHGg : HG :* <[g]> = cover @: HGg. Proof. rewrite -imset_comp [_ :* _]imset2_set1r; apply: eq_imset => Hx /=. by rewrite cover_imset -curry_imset2r. Qed. Lemma rcosets_cycle_partition : partition (HG :* <[g]>) G. Proof. by rewrite defHGg; have [] := partition_partition partHG partHGg. Qed. Variable X : {set gT}. Hypothesis trX : is_transversal X (HG :* <[g]>) G. Let sXG : {subset X <= G}. Proof. exact/subsetP/(transversal_sub trX). Qed. Lemma rcosets_cycle_transversal : H_g_rcosets @: X = HGg. Proof. have sHXgHGg x: x \in X -> H_g_rcosets x \in HGg. by move/sXG=> Gx; apply: imset_f; rewrite -rcosetE imset_f. apply/setP=> Hxg; apply/imsetP/idP=> [[x /sHXgHGg HGgHxg -> //] | HGgHxg]. have [_ /rcosetsP[z Gz ->] ->] := imsetP HGgHxg. pose Hzg := H :* z * <[g]>; pose x := transversal_repr 1 X Hzg. have HGgHzg: Hzg \in HG :* <[g]>. by rewrite mem_mulg ?set11 // -rcosetE imset_f. have Hzg_x: x \in Hzg by rewrite (repr_mem_pblock trX). exists x; first by rewrite (repr_mem_transversal trX). case/mulsgP: Hzg_x => y u /rcoset_eqP <- /(orbit_act 'Rs) <- -> /=. by rewrite rcosetE -rcosetM. Qed. Local Notation defHgX := rcosets_cycle_transversal. Let injHg: {in X &, injective H_g_rcosets}. Proof. apply/imset_injP; rewrite defHgX (card_transversal trX) defHGg. by rewrite (card_in_imset injHGg). Qed. Lemma sum_index_rcosets_cycle : (\sum_(x in X) n_ x)%N = #|G : H|. Proof. by rewrite [#|G : H|](card_partition partHGg) -defHgX big_imset. Qed. Lemma transfer_cycle_expansion : transfer g = \sum_(x in X) fmalpha ((g ^+ n_ x) ^ x^-1). Proof. pose Y := \bigcup_(x in X) [set x * g ^+ i | i : 'I_(n_ x)]. pose rY := transversal_repr 1 Y. pose pcyc x := porbit (actperm 'Rs g) (H :* x). pose traj x := traject (actperm 'Rs g) (H :* x) #|pcyc x|. have Hgr_eq x: H_g_rcosets x = pcyc x. by rewrite /H_g_rcosets -orbitRs -porbit_actperm ?inE. have pcyc_eq x: pcyc x =i traj x by apply: porbit_traject. have uniq_traj x: uniq (traj x) by apply: uniq_traject_porbit. have n_eq x: n_ x = #|pcyc x| by rewrite -Hgr_eq. have size_traj x: size (traj x) = n_ x by rewrite n_eq size_traject. have nth_traj x j: j < n_ x -> nth (H :* x) (traj x) j = H :* (x * g ^+ j). move=> lt_j_x; rewrite nth_traject -?n_eq //. by rewrite -permX -morphX ?inE // actpermE //= rcosetE rcosetM. have sYG: Y \subset G. apply/bigcupsP=> x Xx; apply/subsetP=> _ /imsetP[i _ ->]. by rewrite groupM ?groupX // sXG. have trY: is_transversal Y HG G. apply/and3P; split=> //; apply/forall_inP=> Hy. have /and3P[/eqP <- _ _] := partHGg; rewrite -defHgX cover_imset. case/bigcupP=> x Xx; rewrite Hgr_eq pcyc_eq => /trajectP[i]. rewrite -n_eq -permX -morphX ?in_setT // actpermE /= rcosetE -rcosetM => lti. set y := x * _ => ->{Hy}; pose oi := Ordinal lti. have Yy: y \in Y by apply/bigcupP; exists x => //; apply/imsetP; exists oi. apply/cards1P; exists y; apply/esym/eqP. rewrite eqEsubset sub1set inE Yy rcoset_refl. apply/subsetP=> _ /setIP[/bigcupP[x' Xx' /imsetP[j _ ->]] Hy_x'gj]. have eq_xx': x = x'. apply: (pblock_inj trX) => //; have /andP[/and3P[_ tiX _] _] := trX. have HGgHyg: H :* y * <[g]> \in HG :* <[g]>. by rewrite mem_mulg ?set11 // -rcosetE imset_f ?(subsetP sYG). rewrite !(def_pblock tiX HGgHyg) //. by rewrite -[x'](mulgK (g ^+ j)) mem_mulg // groupV mem_cycle. by rewrite -[x](mulgK (g ^+ i)) mem_mulg ?rcoset_refl // groupV mem_cycle. apply/set1P; rewrite /y eq_xx'; congr (_ * _ ^+ _) => //; apply/eqP. rewrite -(@nth_uniq _ (H :* x) (traj x)) ?size_traj // ?eq_xx' //. by rewrite !nth_traj ?(rcoset_eqP Hy_x'gj) // -eq_xx'. have rYE x i : x \in X -> i < n_ x -> rY (H :* x :* g ^+ i) = x * g ^+ i. move=> Xx lt_i_x; rewrite -rcosetM; apply: (canLR_in (pblockK trY 1)). by apply/bigcupP; exists x => //; apply/imsetP; exists (Ordinal lt_i_x). apply/esym/def_pblock; last exact: rcoset_refl; first by case/and3P: partHG. by rewrite -rcosetE imset_f ?groupM ?groupX // sXG. rewrite (transfer_indep trY Gg) /V -/rY (set_partition_big _ partHGg) /=. rewrite -defHgX big_imset /=; last first. apply/imset_injP; rewrite defHgX (card_transversal trX) defHGg. by rewrite (card_in_imset injHGg). apply eq_bigr=> x Xx; rewrite Hgr_eq (eq_bigl _ _ (pcyc_eq x)) -big_uniq //=. have n_gt0: 0 < n_ x by rewrite indexg_gt0. rewrite /traj -n_eq; case def_n: (n_ x) (n_gt0) => // [n] _. rewrite conjgE invgK -{1}[H :* x]rcoset1 -{1}(expg0 g). elim: {1 3}n 0%N (addn0 n) => [|m IHm] i def_i /=. rewrite big_seq1 {i}[i]def_i rYE // ?def_n //. rewrite -(mulgA _ _ g) -rcosetM -expgSr -[(H :* x) :* _]rcosetE. rewrite -actpermE morphX ?inE // permX // -{2}def_n n_eq iter_porbit mulgA. by rewrite -[H :* x]rcoset1 (rYE _ 0%N) ?mulg1. rewrite big_cons rYE //; last by rewrite def_n -def_i ltnS leq_addl. rewrite permE /= rcosetE -rcosetM -(mulgA _ _ g) -expgSr. rewrite addSnnS in def_i; rewrite IHm //. rewrite rYE //; last by rewrite def_n -def_i ltnS leq_addl. by rewrite mulgV [fmalpha 1]morph1 add0r. Qed. End FactorTransfer. End Transfer. math-comp-mathcomp-1.12.0/mathcomp/solvable/frobenius.v000066400000000000000000001050751375767750300231240ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div. From mathcomp Require Import fintype bigop prime finset fingroup morphism. From mathcomp Require Import perm action quotient gproduct cyclic center. From mathcomp Require Import pgroup nilpotent sylow hall abelian. (******************************************************************************) (* Definition of Frobenius groups, some basic results, and the Frobenius *) (* theorem on the number of solutions of x ^+ n = 1. *) (* semiregular K H <-> *) (* the internal action of H on K is semiregular, i.e., no nontrivial *) (* elements of H and K commute; note that this is actually a symmetric *) (* condition. *) (* semiprime K H <-> *) (* the internal action of H on K is "prime", i.e., an element of K that *) (* centralises a nontrivial element of H must centralise all of H. *) (* normedTI A G L <=> *) (* A is nonempty, strictly disjoint from its conjugates in G, and has *) (* normaliser L in G. *) (* [Frobenius G = K ><| H] <=> *) (* G is (isomorphic to) a Frobenius group with kernel K and complement *) (* H. This is an effective predicate (in bool), which tests the *) (* equality with the semidirect product, and then the fact that H is a *) (* proper self-normalizing TI-subgroup of G. *) (* [Frobenius G with kernel H] <=> *) (* G is (isomorphic to) a Frobenius group with kernel K; same as above, *) (* but without the semi-direct product. *) (* [Frobenius G with complement H] <=> *) (* G is (isomorphic to) a Frobenius group with complement H; same as *) (* above, but without the semi-direct product. The proof that this form *) (* is equivalent to the above (i.e., the existence of Frobenius *) (* kernels) requires character theory and will only be proved in the *) (* vcharacter.v file. *) (* [Frobenius G] <=> G is a Frobenius group. *) (* Frobenius_action G H S to <-> *) (* The action to of G on S defines an isomorphism of G with a *) (* (permutation) Frobenius group, i.e., to is faithful and transitive *) (* on S, no nontrivial element of G fixes more than one point in S, and *) (* H is the stabilizer of some element of S, and non-trivial. Thus, *) (* Frobenius_action G H S 'P *) (* asserts that G is a Frobenius group in the classic sense. *) (* has_Frobenius_action G H <-> *) (* Frobenius_action G H S to holds for some sT : finType, S : {set st} *) (* and to : {action gT &-> sT}. This is a predicate in Prop, but is *) (* exactly reflected by [Frobenius G with complement H] : bool. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Definitions. Variable gT : finGroupType. Implicit Types A G K H L : {set gT}. (* Corresponds to "H acts on K in a regular manner" in B & G. *) Definition semiregular K H := {in H^#, forall x, 'C_K[x] = 1}. (* Corresponds to "H acts on K in a prime manner" in B & G. *) Definition semiprime K H := {in H^#, forall x, 'C_K[x] = 'C_K(H)}. Definition normedTI A G L := [&& A != set0, trivIset (A :^: G) & 'N_G(A) == L]. Definition Frobenius_group_with_complement G H := (H != G) && normedTI H^# G H. Definition Frobenius_group G := [exists H : {group gT}, Frobenius_group_with_complement G H]. Definition Frobenius_group_with_kernel_and_complement G K H := (K ><| H == G) && Frobenius_group_with_complement G H. Definition Frobenius_group_with_kernel G K := [exists H : {group gT}, Frobenius_group_with_kernel_and_complement G K H]. Section FrobeniusAction. Variables G H : {set gT}. Variables (sT : finType) (S : {set sT}) (to : {action gT &-> sT}). Definition Frobenius_action := [/\ [faithful G, on S | to], [transitive G, on S | to], {in G^#, forall x, #|'Fix_(S | to)[x]| <= 1}, H != 1 & exists2 u, u \in S & H = 'C_G[u | to]]. End FrobeniusAction. Variant has_Frobenius_action G H : Prop := HasFrobeniusAction sT S to of @Frobenius_action G H sT S to. End Definitions. Arguments semiregular {gT} K%g H%g. Arguments semiprime {gT} K%g H%g. Arguments normedTI {gT} A%g G%g L%g. Arguments Frobenius_group_with_complement {gT} G%g H%g. Arguments Frobenius_group {gT} G%g. Arguments Frobenius_group_with_kernel {gT} G%g K%g. Arguments Frobenius_group_with_kernel_and_complement {gT} G%g K%g H%g. Arguments Frobenius_action {gT} G%g H%g {sT} S%g to%act. Arguments has_Frobenius_action {gT} G%g H%g. Notation "[ 'Frobenius' G 'with' 'complement' H ]" := (Frobenius_group_with_complement G H) (at level 0, G at level 50, H at level 35, format "[ 'Frobenius' G 'with' 'complement' H ]") : group_scope. Notation "[ 'Frobenius' G 'with' 'kernel' K ]" := (Frobenius_group_with_kernel G K) (at level 0, G at level 50, K at level 35, format "[ 'Frobenius' G 'with' 'kernel' K ]") : group_scope. Notation "[ 'Frobenius' G ]" := (Frobenius_group G) (at level 0, G at level 50, format "[ 'Frobenius' G ]") : group_scope. Notation "[ 'Frobenius' G = K ><| H ]" := (Frobenius_group_with_kernel_and_complement G K H) (at level 0, G at level 50, K, H at level 35, format "[ 'Frobenius' G = K ><| H ]") : group_scope. Section FrobeniusBasics. Variable gT : finGroupType. Implicit Types (A B : {set gT}) (G H K L R X : {group gT}). Lemma semiregular1l H : semiregular 1 H. Proof. by move=> x _ /=; rewrite setI1g. Qed. Lemma semiregular1r K : semiregular K 1. Proof. by move=> x; rewrite setDv inE. Qed. Lemma semiregular_sym H K : semiregular K H -> semiregular H K. Proof. move=> regH x /setD1P[ntx Kx]; apply: contraNeq ntx. rewrite -subG1 -setD_eq0 -setIDAC => /set0Pn[y /setIP[Hy cxy]]. by rewrite (sameP eqP set1gP) -(regH y Hy) inE Kx cent1C. Qed. Lemma semiregularS K1 K2 A1 A2 : K1 \subset K2 -> A1 \subset A2 -> semiregular K2 A2 -> semiregular K1 A1. Proof. move=> sK12 sA12 regKA2 x /setD1P[ntx /(subsetP sA12)A2x]. by apply/trivgP; rewrite -(regKA2 x) ?inE ?ntx ?setSI. Qed. Lemma semiregular_prime H K : semiregular K H -> semiprime K H. Proof. move=> regH x Hx; apply/eqP; rewrite eqEsubset {1}regH // sub1G. by rewrite -cent_set1 setIS ?centS // sub1set; case/setD1P: Hx. Qed. Lemma semiprime_regular H K : semiprime K H -> 'C_K(H) = 1 -> semiregular K H. Proof. by move=> prKH tiKcH x Hx; rewrite prKH. Qed. Lemma semiprimeS K1 K2 A1 A2 : K1 \subset K2 -> A1 \subset A2 -> semiprime K2 A2 -> semiprime K1 A1. Proof. move=> sK12 sA12 prKA2 x /setD1P[ntx A1x]. apply/eqP; rewrite eqEsubset andbC -{1}cent_set1 setIS ?centS ?sub1set //=. rewrite -(setIidPl sK12) -!setIA prKA2 ?setIS ?centS //. by rewrite !inE ntx (subsetP sA12). Qed. Lemma cent_semiprime H K X : semiprime K H -> X \subset H -> X :!=: 1 -> 'C_K(X) = 'C_K(H). Proof. move=> prKH sXH /trivgPn[x Xx ntx]; apply/eqP. rewrite eqEsubset -{1}(prKH x) ?inE ?(subsetP sXH) ?ntx //=. by rewrite -cent_cycle !setIS ?centS ?cycle_subG. Qed. Lemma stab_semiprime H K X : semiprime K H -> X \subset K -> 'C_H(X) != 1 -> 'C_H(X) = H. Proof. move=> prKH sXK ntCHX; apply/setIidPl; rewrite centsC -subsetIidl. rewrite -{2}(setIidPl sXK) -setIA -(cent_semiprime prKH _ ntCHX) ?subsetIl //. by rewrite !subsetI subxx sXK centsC subsetIr. Qed. Lemma cent_semiregular H K X : semiregular K H -> X \subset H -> X :!=: 1 -> 'C_K(X) = 1. Proof. move=> regKH sXH /trivgPn[x Xx ntx]; apply/trivgP. rewrite -(regKH x) ?inE ?(subsetP sXH) ?ntx ?setIS //=. by rewrite -cent_cycle centS ?cycle_subG. Qed. Lemma regular_norm_dvd_pred K H : H \subset 'N(K) -> semiregular K H -> #|H| %| #|K|.-1. Proof. move=> nKH regH; have actsH: [acts H, on K^# | 'J] by rewrite astabsJ normD1. rewrite (cardsD1 1 K) group1 -(acts_sum_card_orbit actsH) /=. rewrite (eq_bigr (fun _ => #|H|)) ?sum_nat_const ?dvdn_mull //. move=> _ /imsetP[x /setIdP[ntx Kx] ->]; rewrite card_orbit astab1J. rewrite ['C_H[x]](trivgP _) ?indexg1 //=. apply/subsetP=> y /setIP[Hy cxy]; apply: contraR ntx => nty. by rewrite -[[set 1]](regH y) inE ?nty // Kx cent1C. Qed. Lemma regular_norm_coprime K H : H \subset 'N(K) -> semiregular K H -> coprime #|K| #|H|. Proof. move=> nKH regH. by rewrite (coprime_dvdr (regular_norm_dvd_pred nKH regH)) ?coprimenP. Qed. Lemma semiregularJ K H x : semiregular K H -> semiregular (K :^ x) (H :^ x). Proof. move=> regH yx; rewrite -conjD1g => /imsetP[y Hy ->]. by rewrite cent1J -conjIg regH ?conjs1g. Qed. Lemma semiprimeJ K H x : semiprime K H -> semiprime (K :^ x) (H :^ x). Proof. move=> prH yx; rewrite -conjD1g => /imsetP[y Hy ->]. by rewrite cent1J centJ -!conjIg prH. Qed. Lemma normedTI_P A G L : reflect [/\ A != set0, L \subset 'N_G(A) & {in G, forall g, ~~ [disjoint A & A :^ g] -> g \in L}] (normedTI A G L). Proof. apply: (iffP and3P) => [[nzA /trivIsetP tiAG /eqP <-] | [nzA sLN tiAG]]. split=> // g Gg; rewrite inE Gg (sameP normP eqP) /= eq_sym; apply: contraR. by apply: tiAG; rewrite ?mem_orbit ?orbit_refl. have [/set0Pn[a Aa] /subsetIP[_ nAL]] := (nzA, sLN); split=> //; last first. rewrite eqEsubset sLN andbT; apply/subsetP=> x /setIP[Gx nAx]. by apply/tiAG/pred0Pn=> //; exists a; rewrite /= (normP nAx) Aa. apply/trivIsetP=> _ _ /imsetP[x Gx ->] /imsetP[y Gy ->]; apply: contraR. rewrite -setI_eq0 -(mulgKV x y) conjsgM; set g := (y * x^-1)%g. have Gg: g \in G by rewrite groupMl ?groupV. rewrite -conjIg (inj_eq (act_inj 'Js x)) (eq_sym A) (sameP eqP normP). by rewrite -cards_eq0 cardJg cards_eq0 setI_eq0 => /tiAG/(subsetP nAL)->. Qed. Arguments normedTI_P {A G L}. Lemma normedTI_memJ_P A G L : reflect [/\ A != set0, L \subset G & {in A & G, forall a g, (a ^ g \in A) = (g \in L)}] (normedTI A G L). Proof. apply: (iffP normedTI_P) => [[-> /subsetIP[sLG nAL] tiAG] | [-> sLG tiAG]]. split=> // a g Aa Gg; apply/idP/idP=> [Aag | Lg]; last first. by rewrite memJ_norm ?(subsetP nAL). by apply/tiAG/pred0Pn=> //; exists (a ^ g)%g; rewrite /= Aag memJ_conjg. split=> // [ | g Gg /pred0Pn[ag /=]]; last first. by rewrite andbC => /andP[/imsetP[a Aa ->]]; rewrite tiAG. apply/subsetP=> g Lg; have Gg := subsetP sLG g Lg. by rewrite !inE Gg; apply/subsetP=> _ /imsetP[a Aa ->]; rewrite tiAG. Qed. Lemma partition_class_support A G : A != set0 -> trivIset (A :^: G) -> partition (A :^: G) (class_support A G). Proof. rewrite /partition cover_imset -class_supportEr eqxx => nzA ->. by apply: contra nzA => /imsetP[x _ /eqP]; rewrite eq_sym -!cards_eq0 cardJg. Qed. Lemma partition_normedTI A G L : normedTI A G L -> partition (A :^: G) (class_support A G). Proof. by case/and3P=> ntA tiAG _; apply: partition_class_support. Qed. Lemma card_support_normedTI A G L : normedTI A G L -> #|class_support A G| = (#|A| * #|G : L|)%N. Proof. case/and3P=> ntA tiAG /eqP <-; rewrite -card_conjugates mulnC. apply: card_uniform_partition (partition_class_support ntA tiAG). by move=> _ /imsetP[y _ ->]; rewrite cardJg. Qed. Lemma normedTI_S A B G L : A != set0 -> L \subset 'N(A) -> A \subset B -> normedTI B G L -> normedTI A G L. Proof. move=> nzA /subsetP nAL /subsetP sAB /normedTI_memJ_P[nzB sLG tiB]. apply/normedTI_memJ_P; split=> // a x Aa Gx. by apply/idP/idP => [Aax | /nAL/memJ_norm-> //]; rewrite -(tiB a) ?sAB. Qed. Lemma cent1_normedTI A G L : normedTI A G L -> {in A, forall x, 'C_G[x] \subset L}. Proof. case/normedTI_memJ_P=> [_ _ tiAG] x Ax; apply/subsetP=> y /setIP[Gy cxy]. by rewrite -(tiAG x) // /(x ^ y) -(cent1P cxy) mulKg. Qed. Lemma Frobenius_actionP G H : reflect (has_Frobenius_action G H) [Frobenius G with complement H]. Proof. apply: (iffP andP) => [[neqHG] | [sT S to [ffulG transG regG ntH [u Su defH]]]]. case/normedTI_P=> nzH /subsetIP[sHG _] tiHG. suffices: Frobenius_action G H (rcosets H G) 'Rs by apply: HasFrobeniusAction. pose Hfix x := 'Fix_(rcosets H G | 'Rs)[x]. have regG: {in G^#, forall x, #|Hfix x| <= 1}. move=> x /setD1P[ntx Gx]. apply: wlog_neg; rewrite -ltnNge => /ltnW/card_gt0P/=[Hy]. rewrite -(cards1 Hy) => /setIP[/imsetP[y Gy ->{Hy}] cHyx]. apply/subset_leq_card/subsetP=> _ /setIP[/imsetP[z Gz ->] cHzx]. rewrite -!sub_astab1 !astab1_act !sub1set astab1Rs in cHyx cHzx *. rewrite !rcosetE; apply/set1P/rcoset_eqP; rewrite mem_rcoset. apply: tiHG; [by rewrite !in_group | apply/pred0Pn; exists (x ^ y^-1)]. by rewrite conjD1g !inE conjg_eq1 ntx -mem_conjg cHyx conjsgM memJ_conjg. have ntH: H :!=: 1 by rewrite -subG1 -setD_eq0. split=> //; first 1 last; first exact: transRs_rcosets. by exists (val H); rewrite ?orbit_refl // astab1Rs (setIidPr sHG). apply/subsetP=> y /setIP[Gy cHy]; apply: contraR neqHG => nt_y. rewrite (index1g sHG) //; apply/eqP; rewrite eqn_leq indexg_gt0 andbT. apply: leq_trans (regG y _); last by rewrite setDE 2!inE Gy nt_y /=. by rewrite /Hfix (setIidPl _) -1?astabC ?sub1set. have sHG: H \subset G by rewrite defH subsetIl. split. apply: contraNneq ntH => /= defG. suffices defS: S = [set u] by rewrite -(trivgP ffulG) /= defS defH. apply/eqP; rewrite eq_sym eqEcard sub1set Su. by rewrite -(atransP transG u Su) card_orbit -defH defG indexgg cards1. apply/normedTI_P; rewrite setD_eq0 subG1 normD1 subsetI sHG normG. split=> // x Gx; rewrite -setI_eq0 conjD1g defH inE Gx conjIg conjGid //. rewrite -setDIl -setIIr -astab1_act setDIl => /set0Pn[y /setIP[Gy /setD1P[_]]]. case/setIP; rewrite 2!(sameP astab1P afix1P) => cuy cuxy; apply/astab1P. apply: contraTeq (regG y Gy) => cu'x. rewrite (cardD1 u) (cardD1 (to u x)) inE Su cuy inE /= inE cu'x cuxy. by rewrite (actsP (atrans_acts transG)) ?Su. Qed. Section FrobeniusProperties. Variables G H K : {group gT}. Hypothesis frobG : [Frobenius G = K ><| H]. Lemma FrobeniusWker : [Frobenius G with kernel K]. Proof. by apply/existsP; exists H. Qed. Lemma FrobeniusWcompl : [Frobenius G with complement H]. Proof. by case/andP: frobG. Qed. Lemma FrobeniusW : [Frobenius G]. Proof. by apply/existsP; exists H; apply: FrobeniusWcompl. Qed. Lemma Frobenius_context : [/\ K ><| H = G, K :!=: 1, H :!=: 1, K \proper G & H \proper G]. Proof. have [/eqP defG neqHG ntH _] := and4P frobG; rewrite setD_eq0 subG1 in ntH. have ntK: K :!=: 1 by apply: contraNneq neqHG => K1; rewrite -defG K1 sdprod1g. rewrite properEcard properEneq neqHG; have /mulG_sub[-> ->] := sdprodW defG. by rewrite -(sdprod_card defG) ltn_Pmulr ?cardG_gt1. Qed. Lemma Frobenius_partition : partition (gval K |: (H^# :^: K)) G. Proof. have [/eqP defG _ tiHG] := and3P frobG; have [_ tiH1G /eqP defN] := and3P tiHG. have [[_ /mulG_sub[sKG sHG] nKH tiKH] mulHK] := (sdprodP defG, sdprodWC defG). set HG := H^# :^: K; set KHG := _ |: _. have defHG: HG = H^# :^: G. have: 'C_G[H^# | 'Js] * K = G by rewrite astab1Js defN mulHK. move/subgroup_transitiveP/atransP. by apply; rewrite ?atrans_orbit ?orbit_refl. have /and3P[defHK _ nzHG] := partition_normedTI tiHG. rewrite -defHG in defHK nzHG tiH1G. have [tiKHG HG'K]: trivIset KHG /\ gval K \notin HG. apply: trivIsetU1 => // _ /imsetP[x Kx ->]; rewrite -setI_eq0. by rewrite -(conjGid Kx) -conjIg setIDA tiKH setDv conj0g. rewrite /partition andbC tiKHG !inE negb_or nzHG eq_sym -card_gt0 cardG_gt0 /=. rewrite eqEcard; apply/andP; split. rewrite /cover big_setU1 //= subUset sKG -/(cover HG) (eqP defHK). by rewrite class_support_subG // (subset_trans _ sHG) ?subD1set. rewrite -(eqnP tiKHG) big_setU1 //= (eqnP tiH1G) (eqP defHK). rewrite (card_support_normedTI tiHG) -(Lagrange sHG) (cardsD1 1) group1 mulSn. by rewrite leq_add2r -mulHK indexMg -indexgI tiKH indexg1. Qed. Lemma Frobenius_cent1_ker : {in K^#, forall x, 'C_G[x] \subset K}. Proof. have [/eqP defG _ /normedTI_memJ_P[_ _ tiHG]] := and3P frobG. move=> x /setD1P[ntx Kx]; have [_ /mulG_sub[sKG _] _ tiKH] := sdprodP defG. have [/eqP <- _ _] := and3P Frobenius_partition; rewrite big_distrl /=. apply/bigcupsP=> _ /setU1P[|/imsetP[y Ky]] ->; first exact: subsetIl. apply: contraR ntx => /subsetPn[z]; rewrite inE mem_conjg => /andP[Hzy cxz] _. rewrite -(conjg_eq1 x y^-1) -in_set1 -set1gE -tiKH inE andbC. rewrite -(tiHG _ _ Hzy) ?(subsetP sKG) ?in_group // Ky andbT -conjJg. by rewrite /(z ^ x) (cent1P cxz) mulKg. Qed. Lemma Frobenius_reg_ker : semiregular K H. Proof. move=> x /setD1P[ntx Hx]. apply/trivgP/subsetP=> y /setIP[Ky cxy]; apply: contraR ntx => nty. have K1y: y \in K^# by rewrite inE nty. have [/eqP/sdprod_context[_ sHG _ _ tiKH] _] := andP frobG. suffices: x \in K :&: H by rewrite tiKH inE. by rewrite inE (subsetP (Frobenius_cent1_ker K1y)) // inE cent1C (subsetP sHG). Qed. Lemma Frobenius_reg_compl : semiregular H K. Proof. by apply: semiregular_sym; apply: Frobenius_reg_ker. Qed. Lemma Frobenius_dvd_ker1 : #|H| %| #|K|.-1. Proof. apply: regular_norm_dvd_pred Frobenius_reg_ker. by have[/sdprodP[]] := Frobenius_context. Qed. Lemma ltn_odd_Frobenius_ker : odd #|G| -> #|H|.*2 < #|K|. Proof. move/oddSg=> oddG. have [/sdprodW/mulG_sub[sKG sHG] ntK _ _ _] := Frobenius_context. by rewrite dvdn_double_ltn ?oddG ?cardG_gt1 ?Frobenius_dvd_ker1. Qed. Lemma Frobenius_index_dvd_ker1 : #|G : K| %| #|K|.-1. Proof. have[defG _ _ /andP[sKG _] _] := Frobenius_context. by rewrite -divgS // -(sdprod_card defG) mulKn ?Frobenius_dvd_ker1. Qed. Lemma Frobenius_coprime : coprime #|K| #|H|. Proof. by rewrite (coprime_dvdr Frobenius_dvd_ker1) ?coprimenP. Qed. Lemma Frobenius_trivg_cent : 'C_K(H) = 1. Proof. by apply: (cent_semiregular Frobenius_reg_ker); case: Frobenius_context. Qed. Lemma Frobenius_index_coprime : coprime #|K| #|G : K|. Proof. by rewrite (coprime_dvdr Frobenius_index_dvd_ker1) ?coprimenP. Qed. Lemma Frobenius_ker_Hall : Hall G K. Proof. have [_ _ _ /andP[sKG _] _] := Frobenius_context. by rewrite /Hall sKG Frobenius_index_coprime. Qed. Lemma Frobenius_compl_Hall : Hall G H. Proof. have [defG _ _ _ _] := Frobenius_context. by rewrite -(sdprod_Hall defG) Frobenius_ker_Hall. Qed. End FrobeniusProperties. Lemma normedTI_J x A G L : normedTI (A :^ x) (G :^ x) (L :^ x) = normedTI A G L. Proof. rewrite {1}/normedTI normJ -conjIg -(conj0g x) !(can_eq (conjsgK x)). congr [&& _, _ == _ & _]; rewrite /cover (reindex_inj (@conjsg_inj _ x)). by apply: eq_big => Hy; rewrite ?orbit_conjsg ?cardJg. by rewrite bigcupJ cardJg (eq_bigl _ _ (orbit_conjsg _ _ _ _)). Qed. Lemma FrobeniusJcompl x G H : [Frobenius G :^ x with complement H :^ x] = [Frobenius G with complement H]. Proof. by congr (_ && _); rewrite ?(can_eq (conjsgK x)) // -conjD1g normedTI_J. Qed. Lemma FrobeniusJ x G K H : [Frobenius G :^ x = K :^ x ><| H :^ x] = [Frobenius G = K ><| H]. Proof. by congr (_ && _); rewrite ?FrobeniusJcompl // -sdprodJ (can_eq (conjsgK x)). Qed. Lemma FrobeniusJker x G K : [Frobenius G :^ x with kernel K :^ x] = [Frobenius G with kernel K]. Proof. apply/existsP/existsP=> [] [H]; last by exists (H :^ x)%G; rewrite FrobeniusJ. by rewrite -(conjsgKV x H) FrobeniusJ; exists (H :^ x^-1)%G. Qed. Lemma FrobeniusJgroup x G : [Frobenius G :^ x] = [Frobenius G]. Proof. apply/existsP/existsP=> [] [H]. by rewrite -(conjsgKV x H) FrobeniusJcompl; exists (H :^ x^-1)%G. by exists (H :^ x)%G; rewrite FrobeniusJcompl. Qed. Lemma Frobenius_ker_dvd_ker1 G K : [Frobenius G with kernel K] -> #|G : K| %| #|K|.-1. Proof. by case/existsP=> H; apply: Frobenius_index_dvd_ker1. Qed. Lemma Frobenius_ker_coprime G K : [Frobenius G with kernel K] -> coprime #|K| #|G : K|. Proof. by case/existsP=> H; apply: Frobenius_index_coprime. Qed. Lemma Frobenius_semiregularP G K H : K ><| H = G -> K :!=: 1 -> H :!=: 1 -> reflect (semiregular K H) [Frobenius G = K ><| H]. Proof. move=> defG ntK ntH. apply: (iffP idP) => [|regG]; first exact: Frobenius_reg_ker. have [nsKG sHG defKH nKH tiKH]:= sdprod_context defG; have [sKG _]:= andP nsKG. apply/and3P; split; first by rewrite defG. by rewrite eqEcard sHG -(sdprod_card defG) -ltnNge ltn_Pmull ?cardG_gt1. apply/normedTI_memJ_P; rewrite setD_eq0 subG1 sHG -defKH -(normC nKH). split=> // z _ /setD1P[ntz Hz] /mulsgP[y x Hy Kx ->]; rewrite groupMl // !inE. rewrite conjg_eq1 ntz; apply/idP/idP=> [Hzxy | Hx]; last by rewrite !in_group. apply: (subsetP (sub1G H)); have Hzy: z ^ y \in H by apply: groupJ. rewrite -(regG (z ^ y)); last by apply/setD1P; rewrite conjg_eq1. rewrite inE Kx cent1C (sameP cent1P commgP) -in_set1 -[[set 1]]tiKH inE /=. rewrite andbC groupM ?groupV -?conjgM //= commgEr groupMr //. by rewrite memJ_norm ?(subsetP nKH) ?groupV. Qed. Lemma prime_FrobeniusP G K H : K :!=: 1 -> prime #|H| -> reflect (K ><| H = G /\ 'C_K(H) = 1) [Frobenius G = K ><| H]. Proof. move=> ntK H_pr; have ntH: H :!=: 1 by rewrite -cardG_gt1 prime_gt1. have [defG | not_sdG] := eqVneq (K ><| H) G; last first. by apply: (iffP andP) => [] [defG]; rewrite defG ?eqxx in not_sdG. apply: (iffP (Frobenius_semiregularP defG ntK ntH)) => [regH | [_ regH x]]. split=> //; have [x defH] := cyclicP (prime_cyclic H_pr). by rewrite defH cent_cycle regH // !inE defH cycle_id andbT -cycle_eq1 -defH. case/setD1P=> nt_x Hx; apply/trivgP; rewrite -regH setIS //= -cent_cycle. by rewrite centS // prime_meetG // (setIidPr _) ?cycle_eq1 ?cycle_subG. Qed. Lemma Frobenius_subl G K K1 H : K1 :!=: 1 -> K1 \subset K -> H \subset 'N(K1) -> [Frobenius G = K ><| H] -> [Frobenius K1 <*> H = K1 ><| H]. Proof. move=> ntK1 sK1K nK1H frobG; have [_ _ ntH _ _] := Frobenius_context frobG. apply/Frobenius_semiregularP=> //. by rewrite sdprodEY ?coprime_TIg ?(coprimeSg sK1K) ?(Frobenius_coprime frobG). by move=> x /(Frobenius_reg_ker frobG) cKx1; apply/trivgP; rewrite -cKx1 setSI. Qed. Lemma Frobenius_subr G K H H1 : H1 :!=: 1 -> H1 \subset H -> [Frobenius G = K ><| H] -> [Frobenius K <*> H1 = K ><| H1]. Proof. move=> ntH1 sH1H frobG; have [defG ntK _ _ _] := Frobenius_context frobG. apply/Frobenius_semiregularP=> //. have [_ _ /(subset_trans sH1H) nH1K tiHK] := sdprodP defG. by rewrite sdprodEY //; apply/trivgP; rewrite -tiHK setIS. by apply: sub_in1 (Frobenius_reg_ker frobG); apply/subsetP/setSD. Qed. Lemma Frobenius_kerP G K : reflect [/\ K :!=: 1, K \proper G, K <| G & {in K^#, forall x, 'C_G[x] \subset K}] [Frobenius G with kernel K]. Proof. apply: (iffP existsP) => [[H frobG] | [ntK ltKG nsKG regK]]. have [/sdprod_context[nsKG _ _ _ _] ntK _ ltKG _] := Frobenius_context frobG. by split=> //; apply: Frobenius_cent1_ker frobG. have /andP[sKG nKG] := nsKG. have hallK: Hall G K. rewrite /Hall sKG //= coprime_sym coprime_pi' //. apply: sub_pgroup (pgroup_pi K) => p; have [P sylP] := Sylow_exists p G. have [[sPG pP p'GiP] sylPK] := (and3P sylP, Hall_setI_normal nsKG sylP). rewrite -p_rank_gt0 -(rank_Sylow sylPK) rank_gt0 => ntPK. rewrite inE /= -p'natEpi // (pnat_dvd _ p'GiP) ?indexgS //. have /trivgPn[z]: P :&: K :&: 'Z(P) != 1. by rewrite meet_center_nil ?(pgroup_nil pP) ?(normalGI sPG nsKG). rewrite !inE -andbA -sub_cent1=> /and4P[_ Kz _ cPz] ntz. by apply: subset_trans (regK z _); [apply/subsetIP | apply/setD1P]. have /splitsP[H /complP[tiKH defG]] := SchurZassenhaus_split hallK nsKG. have [_ sHG] := mulG_sub defG; have nKH := subset_trans sHG nKG. exists H; apply/Frobenius_semiregularP; rewrite ?sdprodE //. by apply: contraNneq (proper_subn ltKG) => H1; rewrite -defG H1 mulg1. apply: semiregular_sym => x Kx; apply/trivgP; rewrite -tiKH. by rewrite subsetI subsetIl (subset_trans _ (regK x _)) ?setSI. Qed. Lemma set_Frobenius_compl G K H : K ><| H = G -> [Frobenius G with kernel K] -> [Frobenius G = K ><| H]. Proof. move=> defG /Frobenius_kerP[ntK ltKG _ regKG]. apply/Frobenius_semiregularP=> //. by apply: contraTneq ltKG => H_1; rewrite -defG H_1 sdprodg1 properxx. apply: semiregular_sym => y /regKG sCyK. have [_ sHG _ _ tiKH] := sdprod_context defG. by apply/trivgP; rewrite /= -(setIidPr sHG) setIAC -tiKH setSI. Qed. Lemma Frobenius_kerS G K G1 : G1 \subset G -> K \proper G1 -> [Frobenius G with kernel K] -> [Frobenius G1 with kernel K]. Proof. move=> sG1G ltKG1 /Frobenius_kerP[ntK _ /andP[_ nKG] regKG]. apply/Frobenius_kerP; rewrite /normal proper_sub // (subset_trans sG1G) //. by split=> // x /regKG; apply: subset_trans; rewrite setSI. Qed. Lemma Frobenius_action_kernel_def G H K sT S to : K ><| H = G -> @Frobenius_action _ G H sT S to -> K :=: 1 :|: [set x in G | 'Fix_(S | to)[x] == set0]. Proof. move=> defG FrobG. have partG: partition (gval K |: (H^# :^: K)) G. apply: Frobenius_partition; apply/andP; rewrite defG; split=> //. by apply/Frobenius_actionP; apply: HasFrobeniusAction FrobG. have{FrobG} [ffulG transG regG ntH [u Su defH]]:= FrobG. apply/setP=> x; rewrite !inE; have [-> | ntx] := eqVneq; first exact: group1. rewrite /= -(cover_partition partG) /cover. have neKHy y: gval K <> H^# :^ y. by move/setP/(_ 1); rewrite group1 conjD1g setD11. rewrite big_setU1 /= ?inE; last by apply/imsetP=> [[y _ /neKHy]]. have [nsKG sHG _ _ tiKH] := sdprod_context defG; have [sKG nKG]:= andP nsKG. symmetry; case Kx: (x \in K) => /=. apply/set0Pn=> [[v /setIP[Sv]]]; have [y Gy ->] := atransP2 transG Su Sv. rewrite -sub1set -astabC sub1set astab1_act mem_conjg => Hxy. case/negP: ntx; rewrite -in_set1 -(conjgKV y x) -mem_conjgV conjs1g -tiKH. by rewrite defH setIA inE -mem_conjg (setIidPl sKG) (normsP nKG) ?Kx. apply/andP=> [[/bigcupP[_ /imsetP[y Ky ->] Hyx] /set0Pn[]]]; exists (to u y). rewrite inE (actsP (atrans_acts transG)) ?(subsetP sKG) // Su. rewrite -sub1set -astabC sub1set astab1_act. by rewrite conjD1g defH conjIg !inE in Hyx; case/and3P: Hyx. Qed. End FrobeniusBasics. Arguments normedTI_P {gT A G L}. Arguments normedTI_memJ_P {gT A G L}. Arguments Frobenius_kerP {gT G K}. Lemma Frobenius_coprime_quotient (gT : finGroupType) (G K H N : {group gT}) : K ><| H = G -> N <| G -> coprime #|K| #|H| /\ H :!=: 1%g -> N \proper K /\ {in H^#, forall x, 'C_K[x] \subset N} -> [Frobenius G / N = (K / N) ><| (H / N)]%g. Proof. move=> defG nsNG [coKH ntH] [ltNK regH]. have [[sNK _] [_ /mulG_sub[sKG sHG] _ _]] := (andP ltNK, sdprodP defG). have [_ nNG] := andP nsNG; have nNH := subset_trans sHG nNG. apply/Frobenius_semiregularP; first exact: quotient_coprime_sdprod. - by rewrite quotient_neq1 ?(normalS _ sKG). - by rewrite -(isog_eq1 (quotient_isog _ _)) ?coprime_TIg ?(coprimeSg sNK). move=> _ /(subsetP (quotientD1 _ _))/morphimP[x nNx H1x ->]. rewrite -cent_cycle -quotient_cycle //=. rewrite -strongest_coprime_quotient_cent ?cycle_subG //. - by rewrite cent_cycle quotientS1 ?regH. - by rewrite subIset ?sNK. - rewrite (coprimeSg (subsetIl N _)) ?(coprimeSg sNK) ?(coprimegS _ coKH) //. by rewrite cycle_subG; case/setD1P: H1x. by rewrite orbC abelian_sol ?cycle_abelian. Qed. Section InjmFrobenius. Variables (gT rT : finGroupType) (D G : {group gT}) (f : {morphism D >-> rT}). Implicit Types (H K : {group gT}) (sGD : G \subset D) (injf : 'injm f). Lemma injm_Frobenius_compl H sGD injf : [Frobenius G with complement H] -> [Frobenius f @* G with complement f @* H]. Proof. case/andP=> neqGH /normedTI_P[nzH /subsetIP[sHG _] tiHG]. have sHD := subset_trans sHG sGD; have sH1D := subset_trans (subD1set H 1) sHD. apply/andP; rewrite (can_in_eq (injmK injf)) //; split=> //. apply/normedTI_P; rewrite normD1 -injmD1 // -!cards_eq0 card_injm // in nzH *. rewrite subsetI normG morphimS //; split=> // _ /morphimP[x Dx Gx ->] ti'fHx. rewrite mem_morphim ?tiHG //; apply: contra ti'fHx; rewrite -!setI_eq0 => tiHx. by rewrite -morphimJ // -injmI ?conj_subG // (eqP tiHx) morphim0. Qed. Lemma injm_Frobenius H K sGD injf : [Frobenius G = K ><| H] -> [Frobenius f @* G = f @* K ><| f @* H]. Proof. case/andP=> /eqP defG frobG. by apply/andP; rewrite (injm_sdprod _ injf defG) // eqxx injm_Frobenius_compl. Qed. Lemma injm_Frobenius_ker K sGD injf : [Frobenius G with kernel K] -> [Frobenius f @* G with kernel f @* K]. Proof. case/existsP=> H frobG; apply/existsP. by exists (f @* H)%G; apply: injm_Frobenius. Qed. Lemma injm_Frobenius_group sGD injf : [Frobenius G] -> [Frobenius f @* G]. Proof. case/existsP=> H frobG; apply/existsP; exists (f @* H)%G. exact: injm_Frobenius_compl. Qed. End InjmFrobenius. Theorem Frobenius_Ldiv (gT : finGroupType) (G : {group gT}) n : n %| #|G| -> n %| #|'Ldiv_n(G)|. Proof. move=> nG; move: {2}_.+1 (ltnSn (#|G| %/ n)) => mq. elim: mq => // mq IHm in gT G n nG *; case/dvdnP: nG => q oG. have [q_gt0 n_gt0] : 0 < q /\ 0 < n by apply/andP; rewrite -muln_gt0 -oG. rewrite ltnS oG mulnK // => leqm. have:= q_gt0; rewrite leq_eqVlt => /predU1P[q1 | lt1q]. rewrite -(mul1n n) q1 -oG (setIidPl _) //. by apply/subsetP=> x Gx; rewrite inE -order_dvdn order_dvdG. pose p := pdiv q; have pr_p: prime p by apply: pdiv_prime. have lt1p: 1 < p := prime_gt1 pr_p; have p_gt0 := ltnW lt1p. have{leqm} lt_qp_mq: q %/ p < mq by apply: leq_trans leqm; rewrite ltn_Pdiv. have: n %| #|'Ldiv_(p * n)(G)|. have: p * n %| #|G| by rewrite oG dvdn_pmul2r ?pdiv_dvd. move/IHm=> IH; apply: dvdn_trans (IH _); first exact: dvdn_mull. by rewrite oG divnMr. rewrite -(cardsID 'Ldiv_n()) dvdn_addl. rewrite -setIA ['Ldiv_n(_)](setIidPr _) //. by apply/subsetP=> x; rewrite !inE -!order_dvdn; apply: dvdn_mull. rewrite -setIDA; set A := _ :\: _. have pA x: x \in A -> #[x]`_p = (n`_p * p)%N. rewrite !inE -!order_dvdn => /andP[xn xnp]. rewrite !p_part // -expnSr; congr (p ^ _)%N; apply/eqP. rewrite eqn_leq -{1}addn1 -(pfactorK 1 pr_p) -lognM ?expn1 // mulnC. rewrite dvdn_leq_log ?muln_gt0 ?p_gt0 //= ltnNge; apply: contra xn => xn. move: xnp; rewrite -[#[x]](partnC p) //. rewrite !Gauss_dvd ?coprime_partC //; case/andP=> _. rewrite p_part ?pfactor_dvdn // xn Gauss_dvdr // coprime_sym. exact: pnat_coprime (pnat_id _) (part_pnat _ _). rewrite -(partnC p n_gt0) Gauss_dvd ?coprime_partC //; apply/andP; split. rewrite -sum1_card (partition_big_imset (@cycle _)) /=. apply: dvdn_sum => _ /imsetP[x /setIP[Gx Ax] ->]. rewrite (eq_bigl (generator <[x]>)) => [|y]. rewrite sum1dep_card -totient_gen -[#[x]](partnC p) //. rewrite totient_coprime ?coprime_partC // dvdn_mulr // . by rewrite (pA x Ax) p_part // -expnSr totient_pfactor // dvdn_mull. rewrite /generator eq_sym andbC; case xy: {+}(_ == _) => //. rewrite !inE -!order_dvdn in Ax *. by rewrite -cycle_subG /order -(eqP xy) cycle_subG Gx. rewrite -sum1_card (partition_big_imset (fun x => x.`_p ^: G)) /=. apply: dvdn_sum => _ /imsetP[x /setIP[Gx Ax] ->]. set y := x.`_p; have oy: #[y] = (n`_p * p)%N by rewrite order_constt pA. rewrite (partition_big (fun x => x.`_p) (mem (y ^: G))) /= => [|z]; last first. by case/andP=> _ /eqP <-; rewrite /= class_refl. pose G' := ('C_G[y] / <[y]>)%G; pose n' := gcdn #|G'| n`_p^'. have n'_gt0: 0 < n' by rewrite gcdn_gt0 cardG_gt0. rewrite (eq_bigr (fun _ => #|'Ldiv_n'(G')|)) => [|_ /imsetP[a Ga ->]]. rewrite sum_nat_const -index_cent1 indexgI. rewrite -(dvdn_pmul2l (cardG_gt0 'C_G[y])) mulnA LagrangeI. have oCy: #|'C_G[y]| = (#[y] * #|G'|)%N. rewrite card_quotient ?subcent1_cycle_norm // Lagrange //. by rewrite subcent1_cycle_sub ?groupX. rewrite oCy -mulnA -(muln_lcm_gcd #|G'|) -/n' mulnA dvdn_mul //. rewrite muln_lcmr -oCy order_constt pA // mulnAC partnC // dvdn_lcm. by rewrite cardSg ?subsetIl // mulnC oG dvdn_pmul2r ?pdiv_dvd. apply: IHm; [exact: dvdn_gcdl | apply: leq_ltn_trans lt_qp_mq]. rewrite -(@divnMr n`_p^') // -muln_lcm_gcd mulnC divnMl //. rewrite leq_divRL // divn_mulAC ?leq_divLR ?dvdn_mulr ?dvdn_lcmr //. rewrite dvdn_leq ?muln_gt0 ?q_gt0 //= mulnC muln_lcmr dvdn_lcm. rewrite -(@dvdn_pmul2l n`_p) // mulnA -oy -oCy mulnCA partnC // -oG. by rewrite cardSg ?subsetIl // dvdn_mul ?pdiv_dvd. pose h := [fun z => coset <[y]> (z ^ a^-1)]. pose h' := [fun Z : coset_of <[y]> => (y * (repr Z).`_p^') ^ a]. rewrite -sum1_card (reindex_onto h h') /= => [|Z]; last first. rewrite conjgK coset_kerl ?cycle_id ?morph_constt ?repr_coset_norm //. rewrite /= coset_reprK 2!inE -order_dvdn dvdn_gcd => /and3P[_ _ p'Z]. by apply: constt_p_elt (pnat_dvd p'Z _); apply: part_pnat. apply: eq_bigl => z; apply/andP/andP=> [[]|[]]. rewrite inE -andbA => /and3P[Gz Az _] /eqP zp_ya. have czy: z ^ a^-1 \in 'C[y]. rewrite -mem_conjg -normJ conjg_set1 -zp_ya. by apply/cent1P; apply: commuteX. have Nz: z ^ a^-1 \in 'N(<[y]>) by apply: subsetP czy; apply: norm_gen. have G'z: h z \in G' by rewrite mem_morphim //= inE groupJ // groupV. rewrite inE G'z inE -order_dvdn dvdn_gcd order_dvdG //=. rewrite /order -morphim_cycle // -quotientE card_quotient ?cycle_subG //. rewrite -(@dvdn_pmul2l #[y]) // Lagrange; last first. by rewrite /= cycleJ cycle_subG mem_conjgV -zp_ya mem_cycle. rewrite oy mulnAC partnC // [#|_|]orderJ; split. by rewrite !inE -!order_dvdn mulnC in Az; case/andP: Az. set Z := coset _ _; have NZ := repr_coset_norm Z; have:= coset_reprK Z. case/kercoset_rcoset=> {NZ}// _ /cycleP[i ->] ->{Z}. rewrite consttM; last exact/commute_sym/commuteX/cent1P. rewrite (constt1P _) ?p_eltNK 1?p_eltX ?p_elt_constt // mul1g. by rewrite conjMg consttJ conjgKV -zp_ya consttC. rewrite 2!inE -order_dvdn; set Z := coset _ _ => /andP[Cz n'Z] /eqP def_z. have Nz: z ^ a^-1 \in 'N(<[y]>). rewrite -def_z conjgK groupMr; first by rewrite -(cycle_subG y) normG. by rewrite groupX ?repr_coset_norm. have{Cz} /setIP[Gz Cz]: z ^ a^-1 \in 'C_G[y]. case/morphimP: Cz => u Nu Cu /kercoset_rcoset[] // _ /cycleP[i ->] ->. by rewrite groupMr // groupX // inE groupX //; apply/cent1P. have{def_z} zp_ya: z.`_p = y ^ a. rewrite -def_z consttJ consttM. rewrite constt_p_elt ?p_elt_constt //. by rewrite (constt1P _) ?p_eltNK ?p_elt_constt ?mulg1. apply: commute_sym; apply/cent1P. by rewrite -def_z conjgK groupMl // in Cz; apply/cent1P. have ozp: #[z ^ a^-1]`_p = #[y] by rewrite -order_constt consttJ zp_ya conjgK. split; rewrite zp_ya // -class_lcoset lcoset_id // eqxx andbT. rewrite -(conjgKV a z) !inE groupJ //= -!order_dvdn orderJ; apply/andP; split. apply: contra (partn_dvd p n_gt0) _. by rewrite ozp -(muln1 n`_p) oy dvdn_pmul2l // dvdn1 neq_ltn lt1p orbT. rewrite -(partnC p n_gt0) mulnCA mulnA -oy -(@partnC p #[_]) // ozp. apply dvdn_mul => //; apply: dvdn_trans (dvdn_trans n'Z (dvdn_gcdr _ _)). rewrite {2}/order -morphim_cycle // -quotientE card_quotient ?cycle_subG //. rewrite -(@dvdn_pmul2l #|<[z ^ a^-1]> :&: <[y]>|) ?cardG_gt0 // LagrangeI. rewrite -[#|<[_]>|](partnC p) ?order_gt0 // dvdn_pmul2r // ozp. by rewrite cardSg ?subsetIr. Qed. math-comp-mathcomp-1.12.0/mathcomp/solvable/gfunctor.v000066400000000000000000000477001375767750300227570ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat fintype. From mathcomp Require Import bigop finset fingroup morphism automorphism. From mathcomp Require Import quotient gproduct. (******************************************************************************) (* This file provides basic interfaces for the notion of "generic" *) (* characteristic subgroups; these amount to subfunctors of the identity *) (* functor in some category of groups. *) (* See "Generic Proof Tools And Finite Group Theory", *) (* Francois Garillot, PhD, 2011, Chapter 3. *) (* The implementation proposed here is fairly basic, relying on first order *) (* function matching and on structure telescopes, both of which are somewhat *) (* limited and fragile. It should switch in the future to more general and *) (* more robust quotation matching. *) (* The definitions in this file (types, properties and structures) are all *) (* packaged under the GFunctor submodule, i.e., client code should refer to *) (* GFunctor.continuous, GFunctor.map, etc. Notations, Coercions and Lemmas *) (* are exported and thus directly available, however. *) (* We provide the following: *) (* object_map == the type of the (polymorphic) object map of a group *) (* functor; the %gF scope is bound to object_map. *) (* := forall gT : finGroupType, {set gT} -> {set gT}. *) (* We define two operations on object_map (with notations in the %gF scope): *) (* F1 \o F2 == the composite map; (F1 \o F2) G expands to F1 (F2 G). *) (* F1 %% F2 == F1 computed modulo F2; we have *) (* (F1 %% F2) G / F2 G = F1 (G / F2 G) *) (* We define the following (type-polymorphic) properties of an object_map F: *) (* group_valued F <-> F G is a group when G is a group *) (* closed F <-> F G is a subgroup o fG when G is a group *) (* continuous F <-> F is continuous with respect to morphism image: *) (* for any f : {morphism G >-> ..}, f @* (F G) is a *) (* a subgroup of F (f @* G); equivalently, F is *) (* functorial in the category Grp of groups. *) (* Most common "characteristic subgroup" are produced *) (* continuous object maps. *) (* iso_continuous F <-> F is continuous with respect to isomorphism image; *) (* equivalently, F is functorial in the Grp groupoid. *) (* The Puig and the Thompson J subgroups are examples *) (* of iso_continuous maps that are not continuous. *) (* pcontinuous F <-> F is continuous with respect to partial morphism *) (* image, i.e., functorial in the category of groups *) (* and partial morphisms. The center and p-core are *) (* examples of pcontinuous maps. *) (* hereditary F <-> inclusion in the image of F is hereditary, i.e., *) (* for any subgroup H of G, the intersection of H with *) (* F G is included in H. Note that F is pcontinuous *) (* iff it is continuous and hereditary; indeed proofs *) (* of pcontinuous F coerce to proofs of hereditary F *) (* and continuous F. *) (* monotonic F <-> F is monotonic with respect to inclusion: for any *) (* subgroup H of G, F H is a subgroup of F G. The *) (* derived and lower central series are examples of *) (* monotonic maps. *) (* Four structures provide interfaces to these properties: *) (* GFunctor.iso_map == structure for object maps that are group_valued, *) (* closed, and iso_continuous. *) (* [igFun by Fsub & !Fcont] == the iso_map structure for an object map F *) (* such that F G is canonically a group when G is, and *) (* given Fsub : closed F and Fcont : iso_continuous F. *) (* [igFun by Fsub & Fcont] == as above, but expecting Fcont : continuous F. *) (* [igFun of F] == clone an existing GFunctor.iso_map structure for F. *) (* GFunctor.map == structure for continuous object maps, inheriting *) (* from the GFunctor.iso_map structure. *) (* [gFun by Fcont] == the map structure for an F with a canonical iso_map *) (* structure, given Fcont : continuous F. *) (* [gFun of F] == clone an existing GFunctor.map structure for F. *) (* GFunctor.pmap == structure for pcontinuous object maps, inheriting *) (* from the GFunctor.map structure. *) (* [pgFun by Fher] == the pmap structure for an F with a canonical map *) (* structure, given Fher : hereditary F. *) (* [pgFun of F] == clone an existing GFunctor.pmap structure for F. *) (* GFunctor.mono_map == structure for monotonic, continuous object maps *) (* inheriting from the GFunctor.map structure. *) (* [mgFun by Fmon] == the mono_map structure for an F with a canonical *) (* map structure, given Fmon : monotonic F. *) (* [mgFun of F] == clone an existing GFunctor.mono_map structure for F *) (* Lemmas for these group functors use either a 'gF' prefix or an 'F' suffix. *) (* The (F1 \o F2) and (F1 %% F2) operations have canonical GFunctor.map *) (* structures when F1 is monotonic or hereditary, respectively. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope gFun_scope. Import GroupScope. Delimit Scope gFun_scope with gF. Module GFunctor. Definition object_map := forall gT : finGroupType, {set gT} -> {set gT}. Bind Scope gFun_scope with object_map. Section Definitions. Implicit Types gT hT : finGroupType. Variable F : object_map. (* Group closure. *) Definition group_valued := forall gT (G : {group gT}), group_set (F G). (* Subgroup closure. *) Definition closed := forall gT (G : {group gT}), F G \subset G. (* General functoriality, i.e., continuity of the object map *) Definition continuous := forall gT hT (G : {group gT}) (phi : {morphism G >-> hT}), phi @* F G \subset F (phi @* G). (* Functoriality on the Grp groupoid (arrows are restricted to isos). *) Definition iso_continuous := forall gT hT (G : {group gT}) (phi : {morphism G >-> hT}), 'injm phi -> phi @* F G \subset F (phi @* G). Lemma continuous_is_iso_continuous : continuous -> iso_continuous. Proof. by move=> Fcont gT hT G phi inj_phi; apply: Fcont. Qed. (* Functoriality on Grp with partial morphisms. *) Definition pcontinuous := forall gT hT (G D : {group gT}) (phi : {morphism D >-> hT}), phi @* F G \subset F (phi @* G). Lemma pcontinuous_is_continuous : pcontinuous -> continuous. Proof. by move=> Fcont gT hT G; apply: Fcont. Qed. (* Heredity with respect to inclusion *) Definition hereditary := forall gT (H G : {group gT}), H \subset G -> F G :&: H \subset F H. Lemma pcontinuous_is_hereditary : pcontinuous -> hereditary. Proof. move=> Fcont gT H G sHG; rewrite -{2}(setIidPl sHG) setIC. by do 2!rewrite -(morphim_idm (subsetIl H _)) morphimIdom ?Fcont. Qed. (* Monotonicity with respect to inclusion *) Definition monotonic := forall gT (H G : {group gT}), H \subset G -> F H \subset F G. (* Self-expanding composition, and modulo *) Variables (k : unit) (F1 F2 : object_map). Definition comp : object_map := fun gT A => F1 (F2 A). Definition modulo : object_map := fun gT A => coset (F2 A) @*^-1 (F1 (A / (F2 A))). End Definitions. Section ClassDefinitions. Structure iso_map := IsoMap { apply : object_map; _ : group_valued apply; _ : closed apply; _ : iso_continuous apply }. Local Coercion apply : iso_map >-> object_map. Structure map := Map { iso_of_map : iso_map; _ : continuous iso_of_map }. Local Coercion iso_of_map : map >-> iso_map. Structure pmap := Pmap { map_of_pmap : map; _ : hereditary map_of_pmap }. Local Coercion map_of_pmap : pmap >-> map. Structure mono_map := MonoMap { map_of_mono : map; _ : monotonic map_of_mono }. Local Coercion map_of_mono : mono_map >-> map. Definition pack_iso F Fcont Fgrp Fsub := @IsoMap F Fgrp Fsub Fcont. Definition clone_iso (F : object_map) := fun Fgrp Fsub Fcont (isoF := @IsoMap F Fgrp Fsub Fcont) => fun isoF0 & phant_id (apply isoF0) F & phant_id isoF isoF0 => isoF. Definition clone (F : object_map) := fun isoF & phant_id (apply isoF) F => fun (funF0 : map) & phant_id (apply funF0) F => fun Fcont (funF := @Map isoF Fcont) & phant_id funF0 funF => funF. Definition clone_pmap (F : object_map) := fun (funF : map) & phant_id (apply funF) F => fun (pfunF0 : pmap) & phant_id (apply pfunF0) F => fun Fher (pfunF := @Pmap funF Fher) & phant_id pfunF0 pfunF => pfunF. Definition clone_mono (F : object_map) := fun (funF : map) & phant_id (apply funF) F => fun (mfunF0 : mono_map) & phant_id (apply mfunF0) F => fun Fmon (mfunF := @MonoMap funF Fmon) & phant_id mfunF0 mfunF => mfunF. End ClassDefinitions. Module Exports. Identity Coercion fun_of_object_map : object_map >-> Funclass. Coercion apply : iso_map >-> object_map. Coercion iso_of_map : map >-> iso_map. Coercion map_of_pmap : pmap >-> map. Coercion map_of_mono : mono_map >-> map. Coercion continuous_is_iso_continuous : continuous >-> iso_continuous. Coercion pcontinuous_is_continuous : pcontinuous >-> continuous. Coercion pcontinuous_is_hereditary : pcontinuous >-> hereditary. Notation "[ 'igFun' 'by' Fsub & Fcont ]" := (pack_iso (continuous_is_iso_continuous Fcont) (fun gT G => groupP _) Fsub) (at level 0, format "[ 'igFun' 'by' Fsub & Fcont ]") : form_scope. Notation "[ 'igFun' 'by' Fsub & ! Fcont ]" := (pack_iso Fcont (fun gT G => groupP _) Fsub) (at level 0, format "[ 'igFun' 'by' Fsub & ! Fcont ]") : form_scope. Notation "[ 'igFun' 'of' F ]" := (@clone_iso F _ _ _ _ id id) (at level 0, format "[ 'igFun' 'of' F ]") : form_scope. Notation "[ 'gFun' 'by' Fcont ]" := (Map Fcont) (at level 0, format "[ 'gFun' 'by' Fcont ]") : form_scope. Notation "[ 'gFun' 'of' F ]" := (@clone F _ id _ id _ id) (at level 0, format "[ 'gFun' 'of' F ]") : form_scope. Notation "[ 'pgFun' 'by' Fher ]" := (Pmap Fher) (at level 0, format "[ 'pgFun' 'by' Fher ]") : form_scope. Notation "[ 'pgFun' 'of' F ]" := (@clone_pmap F _ id _ id _ id) (at level 0, format "[ 'pgFun' 'of' F ]") : form_scope. Notation "[ 'mgFun' 'by' Fmon ]" := (MonoMap Fmon) (at level 0, format "[ 'mgFun' 'by' Fmon ]") : form_scope. Notation "[ 'mgFun' 'of' F ]" := (@clone_mono F _ id _ id _ id) (at level 0, format "[ 'mgFun' 'of' F ]") : form_scope. End Exports. End GFunctor. Export GFunctor.Exports. Bind Scope gFun_scope with GFunctor.object_map. Arguments GFunctor.comp F1 F2 _ /. Notation "F1 \o F2" := (GFunctor.comp F1 F2) : gFun_scope. Notation "F1 %% F2" := (GFunctor.modulo F1 F2) : gFun_scope. Section FunctorGroup. Variables (F : GFunctor.iso_map) (gT : finGroupType) (G : {group gT}). Lemma gFgroupset : group_set (F gT G). Proof. by case: F. Qed. Canonical gFgroup := Group gFgroupset. End FunctorGroup. Canonical gFmod_group (F1 : GFunctor.iso_map) (F2 : GFunctor.object_map) (gT : finGroupType) (G : {group gT}) := [group of (F1 %% F2)%gF gT G]. Section IsoFunctorTheory. Implicit Types gT rT : finGroupType. Variable F : GFunctor.iso_map. Lemma gFsub gT (G : {group gT}) : F gT G \subset G. Proof. by case: F gT G. Qed. Lemma gFsub_trans gT (G : {group gT}) (A : {pred gT}) : G \subset A -> F gT G \subset A. Proof. exact/subset_trans/gFsub. Qed. Lemma gF1 gT : F gT 1 = 1. Proof. exact/trivgP/gFsub. Qed. Lemma gFiso_cont : GFunctor.iso_continuous F. Proof. by case F. Qed. Lemma gFchar gT (G : {group gT}) : F gT G \char G. Proof. apply/andP; split => //; first by apply: gFsub. apply/forall_inP=> f Af; rewrite -{2}(im_autm Af) -(autmE Af). by rewrite -morphimEsub ?gFsub ?gFiso_cont ?injm_autm. Qed. Lemma gFnorm gT (G : {group gT}) : G \subset 'N(F gT G). Proof. exact/char_norm/gFchar. Qed. Lemma gFnorms gT (G : {group gT}) : 'N(G) \subset 'N(F gT G). Proof. exact/char_norms/gFchar. Qed. Lemma gFnormal gT (G : {group gT}) : F gT G <| G. Proof. exact/char_normal/gFchar. Qed. Lemma gFchar_trans gT (G H : {group gT}) : H \char G -> F gT H \char G. Proof. exact/char_trans/gFchar. Qed. Lemma gFnormal_trans gT (G H : {group gT}) : H <| G -> F gT H <| G. Proof. exact/char_normal_trans/gFchar. Qed. Lemma gFnorm_trans gT (A : {pred gT}) (G : {group gT}) : A \subset 'N(G) -> A \subset 'N(F gT G). Proof. by move/subset_trans/(_ (gFnorms G)). Qed. Lemma injmF_sub gT rT (G D : {group gT}) (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> f @* (F gT G) \subset F rT (f @* G). Proof. move=> injf sGD; have:= gFiso_cont (injm_restrm sGD injf). by rewrite im_restrm morphim_restrm (setIidPr _) ?gFsub. Qed. Lemma injmF gT rT (G D : {group gT}) (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> f @* (F gT G) = F rT (f @* G). Proof. move=> injf sGD; have [sfGD injf'] := (morphimS f sGD, injm_invm injf). apply/esym/eqP; rewrite eqEsubset -(injmSK injf') ?gFsub_trans //. by rewrite !(subset_trans (injmF_sub _ _)) ?morphim_invm // gFsub_trans. Qed. Lemma gFisom gT rT (G D : {group gT}) R (f : {morphism D >-> rT}) : G \subset D -> isom G (gval R) f -> isom (F gT G) (F rT R) f. Proof. case/(restrmP f)=> g [gf _ _ _]; rewrite -{f}gf => /isomP[injg <-]. by rewrite sub_isom ?gFsub ?injmF. Qed. Lemma gFisog gT rT (G : {group gT}) (R : {group rT}) : G \isog R -> F gT G \isog F rT R. Proof. by case/isogP=> f injf <-; rewrite -injmF // sub_isog ?gFsub. Qed. End IsoFunctorTheory. Section FunctorTheory. Implicit Types gT rT : finGroupType. Variable F : GFunctor.map. Lemma gFcont : GFunctor.continuous F. Proof. by case F. Qed. Lemma morphimF gT rT (G D : {group gT}) (f : {morphism D >-> rT}) : G \subset D -> f @* (F gT G) \subset F rT (f @* G). Proof. move=> sGD; rewrite -(setIidPr (gFsub F G)). by rewrite -{3}(setIid G) -!(morphim_restrm sGD) gFcont. Qed. End FunctorTheory. Section PartialFunctorTheory. Implicit Types gT rT : finGroupType. Section BasicTheory. Variable F : GFunctor.pmap. Lemma gFhereditary : GFunctor.hereditary F. Proof. by case F. Qed. Lemma gFunctorI gT (G H : {group gT}) : F gT G :&: H = F gT G :&: F gT (G :&: H). Proof. rewrite -{1}(setIidPr (gFsub F G)) [G :&: _]setIC -setIA. rewrite -(setIidPr (gFhereditary (subsetIl G H))). by rewrite setIC -setIA (setIidPr (gFsub F (G :&: H))). Qed. Lemma pmorphimF : GFunctor.pcontinuous F. Proof. move=> gT rT G D f; rewrite -morphimIdom -(setIidPl (gFsub F G)) setICA. apply: (subset_trans (morphimS f (gFhereditary (subsetIr D G)))). by rewrite (subset_trans (morphimF F _ _ )) ?morphimIdom ?subsetIl. Qed. Lemma gFid gT (G : {group gT}) : F gT (F gT G) = F gT G. Proof. apply/eqP; rewrite eqEsubset gFsub. by move/gFhereditary: (gFsub F G); rewrite setIid /=. Qed. End BasicTheory. Section Modulo. Variables (F1 : GFunctor.pmap) (F2 : GFunctor.map). Lemma gFmod_closed : GFunctor.closed (F1 %% F2). Proof. by move=> gT G; rewrite sub_cosetpre_quo ?gFsub ?gFnormal. Qed. Lemma gFmod_cont : GFunctor.continuous (F1 %% F2). Proof. move=> gT rT G f; have nF2 := gFnorm F2. have sDF: G \subset 'dom (coset (F2 _ G)) by rewrite nF2. have sDFf: G \subset 'dom (coset (F2 _ (f @* G)) \o f). by rewrite -sub_morphim_pre ?subsetIl // nF2. pose K := 'ker (restrm sDFf (coset (F2 _ (f @* G)) \o f)). have sFK: 'ker (restrm sDF (coset (F2 _ G))) \subset K. rewrite {}/K !ker_restrm ker_comp /= subsetI subsetIl !ker_coset /=. by rewrite -sub_morphim_pre ?subsetIl // morphimIdom ?morphimF. have sOF := gFsub F1 (G / F2 _ G); have sGG: G \subset G by []. rewrite -sub_quotient_pre; last first. by apply: subset_trans (nF2 _ _); rewrite morphimS ?gFmod_closed. suffices im_fact H : F2 _ G \subset gval H -> H \subset G -> factm sFK sGG @* (H / F2 _ G) = f @* H / F2 _ (f @* G). - rewrite -2?im_fact ?gFmod_closed ?gFsub //. by rewrite cosetpreK morphimF /= ?morphim_restrm ?setIid. by rewrite -sub_quotient_pre ?normG //= trivg_quotient sub1G. move=> sFH sHG; rewrite -(morphimIdom _ (H / _)) /= {2}morphim_restrm setIid. rewrite -morphimIG ?ker_coset // -(morphim_restrm sDF) morphim_factm. by rewrite morphim_restrm morphim_comp -quotientE morphimIdom. Qed. Canonical gFmod_igFun := [igFun by gFmod_closed & gFmod_cont]. Canonical gFmod_gFun := [gFun by gFmod_cont]. End Modulo. Variables F1 F2 : GFunctor.pmap. Lemma gFmod_hereditary : GFunctor.hereditary (F1 %% F2). Proof. move=> gT H G sHG; set FGH := _ :&: H; have nF2H := gFnorm F2 H. rewrite -sub_quotient_pre; last exact: subset_trans (subsetIr _ _) _. pose rH := restrm nF2H (coset (F2 _ H)); pose rHM := [morphism of rH]. have rnorm_simpl: rHM @* H = H / F2 _ H by rewrite morphim_restrm setIid. have nF2G := subset_trans sHG (gFnorm F2 G). pose rG := restrm nF2G (coset (F2 _ G)); pose rGM := [morphism of rG]. have sqKfK: 'ker rGM \subset 'ker rHM. rewrite !ker_restrm !ker_coset (setIidPr (gFsub F2 _)) setIC /=. exact: gFhereditary. have sHH := subxx H; rewrite -rnorm_simpl /= -(morphim_factm sqKfK sHH) /=. apply: subset_trans (gFcont F1 _); rewrite /= {2}morphim_restrm setIid /=. apply: subset_trans (morphimS _ (gFhereditary _ (quotientS _ sHG))) => /=. have ->: FGH / _ = restrm nF2H (coset _) @* FGH. by rewrite morphim_restrm setICA setIid. rewrite -(morphim_factm sqKfK sHH) morphimS //= morphim_restrm -quotientE. by rewrite setICA setIid (subset_trans (quotientI _ _ _)) // cosetpreK. Qed. Canonical gFmod_pgFun := [pgFun by gFmod_hereditary]. End PartialFunctorTheory. Section MonotonicFunctorTheory. Implicit Types gT rT : finGroupType. Lemma gFunctorS (F : GFunctor.mono_map) : GFunctor.monotonic F. Proof. by case: F. Qed. Section Composition. Variables (F1 : GFunctor.mono_map) (F2 : GFunctor.map). Lemma gFcomp_closed : GFunctor.closed (F1 \o F2). Proof. by move=> gT G; rewrite !gFsub_trans. Qed. Lemma gFcomp_cont : GFunctor.continuous (F1 \o F2). Proof. move=> gT rT G phi; rewrite (subset_trans (morphimF _ _ (gFsub _ _))) //. by rewrite (subset_trans (gFunctorS F1 (gFcont F2 phi))). Qed. Canonical gFcomp_igFun := [igFun by gFcomp_closed & gFcomp_cont]. Canonical gFcomp_gFun :=[gFun by gFcomp_cont]. End Composition. Variables F1 F2 : GFunctor.mono_map. Lemma gFcompS : GFunctor.monotonic (F1 \o F2). Proof. by move=> gT H G sHG; rewrite !gFunctorS. Qed. Canonical gFcomp_mgFun := [mgFun by gFcompS]. End MonotonicFunctorTheory. Section GFunctorExamples. Implicit Types gT : finGroupType. Definition idGfun gT := @id {set gT}. Lemma idGfun_closed : GFunctor.closed idGfun. Proof. by []. Qed. Lemma idGfun_cont : GFunctor.continuous idGfun. Proof. by []. Qed. Lemma idGfun_monotonic : GFunctor.monotonic idGfun. Proof. by []. Qed. Canonical bgFunc_id := [igFun by idGfun_closed & idGfun_cont]. Canonical gFunc_id := [gFun by idGfun_cont]. Canonical mgFunc_id := [mgFun by idGfun_monotonic]. Definition trivGfun gT of {set gT} := [1 gT]. Lemma trivGfun_cont : GFunctor.pcontinuous trivGfun. Proof. by move=> gT rT D G f; rewrite morphim1. Qed. Canonical trivGfun_igFun := [igFun by sub1G & trivGfun_cont]. Canonical trivGfun_gFun := [gFun by trivGfun_cont]. Canonical trivGfun_pgFun := [pgFun by trivGfun_cont]. End GFunctorExamples. math-comp-mathcomp-1.12.0/mathcomp/solvable/gseries.v000066400000000000000000000503771375767750300225750ustar00rootroot00000000000000(* (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 fintype bigop finset fingroup morphism. From mathcomp Require Import automorphism quotient action commutator center. (******************************************************************************) (* H <|<| G <=> H is subnormal in G, i.e., H <| ... <| G. *) (* invariant_factor A H G <=> A normalises both H and G, and H <| G. *) (* A.-invariant <=> the (invariant_factor A) relation, in the context *) (* of the g_rel.-series notation. *) (* g_rel.-series H s <=> H :: s is a sequence of groups whose projection *) (* to sets satisfies relation g_rel pairwise; for *) (* example H <|<| G iff G = last H s for some s such *) (* that normal.-series H s. *) (* stable_factor A H G == H <| G and A centralises G / H. *) (* A.-stable == the stable_factor relation, in the scope of the *) (* r.-series notation. *) (* G.-central == the central_factor relation, in the scope of the *) (* r.-series notation. *) (* maximal M G == M is a maximal proper subgroup of G. *) (* maximal_eq M G == (M == G) or (maximal M G). *) (* maxnormal M G N == M is a maximal subgroup of G normalized by N. *) (* minnormal M N == M is a minimal nontrivial group normalized by N. *) (* simple G == G is a (nontrivial) simple group. *) (* := minnormal G G *) (* G.-chief == the chief_factor relation, in the scope of the *) (* r.-series notation. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope group_rel_scope. Import GroupScope. Section GroupDefs. Variable gT : finGroupType. Implicit Types A B U V : {set gT}. Local Notation groupT := (group_of (Phant gT)). Definition subnormal A B := (A \subset B) && (iter #|B| (fun N => generated (class_support A N)) B == A). Definition invariant_factor A B C := [&& A \subset 'N(B), A \subset 'N(C) & B <| C]. Definition group_rel_of (r : rel {set gT}) := [rel H G : groupT | r H G]. Definition stable_factor A V U := ([~: U, A] \subset V) && (V <| U). (* this orders allows and3P to be used *) Definition central_factor A V U := [&& [~: U, A] \subset V, V \subset U & U \subset A]. Definition maximal A B := [max A of G | G \proper B]. Definition maximal_eq A B := (A == B) || maximal A B. Definition maxnormal A B U := [max A of G | G \proper B & U \subset 'N(G)]. Definition minnormal A B := [min A of G | G :!=: 1 & B \subset 'N(G)]. Definition simple A := minnormal A A. Definition chief_factor A V U := maxnormal V U A && (U <| A). End GroupDefs. Arguments subnormal {gT} A%g B%g. Arguments invariant_factor {gT} A%g B%g C%g. Arguments stable_factor {gT} A%g V%g U%g. Arguments central_factor {gT} A%g V%g U%g. Arguments maximal {gT} A%g B%g. Arguments maximal_eq {gT} A%g B%g. Arguments maxnormal {gT} A%g B%g U%g. Arguments minnormal {gT} A%g B%g. Arguments simple {gT} A%g. Arguments chief_factor {gT} A%g V%g U%g. Notation "H <|<| G" := (subnormal H G) (at level 70, no associativity) : group_scope. Notation "A .-invariant" := (invariant_factor A) (at level 2, format "A .-invariant") : group_rel_scope. Notation "A .-stable" := (stable_factor A) (at level 2, format "A .-stable") : group_rel_scope. Notation "A .-central" := (central_factor A) (at level 2, format "A .-central") : group_rel_scope. Notation "G .-chief" := (chief_factor G) (at level 2, format "G .-chief") : group_rel_scope. Arguments group_rel_of {gT} r%group_rel_scope _%G _%G : extra scopes. Notation "r .-series" := (path (rel_of_simpl_rel (group_rel_of r))) (at level 2, format "r .-series") : group_scope. Section Subnormal. Variable gT : finGroupType. Implicit Types (A B C D : {set gT}) (G H K : {group gT}). Let setIgr H G := (G :&: H)%G. Let sub_setIgr G H : G \subset H -> G = setIgr H G. Proof. by move/setIidPl/group_inj. Qed. Let path_setIgr H G s : normal.-series H s -> normal.-series (setIgr G H) (map (setIgr G) s). Proof. elim: s H => //= K s IHs H /andP[/andP[sHK nHK] Ksn]. by rewrite /normal setSI ?normsIG ?IHs. Qed. Lemma subnormalP H G : reflect (exists2 s, normal.-series H s & last H s = G) (H <|<| G). Proof. apply: (iffP andP) => [[sHG snHG] | [s Hsn <-{G}]]. move: #|G| snHG => m; elim: m => [|m IHm] in G sHG *. by exists [::]; last by apply/eqP; rewrite eq_sym. rewrite iterSr => /IHm[|s Hsn defG]. by rewrite sub_gen // class_supportEr (bigD1 1) //= conjsg1 subsetUl. exists (rcons s G); rewrite ?last_rcons // -cats1 cat_path Hsn defG /=. rewrite /normal gen_subG class_support_subG //=. by rewrite norms_gen ?class_support_norm. set f := fun _ => <<_>>; have idf: iter _ f H == H. by elim=> //= m IHm; rewrite (eqP IHm) /f class_support_id genGid. have [m] := ubnP (size s); elim: m s Hsn => // m IHm /lastP[//|s G]. rewrite size_rcons last_rcons rcons_path /= ltnS. set K := last H s => /andP[Hsn /andP[sKG nKG]] lt_s_m. have:= sKG; rewrite subEproper => /predU1P[<-|prKG]; first exact: IHm. pose L := [group of f G]. have sHK: H \subset K by case/IHm: Hsn. have sLK: L \subset K by rewrite gen_subG class_support_sub_norm. rewrite -(subnK (proper_card (sub_proper_trans sLK prKG))) iterD iterSr. have defH: H = setIgr L H by rewrite -sub_setIgr ?sub_gen ?sub_class_support. have: normal.-series H (map (setIgr L) s) by rewrite defH path_setIgr. case/IHm=> [|_]; first by rewrite size_map. rewrite [in last _]defH last_map (subset_trans sHK) //=. by rewrite (setIidPr sLK) => /eqP->. Qed. Lemma subnormal_refl G : G <|<| G. Proof. by apply/subnormalP; exists [::]. Qed. Lemma subnormal_trans K H G : H <|<| K -> K <|<| G -> H <|<| G. Proof. case/subnormalP=> [s1 Hs1 <-] /subnormalP[s2 Hs12 <-]. by apply/subnormalP; exists (s1 ++ s2); rewrite ?last_cat // cat_path Hs1. Qed. Lemma normal_subnormal H G : H <| G -> H <|<| G. Proof. by move=> nsHG; apply/subnormalP; exists [:: G]; rewrite //= nsHG. Qed. Lemma setI_subnormal G H K : K \subset G -> H <|<| G -> H :&: K <|<| K. Proof. move=> sKG /subnormalP[s Hs defG]; apply/subnormalP. exists (map (setIgr K) s); first exact: path_setIgr. rewrite (last_map (setIgr K)) defG. by apply: val_inj; rewrite /= (setIidPr sKG). Qed. Lemma subnormal_sub G H : H <|<| G -> H \subset G. Proof. by case/andP. Qed. Lemma invariant_subnormal A G H : A \subset 'N(G) -> A \subset 'N(H) -> H <|<| G -> exists2 s, (A.-invariant).-series H s & last H s = G. Proof. move=> nGA nHA /andP[]; move: #|G| => m. elim: m => [|m IHm] in G nGA * => sHG. by rewrite eq_sym; exists [::]; last apply/eqP. rewrite iterSr; set K := <<_>>. have nKA: A \subset 'N(K) by rewrite norms_gen ?norms_class_support. have sHK: H \subset K by rewrite sub_gen ?sub_class_support. case/IHm=> // s Hsn defK; exists (rcons s G); last by rewrite last_rcons. rewrite rcons_path Hsn !andbA defK nGA nKA /= -/K. by rewrite gen_subG class_support_subG ?norms_gen ?class_support_norm. Qed. Lemma subnormalEsupport G H : H <|<| G -> H :=: G \/ <> \proper G. Proof. case/andP=> sHG; set K := <<_>> => /eqP <-. have: K \subset G by rewrite gen_subG class_support_subG. rewrite subEproper; case/predU1P=> [defK|]; [left | by right]. by elim: #|G| => //= _ ->. Qed. Lemma subnormalEr G H : H <|<| G -> H :=: G \/ (exists K : {group gT}, [/\ H <|<| K, K <| G & K \proper G]). Proof. case/subnormalP=> s Hs <-{G}. elim/last_ind: s Hs => [|s G IHs]; first by left. rewrite last_rcons -cats1 cat_path /= andbT; set K := last H s. case/andP=> Hs nsKG; have:= normal_sub nsKG; rewrite subEproper. case/predU1P=> [<- | prKG]; [exact: IHs | right; exists K; split=> //]. by apply/subnormalP; exists s. Qed. Lemma subnormalEl G H : H <|<| G -> H :=: G \/ (exists K : {group gT}, [/\ H <| K, K <|<| G & H \proper K]). Proof. case/subnormalP=> s Hs <-{G}; elim: s H Hs => /= [|K s IHs] H; first by left. case/andP=> nsHK Ks; have:= normal_sub nsHK; rewrite subEproper. case/predU1P=> [-> | prHK]; [exact: IHs | right; exists K; split=> //]. by apply/subnormalP; exists s. Qed. End Subnormal. Arguments subnormalP {gT H G}. Section MorphSubNormal. Variable gT : finGroupType. Implicit Type G H K : {group gT}. Lemma morphim_subnormal (rT : finGroupType) G (f : {morphism G >-> rT}) H K : H <|<| K -> f @* H <|<| f @* K. Proof. case/subnormalP => s Hs <-{K}; apply/subnormalP. elim: s H Hs => [|K s IHs] H /=; first by exists [::]. case/andP=> nsHK /IHs[fs Hfs <-]. by exists ([group of f @* K] :: fs); rewrite /= ?morphim_normal. Qed. Lemma quotient_subnormal H G K : G <|<| K -> G / H <|<| K / H. Proof. exact: morphim_subnormal. Qed. End MorphSubNormal. Section MaxProps. Variable gT : finGroupType. Implicit Types G H M : {group gT}. Lemma maximal_eqP M G : reflect (M \subset G /\ forall H, M \subset H -> H \subset G -> H :=: M \/ H :=: G) (maximal_eq M G). Proof. rewrite subEproper /maximal_eq; case: eqP => [->|_]; first left. by split=> // H sGH sHG; right; apply/eqP; rewrite eqEsubset sHG. apply: (iffP maxgroupP) => [] [sMG maxM]; split=> // H. by move/maxM=> maxMH; rewrite subEproper; case/predU1P; auto. by rewrite properEneq => /andP[/eqP neHG sHG] /maxM[]. Qed. Lemma maximal_exists H G : H \subset G -> H :=: G \/ (exists2 M : {group gT}, maximal M G & H \subset M). Proof. rewrite subEproper; case/predU1P=> sHG; first by left. suff [M *]: {M : {group gT} | maximal M G & H \subset M} by right; exists M. exact: maxgroup_exists. Qed. Lemma mulg_normal_maximal G M H : M <| G -> maximal M G -> H \subset G -> ~~ (H \subset M) -> (M * H = G)%g. Proof. case/andP=> sMG nMG /maxgroupP[_ maxM] sHG not_sHM. apply/eqP; rewrite eqEproper mul_subG // -norm_joinEr ?(subset_trans sHG) //. by apply: contra not_sHM => /maxM <-; rewrite ?joing_subl ?joing_subr. Qed. End MaxProps. Section MinProps. Variable gT : finGroupType. Implicit Types G H M : {group gT}. Lemma minnormal_exists G H : H :!=: 1 -> G \subset 'N(H) -> {M : {group gT} | minnormal M G & M \subset H}. Proof. by move=> ntH nHG; apply: mingroup_exists (H) _; rewrite ntH. Qed. End MinProps. Section MorphPreMax. Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Variables (M G : {group rT}). Hypotheses (dM : M \subset f @* D) (dG : G \subset f @* D). Lemma morphpre_maximal : maximal (f @*^-1 M) (f @*^-1 G) = maximal M G. Proof. apply/maxgroupP/maxgroupP; rewrite morphpre_proper //= => [] [ltMG maxM]. split=> // H ltHG sMH; have dH := subset_trans (proper_sub ltHG) dG. rewrite -(morphpreK dH) [f @*^-1 H]maxM ?morphpreK ?morphpreSK //. by rewrite morphpre_proper. split=> // H ltHG sMH. have dH: H \subset D := subset_trans (proper_sub ltHG) (subsetIl D _). have defH: f @*^-1 (f @* H) = H. by apply: morphimGK dH; apply: subset_trans sMH; apply: ker_sub_pre. rewrite -defH morphpre_proper ?morphimS // in ltHG. by rewrite -defH [f @* H]maxM // -(morphpreK dM) morphimS. Qed. Lemma morphpre_maximal_eq : maximal_eq (f @*^-1 M) (f @*^-1 G) = maximal_eq M G. Proof. by rewrite /maximal_eq morphpre_maximal !eqEsubset !morphpreSK. Qed. End MorphPreMax. Section InjmMax. Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Variables M G L : {group gT}. Hypothesis injf : 'injm f. Hypotheses (dM : M \subset D) (dG : G \subset D) (dL : L \subset D). Lemma injm_maximal : maximal (f @* M) (f @* G) = maximal M G. Proof. rewrite -(morphpre_invm injf) -(morphpre_invm injf G). by rewrite morphpre_maximal ?morphim_invm. Qed. Lemma injm_maximal_eq : maximal_eq (f @* M) (f @* G) = maximal_eq M G. Proof. by rewrite /maximal_eq injm_maximal // injm_eq. Qed. Lemma injm_maxnormal : maxnormal (f @* M) (f @* G) (f @* L) = maxnormal M G L. Proof. pose injfm := (injm_proper injf, injm_norms, injmSK injf, subsetIl). apply/maxgroupP/maxgroupP; rewrite !injfm // => [[nML maxM]]. split=> // H nHL sMH; have [/proper_sub sHG _] := andP nHL. have dH := subset_trans sHG dG; apply: (injm_morphim_inj injf) => //. by apply: maxM; rewrite !injfm. split=> // fH nHL sMH; have [/proper_sub sfHG _] := andP nHL. have{sfHG} dfH: fH \subset f @* D := subset_trans sfHG (morphim_sub f G). by rewrite -(morphpreK dfH) !injfm // in nHL sMH *; rewrite (maxM _ nHL). Qed. Lemma injm_minnormal : minnormal (f @* M) (f @* G) = minnormal M G. Proof. pose injfm := (morphim_injm_eq1 injf, injm_norms, injmSK injf, subsetIl). apply/mingroupP/mingroupP; rewrite !injfm // => [[nML minM]]. split=> // H nHG sHM; have dH := subset_trans sHM dM. by apply: (injm_morphim_inj injf) => //; apply: minM; rewrite !injfm. split=> // fH nHG sHM; have dfH := subset_trans sHM (morphim_sub f M). by rewrite -(morphpreK dfH) !injfm // in nHG sHM *; rewrite (minM _ nHG). Qed. End InjmMax. Section QuoMax. Variables (gT : finGroupType) (K G H : {group gT}). Lemma cosetpre_maximal (Q R : {group coset_of K}) : maximal (coset K @*^-1 Q) (coset K @*^-1 R) = maximal Q R. Proof. by rewrite morphpre_maximal ?sub_im_coset. Qed. Lemma cosetpre_maximal_eq (Q R : {group coset_of K}) : maximal_eq (coset K @*^-1 Q) (coset K @*^-1 R) = maximal_eq Q R. Proof. by rewrite /maximal_eq !eqEsubset !cosetpreSK cosetpre_maximal. Qed. Lemma quotient_maximal : K <| G -> K <| H -> maximal (G / K) (H / K) = maximal G H. Proof. by move=> nKG nKH; rewrite -cosetpre_maximal ?quotientGK. Qed. Lemma quotient_maximal_eq : K <| G -> K <| H -> maximal_eq (G / K) (H / K) = maximal_eq G H. Proof. by move=> nKG nKH; rewrite -cosetpre_maximal_eq ?quotientGK. Qed. Lemma maximalJ x : maximal (G :^ x) (H :^ x) = maximal G H. Proof. rewrite -{1}(setTI G) -{1}(setTI H) -!morphim_conj. by rewrite injm_maximal ?subsetT ?injm_conj. Qed. Lemma maximal_eqJ x : maximal_eq (G :^ x) (H :^ x) = maximal_eq G H. Proof. by rewrite /maximal_eq !eqEsubset !conjSg maximalJ. Qed. End QuoMax. Section MaxNormalProps. Variables (gT : finGroupType). Implicit Types (A B C : {set gT}) (G H K L M : {group gT}). Lemma maxnormal_normal A B : maxnormal A B B -> A <| B. Proof. by case/maxsetP=> /and3P[/gen_set_id /= -> pAB nAB]; rewrite /normal proper_sub. Qed. Lemma maxnormal_proper A B C : maxnormal A B C -> A \proper B. Proof. by case/maxsetP=> /and3P[gA pAB _] _; apply: (sub_proper_trans (subset_gen A)). Qed. Lemma maxnormal_sub A B C : maxnormal A B C -> A \subset B. Proof. by move=> maxA; rewrite proper_sub //; apply: (maxnormal_proper maxA). Qed. Lemma ex_maxnormal_ntrivg G : G :!=: 1-> {N : {group gT} | maxnormal N G G}. Proof. move=> ntG; apply: ex_maxgroup; exists [1 gT]%G; rewrite norm1 proper1G. by rewrite subsetT ntG. Qed. Lemma maxnormalM G H K : maxnormal H G G -> maxnormal K G G -> H :<>: K -> H * K = G. Proof. move=> maxH maxK /eqP; apply: contraNeq => ltHK_G. have [nsHG nsKG] := (maxnormal_normal maxH, maxnormal_normal maxK). have cHK: commute H K. exact: normC (subset_trans (normal_sub nsHG) (normal_norm nsKG)). wlog suffices: H K {maxH} maxK nsHG nsKG cHK ltHK_G / H \subset K. by move=> IH; rewrite eqEsubset !IH // -cHK. have{maxK} /maxgroupP[_ maxK] := maxK. apply/joing_idPr/maxK; rewrite ?joing_subr //= comm_joingE //. by rewrite properEneq ltHK_G; apply: normalM. Qed. Lemma maxnormal_minnormal G L M : G \subset 'N(M) -> L \subset 'N(G) -> maxnormal M G L -> minnormal (G / M) (L / M). Proof. move=> nMG nGL /maxgroupP[/andP[/andP[sMG ltMG] nML] maxM]; apply/mingroupP. rewrite -subG1 quotient_sub1 ?ltMG ?quotient_norms //. split=> // Hb /andP[ntHb nHbL]; have nsMG: M <| G by apply/andP. case/inv_quotientS=> // H defHb sMH sHG; rewrite defHb; congr (_ / M). apply/eqP; rewrite eqEproper sHG /=; apply: contra ntHb => ltHG. have nsMH: M <| H := normalS sMH sHG nsMG. rewrite defHb quotientS1 // (maxM H) // ltHG /= -(quotientGK nsMH) -defHb. exact: norm_quotient_pre. Qed. Lemma minnormal_maxnormal G L M : M <| G -> L \subset 'N(M) -> minnormal (G / M) (L / M) -> maxnormal M G L. Proof. case/andP=> sMG nMG nML /mingroupP[/andP[/= ntGM _] minGM]; apply/maxgroupP. split=> [|H /andP[/andP[sHG ltHG] nHL] sMH]. by rewrite /proper sMG nML andbT; apply: contra ntGM => /quotientS1 ->. apply/eqP; rewrite eqEsubset sMH andbT -quotient_sub1 ?(subset_trans sHG) //. rewrite subG1; apply: contraR ltHG => ntHM; rewrite -(quotientSGK nMG) //. by rewrite (minGM (H / M)%G) ?quotientS // ntHM quotient_norms. Qed. End MaxNormalProps. Section Simple. Implicit Types gT rT : finGroupType. Lemma simpleP gT (G : {group gT}) : reflect (G :!=: 1 /\ forall H : {group gT}, H <| G -> H :=: 1 \/ H :=: G) (simple G). Proof. apply: (iffP mingroupP); rewrite normG andbT => [[ntG simG]]. split=> // N /andP[sNG nNG]. by case: (eqsVneq N 1) => [|ntN]; [left | right; apply: simG; rewrite ?ntN]. split=> // N /andP[ntN nNG] sNG. by case: (simG N) ntN => // [|->]; [apply/andP | case/eqP]. Qed. Lemma quotient_simple gT (G H : {group gT}) : H <| G -> simple (G / H) = maxnormal H G G. Proof. move=> nsHG; have nGH := normal_norm nsHG. by apply/idP/idP; [apply: minnormal_maxnormal | apply: maxnormal_minnormal]. Qed. Lemma isog_simple gT rT (G : {group gT}) (M : {group rT}) : G \isog M -> simple G = simple M. Proof. move=> eqGM; wlog suffices: gT rT G M eqGM / simple M -> simple G. by move=> IH; apply/idP/idP; apply: IH; rewrite // isog_sym. case/isogP: eqGM => f injf <- /simpleP[ntGf simGf]. apply/simpleP; split=> [|N nsNG]; first by rewrite -(morphim_injm_eq1 injf). rewrite -(morphim_invm injf (normal_sub nsNG)). have: f @* N <| f @* G by rewrite morphim_normal. by case/simGf=> /= ->; [left | right]; rewrite (morphim1, morphim_invm). Qed. Lemma simple_maxnormal gT (G : {group gT}) : simple G = maxnormal 1 G G. Proof. by rewrite -quotient_simple ?normal1 // -(isog_simple (quotient1_isog G)). Qed. End Simple. Section Chiefs. Variable gT : finGroupType. Implicit Types G H U V : {group gT}. Lemma chief_factor_minnormal G V U : chief_factor G V U -> minnormal (U / V) (G / V). Proof. case/andP=> maxV /andP[sUG nUG]; apply: maxnormal_minnormal => //. by have /andP[_ nVG] := maxgroupp maxV; apply: subset_trans sUG nVG. Qed. Lemma acts_irrQ G U V : G \subset 'N(V) -> V <| U -> acts_irreducibly G (U / V) 'Q = minnormal (U / V) (G / V). Proof. move=> nVG nsVU; apply/mingroupP/mingroupP; case=> /andP[->] /=. rewrite astabsQ // subsetI nVG /= => nUG minUV. rewrite quotient_norms //; split=> // H /andP[ntH nHG] sHU. by apply: minUV (sHU); rewrite ntH -(cosetpreK H) actsQ // norm_quotient_pre. rewrite sub_quotient_pre // => nUG minU; rewrite astabsQ //. rewrite (subset_trans nUG); last first. by rewrite subsetI subsetIl /= -{2}(quotientGK nsVU) morphpre_norm. split=> // H /andP[ntH nHG] sHU. rewrite -{1}(cosetpreK H) astabsQ ?normal_cosetpre ?subsetI ?nVG //= in nHG. apply: minU sHU; rewrite ntH; apply: subset_trans (quotientS _ nHG) _. by rewrite -{2}(cosetpreK H) quotient_norm. Qed. Lemma chief_series_exists H G : H <| G -> {s | (G.-chief).-series 1%G s & last 1%G s = H}. Proof. have [m] := ubnP #|H|; elim: m H => // m IHm U leUm nsUG. have [-> | ntU] := eqVneq U 1%G; first by exists [::]. have [V maxV]: {V : {group gT} | maxnormal V U G}. by apply: ex_maxgroup; exists 1%G; rewrite proper1G ntU norms1. have /andP[ltVU nVG] := maxgroupp maxV. have [||s ch_s defV] := IHm V; first exact: leq_trans (proper_card ltVU) _. by rewrite /normal (subset_trans (proper_sub ltVU) (normal_sub nsUG)). exists (rcons s U); last by rewrite last_rcons. by rewrite rcons_path defV /= ch_s /chief_factor; apply/and3P. Qed. End Chiefs. Section Central. Variables (gT : finGroupType) (G : {group gT}). Implicit Types H K : {group gT}. Lemma central_factor_central H K : central_factor G H K -> (K / H) \subset 'Z(G / H). Proof. by case/and3P=> /quotient_cents2r *; rewrite subsetI quotientS. Qed. Lemma central_central_factor H K : (K / H) \subset 'Z(G / H) -> H <| K -> H <| G -> central_factor G H K. Proof. case/subsetIP=> sKGb cGKb /andP[sHK nHK] /andP[sHG nHG]. by rewrite /central_factor -quotient_cents2 // cGKb sHK -(quotientSGK nHK). Qed. End Central. math-comp-mathcomp-1.12.0/mathcomp/solvable/hall.v000066400000000000000000001226521375767750300220500ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype finset prime fingroup morphism. From mathcomp Require Import automorphism quotient action gproduct gfunctor. From mathcomp Require Import commutator center pgroup finmodule nilpotent. From mathcomp Require Import sylow abelian maximal. (*****************************************************************************) (* In this files we prove the Schur-Zassenhaus splitting and transitivity *) (* theorems (under solvability assumptions), then derive P. Hall's *) (* generalization of Sylow's theorem to solvable groups and its corollaries, *) (* in particular the theory of coprime action. We develop both the theory of *) (* coprime action of a solvable group on Sylow subgroups (as in Aschbacher *) (* 18.7), and that of coprime action on Hall subgroups of a solvable group *) (* as per B & G, Proposition 1.5; however we only support external group *) (* action (as opposed to internal action by conjugation) for the latter case *) (* because it is much harder to apply in practice. *) (*****************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Hall. Implicit Type gT : finGroupType. Theorem SchurZassenhaus_split gT (G H : {group gT}) : Hall G H -> H <| G -> [splits G, over H]. Proof. have [n] := ubnP #|G|; elim: n => // n IHn in gT G H * => /ltnSE-Gn hallH nsHG. have [sHG nHG] := andP nsHG. have [-> | [p pr_p pH]] := trivgVpdiv H. by apply/splitsP; exists G; rewrite inE -subG1 subsetIl mul1g eqxx. have [P sylP] := Sylow_exists p H. case nPG: (P <| G); last first. pose N := ('N_G(P))%G; have sNG: N \subset G by rewrite subsetIl. have eqHN_G: H * N = G by apply: Frattini_arg sylP. pose H' := (H :&: N)%G. have nsH'N: H' <| N. by rewrite /normal subsetIr normsI ?normG ?(subset_trans sNG). have eq_iH: #|G : H| = #|N| %/ #|H'|. rewrite -divgS // -(divnMl (cardG_gt0 H')) mulnC -eqHN_G. by rewrite -mul_cardG (mulnC #|H'|) divnMl // cardG_gt0. have hallH': Hall N H'. rewrite /Hall -divgS subsetIr //= -eq_iH. by case/andP: hallH => _; apply: coprimeSg; apply: subsetIl. have: [splits N, over H']. apply: IHn hallH' nsH'N; apply: {n}leq_trans Gn. rewrite proper_card // properEneq sNG andbT; apply/eqP=> eqNG. by rewrite -eqNG normal_subnorm (subset_trans (pHall_sub sylP)) in nPG. case/splitsP=> K /complP[tiKN eqH'K]. have sKN: K \subset N by rewrite -(mul1g K) -eqH'K mulSg ?sub1set. apply/splitsP; exists K; rewrite inE -subG1; apply/andP; split. by rewrite /= -(setIidPr sKN) setIA tiKN. by rewrite eqEsubset -eqHN_G mulgS // -eqH'K mulGS mulSg ?subsetIl. pose Z := 'Z(P); pose Gbar := G / Z; pose Hbar := H / Z. have sZP: Z \subset P by apply: center_sub. have sZH: Z \subset H by apply: subset_trans (pHall_sub sylP). have sZG: Z \subset G by apply: subset_trans sHG. have nZG: Z <| G by apply: gFnormal_trans nPG. have nZH: Z <| H by apply: normalS nZG. have nHGbar: Hbar <| Gbar by apply: morphim_normal. have hallHbar: Hall Gbar Hbar by apply: morphim_Hall (normal_norm _) _. have: [splits Gbar, over Hbar]. apply: IHn => //; apply: {n}leq_trans Gn; rewrite ltn_quotient //. apply/eqP=> /(trivg_center_pgroup (pHall_pgroup sylP))/eqP. rewrite trivg_card1 (card_Hall sylP) p_part -(expn0 p). by rewrite eqn_exp2l ?prime_gt1 // lognE pH pr_p cardG_gt0. case/splitsP=> Kbar /complP[tiHKbar eqHKbar]. have: Kbar \subset Gbar by rewrite -eqHKbar mulG_subr. case/inv_quotientS=> //= ZK quoZK sZZK sZKG. have nZZK: Z <| ZK by apply: normalS nZG. have cardZK: #|ZK| = (#|Z| * #|G : H|)%N. rewrite -(Lagrange sZZK); congr (_ * _)%N. rewrite -card_quotient -?quoZK; last by case/andP: nZZK. rewrite -(divgS sHG) -(Lagrange sZG) -(Lagrange sZH) divnMl //. rewrite -!card_quotient ?normal_norm //= -/Gbar -/Hbar. by rewrite -eqHKbar (TI_cardMg tiHKbar) mulKn. have: [splits ZK, over Z]. rewrite (Gaschutz_split nZZK _ sZZK) ?center_abelian //; last first. rewrite -divgS // cardZK mulKn ?cardG_gt0 //. by case/andP: hallH => _; apply: coprimeSg. by apply/splitsP; exists 1%G; rewrite inE -subG1 subsetIr mulg1 eqxx. case/splitsP=> K /complP[tiZK eqZK]. have sKZK: K \subset ZK by rewrite -(mul1g K) -eqZK mulSg ?sub1G. have tiHK: H :&: K = 1. apply/trivgP; rewrite /= -(setIidPr sKZK) setIA -tiZK setSI //. rewrite -quotient_sub1; last by rewrite subIset 1?normal_norm. by rewrite /= quotientGI //= -quoZK tiHKbar. apply/splitsP; exists K; rewrite inE tiHK ?eqEcard subxx leqnn /=. rewrite mul_subG ?(subset_trans sKZK) //= TI_cardMg //. rewrite -(@mulKn #|K| #|Z|) ?cardG_gt0 // -TI_cardMg // eqZK. by rewrite cardZK mulKn ?cardG_gt0 // Lagrange. Qed. Theorem SchurZassenhaus_trans_sol gT (H K K1 : {group gT}) : solvable H -> K \subset 'N(H) -> K1 \subset H * K -> coprime #|H| #|K| -> #|K1| = #|K| -> exists2 x, x \in H & K1 :=: K :^ x. Proof. have [n] := ubnP #|H|. elim: n => // n IHn in gT H K K1 * => /ltnSE-leHn solH nHK. have [-> | ] := eqsVneq H 1. rewrite mul1g => sK1K _ eqK1K; exists 1; first exact: set11. by apply/eqP; rewrite conjsg1 eqEcard sK1K eqK1K /=. pose G := (H <*> K)%G. have defG: G :=: H * K by rewrite -normC // -norm_joinEl // joingC. have sHG: H \subset G by apply: joing_subl. have sKG: K \subset G by apply: joing_subr. have nsHG: H <| G by rewrite /(H <| G) sHG join_subG normG. case/(solvable_norm_abelem solH nsHG)=> M [sMH nsMG ntM] /and3P[_ abelM _]. have [sMG nMG] := andP nsMG; rewrite -defG => sK1G coHK oK1K. have nMsG (L : {set gT}): L \subset G -> L \subset 'N(M). by move/subset_trans->. have [coKM coHMK]: coprime #|M| #|K| /\ coprime #|H / M| #|K|. by apply/andP; rewrite -coprimeMl card_quotient ?nMsG ?Lagrange. have oKM (K' : {group gT}): K' \subset G -> #|K'| = #|K| -> #|K' / M| = #|K|. move=> sK'G oK'. rewrite -quotientMidr -?norm_joinEl ?card_quotient ?nMsG //; last first. by rewrite gen_subG subUset sK'G. rewrite -divgS /=; last by rewrite -gen_subG genS ?subsetUr. by rewrite norm_joinEl ?nMsG // coprime_cardMg ?mulnK // oK' coprime_sym. have [xb]: exists2 xb, xb \in H / M & K1 / M = (K / M) :^ xb. apply: IHn; try by rewrite (quotient_sol, morphim_norms, oKM K) ?(oKM K1). by apply: leq_trans leHn; rewrite ltn_quotient. by rewrite -morphimMl ?nMsG // -defG morphimS. case/morphimP=> x nMx Hx ->{xb} eqK1Kx; pose K2 := (K :^ x)%G. have{eqK1Kx} eqK12: K1 / M = K2 / M by rewrite quotientJ. suff [y My ->]: exists2 y, y \in M & K1 :=: K2 :^ y. by exists (x * y); [rewrite groupMl // (subsetP sMH) | rewrite conjsgM]. have nMK1: K1 \subset 'N(M) by apply: nMsG. have defMK: M * K1 = M <*> K1 by rewrite -normC // -norm_joinEl // joingC. have sMKM: M \subset M <*> K1 by rewrite joing_subl. have nMKM: M <| M <*> K1 by rewrite normalYl. have trMK1: M :&: K1 = 1 by rewrite coprime_TIg ?oK1K. have trMK2: M :&: K2 = 1 by rewrite coprime_TIg ?cardJg ?oK1K. apply: (Gaschutz_transitive nMKM _ sMKM) => //=; last 2 first. - by rewrite inE trMK1 defMK !eqxx. - by rewrite -!(setIC M) trMK1. - by rewrite -divgS //= -defMK coprime_cardMg oK1K // mulKn. rewrite inE trMK2 eqxx eq_sym eqEcard /= -defMK andbC. by rewrite !coprime_cardMg ?cardJg ?oK1K ?leqnn //= mulGS -quotientSK -?eqK12. Qed. Lemma SchurZassenhaus_trans_actsol gT (G A B : {group gT}) : solvable A -> A \subset 'N(G) -> B \subset A <*> G -> coprime #|G| #|A| -> #|A| = #|B| -> exists2 x, x \in G & B :=: A :^ x. Proof. set AG := A <*> G; have [n] := ubnP #|AG|. elim: n => // n IHn in gT A B G AG * => /ltnSE-leAn solA nGA sB_AG coGA oAB. have [A1 | ntA] := eqsVneq A 1. by exists 1; rewrite // conjsg1 A1 (@card1_trivg _ B) // -oAB A1 cards1. have [M [sMA nsMA ntM]] := solvable_norm_abelem solA (normal_refl A) ntA. case/is_abelemP=> q q_pr /abelem_pgroup qM; have nMA := normal_norm nsMA. have defAG: AG = A * G := norm_joinEl nGA. have sA_AG: A \subset AG := joing_subl _ _. have sG_AG: G \subset AG := joing_subr _ _. have sM_AG := subset_trans sMA sA_AG. have oAG: #|AG| = (#|A| * #|G|)%N by rewrite defAG coprime_cardMg 1?coprime_sym. have q'G: #|G|`_q = 1%N. rewrite part_p'nat ?p'natE -?prime_coprime // coprime_sym. have [_ _ [k oM]] := pgroup_pdiv qM ntM. by rewrite -(@coprime_pexpr k.+1) // -oM (coprimegS sMA). have coBG: coprime #|B| #|G| by rewrite -oAB coprime_sym. have defBG: B * G = AG. by apply/eqP; rewrite eqEcard mul_subG ?sG_AG //= oAG oAB coprime_cardMg. case nMG: (G \subset 'N(M)). have nsM_AG: M <| AG by rewrite /normal sM_AG join_subG nMA. have nMB: B \subset 'N(M) := subset_trans sB_AG (normal_norm nsM_AG). have sMB: M \subset B. have [Q sylQ]:= Sylow_exists q B; have sQB := pHall_sub sylQ. apply: subset_trans (normal_sub_max_pgroup (Hall_max _) qM nsM_AG) (sQB). rewrite pHallE (subset_trans sQB) //= oAG partnM // q'G muln1 oAB. by rewrite (card_Hall sylQ). have defAGq: AG / M = (A / M) <*> (G / M). by rewrite quotient_gen ?quotientU ?subUset ?nMA. have: B / M \subset (A / M) <*> (G / M) by rewrite -defAGq quotientS. case/IHn; rewrite ?morphim_sol ?quotient_norms ?coprime_morph //. - by rewrite -defAGq (leq_trans _ leAn) ?ltn_quotient. - by rewrite !card_quotient // -!divgS // oAB. move=> Mx; case/morphimP=> x Nx Gx ->{Mx} //; rewrite -quotientJ //= => defBq. exists x => //; apply: quotient_inj defBq; first by rewrite /normal sMB. by rewrite -(normsP nMG x Gx) /normal normJ !conjSg. pose K := M <*> G; pose R := K :&: B; pose N := 'N_G(M). have defK: K = M * G by rewrite -norm_joinEl ?(subset_trans sMA). have oK: #|K| = (#|M| * #|G|)%N. by rewrite defK coprime_cardMg // coprime_sym (coprimegS sMA). have sylM: q.-Sylow(K) M. by rewrite pHallE joing_subl /= oK partnM // q'G muln1 part_pnat_id. have sylR: q.-Sylow(K) R. rewrite pHallE subsetIl /= -(card_Hall sylM) -(@eqn_pmul2r #|G|) // -oK. rewrite -coprime_cardMg ?(coprimeSg _ coBG) ?subsetIr //=. by rewrite group_modr ?joing_subr ?(setIidPl _) // defBG join_subG sM_AG. have [mx] := Sylow_trans sylM sylR. rewrite /= -/K defK; case/imset2P=> m x Mm Gx ->{mx}. rewrite conjsgM conjGid {m Mm}// => defR. have sNG: N \subset G := subsetIl _ _. have pNG: N \proper G by rewrite /proper sNG subsetI subxx nMG. have nNA: A \subset 'N(N) by rewrite normsI ?norms_norm. have: B :^ x^-1 \subset A <*> N. rewrite norm_joinEl ?group_modl // -defAG subsetI !sub_conjgV -normJ -defR. rewrite conjGid ?(subsetP sG_AG) // normsI ?normsG // (subset_trans sB_AG) //. by rewrite join_subG normsM // -defK normsG ?joing_subr. do [case/IHn; rewrite ?cardJg ?(coprimeSg _ coGA) //= -/N] => [|y Ny defB]. rewrite joingC norm_joinEr // coprime_cardMg ?(coprimeSg sNG) //. by rewrite (leq_trans _ leAn) // oAG mulnC ltn_pmul2l // proper_card. exists (y * x); first by rewrite groupM // (subsetP sNG). by rewrite conjsgM -defB conjsgKV. Qed. Lemma Hall_exists_subJ pi gT (G : {group gT}) : solvable G -> exists2 H : {group gT}, pi.-Hall(G) H & forall K : {group gT}, K \subset G -> pi.-group K -> exists2 x, x \in G & K \subset H :^ x. Proof. have [n] := ubnP #|G|; elim: n gT G => // n IHn gT G /ltnSE-leGn solG. have [-> | ntG] := eqsVneq G 1. exists 1%G => [|_ /trivGP-> _]; last by exists 1; rewrite ?set11 ?sub1G. by rewrite pHallE sub1G cards1 part_p'nat. case: (solvable_norm_abelem solG (normal_refl _)) => // M [sMG nsMG ntM]. case/is_abelemP=> p pr_p /and3P[pM cMM _]. pose Gb := (G / M)%G; case: (IHn _ Gb) => [||Hb]; try exact: quotient_sol. by rewrite (leq_trans (ltn_quotient _ _)). case/and3P=> [sHbGb piHb pi'Hb'] transHb. case: (inv_quotientS nsMG sHbGb) => H def_H sMH sHG. have nMG := normal_norm nsMG; have nMH := subset_trans sHG nMG. have{transHb} transH (K : {group gT}): K \subset G -> pi.-group K -> exists2 x, x \in G & K \subset H :^ x. - move=> sKG piK; have nMK := subset_trans sKG nMG. case: (transHb (K / M)%G) => [||xb Gxb sKHxb]; first exact: morphimS. exact: morphim_pgroup. case/morphimP: Gxb => x Nx Gx /= def_x; exists x => //. apply/subsetP=> y Ky. have: y \in coset M y by rewrite val_coset (subsetP nMK, rcoset_refl). have: coset M y \in (H :^ x) / M. rewrite /quotient morphimJ //=. by rewrite def_x def_H in sKHxb; apply/(subsetP sKHxb)/mem_quotient. case/morphimP=> z Nz Hxz ->. rewrite val_coset //; case/rcosetP=> t Mt ->; rewrite groupMl //. by rewrite mem_conjg (subsetP sMH) // -mem_conjg (normP Nx). have{pi'Hb'} pi'H': pi^'.-nat #|G : H|. move: pi'Hb'; rewrite -!divgS // def_H !card_quotient //. by rewrite -(divnMl (cardG_gt0 M)) !Lagrange. have [pi_p | pi'p] := boolP (p \in pi). exists H => //; apply/and3P; split=> //; rewrite /pgroup. by rewrite -(Lagrange sMH) -card_quotient // pnatM -def_H (pi_pnat pM). have [ltHG | leGH {n IHn leGn transH}] := ltnP #|H| #|G|. case: (IHn _ H (leq_trans ltHG leGn)) => [|H1]; first exact: solvableS solG. case/and3P=> sH1H piH1 pi'H1' transH1. have sH1G: H1 \subset G by apply: subset_trans sHG. exists H1 => [|K sKG piK]. apply/and3P; split => //. rewrite -divgS // -(Lagrange sHG) -(Lagrange sH1H) -mulnA. by rewrite mulKn // pnatM pi'H1'. case: (transH K sKG piK) => x Gx def_K. case: (transH1 (K :^ x^-1)%G) => [||y Hy def_K1]. - by rewrite sub_conjgV. - by rewrite /pgroup cardJg. exists (y * x); first by rewrite groupMr // (subsetP sHG). by rewrite -(conjsgKV x K) conjsgM conjSg. have{leGH Gb sHbGb sHG sMH pi'H'} eqHG: H = G. by apply/eqP; rewrite -val_eqE eqEcard sHG. have{H Hb def_H eqHG piHb nMH} hallM: pi^'.-Hall(G) M. rewrite /pHall /pgroup sMG pnatNK -card_quotient //=. by rewrite -eqHG -def_H (pi_pnat pM). case/splitsP: (SchurZassenhaus_split (pHall_Hall hallM) nsMG) => H. case/complP=> trMH defG. have sHG: H \subset G by rewrite -defG mulG_subr. exists H => [|K sKG piK]. apply: etrans hallM; rewrite /pHall sMG sHG /= -!divgS // -defG andbC. by rewrite (TI_cardMg trMH) mulKn ?mulnK // pnatNK. pose G1 := (K <*> M)%G; pose K1 := (H :&: G1)%G. have nMK: K \subset 'N(M) by apply: subset_trans sKG nMG. have defG1: M * K = G1 by rewrite -normC -?norm_joinEl. have sK1G1: K1 \subset M * K by rewrite defG1 subsetIr. have coMK: coprime #|M| #|K|. by rewrite coprime_sym (pnat_coprime piK) //; apply: (pHall_pgroup hallM). case: (SchurZassenhaus_trans_sol _ nMK sK1G1 coMK) => [||x Mx defK1]. - exact: solvableS solG. - apply/eqP; rewrite -(eqn_pmul2l (cardG_gt0 M)) -TI_cardMg //; last first. by apply/trivgP; rewrite -trMH /= setIA subsetIl. rewrite -coprime_cardMg // defG1; apply/eqP; congr #|(_ : {set _})|. rewrite group_modl; last by rewrite -defG1 mulG_subl. by apply/setIidPr; rewrite defG gen_subG subUset sKG. exists x^-1; first by rewrite groupV (subsetP sMG). by rewrite -(_ : K1 :^ x^-1 = K) ?(conjSg, subsetIl) // defK1 conjsgK. Qed. End Hall. Section HallCorollaries. Variable gT : finGroupType. Corollary Hall_exists pi (G : {group gT}) : solvable G -> exists H : {group gT}, pi.-Hall(G) H. Proof. by case/(Hall_exists_subJ pi) => H; exists H. Qed. Corollary Hall_trans pi (G H1 H2 : {group gT}) : solvable G -> pi.-Hall(G) H1 -> pi.-Hall(G) H2 -> exists2 x, x \in G & H1 :=: H2 :^ x. Proof. move=> solG; have [H hallH transH] := Hall_exists_subJ pi solG. have conjH (K : {group gT}): pi.-Hall(G) K -> exists2 x, x \in G & K = (H :^ x)%G. - move=> hallK; have [sKG piK _] := and3P hallK. case: (transH K sKG piK) => x Gx sKH; exists x => //. apply/eqP; rewrite -val_eqE eqEcard sKH cardJg. by rewrite (card_Hall hallH) (card_Hall hallK) /=. case/conjH=> x1 Gx1 ->{H1}; case/conjH=> x2 Gx2 ->{H2}. exists (x2^-1 * x1); first by rewrite groupMl ?groupV. by apply: val_inj; rewrite /= conjsgM conjsgK. Qed. Corollary Hall_superset pi (G K : {group gT}) : solvable G -> K \subset G -> pi.-group K -> exists2 H : {group gT}, pi.-Hall(G) H & K \subset H. Proof. move=> solG sKG; have [H hallH transH] := Hall_exists_subJ pi solG. by case/transH=> // x Gx sKHx; exists (H :^ x)%G; rewrite ?pHallJ. Qed. Corollary Hall_subJ pi (G H K : {group gT}) : solvable G -> pi.-Hall(G) H -> K \subset G -> pi.-group K -> exists2 x, x \in G & K \subset H :^ x. Proof. move=> solG HallH sKG piK; have [M HallM sKM]:= Hall_superset solG sKG piK. have [x Gx defM] := Hall_trans solG HallM HallH. by exists x; rewrite // -defM. Qed. Corollary Hall_Jsub pi (G H K : {group gT}) : solvable G -> pi.-Hall(G) H -> K \subset G -> pi.-group K -> exists2 x, x \in G & K :^ x \subset H. Proof. move=> solG HallH sKG piK; have [x Gx sKHx] := Hall_subJ solG HallH sKG piK. by exists x^-1; rewrite ?groupV // sub_conjgV. Qed. Lemma Hall_Frattini_arg pi (G K H : {group gT}) : solvable K -> K <| G -> pi.-Hall(K) H -> K * 'N_G(H) = G. Proof. move=> solK /andP[sKG nKG] hallH. have sHG: H \subset G by apply: subset_trans sKG; case/andP: hallH. rewrite setIC group_modl //; apply/setIidPr/subsetP=> x Gx. pose H1 := (H :^ x^-1)%G. have hallH1: pi.-Hall(K) H1 by rewrite pHallJnorm // groupV (subsetP nKG). case: (Hall_trans solK hallH hallH1) => y Ky defH. rewrite -(mulKVg y x) mem_mulg //; apply/normP. by rewrite conjsgM {1}defH conjsgK conjsgKV. Qed. End HallCorollaries. Section InternalAction. Variables (pi : nat_pred) (gT : finGroupType). Implicit Types G H K A X : {group gT}. (* Part of Aschbacher (18.7.4). *) Lemma coprime_norm_cent A G : A \subset 'N(G) -> coprime #|G| #|A| -> 'N_G(A) = 'C_G(A). Proof. move=> nGA coGA; apply/eqP; rewrite eqEsubset andbC setIS ?cent_sub //=. rewrite subsetI subsetIl /= (sameP commG1P trivgP) -(coprime_TIg coGA). rewrite subsetI commg_subr subsetIr andbT. move: nGA; rewrite -commg_subl; apply: subset_trans. by rewrite commSg ?subsetIl. Qed. (* This is B & G, Proposition 1.5(a) *) Proposition coprime_Hall_exists A G : A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> exists2 H : {group gT}, pi.-Hall(G) H & A \subset 'N(H). Proof. move=> nGA coGA solG; have [H hallH] := Hall_exists pi solG. have sG_AG: G \subset A <*> G by rewrite joing_subr. have nG_AG: A <*> G \subset 'N(G) by rewrite join_subG nGA normG. pose N := 'N_(A <*> G)(H)%G. have nGN: N \subset 'N(G) by rewrite subIset ?nG_AG. have nGN_N: G :&: N <| N by rewrite /(_ <| N) subsetIr normsI ?normG. have NG_AG: G * N = A <*> G. by apply: Hall_Frattini_arg hallH => //; apply/andP. have iGN_A: #|N| %/ #|G :&: N| = #|A|. rewrite setIC divgI -card_quotient // -quotientMidl NG_AG. rewrite card_quotient -?divgS //= norm_joinEl //. by rewrite coprime_cardMg 1?coprime_sym // mulnK. have hallGN: Hall N (G :&: N). by rewrite /Hall -divgS subsetIr //= iGN_A (coprimeSg _ coGA) ?subsetIl. case/splitsP: {hallGN nGN_N}(SchurZassenhaus_split hallGN nGN_N) => B. case/complP=> trBGN defN. have{trBGN iGN_A} oBA: #|B| = #|A|. by rewrite -iGN_A -{1}defN (TI_cardMg trBGN) mulKn. have sBN: B \subset N by rewrite -defN mulG_subr. case: (SchurZassenhaus_trans_sol solG nGA _ coGA oBA) => [|x Gx defB]. by rewrite -(normC nGA) -norm_joinEl // -NG_AG -(mul1g B) mulgSS ?sub1G. exists (H :^ x^-1)%G; first by rewrite pHallJ ?groupV. apply/subsetP=> y Ay; have: y ^ x \in B by rewrite defB memJ_conjg. move/(subsetP sBN)=> /setIP[_ /normP nHyx]. by apply/normP; rewrite -conjsgM conjgCV invgK conjsgM nHyx. Qed. (* This is B & G, Proposition 1.5(c) *) Proposition coprime_Hall_trans A G H1 H2 : A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> pi.-Hall(G) H1 -> A \subset 'N(H1) -> pi.-Hall(G) H2 -> A \subset 'N(H2) -> exists2 x, x \in 'C_G(A) & H1 :=: H2 :^ x. Proof. move: H1 => H nGA coGA solG hallH nHA hallH2. have{H2 hallH2} [x Gx -> nH1xA] := Hall_trans solG hallH2 hallH. have sG_AG: G \subset A <*> G by rewrite -{1}genGid genS ?subsetUr. have nG_AG: A <*> G \subset 'N(G) by rewrite gen_subG subUset nGA normG. pose N := 'N_(A <*> G)(H)%G. have nGN: N \subset 'N(G) by rewrite subIset ?nG_AG. have nGN_N: G :&: N <| N. apply/normalP; rewrite subsetIr; split=> // y Ny. by rewrite conjIg (normP _) // (subsetP nGN, conjGid). have NG_AG : G * N = A <*> G. by apply: Hall_Frattini_arg hallH => //; apply/andP. have iGN_A: #|N : G :&: N| = #|A|. rewrite -card_quotient //; last by case/andP: nGN_N. rewrite (card_isog (second_isog nGN)) /= -quotientMidr (normC nGN) NG_AG. rewrite card_quotient // -divgS //= joingC norm_joinEr //. by rewrite coprime_cardMg // mulnC mulnK. have solGN: solvable (G :&: N) by apply: solvableS solG; apply: subsetIl. have oAxA: #|A :^ x^-1| = #|A| by apply: cardJg. have sAN: A \subset N by rewrite subsetI -{1}genGid genS // subsetUl. have nGNA: A \subset 'N(G :&: N). by apply/normsP=> y ?; rewrite conjIg (normsP nGA) ?(conjGid, subsetP sAN). have coGNA: coprime #|G :&: N| #|A| := coprimeSg (subsetIl _ _) coGA. case: (SchurZassenhaus_trans_sol solGN nGNA _ coGNA oAxA) => [|y GNy defAx]. have ->: (G :&: N) * A = N. apply/eqP; rewrite eqEcard -{2}(mulGid N) mulgSS ?subsetIr //=. by rewrite coprime_cardMg // -iGN_A Lagrange ?subsetIr. rewrite sub_conjgV conjIg -normJ subsetI conjGid ?joing_subl //. by rewrite mem_gen // inE Gx orbT. case/setIP: GNy => Gy; case/setIP=> _; move/normP=> nHy. exists (y * x)^-1. rewrite -coprime_norm_cent // groupV inE groupM //=; apply/normP. by rewrite conjsgM -defAx conjsgKV. by apply: val_inj; rewrite /= -{2}nHy -(conjsgM _ y) conjsgK. Qed. (* A complement to the above: 'C(A) acts on 'Nby(A) *) Lemma norm_conj_cent A G x : x \in 'C(A) -> (A \subset 'N(G :^ x)) = (A \subset 'N(G)). Proof. by move=> cAx; rewrite norm_conj_norm ?(subsetP (cent_sub A)). Qed. (* Strongest version of the centraliser lemma -- not found in textbooks! *) (* Obviously, the solvability condition could be removed once we have the *) (* Odd Order Theorem. *) Lemma strongest_coprime_quotient_cent A G H : let R := H :&: [~: G, A] in A \subset 'N(H) -> R \subset G -> coprime #|R| #|A| -> solvable R || solvable A -> 'C_G(A) / H = 'C_(G / H)(A / H). Proof. move=> R nHA sRG coRA solRA. have nRA: A \subset 'N(R) by rewrite normsI ?commg_normr. apply/eqP; rewrite eqEsubset subsetI morphimS ?subsetIl //=. rewrite (subset_trans _ (morphim_cent _ _)) ?morphimS ?subsetIr //=. apply/subsetP=> _ /setIP[/morphimP[x Nx Gx ->] cAHx]. have{cAHx} cAxR y: y \in A -> [~ x, y] \in R. move=> Ay; have Ny: y \in 'N(H) by apply: subsetP Ay. rewrite inE mem_commg // andbT coset_idr ?groupR // morphR //=. by apply/eqP; apply/commgP; apply: (centP cAHx); rewrite mem_quotient. have AxRA: A :^ x \subset R * A. apply/subsetP=> _ /imsetP[y Ay ->]. rewrite -normC // -(mulKVg y (y ^ x)) -commgEl mem_mulg //. by rewrite -groupV invg_comm cAxR. have [y Ry def_Ax]: exists2 y, y \in R & A :^ x = A :^ y. have oAx: #|A :^ x| = #|A| by rewrite cardJg. have [solR | solA] := orP solRA; first exact: SchurZassenhaus_trans_sol. by apply: SchurZassenhaus_trans_actsol; rewrite // joingC norm_joinEr. rewrite -imset_coset; apply/imsetP; exists (x * y^-1); last first. by rewrite conjgCV mkerl // ker_coset memJ_norm groupV; case/setIP: Ry. rewrite /= inE groupMl // ?(groupV, subsetP sRG) //=. apply/centP=> z Az; apply/commgP/eqP/set1P. rewrite -[[set 1]](coprime_TIg coRA) inE {1}commgEl commgEr /= -/R. rewrite invMg -mulgA invgK groupMl // conjMg mulgA -commgEl. rewrite groupMl ?cAxR // memJ_norm ?(groupV, subsetP nRA) // Ry /=. by rewrite groupMr // conjVg groupV conjgM -mem_conjg -def_Ax memJ_conjg. Qed. (* A weaker but more practical version, still stronger than the usual form *) (* (viz. Aschbacher 18.7.4), similar to the one needed in Aschbacher's *) (* proof of Thompson factorization. Note that the coprime and solvability *) (* assumptions could be further weakened to H :&: G (and hence become *) (* trivial if H and G are TI). However, the assumption that A act on G is *) (* needed in this case. *) Lemma coprime_norm_quotient_cent A G H : A \subset 'N(G) -> A \subset 'N(H) -> coprime #|H| #|A| -> solvable H -> 'C_G(A) / H = 'C_(G / H)(A / H). Proof. move=> nGA nHA coHA solH; have sRH := subsetIl H [~: G, A]. rewrite strongest_coprime_quotient_cent ?(coprimeSg sRH) 1?(solvableS sRH) //. by rewrite subIset // commg_subl nGA orbT. Qed. (* A useful consequence (similar to Ex. 6.1 in Aschbacher) of the stronger *) (* theorem. *) Lemma coprime_cent_mulG A G H : A \subset 'N(G) -> A \subset 'N(H) -> G \subset 'N(H) -> coprime #|H| #|A| -> solvable H -> 'C_(H * G)(A) = 'C_H(A) * 'C_G(A). Proof. move=> nHA nGA nHG coHA solH; rewrite -norm_joinEr //. have nsHG: H <| H <*> G by rewrite /normal joing_subl join_subG normG. rewrite -{2}(setIidPr (normal_sub nsHG)) setIAC. rewrite group_modr ?setSI ?joing_subr //=; symmetry; apply/setIidPl. rewrite -quotientSK ?subIset 1?normal_norm //. by rewrite !coprime_norm_quotient_cent ?normsY //= norm_joinEr ?quotientMidl. Qed. (* Another special case of the strong coprime quotient lemma; not found in *) (* textbooks, but nevertheless used implicitly throughout B & G, sometimes *) (* justified by switching to external action. *) Lemma quotient_TI_subcent K G H : G \subset 'N(K) -> G \subset 'N(H) -> K :&: H = 1 -> 'C_K(G) / H = 'C_(K / H)(G / H). Proof. move=> nGK nGH tiKH. have tiHR: H :&: [~: K, G] = 1. by apply/trivgP; rewrite /= setIC -tiKH setSI ?commg_subl. apply: strongest_coprime_quotient_cent; rewrite ?tiHR ?sub1G ?solvable1 //. by rewrite cards1 coprime1n. Qed. (* This is B & G, Proposition 1.5(d): the more traditional form of the lemma *) (* above, with the assumption H <| G weakened to H \subset G. The stronger *) (* coprime and solvability assumptions are easier to satisfy in practice. *) Proposition coprime_quotient_cent A G H : H \subset G -> A \subset 'N(H) -> coprime #|G| #|A| -> solvable G -> 'C_G(A) / H = 'C_(G / H)(A / H). Proof. move=> sHG nHA coGA solG. have sRG: H :&: [~: G, A] \subset G by rewrite subIset ?sHG. by rewrite strongest_coprime_quotient_cent ?(coprimeSg sRG) 1?(solvableS sRG). Qed. (* This is B & G, Proposition 1.5(e). *) Proposition coprime_comm_pcore A G K : A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> pi^'.-Hall(G) K -> K \subset 'C_G(A) -> [~: G, A] \subset 'O_pi(G). Proof. move=> nGA coGA solG hallK cKA. case: (coprime_Hall_exists nGA) => // H hallH nHA. have sHG: H \subset G by case/andP: hallH. have sKG: K \subset G by case/andP: hallK. have coKH: coprime #|K| #|H|. case/and3P: hallH=> _ piH _; case/and3P: hallK => _ pi'K _. by rewrite coprime_sym (pnat_coprime piH pi'K). have defG: G :=: K * H. apply/eqP; rewrite eq_sym eqEcard coprime_cardMg //. rewrite -{1}(mulGid G) mulgSS //= (card_Hall hallH) (card_Hall hallK). by rewrite mulnC partnC. have sGA_H: [~: G, A] \subset H. rewrite gen_subG defG. apply/subsetP=> _ /imset2P[_ a /imset2P[x y Kx Hy ->] Aa ->]. rewrite commMgJ (([~ x, a] =P 1) _) ?(conj1g, mul1g). by rewrite groupMl ?groupV // memJ_norm ?(subsetP nHA). by rewrite subsetI sKG in cKA; apply/commgP/(centsP cKA). apply: pcore_max; last first. by rewrite /(_ <| G) /= commg_norml commGC commg_subr nGA. by case/and3P: hallH => _ piH _; apply: pgroupS piH. Qed. End InternalAction. (* This is B & G, Proposition 1.5(b). *) Proposition coprime_Hall_subset pi (gT : finGroupType) (A G X : {group gT}) : A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> X \subset G -> pi.-group X -> A \subset 'N(X) -> exists H : {group gT}, [/\ pi.-Hall(G) H, A \subset 'N(H) & X \subset H]. Proof. have [n] := ubnP #|G|. elim: n => // n IHn in gT A G X * => /ltnSE-leGn nGA coGA solG sXG piX nXA. have [G1 | ntG] := eqsVneq G 1. case: (coprime_Hall_exists pi nGA) => // H hallH nHA. by exists H; split; rewrite // (subset_trans sXG) // G1 sub1G. have sG_AG: G \subset A <*> G by rewrite joing_subr. have sA_AG: A \subset A <*> G by rewrite joing_subl. have nG_AG: A <*> G \subset 'N(G) by rewrite join_subG nGA normG. have nsG_AG: G <| A <*> G by apply/andP. case: (solvable_norm_abelem solG nsG_AG) => // M [sMG nsMAG ntM]. have{nsMAG} [nMA nMG]: A \subset 'N(M) /\ G \subset 'N(M). by apply/andP; rewrite -join_subG normal_norm. have nMX: X \subset 'N(M) by apply: subset_trans nMG. case/is_abelemP=> p pr_p; case/and3P=> pM cMM _. have: #|G / M| < n by rewrite (leq_trans (ltn_quotient _ _)). move/(IHn _ (A / M)%G _ (X / M)%G); rewrite !(quotient_norms, quotientS) //. rewrite !(coprime_morph, quotient_sol, morphim_pgroup) //. case=> //= Hq []; case/and3P=> sHGq piHq pi'Hq' nHAq sXHq. case/inv_quotientS: (sHGq) => [|HM defHM sMHM sHMG]; first exact/andP. have nMHM := subset_trans sHMG nMG. have{sXHq} sXHM: X \subset HM by rewrite -(quotientSGK nMX) -?defHM. have{pi'Hq' sHGq} pi'HM': pi^'.-nat #|G : HM|. move: pi'Hq'; rewrite -!divgS // defHM !card_quotient //. by rewrite -(divnMl (cardG_gt0 M)) !Lagrange. have{nHAq} nHMA: A \subset 'N(HM). by rewrite -(quotientSGK nMA) ?normsG ?quotient_normG -?defHM //; apply/andP. case/orP: (orbN (p \in pi)) => pi_p. exists HM; split=> //; apply/and3P; split; rewrite /pgroup //. by rewrite -(Lagrange sMHM) pnatM -card_quotient // -defHM (pi_pnat pM). case: (ltnP #|HM| #|G|) => [ltHG | leGHM {n IHn leGn}]. case: (IHn _ A HM X (leq_trans ltHG leGn)) => // [||H [hallH nHA sXH]]. - exact: coprimeSg coGA. - exact: solvableS solG. case/and3P: hallH => sHHM piH pi'H'. have sHG: H \subset G by apply: subset_trans sHMG. exists H; split=> //; apply/and3P; split=> //. rewrite -divgS // -(Lagrange sHMG) -(Lagrange sHHM) -mulnA mulKn //. by rewrite pnatM pi'H'. have{leGHM nHMA sHMG sMHM sXHM pi'HM'} eqHMG: HM = G. by apply/eqP; rewrite -val_eqE eqEcard sHMG. have pi'M: pi^'.-group M by rewrite /pgroup (pi_pnat pM). have{HM Hq nMHM defHM eqHMG piHq} hallM: pi^'.-Hall(G) M. apply/and3P; split; rewrite // /pgroup pnatNK. by rewrite -card_quotient // -eqHMG -defHM. case: (coprime_Hall_exists pi nGA) => // H hallH nHA. pose XM := (X <*> M)%G; pose Y := (H :&: XM)%G. case/and3P: (hallH) => sHG piH _. have sXXM: X \subset XM by rewrite joing_subl. have co_pi_M (B : {group gT}): pi.-group B -> coprime #|B| #|M|. by move=> piB; rewrite (pnat_coprime piB). have hallX: pi.-Hall(XM) X. rewrite /pHall piX sXXM -divgS //= norm_joinEl //. by rewrite coprime_cardMg ?co_pi_M // mulKn. have sXMG: XM \subset G by rewrite join_subG sXG. have hallY: pi.-Hall(XM) Y. have sYXM: Y \subset XM by rewrite subsetIr. have piY: pi.-group Y by apply: pgroupS piH; apply: subsetIl. rewrite /pHall sYXM piY -divgS // -(_ : Y * M = XM). by rewrite coprime_cardMg ?co_pi_M // mulKn //. rewrite /= setIC group_modr ?joing_subr //=; apply/setIidPl. rewrite ((H * M =P G) _) // eqEcard mul_subG //= coprime_cardMg ?co_pi_M //. by rewrite (card_Hall hallM) (card_Hall hallH) partnC. have nXMA: A \subset 'N(XM) by rewrite normsY. have:= coprime_Hall_trans nXMA _ _ hallX nXA hallY. rewrite !(coprimeSg sXMG, solvableS sXMG, normsI) //. case=> // x /setIP[XMx cAx] ->. exists (H :^ x)%G; split; first by rewrite pHallJ ?(subsetP sXMG). by rewrite norm_conj_cent. by rewrite conjSg subsetIl. Qed. Section ExternalAction. Variables (pi : nat_pred) (aT gT : finGroupType). Variables (A : {group aT}) (G : {group gT}) (to : groupAction A G). Section FullExtension. Local Notation inA := (sdpair2 to). Local Notation inG := (sdpair1 to). Local Notation A' := (inA @* gval A). Local Notation G' := (inG @* gval G). Let injG : 'injm inG := injm_sdpair1 _. Let injA : 'injm inA := injm_sdpair2 _. Hypotheses (coGA : coprime #|G| #|A|) (solG : solvable G). Lemma external_action_im_coprime : coprime #|G'| #|A'|. Proof. by rewrite !card_injm. Qed. Let coGA' := external_action_im_coprime. Let solG' : solvable G' := morphim_sol _ solG. Let nGA' := im_sdpair_norm to. Lemma ext_coprime_Hall_exists : exists2 H : {group gT}, pi.-Hall(G) H & [acts A, on H | to]. Proof. have [H' hallH' nHA'] := coprime_Hall_exists pi nGA' coGA' solG'. have sHG' := pHall_sub hallH'. exists (inG @*^-1 H')%G => /=. by rewrite -(morphim_invmE injG) -{1}(im_invm injG) morphim_pHall. by rewrite actsEsd ?morphpreK // subsetIl. Qed. Lemma ext_coprime_Hall_trans (H1 H2 : {group gT}) : pi.-Hall(G) H1 -> [acts A, on H1 | to] -> pi.-Hall(G) H2 -> [acts A, on H2 | to] -> exists2 x, x \in 'C_(G | to)(A) & H1 :=: H2 :^ x. Proof. move=> hallH1 nH1A hallH2 nH2A. have sH1G := pHall_sub hallH1; have sH2G := pHall_sub hallH2. rewrite !actsEsd // in nH1A nH2A. have hallH1': pi.-Hall(G') (inG @* H1) by rewrite morphim_pHall. have hallH2': pi.-Hall(G') (inG @* H2) by rewrite morphim_pHall. have [x'] := coprime_Hall_trans nGA' coGA' solG' hallH1' nH1A hallH2' nH2A. case/setIP=> /= Gx' cAx' /eqP defH1; pose x := invm injG x'. have Gx: x \in G by rewrite -(im_invm injG) mem_morphim. have def_x': x' = inG x by rewrite invmK. exists x; first by rewrite inE Gx gacentEsd mem_morphpre /= -?def_x'. apply/eqP; move: defH1; rewrite def_x' /= -morphimJ //=. by rewrite !eqEsubset !injmSK // conj_subG. Qed. Lemma ext_norm_conj_cent (H : {group gT}) x : H \subset G -> x \in 'C_(G | to)(A) -> [acts A, on H :^ x | to] = [acts A, on H | to]. Proof. move=> sHG /setIP[Gx]. rewrite gacentEsd !actsEsd ?conj_subG ?morphimJ // 2!inE Gx /=. exact: norm_conj_cent. Qed. Lemma ext_coprime_Hall_subset (X : {group gT}) : X \subset G -> pi.-group X -> [acts A, on X | to] -> exists H : {group gT}, [/\ pi.-Hall(G) H, [acts A, on H | to] & X \subset H]. Proof. move=> sXG piX; rewrite actsEsd // => nXA'. case: (coprime_Hall_subset nGA' coGA' solG' _ (morphim_pgroup _ piX) nXA'). exact: morphimS. move=> H' /= [piH' nHA' sXH']; have sHG' := pHall_sub piH'. exists (inG @*^-1 H')%G; rewrite actsEsd ?subsetIl ?morphpreK // nHA'. rewrite -sub_morphim_pre //= sXH'; split=> //. by rewrite -(morphim_invmE injG) -{1}(im_invm injG) morphim_pHall. Qed. End FullExtension. (* We only prove a weaker form of the coprime group action centraliser *) (* lemma, because it is more convenient in practice to make G the range *) (* of the action, whence G both contains H and is stable under A. *) (* However we do restrict the coprime/solvable assumptions to H, and *) (* we do not require that G normalize H. *) Lemma ext_coprime_quotient_cent (H : {group gT}) : H \subset G -> [acts A, on H | to] -> coprime #|H| #|A| -> solvable H -> 'C_(|to)(A) / H = 'C_(|to / H)(A). Proof. move=> sHG nHA coHA solH; pose N := 'N_G(H). have nsHN: H <| N by rewrite normal_subnorm. have [sHN nHn] := andP nsHN. have sNG: N \subset G by apply: subsetIl. have nNA: {acts A, on group N | to}. split; rewrite // actsEsd // injm_subnorm ?injm_sdpair1 //=. by rewrite normsI ?norms_norm ?im_sdpair_norm -?actsEsd. rewrite -!(gacentIdom _ A) -quotientInorm -gacentIim setIAC. rewrite -(gacent_actby nNA) gacentEsd -morphpreIim /= -/N. have:= (injm_sdpair1 <[nNA]>, injm_sdpair2 <[nNA]>). set inG := sdpair1 _; set inA := sdpair2 _ => [[injG injA]]. set G' := inG @* N; set A' := inA @* A; pose H' := inG @* H. have defN: 'N(H | to) = A by apply/eqP; rewrite eqEsubset subsetIl. have def_Dq: qact_dom to H = A by rewrite qact_domE. have sAq: A \subset qact_dom to H by rewrite def_Dq. rewrite {2}def_Dq -(gacent_ract _ sAq); set to_q := (_ \ _)%gact. have:= And3 (sdprod_sdpair to_q) (injm_sdpair1 to_q) (injm_sdpair2 to_q). rewrite gacentEsd; set inAq := sdpair2 _; set inGq := sdpair1 _ => /=. set Gq := inGq @* _; set Aq := inAq @* _ => [[q_d iGq iAq]]. have nH': 'N(H') = setT. apply/eqP; rewrite -subTset -im_sdpair mulG_subG morphim_norms //=. by rewrite -actsEsd // acts_actby subxx /= (setIidPr sHN). have: 'dom (coset H' \o inA \o invm iAq) = Aq. by rewrite ['dom _]morphpre_invm /= nH' morphpreT. case/domP=> qA [def_qA ker_qA _ im_qA]. have{coHA} coHA': coprime #|H'| #|A'| by rewrite !card_injm. have{ker_qA} injAq: 'injm qA. rewrite {}ker_qA !ker_comp ker_coset morphpre_invm -morphpreIim /= setIC. by rewrite coprime_TIg // -kerE (trivgP injA) morphim1. have{im_qA} im_Aq : qA @* Aq = A' / H'. by rewrite {}im_qA !morphim_comp im_invm. have: 'dom (quotm (sdpair1_morphism <[nNA]>) nsHN \o invm iGq) = Gq. by rewrite ['dom _]morphpre_invm /= quotientInorm. case/domP=> qG [def_qG ker_qG _ im_qG]. have{ker_qG} injGq: 'injm qG. rewrite {}ker_qG ker_comp ker_quotm morphpre_invm (trivgP injG). by rewrite quotient1 morphim1. have im_Gq: qG @* Gq = G' / H'. rewrite {}im_qG morphim_comp im_invm morphim_quotm //= -/inG -/H'. by rewrite -morphimIdom setIAC setIid. have{def_qA def_qG} q_J : {in Gq & Aq, morph_act 'J 'J qG qA}. move=> x' a'; case/morphimP=> Hx; case/morphimP=> x nHx Gx -> GHx ->{Hx x'}. case/morphimP=> a _ Aa ->{a'} /=; rewrite -/inAq -/inGq. rewrite !{}def_qG {}def_qA /= !invmE // -sdpair_act //= -/inG -/inA. have Nx: x \in N by rewrite inE Gx. have Nxa: to x a \in N by case: (nNA); move/acts_act->. have [Gxa nHxa] := setIP Nxa. rewrite invmE qactE ?quotmE ?mem_morphim ?def_Dq //=. by rewrite -morphJ /= ?nH' ?inE // -sdpair_act //= actbyE. pose q := sdprodm q_d q_J. have{injAq injGq} injq: 'injm q. rewrite injm_sdprodm injAq injGq /= {}im_Aq {}im_Gq -/Aq . by rewrite -quotientGI ?im_sdpair_TI ?morphimS //= quotient1. rewrite -[inGq @*^-1 _]morphpreIim -/Gq. have sC'G: inG @*^-1 'C_G'(A') \subset G by rewrite !subIset ?subxx. rewrite -[_ / _](injmK iGq) ?quotientS //= -/inGq; congr (_ @*^-1 _). apply: (injm_morphim_inj injq); rewrite 1?injm_subcent ?subsetT //= -/q. rewrite 2?morphim_sdprodml ?morphimS //= im_Gq. rewrite morphim_sdprodmr ?morphimS //= im_Aq. rewrite {}im_qG morphim_comp morphim_invm ?morphimS //. rewrite morphim_quotm morphpreK ?subsetIl //= -/H'. rewrite coprime_norm_quotient_cent ?im_sdpair_norm ?nH' ?subsetT //=. exact: morphim_sol. Qed. End ExternalAction. Section SylowSolvableAct. Variables (gT : finGroupType) (p : nat). Implicit Types A B G X : {group gT}. Lemma sol_coprime_Sylow_exists A G : solvable A -> A \subset 'N(G) -> coprime #|G| #|A| -> exists2 P : {group gT}, p.-Sylow(G) P & A \subset 'N(P). Proof. move=> solA nGA coGA; pose AG := A <*> G. have nsG_AG: G <| AG by rewrite /normal joing_subr join_subG nGA normG. have [sG_AG nG_AG]:= andP nsG_AG. have [P sylP] := Sylow_exists p G; pose N := 'N_AG(P); pose NG := G :&: N. have nGN: N \subset 'N(G) by rewrite subIset ?nG_AG. have sNG_G: NG \subset G := subsetIl G N. have nsNG_N: NG <| N by rewrite /normal subsetIr normsI ?normG. have defAG: G * N = AG := Frattini_arg nsG_AG sylP. have oA : #|A| = #|N| %/ #|NG|. rewrite /NG setIC divgI -card_quotient // -quotientMidl defAG. rewrite card_quotient -?divgS //= norm_joinEl //. by rewrite coprime_cardMg 1?coprime_sym // mulnK. have: [splits N, over NG]. rewrite SchurZassenhaus_split // /Hall -divgS subsetIr //. by rewrite -oA (coprimeSg sNG_G). case/splitsP=> B; case/complP=> tNG_B defN. have [nPB]: B \subset 'N(P) /\ B \subset AG. by apply/andP; rewrite andbC -subsetI -/N -defN mulG_subr. case/SchurZassenhaus_trans_actsol => // [|x Gx defB]. by rewrite oA -defN TI_cardMg // mulKn. exists (P :^ x^-1)%G; first by rewrite pHallJ ?groupV. by rewrite normJ -sub_conjg -defB. Qed. Lemma sol_coprime_Sylow_trans A G : solvable A -> A \subset 'N(G) -> coprime #|G| #|A| -> [transitive 'C_G(A), on [set P in 'Syl_p(G) | A \subset 'N(P)] | 'JG]. Proof. move=> solA nGA coGA; pose AG := A <*> G; set FpA := finset _. have nG_AG: AG \subset 'N(G) by rewrite join_subG nGA normG. have [P sylP nPA] := sol_coprime_Sylow_exists solA nGA coGA. pose N := 'N_AG(P); have sAN: A \subset N by rewrite subsetI joing_subl. have trNPA: A :^: AG ::&: N = A :^: N. pose NG := 'N_G(P); have sNG_G : NG \subset G := subsetIl _ _. have nNGA: A \subset 'N(NG) by rewrite normsI ?norms_norm. apply/setP=> Ax; apply/setIdP/imsetP=> [[]|[x Nx ->{Ax}]]; last first. by rewrite conj_subG //; case/setIP: Nx => AGx; rewrite imset_f. have ->: N = A <*> NG by rewrite /N /AG !norm_joinEl // -group_modl. have coNG_A := coprimeSg sNG_G coGA; case/imsetP=> x AGx ->{Ax}. case/SchurZassenhaus_trans_actsol; rewrite ?cardJg // => y Ny /= ->. by exists y; rewrite // mem_gen 1?inE ?Ny ?orbT. have{trNPA}: [transitive 'N_AG(A), on FpA | 'JG]. have ->: FpA = 'Fix_('Syl_p(G) | 'JG)(A). by apply/setP=> Q; rewrite 4!inE afixJG. have SylP : P \in 'Syl_p(G) by rewrite inE. apply/(trans_subnorm_fixP _ SylP); rewrite ?astab1JG //. rewrite (atrans_supgroup _ (Syl_trans _ _)) ?joing_subr //= -/AG. by apply/actsP=> x /= AGx Q /=; rewrite !inE -{1}(normsP nG_AG x) ?pHallJ2. rewrite {1}/AG norm_joinEl // -group_modl ?normG ?coprime_norm_cent //=. rewrite -cent_joinEr ?subsetIr // => trC_FpA. have FpA_P: P \in FpA by rewrite !inE sylP. apply/(subgroup_transitiveP FpA_P _ trC_FpA); rewrite ?joing_subr //=. rewrite astab1JG cent_joinEr ?subsetIr // -group_modl // -mulgA. by congr (_ * _); rewrite mulSGid ?subsetIl. Qed. Lemma sol_coprime_Sylow_subset A G X : A \subset 'N(G) -> coprime #|G| #|A| -> solvable A -> X \subset G -> p.-group X -> A \subset 'N(X) -> exists P : {group gT}, [/\ p.-Sylow(G) P, A \subset 'N(P) & X \subset P]. Proof. move=> nGA coGA solA sXG pX nXA. pose nAp (Q : {group gT}) := [&& p.-group Q, Q \subset G & A \subset 'N(Q)]. have: nAp X by apply/and3P. case/maxgroup_exists=> R; case/maxgroupP; case/and3P=> pR sRG nRA maxR sXR. have [P sylP sRP]:= Sylow_superset sRG pR. suffices defP: P :=: R by exists P; rewrite sylP defP. case/and3P: sylP => sPG pP _; apply: (nilpotent_sub_norm (pgroup_nil pP)) => //. pose N := 'N_G(R); have{sPG} sPN_N: 'N_P(R) \subset N by apply: setSI. apply: norm_sub_max_pgroup (pgroupS (subsetIl _ _) pP) sPN_N (subsetIr _ _). have nNA: A \subset 'N(N) by rewrite normsI ?norms_norm. have coNA: coprime #|N| #|A| by apply: coprimeSg coGA; rewrite subsetIl. have{solA coNA} [Q sylQ nQA] := sol_coprime_Sylow_exists solA nNA coNA. suffices defQ: Q :=: R by rewrite max_pgroup_Sylow -{2}defQ. apply: maxR; first by apply/and3P; case/and3P: sylQ; rewrite subsetI; case/andP. by apply: normal_sub_max_pgroup (Hall_max sylQ) pR _; rewrite normal_subnorm. Qed. End SylowSolvableAct. math-comp-mathcomp-1.12.0/mathcomp/solvable/jordanholder.v000066400000000000000000000715531375767750300236060ustar00rootroot00000000000000(* (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 fintype bigop finset fingroup morphism. From mathcomp Require Import automorphism quotient action gseries. (******************************************************************************) (* This files establishes Jordan-Holder theorems for finite groups. These *) (* theorems state the uniqueness up to permutation and isomorphism for the *) (* series of quotient built from the successive elements of any composition *) (* series of the same group. These quotients are also called factors of the *) (* composition series. To avoid the heavy use of highly polymorphic lists *) (* describing these quotient series, we introduce sections. *) (* This library defines: *) (* (G1 / G2)%sec == alias for the pair (G1, G2) of groups in the same *) (* finGroupType, coerced to the actual quotient group*) (* group G1 / G2. We call this pseudo-quotient a *) (* section of G1 and G2. *) (* section_isog s1 s2 == s1 and s2 respectively coerce to isomorphic *) (* quotient groups. *) (* section_repr s == canonical representative of the isomorphism class *) (* of the section s. *) (* mksrepr G1 G2 == canonical representative of the isomorphism class *) (* of (G1 / G2)%sec. *) (* mkfactors G s == if s is [:: s1, s2, ..., sn], constructs the list *) (* [:: mksrepr G s1, mksrepr s1 s2, ..., mksrepr sn-1 sn] *) (* comps G s == s is a composition series for G i.e. s is a *) (* decreasing sequence of subgroups of G *) (* in which two adjacent elements are maxnormal one *) (* in the other and the last element of s is 1. *) (* Given aT and rT two finGroupTypes, (D : {group rT}), (A : {group aT}) and *) (* (to : groupAction A D) an external action. *) (* maxainv to B C == C is a maximal proper normal subgroup of B *) (* invariant by (the external action of A via) to. *) (* asimple to B == the maximal proper normal subgroup of B invariant *) (* by the external action to is trivial. *) (* acomps to G s == s is a composition series for G invariant by to, *) (* i.e. s is a decreasing sequence of subgroups of G *) (* in which two adjacent elements are maximally *) (* invariant by to one in the other and the *) (* last element of s is 1. *) (* We prove two versions of the result: *) (* - JordanHolderUniqueness establishes the uniqueness up to permutation *) (* and isomorphism of the lists of factors in composition series of a *) (* given group. *) (* - StrongJordanHolderUniqueness extends the result to composition series *) (* invariant by an external group action. *) (* See also "The Rooster and the Butterflies", proceedings of Calculemus 2013,*) (* by Assia Mahboubi. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope section_scope. Import GroupScope. Inductive section (gT : finGroupType) := GSection of {group gT} * {group gT}. Delimit Scope section_scope with sec. Bind Scope section_scope with section. Definition mkSec (gT : finGroupType) (G1 G2 : {group gT}) := GSection (G1, G2). Infix "/" := mkSec : section_scope. Coercion pair_of_section gT (s : section gT) := let: GSection u := s in u. Coercion quotient_of_section gT (s : section gT) : GroupSet.sort _ := s.1 / s.2. Coercion section_group gT (s : section gT) : {group (coset_of s.2)} := Eval hnf in [group of s]. Section Sections. Variables (gT : finGroupType). Implicit Types (G : {group gT}) (s : section gT). Canonical section_subType := Eval hnf in [newType for @pair_of_section gT]. Definition section_eqMixin := Eval hnf in [eqMixin of section gT by <:]. Canonical section_eqType := Eval hnf in EqType (section gT) section_eqMixin. Definition section_choiceMixin := [choiceMixin of section gT by <:]. Canonical section_choiceType := Eval hnf in ChoiceType (section gT) section_choiceMixin. Definition section_countMixin := [countMixin of section gT by <:]. Canonical section_countType := Eval hnf in CountType (section gT) section_countMixin. Canonical section_subCountType := Eval hnf in [subCountType of section gT]. Definition section_finMixin := [finMixin of section gT by <:]. Canonical section_finType := Eval hnf in FinType (section gT) section_finMixin. Canonical section_subFinType := Eval hnf in [subFinType of section gT]. Canonical section_group. (* Isomorphic sections *) Definition section_isog := [rel x y : section gT | x \isog y]. (* A witness of the isomorphism class of a section *) Definition section_repr s := odflt (1 / 1)%sec (pick (section_isog ^~ s)). Definition mksrepr G1 G2 := section_repr (mkSec G1 G2). Lemma section_reprP s : section_repr s \isog s. Proof. by rewrite /section_repr; case: pickP => //= /(_ s); rewrite isog_refl. Qed. Lemma section_repr_isog s1 s2 : s1 \isog s2 -> section_repr s1 = section_repr s2. Proof. by move=> iso12; congr (odflt _ _); apply: eq_pick => s; apply: isog_transr. Qed. Definition mkfactors (G : {group gT}) (s : seq {group gT}) := map section_repr (pairmap (@mkSec _) G s). End Sections. Section CompositionSeries. Variable gT : finGroupType. Local Notation gTg := {group gT}. Implicit Types (G : gTg) (s : seq gTg). Local Notation compo := [rel x y : {set gT} | maxnormal y x x]. Definition comps G s := ((last G s) == 1%G) && compo.-series G s. Lemma compsP G s : reflect (last G s = 1%G /\ path [rel x y : gTg | maxnormal y x x] G s) (comps G s). Proof. by apply: (iffP andP) => [] [/eqP]. Qed. Lemma trivg_comps G s : comps G s -> (G :==: 1) = (s == [::]). Proof. case/andP=> ls cs; apply/eqP/eqP=> [G1 | s1]; last first. by rewrite s1 /= in ls; apply/eqP. by case: s {ls} cs => //= H s /andP[/maxgroupp]; rewrite G1 /proper sub1G andbF. Qed. Lemma comps_cons G H s : comps G (H :: s) -> comps H s. Proof. by case/andP => /= ls /andP[_]; rewrite /comps ls. Qed. Lemma simple_compsP G s : comps G s -> reflect (s = [:: 1%G]) (simple G). Proof. move=> cs; apply: (iffP idP) => [|s1]; last first. by rewrite s1 /comps eqxx /= andbT -simple_maxnormal in cs. case: s cs => [/trivg_comps/eqP-> | H s]; first by case/simpleP; rewrite eqxx. rewrite [comps _ _]andbCA /= => /andP[/maxgroupp maxH /trivg_comps/esym nil_s]. rewrite simple_maxnormal => /maxgroupP[_ simG]. have H1: H = 1%G by apply/val_inj/simG; rewrite // sub1G. by move: nil_s; rewrite H1 eqxx => /eqP->. Qed. Lemma exists_comps (G : gTg) : exists s, comps G s. Proof. elim: {G} #|G| {1 3}G (leqnn #|G|) => [G | n IHn G cG]. by rewrite leqNgt cardG_gt0. have [sG | nsG] := boolP (simple G). by exists [:: 1%G]; rewrite /comps eqxx /= -simple_maxnormal andbT. have [-> | ntG] := eqVneq G 1%G; first by exists [::]; rewrite /comps eqxx. have [N maxN] := ex_maxnormal_ntrivg ntG. have [|s /andP[ls cs]] := IHn N. by rewrite -ltnS (leq_trans _ cG) // proper_card // (maxnormal_proper maxN). by exists (N :: s); apply/and3P. Qed. (******************************************************************************) (* The factors associated to two composition series of the same group are *) (* the same up to isomorphism and permutation *) (******************************************************************************) Lemma JordanHolderUniqueness (G : gTg) (s1 s2 : seq gTg) : comps G s1 -> comps G s2 -> perm_eq (mkfactors G s1) (mkfactors G s2). Proof. have [n] := ubnP #|G|; elim: n G => // n Hi G in s1 s2 * => /ltnSE-cG cs1 cs2. have [G1 | ntG] := boolP (G :==: 1). have -> : s1 = [::] by apply/eqP; rewrite -(trivg_comps cs1). have -> : s2 = [::] by apply/eqP; rewrite -(trivg_comps cs2). by rewrite /= perm_refl. have [sG | nsG] := boolP (simple G). by rewrite (simple_compsP cs1 sG) (simple_compsP cs2 sG) perm_refl. case es1: s1 cs1 => [|N1 st1] cs1. by move: (trivg_comps cs1); rewrite eqxx; move/negP:ntG. case es2: s2 cs2 => [|N2 st2] cs2 {s1 es1}. by move: (trivg_comps cs2); rewrite eqxx; move/negP:ntG. case/andP: cs1 => /= lst1; case/andP=> maxN_1 pst1. case/andP: cs2 => /= lst2; case/andP=> maxN_2 pst2. have cN1 : #|N1| < n. by rewrite (leq_trans _ cG) ?proper_card ?(maxnormal_proper maxN_1). have cN2 : #|N2| < n. by rewrite (leq_trans _ cG) ?proper_card ?(maxnormal_proper maxN_2). case: (N1 =P N2) {s2 es2} => [eN12 |]. by rewrite eN12 /= perm_cons Hi // /comps ?lst2 //= -eN12 lst1. move/eqP; rewrite -val_eqE /=; move/eqP=> neN12. have nN1G : N1 <| G by apply: maxnormal_normal. have nN2G : N2 <| G by apply: maxnormal_normal. pose N := (N1 :&: N2)%G. have nNG : N <| G. by rewrite /normal subIset ?(normal_sub nN1G) //= normsI ?normal_norm. have iso1 : (G / N1)%G \isog (N2 / N)%G. rewrite isog_sym /= -(maxnormalM maxN_1 maxN_2) //. rewrite (@normC _ N1 N2) ?(subset_trans (normal_sub nN1G)) ?normal_norm //. by rewrite weak_second_isog ?(subset_trans (normal_sub nN2G)) ?normal_norm. have iso2 : (G / N2)%G \isog (N1 / N)%G. rewrite isog_sym /= -(maxnormalM maxN_1 maxN_2) // setIC. by rewrite weak_second_isog ?(subset_trans (normal_sub nN1G)) ?normal_norm. have [sN /andP[lsN csN]] := exists_comps N. have i1 : perm_eq (mksrepr G N1 :: mkfactors N1 st1) [:: mksrepr G N1, mksrepr N1 N & mkfactors N sN]. rewrite perm_cons -[mksrepr _ _ :: _]/(mkfactors N1 [:: N & sN]). apply: Hi=> //; rewrite /comps ?lst1 //= lsN csN andbT /=. rewrite -quotient_simple. by rewrite -(isog_simple iso2) quotient_simple. by rewrite (normalS (subsetIl N1 N2) (normal_sub nN1G)). have i2 : perm_eq (mksrepr G N2 :: mkfactors N2 st2) [:: mksrepr G N2, mksrepr N2 N & mkfactors N sN]. rewrite perm_cons -[mksrepr _ _ :: _]/(mkfactors N2 [:: N & sN]). apply: Hi=> //; rewrite /comps ?lst2 //= lsN csN andbT /=. rewrite -quotient_simple. by rewrite -(isog_simple iso1) quotient_simple. by rewrite (normalS (subsetIr N1 N2) (normal_sub nN2G)). pose fG1 := [:: mksrepr G N1, mksrepr N1 N & mkfactors N sN]. pose fG2 := [:: mksrepr G N2, mksrepr N2 N & mkfactors N sN]. have i3 : perm_eq fG1 fG2. rewrite (@perm_catCA _ [::_] [::_]) /mksrepr. rewrite (@section_repr_isog _ (mkSec _ _) (mkSec _ _) iso1). rewrite -(@section_repr_isog _ (mkSec _ _) (mkSec _ _) iso2). exact: perm_refl. apply: (perm_trans i1); apply: (perm_trans i3); rewrite perm_sym. by apply: perm_trans i2; apply: perm_refl. Qed. End CompositionSeries. (******************************************************************************) (* Helper lemmas for group actions. *) (******************************************************************************) Section MoreGroupAction. Variables (aT rT : finGroupType). Variables (A : {group aT}) (D : {group rT}). Variable to : groupAction A D. Lemma gactsP (G : {set rT}) : reflect {acts A, on G | to} [acts A, on G | to]. Proof. apply: (iffP idP) => [nGA x|nGA]; first exact: acts_act. apply/subsetP=> a Aa; rewrite !inE; rewrite Aa. by apply/subsetP=> x; rewrite inE nGA. Qed. Lemma gactsM (N1 N2 : {set rT}) : N1 \subset D -> N2 \subset D -> [acts A, on N1 | to] -> [acts A, on N2 | to] -> [acts A, on N1 * N2 | to]. Proof. move=> sN1D sN2D aAN1 aAN2; apply/gactsP=> x Ax y. apply/idP/idP; case/mulsgP=> y1 y2 N1y1 N2y2 e. move: (actKin to Ax y); rewrite e; move<-. rewrite gactM ?groupV ?(subsetP sN1D y1) ?(subsetP sN2D) //. by apply: mem_mulg; rewrite ?(gactsP _ aAN1) ?(gactsP _ aAN2) // groupV. rewrite e gactM // ?(subsetP sN1D y1) ?(subsetP sN2D) //. by apply: mem_mulg; rewrite ?(gactsP _ aAN1) // ?(gactsP _ aAN2). Qed. Lemma gactsI (N1 N2 : {set rT}) : [acts A, on N1 | to] -> [acts A, on N2 | to] -> [acts A, on N1 :&: N2 | to]. Proof. move=> aAN1 aAN2. apply/subsetP=> x Ax; rewrite !inE Ax /=; apply/subsetP=> y Ny; rewrite inE. case/setIP: Ny=> N1y N2y; rewrite inE ?astabs_act ?N1y ?N2y //. - by move/subsetP: aAN2; move/(_ x Ax). - by move/subsetP: aAN1; move/(_ x Ax). Qed. Lemma gastabsP (S : {set rT}) (a : aT) : a \in A -> reflect (forall x, (to x a \in S) = (x \in S)) (a \in 'N(S | to)). Proof. move=> Aa; apply: (iffP idP) => [nSa x|nSa]; first exact: astabs_act. by rewrite !inE Aa; apply/subsetP=> x; rewrite inE nSa. Qed. End MoreGroupAction. (******************************************************************************) (* Helper lemmas for quotient actions. *) (******************************************************************************) Section MoreQuotientAction. Variables (aT rT : finGroupType). Variables (A : {group aT})(D : {group rT}). Variable to : groupAction A D. Lemma qact_dom_doms (H : {group rT}) : H \subset D -> qact_dom to H \subset A. Proof. by move=> sHD; apply/subsetP=> x; rewrite qact_domE // inE; case/andP. Qed. Lemma acts_qact_doms (H : {group rT}) : H \subset D -> [acts A, on H | to] -> qact_dom to H :=: A. Proof. move=> sHD aH; apply/eqP; rewrite eqEsubset; apply/andP. split; first exact: qact_dom_doms. apply/subsetP=> x Ax; rewrite qact_domE //; apply/gastabsP=> //. by move/gactsP: aH; move/(_ x Ax). Qed. Lemma qacts_cosetpre (H : {group rT}) (K' : {group coset_of H}) : H \subset D -> [acts A, on H | to] -> [acts qact_dom to H, on K' | to / H] -> [acts A, on coset H @*^-1 K' | to]. Proof. move=> sHD aH aK'; apply/subsetP=> x Ax; move: (Ax) (subsetP aK'). rewrite -{1}(acts_qact_doms sHD aH) => qdx; move/(_ x qdx) => nx. rewrite !inE Ax; apply/subsetP=> y; case/morphpreP=> Ny /= K'Hy; rewrite inE. apply/morphpreP; split; first by rewrite acts_qact_dom_norm. by move/gastabsP: nx; move/(_ qdx (coset H y)); rewrite K'Hy qactE. Qed. Lemma qacts_coset (H K : {group rT}) : H \subset D -> [acts A, on K | to] -> [acts qact_dom to H, on (coset H) @* K | to / H]. Proof. move=> sHD aK. apply/subsetP=> x qdx; rewrite inE qdx inE; apply/subsetP=> y. case/morphimP=> z Nz Kz /= e; rewrite e inE qactE // imset_f // inE. move/gactsP: aK; move/(_ x (subsetP (qact_dom_doms sHD) _ qdx) z); rewrite Kz. move->; move/acts_act: (acts_qact_dom to H); move/(_ x qdx z). by rewrite Nz andbT. Qed. End MoreQuotientAction. Section StableCompositionSeries. Variables (aT rT : finGroupType). Variables (D : {group rT})(A : {group aT}). Variable to : groupAction A D. Definition maxainv (B C : {set rT}) := [max C of H | [&& (H <| B), ~~ (B \subset H) & [acts A, on H | to]]]. Section MaxAinvProps. Variables K N : {group rT}. Lemma maxainv_norm : maxainv K N -> N <| K. Proof. by move/maxgroupp; case/andP. Qed. Lemma maxainv_proper : maxainv K N -> N \proper K. Proof. by move/maxgroupp; case/andP; rewrite properE; move/normal_sub->; case/andP. Qed. Lemma maxainv_sub : maxainv K N -> N \subset K. Proof. by move=> h; apply: proper_sub; apply: maxainv_proper. Qed. Lemma maxainv_ainvar : maxainv K N -> A \subset 'N(N | to). Proof. by move/maxgroupp; case/and3P. Qed. Lemma maxainvS : maxainv K N -> N \subset K. Proof. by move=> pNN; rewrite proper_sub // maxainv_proper. Qed. Lemma maxainv_exists : K :!=: 1 -> {N : {group rT} | maxainv K N}. Proof. move=> nt; apply: ex_maxgroup. exists [1 rT]%G. rewrite /= normal1 subG1 nt /=. apply/subsetP=> a Da; rewrite !inE Da /= sub1set !inE. by rewrite /= -actmE // morph1 eqxx. Qed. End MaxAinvProps. Lemma maxainvM (G H K : {group rT}) : H \subset D -> K \subset D -> maxainv G H -> maxainv G K -> H :<>: K -> H * K = G. Proof. move: H K => N1 N2 sN1D sN2D pmN1 pmN2 neN12. have cN12 : commute N1 N2. apply: normC; apply: (subset_trans (maxainv_sub pmN1)). by rewrite normal_norm ?maxainv_norm. wlog nsN21 : G N1 N2 sN1D sN2D pmN1 pmN2 neN12 cN12/ ~~(N1 \subset N2). move/eqP: (neN12); rewrite eqEsubset negb_and; case/orP=> ns; first by apply. by rewrite cN12; apply=> //; apply: sym_not_eq. have nP : N1 * N2 <| G by rewrite normalM ?maxainv_norm. have sN2P : N2 \subset N1 * N2 by rewrite mulg_subr ?group1. case/maxgroupP: (pmN1); case/andP=> nN1G pN1G mN1. case/maxgroupP: (pmN2); case/andP=> nN2G pN2G mN2. case/andP: pN1G=> nsGN1 ha1; case/andP: pN2G=> nsGN2 ha2. case e : (G \subset N1 * N2). by apply/eqP; rewrite eqEsubset e mulG_subG !normal_sub. have: N1 <*> N2 = N2 by apply: mN2; rewrite /= ?comm_joingE // nP e /= gactsM. by rewrite comm_joingE // => h; move: nsN21; rewrite -h mulg_subl. Qed. Definition asimple (K : {set rT}) := maxainv K 1. Implicit Types (H K : {group rT}) (s : seq {group rT}). Lemma asimpleP K : reflect [/\ K :!=: 1 & forall H, H <| K -> [acts A, on H | to] -> H :=: 1 \/ H :=: K] (asimple K). Proof. apply: (iffP idP). case/maxgroupP; rewrite normal1 /=; case/andP=> nsK1 aK H1. rewrite eqEsubset negb_and nsK1 /=; split => // H nHK ha. case eHK : (H :==: K); first by right; apply/eqP. left; apply: H1; rewrite ?sub1G // nHK; move/negbT: eHK. by rewrite eqEsubset negb_and normal_sub //=; move->. case=> ntK h; apply/maxgroupP; split. move: ntK; rewrite eqEsubset sub1G andbT normal1; move->. apply/subsetP=> a Da; rewrite !inE Da /= sub1set !inE. by rewrite /= -actmE // morph1 eqxx. move=> H /andP[nHK /andP[nsKH ha]] _. case: (h _ nHK ha)=> // /eqP; rewrite eqEsubset. by rewrite (negbTE nsKH) andbF. Qed. Definition acomps K s := ((last K s) == 1%G) && path [rel x y : {group rT} | maxainv x y] K s. Lemma acompsP K s : reflect (last K s = 1%G /\ path [rel x y : {group rT} | maxainv x y] K s) (acomps K s). Proof. by apply: (iffP andP); case; move/eqP. Qed. Lemma trivg_acomps K s : acomps K s -> (K :==: 1) = (s == [::]). Proof. case/andP=> ls cs; apply/eqP/eqP; last first. by move=> se; rewrite se /= in ls; apply/eqP. move=> G1; case: s ls cs => // H s _ /=; case/andP; case/maxgroupP. by rewrite G1 sub1G andbF. Qed. Lemma acomps_cons K H s : acomps K (H :: s) -> acomps H s. Proof. by case/andP => /= ls; case/andP=> _ p; rewrite /acomps ls. Qed. Lemma asimple_acompsP K s : acomps K s -> reflect (s = [:: 1%G]) (asimple K). Proof. move=> cs; apply: (iffP idP); last first. by move=> se; move: cs; rewrite se /=; case/andP=> /=; rewrite andbT. case: s cs. by rewrite /acomps /= andbT; move/eqP->; case/asimpleP; rewrite eqxx. move=> H s cs sG; apply/eqP. rewrite eqseq_cons -(trivg_acomps (acomps_cons cs)) andbC andbb. case/acompsP: cs => /= ls; case/andP=> mH ps. case/maxgroupP: sG; case/and3P => _ ntG _ ->; rewrite ?sub1G //. rewrite (maxainv_norm mH); case/andP: (maxainv_proper mH)=> _ ->. exact: (maxainv_ainvar mH). Qed. Lemma exists_acomps K : exists s, acomps K s. Proof. elim: {K} #|K| {1 3}K (leqnn #|K|) => [K | n Hi K cK]. by rewrite leqNgt cardG_gt0. case/orP: (orbN (asimple K)) => [sK | nsK]. by exists [:: (1%G : {group rT})]; rewrite /acomps eqxx /= andbT. case/orP: (orbN (K :==: 1))=> [tK | ntK]. by exists (Nil _); rewrite /acomps /= andbT. case: (maxainv_exists ntK)=> N pmN. have cN: #|N| <= n. by rewrite -ltnS (leq_trans _ cK) // proper_card // (maxainv_proper pmN). case: (Hi _ cN)=> s; case/andP=> lasts ps; exists [:: N & s]; rewrite /acomps. by rewrite last_cons lasts /= pmN. Qed. End StableCompositionSeries. Arguments maxainv {aT rT D%G A%G} to%gact B%g C%g. Arguments asimple {aT rT D%G A%G} to%gact K%g. Section StrongJordanHolder. Section AuxiliaryLemmas. Variables aT rT : finGroupType. Variables (A : {group aT}) (D : {group rT}) (to : groupAction A D). Lemma maxainv_asimple_quo (G H : {group rT}) : H \subset D -> maxainv to G H -> asimple (to / H) (G / H). Proof. move=> sHD /maxgroupP[/and3P[nHG pHG aH] Hmax]. apply/asimpleP; split; first by rewrite -subG1 quotient_sub1 ?normal_norm. move=> K' nK'Q aK'. have: (K' \proper (G / H)) || (G / H == K'). by rewrite properE eqEsubset andbC (normal_sub nK'Q) !andbT orbC orbN. case/orP=> [ pHQ | eQH]; last by right; apply sym_eq; apply/eqP. left; pose K := ((coset H) @*^-1 K')%G. have eK'I : K' \subset (coset H) @* 'N(H). by rewrite (subset_trans (normal_sub nK'Q)) ?morphimS ?normal_norm. have eKK' : K' :=: K / H by rewrite /(K / H) morphpreK //=. suff eKH : K :=: H by rewrite -trivg_quotient eKK' eKH. have sHK : H \subset K by rewrite -ker_coset kerE morphpreS // sub1set group1. apply: Hmax => //; apply/and3P; split; last exact: qacts_cosetpre. by rewrite -(quotientGK nHG) cosetpre_normal. by move: (proper_subn pHQ); rewrite sub_morphim_pre ?normal_norm. Qed. Lemma asimple_quo_maxainv (G H : {group rT}) : H \subset D -> G \subset D -> [acts A, on G | to] -> [acts A, on H | to] -> H <| G -> asimple (to / H) (G / H) -> maxainv to G H. Proof. move=> sHD sGD aG aH nHG /asimpleP[ntQ maxQ]; apply/maxgroupP; split. by rewrite nHG -quotient_sub1 ?normal_norm // subG1 ntQ. move=> K /and3P[nKG nsGK aK] sHK. pose K' := (K / H)%G. have K'dQ : K' <| (G / H)%G by apply: morphim_normal. have nKH : H <| K by rewrite (normalS _ _ nHG) // normal_sub. have: K' :=: 1%G \/ K' :=: (G / H). apply: (maxQ K' K'dQ) => /=. apply/subsetP=> x Adx. rewrite inE Adx /= inE. apply/subsetP=> y. rewrite quotientE; case/morphimP=> z Nz Kz ->; rewrite /= !inE qactE //. have ntoyx : to z x \in 'N(H) by rewrite (acts_qact_dom_norm Adx). apply/morphimP; exists (to z x) => //. suff h: qact_dom to H \subset A. by rewrite astabs_act // (subsetP aK) //; apply: (subsetP h). by apply/subsetP=> t; rewrite qact_domE // inE; case/andP. case; last first. move/quotient_injG; rewrite !inE /=; move/(_ nKH nHG)=> c; move: nsGK. by rewrite c subxx. rewrite /= -trivg_quotient => tK'; apply: (congr1 (@gval _)); move: tK'. by apply: (@quotient_injG _ H); rewrite ?inE /= ?normal_refl. Qed. Lemma asimpleI (N1 N2 : {group rT}) : N2 \subset 'N(N1) -> N1 \subset D -> [acts A, on N1 | to] -> [acts A, on N2 | to] -> asimple (to / N1) (N2 / N1) -> asimple (to / (N2 :&: N1)) (N2 / (N2 :&: N1)). Proof. move=> nN21 sN1D aN1 aN2 /asimpleP[ntQ1 max1]. have [f1 [f1e f1ker f1pre f1im]] := restrmP (coset_morphism N1) nN21. have hf2' : N2 \subset 'N(N2 :&: N1) by apply: normsI => //; rewrite normG. have hf2'' : 'ker (coset (N2 :&: N1)) \subset 'ker f1. by rewrite f1ker !ker_coset. pose f2 := factm_morphism hf2'' hf2'. apply/asimpleP; split. rewrite /= setIC; apply/negP; move: (second_isog nN21); move/isog_eq1->. by apply/negP. move=> H nHQ2 aH; pose K := f2 @* H. have nKQ1 : K <| N2 / N1. rewrite (_ : N2 / N1 = f2 @* (N2 / (N2 :&: N1))) ?morphim_normal //. by rewrite morphim_factm f1im. have sqA : qact_dom to N1 \subset A. by apply/subsetP=> t; rewrite qact_domE // inE; case/andP. have nNN2 : (N2 :&: N1) <| N2. by rewrite /normal subsetIl; apply: normsI => //; apply: normG. have aKQ1 : [acts qact_dom to N1, on K | to / N1]. pose H':= coset (N2 :&: N1)@*^-1 H. have eHH' : H :=: H' / (N2 :&: N1) by rewrite cosetpreK. have -> : K :=: f1 @* H' by rewrite /K eHH' morphim_factm. have sH'N2 : H' \subset N2. rewrite /H' eHH' quotientGK ?normal_cosetpre //=. by rewrite sub_cosetpre_quo ?normal_sub. have -> : f1 @* H' = coset N1 @* H' by rewrite f1im //=. apply: qacts_coset => //; apply: qacts_cosetpre => //; last exact: gactsI. by apply: (subset_trans (subsetIr _ _)). have injf2 : 'injm f2. by rewrite ker_factm f1ker /= ker_coset /= subG1 /= -quotientE trivg_quotient. have iHK : H \isog K. apply/isogP; pose f3 := restrm_morphism (normal_sub nHQ2) f2. by exists f3; rewrite 1?injm_restrm // morphim_restrm setIid. case: (max1 _ nKQ1 aKQ1). by move/eqP; rewrite -(isog_eq1 iHK); move/eqP->; left. move=> he /=; right; apply/eqP; rewrite eqEcard normal_sub //=. move: (second_isog nN21); rewrite setIC; move/card_isog->; rewrite -he. by move/card_isog: iHK=> <-; rewrite leqnn. Qed. End AuxiliaryLemmas. Variables (aT rT : finGroupType). Variables (A : {group aT}) (D : {group rT}) (to : groupAction A D). (******************************************************************************) (* The factors associated to two A-stable composition series of the same *) (* group are the same up to isomorphism and permutation *) (******************************************************************************) Lemma StrongJordanHolderUniqueness (G : {group rT}) (s1 s2 : seq {group rT}) : G \subset D -> acomps to G s1 -> acomps to G s2 -> perm_eq (mkfactors G s1) (mkfactors G s2). Proof. have [n] := ubnP #|G|; elim: n G => // n Hi G in s1 s2 * => cG hsD cs1 cs2. case/orP: (orbN (G :==: 1)) => [tG | ntG]. have -> : s1 = [::] by apply/eqP; rewrite -(trivg_acomps cs1). have -> : s2 = [::] by apply/eqP; rewrite -(trivg_acomps cs2). by rewrite /= perm_refl. case/orP: (orbN (asimple to G))=> [sG | nsG]. have -> : s1 = [:: 1%G ] by apply/(asimple_acompsP cs1). have -> : s2 = [:: 1%G ] by apply/(asimple_acompsP cs2). by rewrite /= perm_refl. case es1: s1 cs1 => [|N1 st1] cs1. by move: (trivg_comps cs1); rewrite eqxx; move/negP:ntG. case es2: s2 cs2 => [|N2 st2] cs2 {s1 es1}. by move: (trivg_comps cs2); rewrite eqxx; move/negP:ntG. case/andP: cs1 => /= lst1; case/andP=> maxN_1 pst1. case/andP: cs2 => /= lst2; case/andP=> maxN_2 pst2. have sN1D : N1 \subset D. by apply: subset_trans hsD; apply: maxainv_sub maxN_1. have sN2D : N2 \subset D. by apply: subset_trans hsD; apply: maxainv_sub maxN_2. have cN1 : #|N1| < n. by rewrite -ltnS (leq_trans _ cG) ?ltnS ?proper_card ?(maxainv_proper maxN_1). have cN2 : #|N2| < n. by rewrite -ltnS (leq_trans _ cG) ?ltnS ?proper_card ?(maxainv_proper maxN_2). case: (N1 =P N2) {s2 es2} => [eN12 |]. by rewrite eN12 /= perm_cons Hi // /acomps ?lst2 //= -eN12 lst1. move/eqP; rewrite -val_eqE /=; move/eqP=> neN12. have nN1G : N1 <| G by apply: (maxainv_norm maxN_1). have nN2G : N2 <| G by apply: (maxainv_norm maxN_2). pose N := (N1 :&: N2)%G. have nNG : N <| G. by rewrite /normal subIset ?(normal_sub nN1G) //= normsI ?normal_norm. have iso1 : (G / N1)%G \isog (N2 / N)%G. rewrite isog_sym /= -(maxainvM _ _ maxN_1 maxN_2) //. rewrite (@normC _ N1 N2) ?(subset_trans (normal_sub nN1G)) ?normal_norm //. by rewrite weak_second_isog ?(subset_trans (normal_sub nN2G)) ?normal_norm. have iso2 : (G / N2)%G \isog (N1 / N)%G. rewrite isog_sym /= -(maxainvM _ _ maxN_1 maxN_2) // setIC. by rewrite weak_second_isog ?(subset_trans (normal_sub nN1G)) ?normal_norm. case: (exists_acomps to N)=> sN; case/andP=> lsN csN. have aN1 : [acts A, on N1 | to]. by case/maxgroupP: maxN_1; case/and3P. have aN2 : [acts A, on N2 | to]. by case/maxgroupP: maxN_2; case/and3P. have nNN1 : N <| N1. by apply: (normalS _ _ nNG); rewrite ?subsetIl ?normal_sub. have nNN2 : N <| N2. by apply: (normalS _ _ nNG); rewrite ?subsetIr ?normal_sub. have aN : [ acts A, on N1 :&: N2 | to]. apply/subsetP=> x Ax; rewrite !inE Ax /=; apply/subsetP=> y Ny; rewrite inE. case/setIP: Ny=> N1y N2y. rewrite inE ?astabs_act ?N1y ?N2y //. by move/subsetP: aN2; move/(_ x Ax). by move/subsetP: aN1; move/(_ x Ax). have i1 : perm_eq (mksrepr G N1 :: mkfactors N1 st1) [:: mksrepr G N1, mksrepr N1 N & mkfactors N sN]. rewrite perm_cons -[mksrepr _ _ :: _]/(mkfactors N1 [:: N & sN]). apply: Hi=> //; rewrite /acomps ?lst1 //= lsN csN andbT /=. apply: asimple_quo_maxainv=> //; first by apply: subIset; rewrite sN1D. apply: asimpleI => //. by apply: subset_trans (normal_norm nN2G); apply: normal_sub. rewrite -quotientMidl (maxainvM _ _ maxN_2) //. by apply: maxainv_asimple_quo. by move=> e; apply: neN12. have i2 : perm_eq (mksrepr G N2 :: mkfactors N2 st2) [:: mksrepr G N2, mksrepr N2 N & mkfactors N sN]. rewrite perm_cons -[mksrepr _ _ :: _]/(mkfactors N2 [:: N & sN]). apply: Hi=> //; rewrite /acomps ?lst2 //= lsN csN andbT /=. apply: asimple_quo_maxainv=> //; first by apply: subIset; rewrite sN1D. have e : N1 :&: N2 :=: N2 :&: N1 by rewrite setIC. rewrite (group_inj (setIC N1 N2)); apply: asimpleI => //. by apply: subset_trans (normal_norm nN1G); apply: normal_sub. rewrite -quotientMidl (maxainvM _ _ maxN_1) //. exact: maxainv_asimple_quo. pose fG1 := [:: mksrepr G N1, mksrepr N1 N & mkfactors N sN]. pose fG2 := [:: mksrepr G N2, mksrepr N2 N & mkfactors N sN]. have i3 : perm_eq fG1 fG2. rewrite (@perm_catCA _ [::_] [::_]) /mksrepr. rewrite (@section_repr_isog _ (mkSec _ _) (mkSec _ _) iso1). rewrite -(@section_repr_isog _ (mkSec _ _) (mkSec _ _) iso2). exact: perm_refl. apply: (perm_trans i1); apply: (perm_trans i3); rewrite perm_sym. by apply: perm_trans i2; apply: perm_refl. Qed. End StrongJordanHolder. math-comp-mathcomp-1.12.0/mathcomp/solvable/maximal.v000066400000000000000000002223361375767750300225600ustar00rootroot00000000000000(* (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 choice. From mathcomp Require Import div fintype finfun bigop finset prime binomial. From mathcomp Require Import fingroup morphism perm automorphism quotient. From mathcomp Require Import action commutator gproduct gfunctor ssralg. From mathcomp Require Import finalg zmodp cyclic pgroup center gseries. From mathcomp Require Import nilpotent sylow abelian finmodule. (******************************************************************************) (* This file establishes basic properties of several important classes of *) (* maximal subgroups: maximal, max and min normal, simple, characteristically *) (* simple subgroups, the Frattini and Fitting subgroups, the Thompson *) (* critical subgroup, special and extra-special groups, and self-centralising *) (* normal (SCN) subgroups. In detail, we define: *) (* charsimple G == G is characteristically simple (it has no nontrivial *) (* characteristic subgroups, and is nontrivial) *) (* 'Phi(G) == the Frattini subgroup of G, i.e., the intersection of *) (* all its maximal proper subgroups. *) (* 'F(G) == the Fitting subgroup of G, i.e., the largest normal *) (* nilpotent subgroup of G (defined as the (direct) *) (* product of all the p-cores of G). *) (* critical C G == C is a critical subgroup of G: C is characteristic *) (* (but not functorial) in G, the center of C contains *) (* both its Frattini subgroup and the commutator [G, C], *) (* and is equal to the centraliser of C in G. The *) (* Thompson_critical theorem provides critical subgroups *) (* for p-groups; we also show that in this case the *) (* centraliser of C in Aut G is a p-group as well. *) (* special G == G is a special group: its center, Frattini, and *) (* derived sugroups coincide (we follow Aschbacher in *) (* not considering nontrivial elementary abelian groups *) (* as special); we show that a p-group factors under *) (* coprime action into special groups (Aschbacher 24.7). *) (* extraspecial G == G is a special group whose center has prime order *) (* (hence G is non-abelian). *) (* 'SCN(G) == the set of self-centralising normal abelian subgroups *) (* of G (the A <| G such that 'C_G(A) = A). *) (* 'SCN_n(G) == the subset of 'SCN(G) containing all groups with rank *) (* at least n (i.e., A \in 'SCN(G) and 'm(A) >= n). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section Defs. Variable gT : finGroupType. Implicit Types (A B D : {set gT}) (G : {group gT}). Definition charsimple A := [min A of G | G :!=: 1 & G \char A]. Definition Frattini A := \bigcap_(G : {group gT} | maximal_eq G A) G. Canonical Frattini_group A : {group gT} := Eval hnf in [group of Frattini A]. Definition Fitting A := \big[dprod/1]_(p <- primes #|A|) 'O_p(A). Lemma Fitting_group_set G : group_set (Fitting G). Proof. suffices [F ->]: exists F : {group gT}, Fitting G = F by apply: groupP. rewrite /Fitting; elim: primes (primes_uniq #|G|) => [_|p r IHr] /=. by exists [1 gT]%G; rewrite big_nil. case/andP=> rp /IHr[F defF]; rewrite big_cons defF. suffices{IHr} /and3P[p'F sFG nFG]: p^'.-group F && (F <| G). have nFGp: 'O_p(G) \subset 'N(F) := gFsub_trans _ nFG. have pGp: p.-group('O_p(G)) := pcore_pgroup p G. have{pGp} tiGpF: 'O_p(G) :&: F = 1 by rewrite coprime_TIg ?(pnat_coprime pGp). exists ('O_p(G) <*> F)%G; rewrite dprodEY // (sameP commG1P trivgP) -tiGpF. by rewrite subsetI commg_subl commg_subr (subset_trans sFG) // gFnorm. move/bigdprodWY: defF => <- {F}; elim: r rp => [_|q r IHr] /=. by rewrite big_nil gen0 pgroup1 normal1. rewrite inE eq_sym big_cons -joingE -joing_idr => /norP[qp /IHr {IHr}]. set F := <<_>> => /andP[p'F nsFG]. rewrite norm_joinEl /= -/F; last exact/gFsub_trans/normal_norm. by rewrite pgroupM p'F normalM ?pcore_normal //= (pi_pgroup (pcore_pgroup q G)). Qed. Canonical Fitting_group G := group (Fitting_group_set G). Definition critical A B := [/\ A \char B, Frattini A \subset 'Z(A), [~: B, A] \subset 'Z(A) & 'C_B(A) = 'Z(A)]. Definition special A := Frattini A = 'Z(A) /\ A^`(1) = 'Z(A). Definition extraspecial A := special A /\ prime #|'Z(A)|. Definition SCN B := [set A : {group gT} | A <| B & 'C_B(A) == A]. Definition SCN_at n B := [set A in SCN B | n <= 'r(A)]. End Defs. Arguments charsimple {gT} A%g. Arguments Frattini {gT} A%g. Arguments Fitting {gT} A%g. Arguments critical {gT} A%g B%g. Arguments special {gT} A%g. Arguments extraspecial {gT} A%g. Arguments SCN {gT} B%g. Arguments SCN_at {gT} n%N B%g. Notation "''Phi' ( A )" := (Frattini A) (at level 8, format "''Phi' ( A )") : group_scope. Notation "''Phi' ( G )" := (Frattini_group G) : Group_scope. Notation "''F' ( G )" := (Fitting G) (at level 8, format "''F' ( G )") : group_scope. Notation "''F' ( G )" := (Fitting_group G) : Group_scope. Notation "''SCN' ( B )" := (SCN B) (at level 8, format "''SCN' ( B )") : group_scope. Notation "''SCN_' n ( B )" := (SCN_at n B) (at level 8, n at level 2, format "''SCN_' n ( B )") : group_scope. Section PMax. Variables (gT : finGroupType) (p : nat) (P M : {group gT}). Hypothesis pP : p.-group P. Lemma p_maximal_normal : maximal M P -> M <| P. Proof. case/maxgroupP=> /andP[sMP sPM] maxM; rewrite /normal sMP. have:= subsetIl P 'N(M); rewrite subEproper. case/predU1P=> [/setIidPl-> // | /maxM/= SNM]; case/negP: sPM. rewrite (nilpotent_sub_norm (pgroup_nil pP) sMP) //. by rewrite SNM // subsetI sMP normG. Qed. Lemma p_maximal_index : maximal M P -> #|P : M| = p. Proof. move=> maxM; have nM := p_maximal_normal maxM. rewrite -card_quotient ?normal_norm //. rewrite -(quotient_maximal _ nM) ?normal_refl // trivg_quotient in maxM. case/maxgroupP: maxM; rewrite properEneq eq_sym sub1G andbT /=. case/(pgroup_pdiv (quotient_pgroup M pP)) => p_pr /Cauchy[] // xq. rewrite /order -cycle_subG subEproper => /predU1P[-> // | sxPq oxq_p _]. by move/(_ _ sxPq (sub1G _)) => xq1; rewrite -oxq_p xq1 cards1 in p_pr. Qed. Lemma p_index_maximal : M \subset P -> prime #|P : M| -> maximal M P. Proof. move=> sMP /primeP[lt1PM pr_PM]. apply/maxgroupP; rewrite properEcard sMP -(Lagrange sMP). rewrite -{1}(muln1 #|M|) ltn_pmul2l //; split=> // H sHP sMH. apply/eqP; rewrite eq_sym eqEcard sMH. case/orP: (pr_PM _ (indexSg sMH (proper_sub sHP))) => /eqP iM. by rewrite -(Lagrange sMH) iM muln1 /=. by have:= proper_card sHP; rewrite -(Lagrange sMH) iM Lagrange ?ltnn. Qed. End PMax. Section Frattini. Variables gT : finGroupType. Implicit Type G M : {group gT}. Lemma Phi_sub G : 'Phi(G) \subset G. Proof. by rewrite bigcap_inf // /maximal_eq eqxx. Qed. Lemma Phi_sub_max G M : maximal M G -> 'Phi(G) \subset M. Proof. by move=> maxM; rewrite bigcap_inf // /maximal_eq predU1r. Qed. Lemma Phi_proper G : G :!=: 1 -> 'Phi(G) \proper G. Proof. move/eqP; case/maximal_exists: (sub1G G) => [<- //| [M maxM _] _]. exact: sub_proper_trans (Phi_sub_max maxM) (maxgroupp maxM). Qed. Lemma Phi_nongen G X : 'Phi(G) <*> X = G -> <> = G. Proof. move=> defG; have: <> \subset G by rewrite -{1}defG genS ?subsetUr. case/maximal_exists=> //= [[M maxM]]; rewrite gen_subG => sXM. case/andP: (maxgroupp maxM) => _ /negP[]. by rewrite -defG gen_subG subUset Phi_sub_max. Qed. Lemma Frattini_continuous (rT : finGroupType) G (f : {morphism G >-> rT}) : f @* 'Phi(G) \subset 'Phi(f @* G). Proof. apply/bigcapsP=> M maxM; rewrite sub_morphim_pre ?Phi_sub // bigcap_inf //. have {2}<-: f @*^-1 (f @* G) = G by rewrite morphimGK ?subsetIl. by rewrite morphpre_maximal_eq ?maxM //; case/maximal_eqP: maxM. Qed. End Frattini. Canonical Frattini_igFun := [igFun by Phi_sub & Frattini_continuous]. Canonical Frattini_gFun := [gFun by Frattini_continuous]. Section Frattini0. Variable gT : finGroupType. Implicit Types (rT : finGroupType) (D G : {group gT}). Lemma Phi_char G : 'Phi(G) \char G. Proof. exact: gFchar. Qed. Lemma Phi_normal G : 'Phi(G) <| G. Proof. exact: gFnormal. Qed. Lemma injm_Phi rT D G (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> f @* 'Phi(G) = 'Phi(f @* G). Proof. exact: injmF. Qed. Lemma isog_Phi rT G (H : {group rT}) : G \isog H -> 'Phi(G) \isog 'Phi(H). Proof. exact: gFisog. Qed. Lemma PhiJ G x : 'Phi(G :^ x) = 'Phi(G) :^ x. Proof. rewrite -{1}(setIid G) -(setIidPr (Phi_sub G)) -!morphim_conj. by rewrite injm_Phi ?injm_conj. Qed. End Frattini0. Section Frattini2. Variables gT : finGroupType. Implicit Type G : {group gT}. Lemma Phi_quotient_id G : 'Phi (G / 'Phi(G)) = 1. Proof. apply/trivgP; rewrite -cosetpreSK cosetpre1 /=; apply/bigcapsP=> M maxM. have nPhi := Phi_normal G; have nPhiM: 'Phi(G) <| M. by apply: normalS nPhi; [apply: bigcap_inf | case/maximal_eqP: maxM]. by rewrite sub_cosetpre_quo ?bigcap_inf // quotient_maximal_eq. Qed. Lemma Phi_quotient_cyclic G : cyclic (G / 'Phi(G)) -> cyclic G. Proof. case/cyclicP=> /= Px; case: (cosetP Px) => x nPx ->{Px} defG. apply/cyclicP; exists x; symmetry; apply: Phi_nongen. rewrite -joing_idr norm_joinEr -?quotientK ?cycle_subG //. by rewrite /quotient morphim_cycle //= -defG quotientGK ?Phi_normal. Qed. Variables (p : nat) (P : {group gT}). Lemma trivg_Phi : p.-group P -> ('Phi(P) == 1) = p.-abelem P. Proof. move=> pP; case: (eqsVneq P 1) => [P1 | ntP]. by rewrite P1 abelem1 -subG1 -P1 Phi_sub. have [p_pr _ _] := pgroup_pdiv pP ntP. apply/eqP/idP=> [trPhi | abP]. apply/abelemP=> //; split=> [|x Px]. apply/commG1P/trivgP; rewrite -trPhi. apply/bigcapsP=> M /predU1P[-> | maxM]; first exact: der1_subG. have /andP[_ nMP]: M <| P := p_maximal_normal pP maxM. rewrite der1_min // cyclic_abelian // prime_cyclic // card_quotient //. by rewrite (p_maximal_index pP). apply/set1gP; rewrite -trPhi; apply/bigcapP=> M. case/predU1P=> [-> | maxM]; first exact: groupX. have /andP[_ nMP] := p_maximal_normal pP maxM. have nMx : x \in 'N(M) by apply: subsetP Px. apply: coset_idr; rewrite ?groupX ?morphX //=; apply/eqP. rewrite -(p_maximal_index pP maxM) -card_quotient // -order_dvdn cardSg //=. by rewrite cycle_subG mem_quotient. apply/trivgP/subsetP=> x Phi_x; rewrite -cycle_subG. have Px: x \in P by apply: (subsetP (Phi_sub P)). have sxP: <[x]> \subset P by rewrite cycle_subG. case/splitsP: (abelem_splits abP sxP) => K /complP[tiKx defP]. have [-> | nt_x] := eqVneq x 1; first by rewrite cycle1. have oxp := abelem_order_p abP Px nt_x. rewrite /= -tiKx subsetI subxx cycle_subG. apply: (bigcapP Phi_x); apply/orP; right. apply: p_index_maximal; rewrite -?divgS -defP ?mulG_subr //. by rewrite (TI_cardMg tiKx) mulnK // [#|_|]oxp. Qed. End Frattini2. Section Frattini3. Variables (gT : finGroupType) (p : nat) (P : {group gT}). Hypothesis pP : p.-group P. Lemma Phi_quotient_abelem : p.-abelem (P / 'Phi(P)). Proof. by rewrite -trivg_Phi ?morphim_pgroup //= Phi_quotient_id. Qed. Lemma Phi_joing : 'Phi(P) = P^`(1) <*> 'Mho^1(P). Proof. have [sPhiP nPhiP] := andP (Phi_normal P). apply/eqP; rewrite eqEsubset join_subG. case: (eqsVneq P 1) => [-> | ntP] in sPhiP *. by rewrite /= (trivgP sPhiP) sub1G der_subS Mho_sub. have [p_pr _ _] := pgroup_pdiv pP ntP. have [abP x1P] := abelemP p_pr Phi_quotient_abelem. apply/andP; split. have nMP: P \subset 'N(P^`(1) <*> 'Mho^1(P)) by rewrite normsY // !gFnorm. rewrite -quotient_sub1 ?gFsub_trans //=. suffices <-: 'Phi(P / (P^`(1) <*> 'Mho^1(P))) = 1 by apply: morphimF. apply/eqP; rewrite (trivg_Phi (morphim_pgroup _ pP)) /= -quotientE. apply/abelemP=> //; rewrite [abelian _]quotient_cents2 ?joing_subl //. split=> // _ /morphimP[x Nx Px ->] /=. rewrite -morphX //= coset_id // (MhoE 1 pP) joing_idr expn1. by rewrite mem_gen //; apply/setUP; right; apply: imset_f. rewrite -quotient_cents2 // [_ \subset 'C(_)]abP (MhoE 1 pP) gen_subG /=. apply/subsetP=> _ /imsetP[x Px ->]; rewrite expn1. have nPhi_x: x \in 'N('Phi(P)) by apply: (subsetP nPhiP). by rewrite coset_idr ?groupX ?morphX ?x1P ?mem_morphim. Qed. Lemma Phi_Mho : abelian P -> 'Phi(P) = 'Mho^1(P). Proof. by move=> cPP; rewrite Phi_joing (derG1P cPP) joing1G. Qed. End Frattini3. Section Frattini4. Variables (p : nat) (gT : finGroupType). Implicit Types (rT : finGroupType) (P G H K D : {group gT}). Lemma PhiS G H : p.-group H -> G \subset H -> 'Phi(G) \subset 'Phi(H). Proof. move=> pH sGH; rewrite (Phi_joing pH) (Phi_joing (pgroupS sGH pH)). by rewrite genS // setUSS ?dergS ?MhoS. Qed. Lemma morphim_Phi rT P D (f : {morphism D >-> rT}) : p.-group P -> P \subset D -> f @* 'Phi(P) = 'Phi(f @* P). Proof. move=> pP sPD; rewrite !(@Phi_joing _ p) ?morphim_pgroup //. rewrite morphim_gen ?subUset ?gFsub_trans // morphimU -joingE. by rewrite morphimR ?morphim_Mho. Qed. Lemma quotient_Phi P H : p.-group P -> P \subset 'N(H) -> 'Phi(P) / H = 'Phi(P / H). Proof. exact: morphim_Phi. Qed. (* This is Aschbacher (23.2) *) Lemma Phi_min G H : p.-group G -> G \subset 'N(H) -> p.-abelem (G / H) -> 'Phi(G) \subset H. Proof. move=> pG nHG; rewrite -trivg_Phi ?quotient_pgroup // -subG1 /=. by rewrite -(quotient_Phi pG) ?quotient_sub1 // gFsub_trans. Qed. Lemma Phi_cprod G H K : p.-group G -> H \* K = G -> 'Phi(H) \* 'Phi(K) = 'Phi(G). Proof. move=> pG defG; have [_ /mulG_sub[sHG sKG] cHK] := cprodP defG. rewrite cprodEY /=; last by rewrite (centSS (Phi_sub _) (Phi_sub _)). rewrite !(Phi_joing (pgroupS _ pG)) //=. have /cprodP[_ <- /cent_joinEr <-] := der_cprod 1 defG. have /cprodP[_ <- /cent_joinEr <-] := Mho_cprod 1 defG. by rewrite !joingA /= -!(joingA H^`(1)) (joingC K^`(1)). Qed. Lemma Phi_mulg H K : p.-group H -> p.-group K -> K \subset 'C(H) -> 'Phi(H * K) = 'Phi(H) * 'Phi(K). Proof. move=> pH pK cHK; have defHK := cprodEY cHK. have [|_ ->] /= := cprodP (Phi_cprod _ defHK); rewrite cent_joinEr //. by rewrite pgroupM pH. Qed. Lemma charsimpleP G : reflect (G :!=: 1 /\ forall K, K :!=: 1 -> K \char G -> K :=: G) (charsimple G). Proof. apply: (iffP mingroupP); rewrite char_refl andbT => -[ntG simG]. by split=> // K ntK chK; apply: simG; rewrite ?ntK // char_sub. by split=> // K /andP[ntK chK] _; apply: simG. Qed. End Frattini4. Section Fitting. Variable gT : finGroupType. Implicit Types (p : nat) (G H : {group gT}). Lemma Fitting_normal G : 'F(G) <| G. Proof. rewrite -['F(G)](bigdprodWY (erefl 'F(G))). elim/big_rec: _ => [|p H _ nsHG]; first by rewrite gen0 normal1. by rewrite -[<<_>>]joing_idr normalY ?pcore_normal. Qed. Lemma Fitting_sub G : 'F(G) \subset G. Proof. by rewrite normal_sub ?Fitting_normal. Qed. Lemma Fitting_nil G : nilpotent 'F(G). Proof. apply: (bigdprod_nil (erefl 'F(G))) => p _. exact: pgroup_nil (pcore_pgroup p G). Qed. Lemma Fitting_max G H : H <| G -> nilpotent H -> H \subset 'F(G). Proof. move=> nsHG nilH; rewrite -(Sylow_gen H) gen_subG. apply/bigcupsP=> P /SylowP[p _ sylP]. case Gp: (p \in \pi(G)); last first. rewrite card1_trivg ?sub1G // (card_Hall sylP). rewrite part_p'nat // (pnat_dvd (cardSg (normal_sub nsHG))) //. by rewrite /pnat cardG_gt0 all_predC has_pred1 Gp. rewrite {P sylP}(nilpotent_Hall_pcore nilH sylP). rewrite -(bigdprodWY (erefl 'F(G))) sub_gen //. rewrite -(filter_pi_of (ltnSn _)) big_filter big_mkord. apply: (bigcup_max (Sub p _)) => //= [|_]. by have:= Gp; rewrite ltnS mem_primes => /and3P[_ ntG /dvdn_leq->]. by rewrite pcore_max ?pcore_pgroup ?gFnormal_trans. Qed. Lemma pcore_Fitting pi G : 'O_pi('F(G)) \subset 'O_pi(G). Proof. by rewrite pcore_max ?pcore_pgroup ?gFnormal_trans ?Fitting_normal. Qed. Lemma p_core_Fitting p G : 'O_p('F(G)) = 'O_p(G). Proof. apply/eqP; rewrite eqEsubset pcore_Fitting pcore_max ?pcore_pgroup //. apply: normalS (normal_sub (Fitting_normal _)) (pcore_normal _ _). exact: Fitting_max (pcore_normal _ _) (pgroup_nil (pcore_pgroup _ _)). Qed. Lemma nilpotent_Fitting G : nilpotent G -> 'F(G) = G. Proof. by move=> nilG; apply/eqP; rewrite eqEsubset Fitting_sub Fitting_max. Qed. Lemma Fitting_eq_pcore p G : 'O_p^'(G) = 1 -> 'F(G) = 'O_p(G). Proof. move=> p'G1; have /dprodP[_ /= <- _ _] := nilpotent_pcoreC p (Fitting_nil G). by rewrite p_core_Fitting ['O_p^'(_)](trivgP _) ?mulg1 // -p'G1 pcore_Fitting. Qed. Lemma FittingEgen G : 'F(G) = <<\bigcup_(p < #|G|.+1 | (p : nat) \in \pi(G)) 'O_p(G)>>. Proof. apply/eqP; rewrite eqEsubset gen_subG /=. rewrite -{1}(bigdprodWY (erefl 'F(G))) (big_nth 0) big_mkord genS. by apply/bigcupsP=> p _; rewrite -p_core_Fitting pcore_sub. apply/bigcupsP=> [[i /= lti]] _; set p := nth _ _ i. have pi_p: p \in \pi(G) by rewrite mem_nth. have p_dv_G: p %| #|G| by rewrite mem_primes in pi_p; case/and3P: pi_p. have lepG: p < #|G|.+1 by rewrite ltnS dvdn_leq. by rewrite (bigcup_max (Ordinal lepG)). Qed. End Fitting. Section FittingFun. Implicit Types gT rT : finGroupType. Lemma morphim_Fitting : GFunctor.pcontinuous (@Fitting). Proof. move=> gT rT G D f; apply: Fitting_max. by rewrite morphim_normal ?Fitting_normal. by rewrite morphim_nil ?Fitting_nil. Qed. Lemma FittingS gT (G H : {group gT}) : H \subset G -> H :&: 'F(G) \subset 'F(H). Proof. move=> sHG; rewrite -{2}(setIidPl sHG). do 2!rewrite -(morphim_idm (subsetIl H _)) morphimIdom; apply: morphim_Fitting. Qed. Lemma FittingJ gT (G : {group gT}) x : 'F(G :^ x) = 'F(G) :^ x. Proof. rewrite !FittingEgen -genJ /= cardJg; symmetry; congr <<_>>. rewrite (big_morph (conjugate^~ x) (fun A B => conjUg A B x) (imset0 _)). by apply: eq_bigr => p _; rewrite pcoreJ. Qed. End FittingFun. Canonical Fitting_igFun := [igFun by Fitting_sub & morphim_Fitting]. Canonical Fitting_gFun := [gFun by morphim_Fitting]. Canonical Fitting_pgFun := [pgFun by morphim_Fitting]. Section IsoFitting. Variables (gT rT : finGroupType) (G D : {group gT}) (f : {morphism D >-> rT}). Lemma Fitting_char : 'F(G) \char G. Proof. exact: gFchar. Qed. Lemma injm_Fitting : 'injm f -> G \subset D -> f @* 'F(G) = 'F(f @* G). Proof. exact: injmF. Qed. Lemma isog_Fitting (H : {group rT}) : G \isog H -> 'F(G) \isog 'F(H). Proof. exact: gFisog. Qed. End IsoFitting. Section CharSimple. Variable gT : finGroupType. Implicit Types (rT : finGroupType) (G H K L : {group gT}) (p : nat). Lemma minnormal_charsimple G H : minnormal H G -> charsimple H. Proof. case/mingroupP=> /andP[ntH nHG] minH. apply/charsimpleP; split=> // K ntK chK. by apply: minH; rewrite ?ntK (char_sub chK, char_norm_trans chK). Qed. Lemma maxnormal_charsimple G H L : G <| L -> maxnormal H G L -> charsimple (G / H). Proof. case/andP=> sGL nGL /maxgroupP[/andP[/andP[sHG not_sGH] nHL] maxH]. have nHG: G \subset 'N(H) := subset_trans sGL nHL. apply/charsimpleP; rewrite -subG1 quotient_sub1 //; split=> // HK ntHK chHK. case/(inv_quotientN _): (char_normal chHK) => [|K defHK sHK]; first exact/andP. case/andP; rewrite subEproper defHK => /predU1P[-> // | ltKG] nKG. have nHK: H <| K by rewrite /normal sHK (subset_trans (proper_sub ltKG)). case/negP: ntHK; rewrite defHK -subG1 quotient_sub1 ?normal_norm //. rewrite (maxH K) // ltKG -(quotientGK nHK) -defHK norm_quotient_pre //. by rewrite (char_norm_trans chHK) ?quotient_norms. Qed. Lemma abelem_split_dprod rT p (A B : {group rT}) : p.-abelem A -> B \subset A -> exists C : {group rT}, B \x C = A. Proof. move=> abelA sBA; have [_ cAA _]:= and3P abelA. case/splitsP: (abelem_splits abelA sBA) => C /complP[tiBC defA]. by exists C; rewrite dprodE // (centSS _ sBA cAA) // -defA mulG_subr. Qed. Lemma p_abelem_split1 rT p (A : {group rT}) x : p.-abelem A -> x \in A -> exists B : {group rT}, [/\ B \subset A, #|B| = #|A| %/ #[x] & <[x]> \x B = A]. Proof. move=> abelA Ax; have sxA: <[x]> \subset A by rewrite cycle_subG. have [B defA] := abelem_split_dprod abelA sxA. have [_ defxB _ ti_xB] := dprodP defA. have sBA: B \subset A by rewrite -defxB mulG_subr. by exists B; split; rewrite // -defxB (TI_cardMg ti_xB) mulKn ?order_gt0. Qed. Lemma abelem_charsimple p G : p.-abelem G -> G :!=: 1 -> charsimple G. Proof. move=> abelG ntG; apply/charsimpleP; split=> // K ntK /charP[sKG chK]. case/eqVproper: sKG => // /properP[sKG [x Gx notKx]]. have ox := abelem_order_p abelG Gx (group1_contra notKx). have [A [sAG oA defA]] := p_abelem_split1 abelG Gx. case/trivgPn: ntK => y Ky nty; have Gy := subsetP sKG y Ky. have{nty} oy := abelem_order_p abelG Gy nty. have [B [sBG oB defB]] := p_abelem_split1 abelG Gy. have: isog A B; last case/isogP=> fAB injAB defAB. rewrite (isog_abelem_card _ (abelemS sAG abelG)) (abelemS sBG) //=. by rewrite oA oB ox oy. have: isog <[x]> <[y]>; last case/isogP=> fxy injxy /= defxy. by rewrite isog_cyclic_card ?cycle_cyclic // [#|_|]oy -ox eqxx. have cfxA: fAB @* A \subset 'C(fxy @* <[x]>). by rewrite defAB defxy; case/dprodP: defB. have injf: 'injm (dprodm defA cfxA). by rewrite injm_dprodm injAB injxy defAB defxy; apply/eqP; case/dprodP: defB. case/negP: notKx; rewrite -cycle_subG -(injmSK injf) ?cycle_subG //=. rewrite morphim_dprodml // defxy cycle_subG /= chK //. have [_ {4}<- _ _] := dprodP defB; have [_ {3}<- _ _] := dprodP defA. by rewrite morphim_dprodm // defAB defxy. Qed. Lemma charsimple_dprod G : charsimple G -> exists H : {group gT}, [/\ H \subset G, simple H & exists2 I : {set {perm gT}}, I \subset Aut G & \big[dprod/1]_(f in I) f @: H = G]. Proof. case/charsimpleP=> ntG simG. have [H minH sHG]: {H : {group gT} | minnormal H G & H \subset G}. by apply: mingroup_exists; rewrite ntG normG. case/mingroupP: minH => /andP[ntH nHG] minH. pose Iok (I : {set {perm gT}}) := (I \subset Aut G) && [exists (M : {group gT} | M <| G), \big[dprod/1]_(f in I) f @: H == M]. have defH: (1 : {perm gT}) @: H = H. apply/eqP; rewrite eqEcard card_imset ?leqnn; last exact: perm_inj. by rewrite andbT; apply/subsetP=> _ /imsetP[x Hx ->]; rewrite perm1. have [|I] := @maxset_exists _ Iok 1. rewrite /Iok sub1G; apply/existsP; exists H. by rewrite /normal sHG nHG (big_pred1 1) => [|f]; rewrite ?defH /= ?inE. case/maxsetP=> /andP[Aut_I /exists_eq_inP[M /andP[sMG nMG] defM]] maxI. rewrite sub1set=> ntI; case/eqVproper: sMG => [defG | /andP[sMG not_sGM]]. exists H; split=> //; last by exists I; rewrite ?defM. apply/mingroupP; rewrite ntH normG; split=> // N /andP[ntN nNH] sNH. apply: minH => //; rewrite ntN /= -defG. move: defM; rewrite (bigD1 1) //= defH; case/dprodP=> [[_ K _ ->] <- cHK _]. by rewrite mul_subG // cents_norm // (subset_trans cHK) ?centS. have defG: <<\bigcup_(f in Aut G) f @: H>> = G. have sXG: \bigcup_(f in Aut G) f @: H \subset G. by apply/bigcupsP=> f Af; rewrite -(im_autm Af) morphimEdom imsetS. apply: simG. apply: contra ntH; rewrite -!subG1; apply: subset_trans. by rewrite sub_gen // (bigcup_max 1) ?group1 ?defH. rewrite /characteristic gen_subG sXG; apply/forall_inP=> f Af. rewrite -(autmE Af) -morphimEsub ?gen_subG ?morphim_gen // genS //. rewrite morphimEsub //= autmE. apply/subsetP=> _ /imsetP[_ /bigcupP[g Ag /imsetP[x Hx ->]] ->]. apply/bigcupP; exists (g * f); first exact: groupM. by apply/imsetP; exists x; rewrite // permM. have [f Af sfHM]: exists2 f, f \in Aut G & ~~ (f @: H \subset M). move: not_sGM; rewrite -{1}defG gen_subG; case/subsetPn=> x. by case/bigcupP=> f Af fHx Mx; exists f => //; apply/subsetPn; exists x. case If: (f \in I). by case/negP: sfHM; rewrite -(bigdprodWY defM) sub_gen // (bigcup_max f). case/idP: (If); rewrite -(maxI ([set f] :|: I)) ?subsetUr ?inE ?eqxx //. rewrite {maxI}/Iok subUset sub1set Af {}Aut_I; apply/existsP. have sfHG: autm Af @* H \subset G by rewrite -{4}(im_autm Af) morphimS. have{minH nHG} /mingroupP[/andP[ntfH nfHG] minfH]: minnormal (autm Af @* H) G. apply/mingroupP; rewrite andbC -{1}(im_autm Af) morphim_norms //=. rewrite -subG1 sub_morphim_pre // -kerE ker_autm subG1. split=> // N /andP[ntN nNG] sNfH. have sNG: N \subset G := subset_trans sNfH sfHG. apply/eqP; rewrite eqEsubset sNfH sub_morphim_pre //=. rewrite -(morphim_invmE (injm_autm Af)) [_ @* N]minH //=. rewrite -subG1 sub_morphim_pre /= ?im_autm // morphpre_invm morphim1 subG1. by rewrite ntN -{1}(im_invm (injm_autm Af)) /= {2}im_autm morphim_norms. by rewrite sub_morphim_pre /= ?im_autm // morphpre_invm. have{minfH sfHM} tifHM: autm Af @* H :&: M = 1. apply/eqP/idPn=> ntMfH; case/setIidPl: sfHM. rewrite -(autmE Af) -morphimEsub //. by apply: minfH; rewrite ?subsetIl // ntMfH normsI. have cfHM: M \subset 'C(autm Af @* H). rewrite centsC (sameP commG1P trivgP) -tifHM subsetI commg_subl commg_subr. by rewrite (subset_trans sMG) // (subset_trans sfHG). exists (autm Af @* H <*> M)%G; rewrite /normal /= join_subG sMG sfHG normsY //=. rewrite (bigD1 f) ?inE ?eqxx // (eq_bigl (mem I)) /= => [|g]; last first. by rewrite /= !inE andbC; case: eqP => // ->. by rewrite defM -(autmE Af) -morphimEsub // dprodE // cent_joinEr ?eqxx. Qed. Lemma simple_sol_prime G : solvable G -> simple G -> prime #|G|. Proof. move=> solG /simpleP[ntG simG]. have{solG} cGG: abelian G. apply/commG1P; case/simG: (der_normal 1 G) => // /eqP/idPn[]. by rewrite proper_neq // (sol_der1_proper solG). case: (trivgVpdiv G) ntG => [-> | [p p_pr]]; first by rewrite eqxx. case/Cauchy=> // x Gx oxp _; move: p_pr; rewrite -oxp orderE. have: <[x]> <| G by rewrite -sub_abelian_normal ?cycle_subG. by case/simG=> -> //; rewrite cards1. Qed. Lemma charsimple_solvable G : charsimple G -> solvable G -> is_abelem G. Proof. case/charsimple_dprod=> H [sHG simH [I Aut_I defG]] solG. have p_pr: prime #|H| by apply: simple_sol_prime (solvableS sHG solG) simH. set p := #|H| in p_pr; apply/is_abelemP; exists p => //. elim/big_rec: _ (G) defG => [_ <-|f B If IH_B M defM]; first exact: abelem1. have [Af [[_ K _ defB] _ _ _]] := (subsetP Aut_I f If, dprodP defM). rewrite (dprod_abelem p defM) defB IH_B // andbT -(autmE Af) -morphimEsub //=. rewrite morphim_abelem ?abelemE // exponent_dvdn. by rewrite cyclic_abelian ?prime_cyclic. Qed. Lemma minnormal_solvable L G H : minnormal H L -> H \subset G -> solvable G -> [/\ L \subset 'N(H), H :!=: 1 & is_abelem H]. Proof. move=> minH sHG solG; have /andP[ntH nHL] := mingroupp minH. split=> //; apply: (charsimple_solvable (minnormal_charsimple minH)). exact: solvableS solG. Qed. Lemma solvable_norm_abelem L G : solvable G -> G <| L -> G :!=: 1 -> exists H : {group gT}, [/\ H \subset G, H <| L, H :!=: 1 & is_abelem H]. Proof. move=> solG /andP[sGL nGL] ntG. have [H minH sHG]: {H : {group gT} | minnormal H L & H \subset G}. by apply: mingroup_exists; rewrite ntG. have [nHL ntH abH] := minnormal_solvable minH sHG solG. by exists H; split; rewrite // /normal (subset_trans sHG). Qed. Lemma trivg_Fitting G : solvable G -> ('F(G) == 1) = (G :==: 1). Proof. move=> solG; apply/idP/idP=> [F1 | /eqP->]; last by rewrite gF1. apply/idPn=> /(solvable_norm_abelem solG (normal_refl _))[M [_ nsMG ntM]]. case/is_abelemP=> p _ /and3P[pM _ _]; case/negP: ntM. by rewrite -subG1 -(eqP F1) Fitting_max ?(pgroup_nil pM). Qed. Lemma Fitting_pcore pi G : 'F('O_pi(G)) = 'O_pi('F(G)). Proof. apply/eqP; rewrite eqEsubset. rewrite (subset_trans _ (pcoreS _ (Fitting_sub _))); last first. by rewrite subsetI Fitting_sub Fitting_max ?Fitting_nil ?gFnormal_trans. rewrite (subset_trans _ (FittingS (pcore_sub _ _))) // subsetI pcore_sub. by rewrite pcore_max ?pcore_pgroup ?gFnormal_trans. Qed. End CharSimple. Section SolvablePrimeFactor. Variables (gT : finGroupType) (G : {group gT}). Lemma index_maxnormal_sol_prime (H : {group gT}) : solvable G -> maxnormal H G G -> prime #|G : H|. Proof. move=> solG maxH; have nsHG := maxnormal_normal maxH. rewrite -card_quotient ?normal_norm // simple_sol_prime ?quotient_sol //. by rewrite quotient_simple. Qed. Lemma sol_prime_factor_exists : solvable G -> G :!=: 1 -> {H : {group gT} | H <| G & prime #|G : H| }. Proof. move=> solG /ex_maxnormal_ntrivg[H maxH]. by exists H; [apply: maxnormal_normal | apply: index_maxnormal_sol_prime]. Qed. End SolvablePrimeFactor. Section Special. Variables (gT : finGroupType) (p : nat) (A G : {group gT}). (* This is Aschbacher (23.7) *) Lemma center_special_abelem : p.-group G -> special G -> p.-abelem 'Z(G). Proof. move=> pG [defPhi defG']. have [-> | ntG] := eqsVneq G 1; first by rewrite center1 abelem1. have [p_pr _ _] := pgroup_pdiv pG ntG. have fM: {in 'Z(G) &, {morph expgn^~ p : x y / x * y}}. by move=> x y /setIP[_ /centP cxG] /setIP[/cxG cxy _]; apply: expgMn. rewrite abelemE //= center_abelian; apply/exponentP=> /= z Zz. apply: (@kerP _ _ _ (Morphism fM)) => //; apply: subsetP z Zz. rewrite -{1}defG' gen_subG; apply/subsetP=> _ /imset2P[x y Gx Gy ->]. have Zxy: [~ x, y] \in 'Z(G) by rewrite -defG' mem_commg. have Zxp: x ^+ p \in 'Z(G). rewrite -defPhi (Phi_joing pG) (MhoE 1 pG) joing_idr mem_gen // !inE. by rewrite expn1 orbC (imset_f (expgn^~ p)). rewrite mem_morphpre /= ?defG' ?Zxy // inE -commXg; last first. by red; case/setIP: Zxy => _ /centP->. by apply/commgP; red; case/setIP: Zxp => _ /centP->. Qed. Lemma exponent_special : p.-group G -> special G -> exponent G %| p ^ 2. Proof. move=> pG spG; have [defPhi _] := spG. have /and3P[_ _ expZ] := center_special_abelem pG spG. apply/exponentP=> x Gx; rewrite expgM (exponentP expZ) // -defPhi. by rewrite (Phi_joing pG) mem_gen // inE orbC (Mho_p_elt 1) ?(mem_p_elt pG). Qed. (* Aschbacher 24.7 (replaces Gorenstein 5.3.7) *) Theorem abelian_charsimple_special : p.-group G -> coprime #|G| #|A| -> [~: G, A] = G -> \bigcup_(H : {group gT} | (H \char G) && abelian H) H \subset 'C(A) -> special G /\ 'C_G(A) = 'Z(G). Proof. move=> pG coGA defG /bigcupsP cChaA. have cZA: 'Z(G) \subset 'C_G(A). by rewrite subsetI center_sub cChaA // center_char center_abelian. have cChaG (H : {group gT}): H \char G -> abelian H -> H \subset 'Z(G). move=> chH abH; rewrite subsetI char_sub //= centsC -defG. rewrite comm_norm_cent_cent ?(char_norm chH) -?commg_subl ?defG //. by rewrite centsC cChaA ?chH. have cZ2GG: [~: 'Z_2(G), G, G] = 1. by apply/commG1P; rewrite (subset_trans (ucn_comm 1 G)) // ucn1 subsetIr. have{cZ2GG} cG'Z: 'Z_2(G) \subset 'C(G^`(1)). by rewrite centsC; apply/commG1P; rewrite three_subgroup // (commGC G). have{cG'Z} sZ2G'_Z: 'Z_2(G) :&: G^`(1) \subset 'Z(G). apply: cChaG; first by rewrite charI ?ucn_char ?der_char. by rewrite /abelian subIset // (subset_trans cG'Z) // centS ?subsetIr. have{sZ2G'_Z} sG'Z: G^`(1) \subset 'Z(G). rewrite der1_min ?gFnorm //; apply/derG1P. have /TI_center_nil: nilpotent (G / 'Z(G)) := quotient_nil _ (pgroup_nil pG). apply; first exact: gFnormal; rewrite /= setIC -ucn1 -ucn_central. rewrite -quotient_der ?gFnorm // -quotientGI ?ucn_subS ?quotientS1 //=. by rewrite ucn1. have sCG': 'C_G(A) \subset G^`(1). rewrite -quotient_sub1 //; last by rewrite subIset ?gFnorm. rewrite (subset_trans (quotient_subcent _ G A)) //= -[G in G / _]defG. have nGA: A \subset 'N(G) by rewrite -commg_subl defG. rewrite quotientR ?gFnorm_trans ?normG //. rewrite coprime_abel_cent_TI ?quotient_norms ?coprime_morph //. exact: sub_der1_abelian. have defZ: 'Z(G) = G^`(1) by apply/eqP; rewrite eqEsubset (subset_trans cZA). split; last by apply/eqP; rewrite eqEsubset cZA defZ sCG'. split=> //; apply/eqP; rewrite eqEsubset defZ (Phi_joing pG) joing_subl. have:= pG; rewrite -pnat_exponent => /p_natP[n expGpn]. rewrite join_subG subxx andbT /= -defZ -(subnn n.-1). elim: {2}n.-1 => [|m IHm]. rewrite (MhoE _ pG) gen_subG; apply/subsetP=> _ /imsetP[x Gx ->]. rewrite subn0 -subn1 -add1n -maxnE maxnC maxnE expnD. by rewrite expgM -expGpn expg_exponent ?groupX ?group1. rewrite cChaG ?Mho_char //= (MhoE _ pG) /abelian cent_gen gen_subG. apply/centsP=> _ /imsetP[x Gx ->] _ /imsetP[y Gy ->]. move: sG'Z; rewrite subsetI centsC => /andP[_ /centsP cGG']. apply/commgP; rewrite {1}expnSr expgM. rewrite commXg -?commgX; try by apply: cGG'; rewrite ?mem_commg ?groupX. apply/commgP; rewrite subsetI Mho_sub centsC in IHm. apply: (centsP IHm); first by rewrite groupX. rewrite -add1n -(addn1 m) subnDA -maxnE maxnC maxnE. rewrite -expgM -expnSr -addSn expnD expgM groupX //=. by rewrite Mho_p_elt ?(mem_p_elt pG). Qed. End Special. Section Extraspecial. Variables (p : nat) (gT rT : finGroupType). Implicit Types D E F G H K M R S T U : {group gT}. Section Basic. Variable S : {group gT}. Hypotheses (pS : p.-group S) (esS : extraspecial S). Let pZ : p.-group 'Z(S) := pgroupS (center_sub S) pS. Lemma extraspecial_prime : prime p. Proof. by case: esS => _ /prime_gt1; rewrite cardG_gt1; case/(pgroup_pdiv pZ). Qed. Lemma card_center_extraspecial : #|'Z(S)| = p. Proof. by apply/eqP; apply: (pgroupP pZ); case: esS. Qed. Lemma min_card_extraspecial : #|S| >= p ^ 3. Proof. have p_gt1 := prime_gt1 extraspecial_prime. rewrite leqNgt (card_pgroup pS) ltn_exp2l // ltnS. case: esS => [[_ defS']]; apply: contraL => /(p2group_abelian pS)/derG1P S'1. by rewrite -defS' S'1 cards1. Qed. End Basic. Lemma card_p3group_extraspecial E : prime p -> #|E| = (p ^ 3)%N -> #|'Z(E)| = p -> extraspecial E. Proof. move=> p_pr oEp3 oZp; have p_gt0 := prime_gt0 p_pr. have pE: p.-group E by rewrite /pgroup oEp3 pnatX pnat_id. have pEq: p.-group (E / 'Z(E))%g by rewrite quotient_pgroup. have /andP[sZE nZE] := center_normal E. have oEq: #|E / 'Z(E)|%g = (p ^ 2)%N. by rewrite card_quotient -?divgS // oEp3 oZp expnS mulKn. have cEEq: abelian (E / 'Z(E))%g by apply: card_p2group_abelian oEq. have not_cEE: ~~ abelian E. have: #|'Z(E)| < #|E| by rewrite oEp3 oZp (ltn_exp2l 1) ?prime_gt1. by apply: contraL => cEE; rewrite -leqNgt subset_leq_card // subsetI subxx. have defE': E^`(1) = 'Z(E). apply/eqP; rewrite eqEsubset der1_min //=; apply: contraR not_cEE => not_sE'Z. apply/commG1P/(TI_center_nil (pgroup_nil pE) (der_normal 1 _)). by rewrite setIC prime_TIg ?oZp. split; [split=> // | by rewrite oZp]; apply/eqP. rewrite eqEsubset andbC -{1}defE' {1}(Phi_joing pE) joing_subl. rewrite -quotient_sub1 ?gFsub_trans ?subG1 //=. rewrite (quotient_Phi pE) //= (trivg_Phi pEq). apply/abelemP=> //; split=> // Zx EqZx; apply/eqP; rewrite -order_dvdn /order. rewrite (card_pgroup (mem_p_elt pEq EqZx)) (@dvdn_exp2l _ _ 1) //. rewrite leqNgt -pfactor_dvdn // -oEq; apply: contra not_cEE => sEqZx. rewrite cyclic_center_factor_abelian //; apply/cyclicP. exists Zx; apply/eqP; rewrite eq_sym eqEcard cycle_subG EqZx -orderE. exact: dvdn_leq sEqZx. Qed. Lemma p3group_extraspecial G : p.-group G -> ~~ abelian G -> logn p #|G| <= 3 -> extraspecial G. Proof. move=> pG not_cGG; have /andP[sZG nZG] := center_normal G. have ntG: G :!=: 1 by apply: contraNneq not_cGG => ->; apply: abelian1. have ntZ: 'Z(G) != 1 by rewrite (center_nil_eq1 (pgroup_nil pG)). have [p_pr _ [n oG]] := pgroup_pdiv pG ntG; rewrite oG pfactorK //. have [_ _ [m oZ]] := pgroup_pdiv (pgroupS sZG pG) ntZ. have lt_m1_n: m.+1 < n. suffices: 1 < logn p #|(G / 'Z(G))|. rewrite card_quotient // -divgS // logn_div ?cardSg //. by rewrite oG oZ !pfactorK // ltn_subRL addn1. rewrite ltnNge; apply: contra not_cGG => cycGs. apply: cyclic_center_factor_abelian; rewrite (dvdn_prime_cyclic p_pr) //. by rewrite (card_pgroup (quotient_pgroup _ pG)) (dvdn_exp2l _ cycGs). rewrite -{lt_m1_n}(subnKC lt_m1_n) !addSn !ltnS leqn0 in oG *. case: m => // in oZ oG * => /eqP n2; rewrite {n}n2 in oG. exact: card_p3group_extraspecial oZ. Qed. Lemma extraspecial_nonabelian G : extraspecial G -> ~~ abelian G. Proof. case=> [[_ defG'] oZ]; rewrite /abelian (sameP commG1P eqP). by rewrite -derg1 defG' -cardG_gt1 prime_gt1. Qed. Lemma exponent_2extraspecial G : 2.-group G -> extraspecial G -> exponent G = 4. Proof. move=> p2G esG; have [spG _] := esG. case/dvdn_pfactor: (exponent_special p2G spG) => // k. rewrite leq_eqVlt ltnS => /predU1P[-> // | lek1] expG. case/negP: (extraspecial_nonabelian esG). by rewrite (@abelem_abelian _ 2) ?exponent2_abelem // expG pfactor_dvdn. Qed. Lemma injm_special D G (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> special G -> special (f @* G). Proof. move=> injf sGD [defPhiG defG']. by rewrite /special -morphim_der // -injm_Phi // defPhiG defG' injm_center. Qed. Lemma injm_extraspecial D G (f : {morphism D >-> rT}) : 'injm f -> G \subset D -> extraspecial G -> extraspecial (f @* G). Proof. move=> injf sGD [spG ZG_pr]; split; first exact: injm_special spG. by rewrite -injm_center // card_injm // subIset ?sGD. Qed. Lemma isog_special G (R : {group rT}) : G \isog R -> special G -> special R. Proof. by case/isogP=> f injf <-; apply: injm_special. Qed. Lemma isog_extraspecial G (R : {group rT}) : G \isog R -> extraspecial G -> extraspecial R. Proof. by case/isogP=> f injf <-; apply: injm_extraspecial. Qed. Lemma cprod_extraspecial G H K : p.-group G -> H \* K = G -> H :&: K = 'Z(H) -> extraspecial H -> extraspecial K -> extraspecial G. Proof. move=> pG defG ziHK [[PhiH defH'] ZH_pr] [[PhiK defK'] ZK_pr]. have [_ defHK cHK]:= cprodP defG. have sZHK: 'Z(H) \subset 'Z(K). by rewrite subsetI -{1}ziHK subsetIr subIset // centsC cHK. have{sZHK} defZH: 'Z(H) = 'Z(K). by apply/eqP; rewrite eqEcard sZHK leq_eqVlt eq_sym -dvdn_prime2 ?cardSg. have defZ: 'Z(G) = 'Z(K). by case/cprodP: (center_cprod defG) => /= _ <- _; rewrite defZH mulGid. split; first split; rewrite defZ //. by have /cprodP[_ <- _] := Phi_cprod pG defG; rewrite PhiH PhiK defZH mulGid. by have /cprodP[_ <- _] := der_cprod 1 defG; rewrite defH' defK' defZH mulGid. Qed. (* Lemmas bundling Aschbacher (23.10) with (19.1), (19.2), (19.12) and (20.8) *) Section ExtraspecialFormspace. Variable G : {group gT}. Hypotheses (pG : p.-group G) (esG : extraspecial G). Let p_pr := extraspecial_prime pG esG. Let oZ := card_center_extraspecial pG esG. Let p_gt1 := prime_gt1 p_pr. Let p_gt0 := prime_gt0 p_pr. (* This encasulates Aschbacher (23.10)(1). *) Lemma cent1_extraspecial_maximal x : x \in G -> x \notin 'Z(G) -> maximal 'C_G[x] G. Proof. move=> Gx notZx; pose f y := [~ x, y]; have [[_ defG'] prZ] := esG. have{defG'} fZ y: y \in G -> f y \in 'Z(G). by move=> Gy; rewrite -defG' mem_commg. have fM: {in G &, {morph f : y z / y * z}}%g. move=> y z Gy Gz; rewrite {1}/f commgMJ conjgCV -conjgM (conjg_fixP _) //. rewrite (sameP commgP cent1P); apply: subsetP (fZ y Gy). by rewrite subIset // orbC -cent_set1 centS // sub1set !(groupM, groupV). pose fm := Morphism fM. have fmG: fm @* G = 'Z(G). have sfmG: fm @* G \subset 'Z(G). by apply/subsetP=> _ /morphimP[z _ Gz ->]; apply: fZ. apply/eqP; rewrite eqEsubset sfmG; apply: contraR notZx => /(prime_TIg prZ). rewrite (setIidPr _) // => fmG1; rewrite inE Gx; apply/centP=> y Gy. by apply/commgP; rewrite -in_set1 -[[set _]]fmG1; apply: mem_morphim. have ->: 'C_G[x] = 'ker fm. apply/setP=> z; rewrite inE (sameP cent1P commgP) !inE. by rewrite -invg_comm eq_invg_mul mulg1. rewrite p_index_maximal ?subsetIl // -card_quotient ?ker_norm //. by rewrite (card_isog (first_isog fm)) /= fmG. Qed. (* This is the tranposition of the hyperplane dimension theorem (Aschbacher *) (* (19.1)) to subgroups of an extraspecial group. *) Lemma subcent1_extraspecial_maximal U x : U \subset G -> x \in G :\: 'C(U) -> maximal 'C_U[x] U. Proof. move=> sUG /setDP[Gx not_cUx]; apply/maxgroupP; split=> [|H ltHU sCxH]. by rewrite /proper subsetIl subsetI subxx sub_cent1. case/andP: ltHU => sHU not_sHU; have sHG := subset_trans sHU sUG. apply/eqP; rewrite eqEsubset sCxH subsetI sHU /= andbT. apply: contraR not_sHU => not_sHCx. have maxCx: maximal 'C_G[x] G. rewrite cent1_extraspecial_maximal //; apply: contra not_cUx. by rewrite inE Gx; apply: subsetP (centS sUG) _. have nsCx := p_maximal_normal pG maxCx. rewrite -(setIidPl sUG) -(mulg_normal_maximal nsCx maxCx sHG) ?subsetI ?sHG //. by rewrite -group_modr //= setIA (setIidPl sUG) mul_subG. Qed. (* This is the tranposition of the orthogonal subspace dimension theorem *) (* (Aschbacher (19.2)) to subgroups of an extraspecial group. *) Lemma card_subcent_extraspecial U : U \subset G -> #|'C_G(U)| = (#|'Z(G) :&: U| * #|G : U|)%N. Proof. move=> sUG; rewrite setIAC (setIidPr sUG). have [m leUm] := ubnP #|U|; elim: m => // m IHm in U leUm sUG *. have [cUG | not_cUG]:= orP (orbN (G \subset 'C(U))). by rewrite !(setIidPl _) ?Lagrange // centsC. have{not_cUG} [x Gx not_cUx] := subsetPn not_cUG. pose W := 'C_U[x]; have sCW_G: 'C_G(W) \subset G := subsetIl G _. have maxW: maximal W U by rewrite subcent1_extraspecial_maximal // inE not_cUx. have nsWU: W <| U := p_maximal_normal (pgroupS sUG pG) maxW. have ltWU: W \proper U by apply: maxgroupp maxW. have [sWU [u Uu notWu]] := properP ltWU; have sWG := subset_trans sWU sUG. have defU: W * <[u]> = U by rewrite (mulg_normal_maximal nsWU) ?cycle_subG. have iCW_CU: #|'C_G(W) : 'C_G(U)| = p. rewrite -defU centM cent_cycle setIA /=; rewrite inE Uu cent1C in notWu. apply: p_maximal_index (pgroupS sCW_G pG) _. apply: subcent1_extraspecial_maximal sCW_G _. rewrite inE andbC (subsetP sUG) //= -sub_cent1. by apply/subsetPn; exists x; rewrite // inE Gx -sub_cent1 subsetIr. apply/eqP; rewrite -(eqn_pmul2r p_gt0) -{1}iCW_CU Lagrange ?setIS ?centS //. rewrite IHm ?(leq_trans (proper_card ltWU)) // -setIA -mulnA. rewrite -(Lagrange_index sUG sWU) (p_maximal_index (pgroupS sUG pG)) //=. by rewrite -cent_set1 (setIidPr (centS _)) ?sub1set. Qed. (* This is the tranposition of the proof that a singular vector is contained *) (* in a hyperbolic plane (Aschbacher (19.12)) to subgroups of an extraspecial *) (* group. *) Lemma split1_extraspecial x : x \in G :\: 'Z(G) -> {E : {group gT} & {R : {group gT} | [/\ #|E| = (p ^ 3)%N /\ #|R| = #|G| %/ p ^ 2, E \* R = G /\ E :&: R = 'Z(E), 'Z(E) = 'Z(G) /\ 'Z(R) = 'Z(G), extraspecial E /\ x \in E & if abelian R then R :=: 'Z(G) else extraspecial R]}}. Proof. case/setDP=> Gx notZx; rewrite inE Gx /= in notZx. have [[defPhiG defG'] prZ] := esG. have maxCx: maximal 'C_G[x] G. by rewrite subcent1_extraspecial_maximal // inE notZx. pose y := repr (G :\: 'C[x]). have [Gy not_cxy]: y \in G /\ y \notin 'C[x]. move/maxgroupp: maxCx => /properP[_ [t Gt not_cyt]]. by apply/setDP; apply: (mem_repr t); rewrite !inE Gt andbT in not_cyt *. pose E := <[x]> <*> <[y]>; pose R := 'C_G(E). exists [group of E]; exists [group of R] => /=. have sEG: E \subset G by rewrite join_subG !cycle_subG Gx. have [Ex Ey]: x \in E /\ y \in E by rewrite !mem_gen // inE cycle_id ?orbT. have sZE: 'Z(G) \subset E. rewrite (('Z(G) =P E^`(1)) _) ?der_sub // eqEsubset -{2}defG' dergS // andbT. apply: contraR not_cxy => /= not_sZE'. rewrite (sameP cent1P commgP) -in_set1 -[[set 1]](prime_TIg prZ not_sZE'). by rewrite /= -defG' inE !mem_commg. have ziER: E :&: R = 'Z(E) by rewrite setIA (setIidPl sEG). have cER: R \subset 'C(E) by rewrite subsetIr. have iCxG: #|G : 'C_G[x]| = p by apply: p_maximal_index. have maxR: maximal R 'C_G[x]. rewrite /R centY !cent_cycle setIA. rewrite subcent1_extraspecial_maximal ?subsetIl // inE Gy andbT -sub_cent1. by apply/subsetPn; exists x; rewrite 1?cent1C // inE Gx cent1id. have sRCx: R \subset 'C_G[x] by rewrite -cent_cycle setIS ?centS ?joing_subl. have sCxG: 'C_G[x] \subset G by rewrite subsetIl. have sRG: R \subset G by rewrite subsetIl. have iRCx: #|'C_G[x] : R| = p by rewrite (p_maximal_index (pgroupS sCxG pG)). have defG: E * R = G. rewrite -cent_joinEr //= -/R joingC joingA. have cGx_x: <[x]> \subset 'C_G[x] by rewrite cycle_subG inE Gx cent1id. have nsRcx := p_maximal_normal (pgroupS sCxG pG) maxR. rewrite (norm_joinEr (subset_trans cGx_x (normal_norm nsRcx))). rewrite (mulg_normal_maximal nsRcx) //=; last first. by rewrite centY !cent_cycle cycle_subG !in_setI Gx cent1id cent1C. have nsCxG := p_maximal_normal pG maxCx. have syG: <[y]> \subset G by rewrite cycle_subG. rewrite (norm_joinEr (subset_trans syG (normal_norm nsCxG))). by rewrite (mulg_normal_maximal nsCxG) //= cycle_subG inE Gy. have defZR: 'Z(R) = 'Z(G) by rewrite -['Z(R)]setIA -centM defG. have defZE: 'Z(E) = 'Z(G). by rewrite -defG -center_prod ?mulGSid //= -ziER subsetI center_sub defZR sZE. have [n oG] := p_natP pG. have n_gt1: n > 1. by rewrite ltnW // -(@leq_exp2l p) // -oG min_card_extraspecial. have oR: #|R| = (p ^ n.-2)%N. apply/eqP; rewrite -(divg_indexS sRCx) iRCx /= -(divg_indexS sCxG) iCxG /= oG. by rewrite -{1}(subnKC n_gt1) subn2 !expnS !mulKn. have oE: #|E| = (p ^ 3)%N. apply/eqP; rewrite -(@eqn_pmul2r #|R|) ?cardG_gt0 // mul_cardG defG ziER. by rewrite defZE oZ oG -{1}(subnKC n_gt1) oR -expnSr -expnD subn2. rewrite cprodE // oR oG -expnB ?subn2 //; split=> //. by split=> //; apply: card_p3group_extraspecial _ oE _; rewrite // defZE. case: ifP => [cRR | not_cRR]; first by rewrite -defZR (center_idP _). split; rewrite /special defZR //. have ntR': R^`(1) != 1 by rewrite (sameP eqP commG1P) -abelianE not_cRR. have pR: p.-group R := pgroupS sRG pG. have pR': p.-group R^`(1) := pgroupS (der_sub 1 _) pR. have defR': R^`(1) = 'Z(G). apply/eqP; rewrite eqEcard -{1}defG' dergS //= oZ. by have [_ _ [k ->]]:= pgroup_pdiv pR' ntR'; rewrite (leq_exp2l 1). split=> //; apply/eqP; rewrite eqEsubset -{1}defPhiG -defR' (PhiS pG) //=. by rewrite (Phi_joing pR) joing_subl. Qed. (* This is the tranposition of the proof that the dimension of any maximal *) (* totally singular subspace is equal to the Witt index (Aschbacher (20.8)), *) (* to subgroups of an extraspecial group (in a slightly more general form, *) (* since we allow for p != 2). *) (* Note that Aschbacher derives this from the Witt lemma, which we avoid. *) Lemma pmaxElem_extraspecial : 'E*_p(G) = 'E_p^('r_p(G))(G). Proof. have sZmax: {in 'E*_p(G), forall E, 'Z(G) \subset E}. move=> E maxE; have defE := pmaxElem_LdivP p_pr maxE. have abelZ: p.-abelem 'Z(G) by rewrite prime_abelem ?oZ. rewrite -(Ohm1_id abelZ) (OhmE 1 (abelem_pgroup abelZ)) gen_subG -defE. by rewrite setSI // setIS ?centS // -defE !subIset ?subxx. suffices card_max: {in 'E*_p(G) &, forall E F, #|E| <= #|F| }. have EprGmax: 'E_p^('r_p(G))(G) \subset 'E*_p(G) := p_rankElem_max p G. have [E EprE]:= p_rank_witness p G; have maxE := subsetP EprGmax E EprE. apply/eqP; rewrite eqEsubset EprGmax andbT; apply/subsetP=> F maxF. rewrite inE; have [-> _]:= pmaxElemP maxF; have [_ _ <-]:= pnElemP EprE. by apply/eqP; congr (logn p _); apply/eqP; rewrite eqn_leq !card_max. move=> E F maxE maxF; set U := E :&: F. have [sUE sUF]: U \subset E /\ U \subset F by apply/andP; rewrite -subsetI. have sZU: 'Z(G) \subset U by rewrite subsetI !sZmax. have [EpE _]:= pmaxElemP maxE; have{EpE} [sEG abelE] := pElemP EpE. have [EpF _]:= pmaxElemP maxF; have{EpF} [sFG abelF] := pElemP EpF. have [V] := abelem_split_dprod abelE sUE; case/dprodP=> _ defE cUV tiUV. have [W] := abelem_split_dprod abelF sUF; case/dprodP=> _ defF _ tiUW. have [sVE sWF]: V \subset E /\ W \subset F by rewrite -defE -defF !mulG_subr. have [sVG sWG] := (subset_trans sVE sEG, subset_trans sWF sFG). rewrite -defE -defF !TI_cardMg // leq_pmul2l ?cardG_gt0 //. rewrite -(leq_pmul2r (cardG_gt0 'C_G(W))) mul_cardG. rewrite card_subcent_extraspecial // mulnCA Lagrange // mulnC. rewrite leq_mul ?subset_leq_card //; last by rewrite mul_subG ?subsetIl. apply: subset_trans (sub1G _); rewrite -tiUV !subsetI subsetIl subIset ?sVE //=. rewrite -(pmaxElem_LdivP p_pr maxF) -defF centM -!setIA -(setICA 'C(W)). rewrite setIC setIA setIS // subsetI cUV sub_LdivT. by case/and3P: (abelemS sVE abelE). Qed. End ExtraspecialFormspace. (* This is B & G, Theorem 4.15, as done in Aschbacher (23.8) *) Lemma critical_extraspecial R S : p.-group R -> S \subset R -> extraspecial S -> [~: S, R] \subset S^`(1) -> S \* 'C_R(S) = R. Proof. move=> pR sSR esS sSR_S'; have [[defPhi defS'] _] := esS. have [pS [sPS nPS]] := (pgroupS sSR pR, andP (Phi_normal S : 'Phi(S) <| S)). have{esS} oZS: #|'Z(S)| = p := card_center_extraspecial pS esS. have nSR: R \subset 'N(S) by rewrite -commg_subl (subset_trans sSR_S') ?der_sub. have nsCR: 'C_R(S) <| R by rewrite (normalGI nSR) ?cent_normal. have nCS: S \subset 'N('C_R(S)) by rewrite cents_norm // centsC subsetIr. rewrite cprodE ?subsetIr //= -{2}(quotientGK nsCR) normC -?quotientK //. congr (_ @*^-1 _); apply/eqP; rewrite eqEcard quotientS //=. rewrite -(card_isog (second_isog nCS)) setIAC (setIidPr sSR) /= -/'Z(S) -defPhi. rewrite -ker_conj_aut (card_isog (first_isog_loc _ nSR)) //=; set A := _ @* R. have{pS} abelSb := Phi_quotient_abelem pS; have [pSb cSSb _] := and3P abelSb. have [/= Xb defSb oXb] := grank_witness (S / 'Phi(S)). pose X := (repr \o val : coset_of _ -> gT) @: Xb. have sXS: X \subset S; last have nPX := subset_trans sXS nPS. apply/subsetP=> x; case/imsetP=> xb Xxb ->; have nPx := repr_coset_norm xb. rewrite -sub1set -(quotientSGK _ sPS) ?sub1set ?quotient_set1 //= sub1set. by rewrite coset_reprK -defSb mem_gen. have defS: <> = S. apply: Phi_nongen; apply/eqP; rewrite eqEsubset join_subG sPS sXS -joing_idr. rewrite -genM_join sub_gen // -quotientSK ?quotient_gen // -defSb genS //. apply/subsetP=> xb Xxb; apply/imsetP; rewrite (setIidPr nPX). by exists (repr xb); rewrite /= ?coset_reprK //; apply: imset_f. pose f (a : {perm gT}) := [ffun x => if x \in X then x^-1 * a x else 1]. have injf: {in A &, injective f}. move=> _ _ /morphimP[y nSy Ry ->] /morphimP[z nSz Rz ->]. move/ffunP=> eq_fyz; apply: (@eq_Aut _ S); rewrite ?Aut_aut //= => x Sx. rewrite !norm_conj_autE //; apply: canRL (conjgKV z) _; rewrite -conjgM. rewrite /conjg -(centP _ x Sx) ?mulKg {x Sx}// -defS cent_gen -sub_cent1. apply/subsetP=> x Xx; have Sx := subsetP sXS x Xx. move/(_ x): eq_fyz; rewrite !ffunE Xx !norm_conj_autE // => /mulgI xy_xz. by rewrite cent1C inE conjg_set1 conjgM xy_xz conjgK. have sfA_XS': f @: A \subset pffun_on 1 X S^`(1). apply/subsetP=> _ /imsetP[_ /morphimP[y nSy Ry ->] ->]. apply/pffun_onP; split=> [|_ /imageP[x /= Xx ->]]. by apply/subsetP=> x; apply: contraR; rewrite ffunE => /negPf->. have Sx := subsetP sXS x Xx. by rewrite ffunE Xx norm_conj_autE // (subsetP sSR_S') ?mem_commg. rewrite -(card_in_imset injf) (leq_trans (subset_leq_card sfA_XS')) // defS'. rewrite card_pffun_on (card_pgroup pSb) -rank_abelem -?grank_abelian // -oXb. by rewrite -oZS ?leq_pexp2l ?cardG_gt0 ?leq_imset_card. Qed. (* This is part of Aschbacher (23.13) and (23.14). *) Theorem extraspecial_structure S : p.-group S -> extraspecial S -> {Es | all (fun E => (#|E| == p ^ 3)%N && ('Z(E) == 'Z(S))) Es & \big[cprod/1%g]_(E <- Es) E \* 'Z(S) = S}. Proof. have [m] := ubnP #|S|; elim: m S => // m IHm S leSm pS esS. have [x Z'x]: {x | x \in S :\: 'Z(S)}. apply/sigW/set0Pn; rewrite -subset0 subDset setU0. apply: contra (extraspecial_nonabelian esS) => sSZ. exact: abelianS sSZ (center_abelian S). have [E [R [[oE oR]]]]:= split1_extraspecial pS esS Z'x. case=> defS _ [defZE defZR] _; case: ifP => [_ defR | _ esR]. by exists [:: E]; rewrite /= ?oE ?defZE ?eqxx // big_seq1 -defR. have sRS: R \subset S by case/cprodP: defS => _ <- _; rewrite mulG_subr. have [|Es esEs defR] := IHm _ _ (pgroupS sRS pS) esR. rewrite oR (leq_trans (ltn_Pdiv _ _)) ?cardG_gt0 // (ltn_exp2l 0) //. exact: prime_gt1 (extraspecial_prime pS esS). exists (E :: Es); first by rewrite /= oE defZE !eqxx -defZR. by rewrite -defZR big_cons -cprodA defR. Qed. Section StructureCorollaries. Variable S : {group gT}. Hypotheses (pS : p.-group S) (esS : extraspecial S). Let p_pr := extraspecial_prime pS esS. Let oZ := card_center_extraspecial pS esS. (* This is Aschbacher (23.10)(2). *) Lemma card_extraspecial : {n | n > 0 & #|S| = (p ^ n.*2.+1)%N}. Proof. set T := S; exists (logn p #|T|)./2. rewrite half_gt0 ltnW // -(leq_exp2l _ _ (prime_gt1 p_pr)) -card_pgroup //. exact: min_card_extraspecial. have [Es] := extraspecial_structure pS esS; rewrite -[in RHS]/T. elim: Es T => [_ _ <-| E s IHs T] /=. by rewrite big_nil cprod1g oZ (pfactorK 1). rewrite -andbA big_cons -cprodA => /and3P[/eqP oEp3 /eqP defZE]. move=> /IHs{}IHs /cprodP[[_ U _ defU]]; rewrite defU => defT cEU. rewrite -(mulnK #|T| (cardG_gt0 (E :&: U))) -defT -mul_cardG /=. have ->: E :&: U = 'Z(S). apply/eqP; rewrite eqEsubset subsetI -{1 2}defZE subsetIl setIS //=. by case/cprodP: defU => [[V _ -> _]] <- _; apply: mulG_subr. rewrite (IHs U) // oEp3 oZ -expnD addSn expnS mulKn ?prime_gt0 //. by rewrite pfactorK //= uphalf_double. Qed. Lemma Aut_extraspecial_full : Aut_in (Aut S) 'Z(S) \isog Aut 'Z(S). Proof. have [p_gt1 p_gt0] := (prime_gt1 p_pr, prime_gt0 p_pr). have [Es] := extraspecial_structure pS esS. elim: Es S oZ => [T _ _ <-| E s IHs T oZT] /=. rewrite big_nil cprod1g (center_idP (center_abelian T)). by apply/Aut_sub_fullP=> // g injg gZ; exists g. rewrite -andbA big_cons -cprodA => /and3P[/eqP-oE /eqP-defZE es_s]. case/cprodP=> -[_ U _ defU]; rewrite defU => defT cEU. have sUT: U \subset T by rewrite -defT mulG_subr. have sZU: 'Z(T) \subset U. by case/cprodP: defU => [[V _ -> _] <- _]; apply: mulG_subr. have defZU: 'Z(E) = 'Z(U). apply/eqP; rewrite eqEsubset defZE subsetI sZU subIset ?centS ?orbT //=. by rewrite subsetI subIset ?sUT //= -defT centM setSI. apply: (Aut_cprod_full _ defZU); rewrite ?cprodE //; last first. by apply: IHs; rewrite -?defZU ?defZE. have oZE: #|'Z(E)| = p by rewrite defZE. have [p2 | odd_p] := even_prime p_pr. suffices <-: restr_perm 'Z(E) @* Aut E = Aut 'Z(E) by apply: Aut_in_isog. apply/eqP; rewrite eqEcard restr_perm_Aut ?center_sub //=. by rewrite card_Aut_cyclic ?prime_cyclic ?oZE // {1}p2 cardG_gt0. have pE: p.-group E by rewrite /pgroup oE pnatX pnat_id. have nZE: E \subset 'N('Z(E)) by rewrite normal_norm ?center_normal. have esE: extraspecial E := card_p3group_extraspecial p_pr oE oZE. have [[defPhiE defE'] prZ] := esE. have{defPhiE} sEpZ x: x \in E -> (x ^+ p)%g \in 'Z(E). move=> Ex; rewrite -defPhiE (Phi_joing pE) mem_gen // inE orbC. by rewrite (Mho_p_elt 1) // (mem_p_elt pE). have ltZE: 'Z(E) \proper E by rewrite properEcard subsetIl oZE oE (ltn_exp2l 1). have [x [Ex notZx oxp]]: exists x, [/\ x \in E, x \notin 'Z(E) & #[x] %| p]%N. have [_ [x Ex notZx]] := properP ltZE. case: (prime_subgroupVti <[x ^+ p]> prZ) => [sZxp | ]; last first. move/eqP; rewrite (setIidPl _) ?cycle_subG ?sEpZ //. by rewrite cycle_eq1 -order_dvdn; exists x. have [y Ey notxy]: exists2 y, y \in E & y \notin <[x]>. apply/subsetPn; apply: contra (extraspecial_nonabelian esE) => sEx. by rewrite (abelianS sEx) ?cycle_abelian. have: (y ^+ p)%g \in <[x ^+ p]> by rewrite (subsetP sZxp) ?sEpZ. case/cycleP=> i def_yp; set xi := (x ^- i)%g. have Exi: xi \in E by rewrite groupV groupX. exists (y * xi)%g; split; first by rewrite groupM. have sxpx: <[x ^+ p]> \subset <[x]> by rewrite cycle_subG mem_cycle. apply: contra notxy; move/(subsetP (subset_trans sZxp sxpx)). by rewrite groupMr // groupV mem_cycle. pose z := [~ xi, y]; have Zz: z \in 'Z(E) by rewrite -defE' mem_commg. case: (setIP Zz) => _; move/centP=> cEz. rewrite order_dvdn expMg_Rmul; try by apply: commute_sym; apply: cEz. rewrite def_yp expgVn -!expgM mulnC mulgV mul1g -order_dvdn. by rewrite (dvdn_trans (order_dvdG Zz)) //= oZE bin2odd // dvdn_mulr. have{oxp} ox: #[x] = p. apply/eqP; case/primeP: p_pr => _ dvd_p; case/orP: (dvd_p _ oxp) => //. by rewrite order_eq1; case: eqP notZx => // ->; rewrite group1. have [y Ey not_cxy]: exists2 y, y \in E & y \notin 'C[x]. by apply/subsetPn; rewrite sub_cent1; rewrite inE Ex in notZx. have notZy: y \notin 'Z(E). apply: contra not_cxy; rewrite inE Ey; apply: subsetP. by rewrite -cent_set1 centS ?sub1set. pose K := 'C_E[y]; have maxK: maximal K E by apply: cent1_extraspecial_maximal. have nsKE: K <| E := p_maximal_normal pE maxK; have [sKE nKE] := andP nsKE. have oK: #|K| = (p ^ 2)%N. by rewrite -(divg_indexS sKE) oE (p_maximal_index pE) ?mulKn. have cKK: abelian K := card_p2group_abelian p_pr oK. have sZK: 'Z(E) \subset K by rewrite setIS // -cent_set1 centS ?sub1set. have defE: K ><| <[x]> = E. have notKx: x \notin K by rewrite inE Ex cent1C. rewrite sdprodE ?(mulg_normal_maximal nsKE) ?cycle_subG ?(subsetP nKE) //. by rewrite setIC prime_TIg -?orderE ?ox ?cycle_subG. have /cyclicP[z defZ]: cyclic 'Z(E) by rewrite prime_cyclic ?oZE. apply/(Aut_sub_fullP (center_sub E)); rewrite /= defZ => g injg gZ. pose k := invm (injm_Zp_unitm z) (aut injg gZ). have fM: {in K &, {morph expgn^~ (val k): u v / u * v}}. by move=> u v Ku Kv; rewrite /= expgMn // /commute (centsP cKK). pose f := Morphism fM; have fK: f @* K = K. apply/setP=> u; rewrite morphimEdom. apply/imsetP/idP=> [[v Kv ->] | Ku]; first exact: groupX. exists (u ^+ expg_invn K (val k)); first exact: groupX. rewrite /f /= expgAC expgK // oK coprimeXl // -unitZpE //. by case: (k) => /=; rewrite orderE -defZ oZE => j; rewrite natr_Zp. have fMact: {in K & <[x]>, morph_act 'J 'J f (idm <[x]>)}. by move=> u v _ _; rewrite /= conjXg. exists (sdprodm_morphism defE fMact). rewrite im_sdprodm injm_sdprodm injm_idm -card_im_injm im_idm fK. have [_ -> _ ->] := sdprodP defE; rewrite !eqxx; split=> //= u Zu. rewrite sdprodmEl ?(subsetP sZK) ?defZ // -(autE injg gZ Zu). rewrite -[aut _ _](invmK (injm_Zp_unitm z)); first by rewrite permE Zu. by rewrite im_Zp_unitm Aut_aut. Qed. (* These are the parts of Aschbacher (23.12) and exercise 8.5 that are later *) (* used in Aschbacher (34.9), which itself replaces the informal discussion *) (* quoted from Gorenstein in the proof of B & G, Theorem 2.5. *) Lemma center_aut_extraspecial k : coprime k p -> exists2 f, f \in Aut S & forall z, z \in 'Z(S) -> f z = (z ^+ k)%g. Proof. have /cyclicP[z defZ]: cyclic 'Z(S) by rewrite prime_cyclic ?oZ. have oz: #[z] = p by rewrite orderE -defZ. rewrite coprime_sym -unitZpE ?prime_gt1 // -oz => u_k. pose g := Zp_unitm (FinRing.unit 'Z_#[z] u_k). have AutZg: g \in Aut 'Z(S) by rewrite defZ -im_Zp_unitm mem_morphim ?inE. have ZSfull := Aut_sub_fullP (center_sub S) Aut_extraspecial_full. have [f [injf fS fZ]] := ZSfull _ (injm_autm AutZg) (im_autm AutZg). exists (aut injf fS) => [|u Zu]; first exact: Aut_aut. have [Su _] := setIP Zu; have z_u: u \in <[z]> by rewrite -defZ. by rewrite autE // fZ //= autmE permE /= z_u /cyclem expg_znat. Qed. End StructureCorollaries. End Extraspecial. Section SCN. Variables (gT : finGroupType) (p : nat) (G : {group gT}). Implicit Types A Z H : {group gT}. Lemma SCN_P A : reflect (A <| G /\ 'C_G(A) = A) (A \in 'SCN(G)). Proof. by apply: (iffP setIdP) => [] [->]; move/eqP. Qed. Lemma SCN_abelian A : A \in 'SCN(G) -> abelian A. Proof. by case/SCN_P=> _ defA; rewrite /abelian -{1}defA subsetIr. Qed. Lemma exponent_Ohm1_class2 H : odd p -> p.-group H -> nil_class H <= 2 -> exponent 'Ohm_1(H) %| p. Proof. move=> odd_p pH; rewrite nil_class2 => sH'Z; apply/exponentP=> x /=. rewrite (OhmE 1 pH) expn1 gen_set_id => {x} [/LdivP[] //|]. apply/group_setP; split=> [|x y]; first by rewrite !inE group1 expg1n //=. case/LdivP=> Hx xp1 /LdivP[Hy yp1]; rewrite !inE groupM //=. have [_ czH]: [~ y, x] \in H /\ centralises [~ y, x] H. by apply/centerP; rewrite (subsetP sH'Z) ?mem_commg. rewrite expMg_Rmul ?xp1 ?yp1 /commute ?czH //= !mul1g. by rewrite bin2odd // -commXXg ?yp1 /commute ?czH // comm1g. Qed. (* SCN_max and max_SCN cover Aschbacher 23.15(1) *) Lemma SCN_max A : A \in 'SCN(G) -> [max A | A <| G & abelian A]. Proof. case/SCN_P => nAG scA; apply/maxgroupP; split=> [|H]. by rewrite nAG /abelian -{1}scA subsetIr. do 2![case/andP]=> sHG _ abelH sAH; apply/eqP. by rewrite eqEsubset sAH -scA subsetI sHG centsC (subset_trans sAH). Qed. Lemma max_SCN A : p.-group G -> [max A | A <| G & abelian A] -> A \in 'SCN(G). Proof. move/pgroup_nil=> nilG; rewrite /abelian. case/maxgroupP=> /andP[nsAG abelA] maxA; have [sAG nAG] := andP nsAG. rewrite inE nsAG eqEsubset /= andbC subsetI abelA normal_sub //=. rewrite -quotient_sub1; last by rewrite subIset 1?normal_norm. apply/trivgP; apply: (TI_center_nil (quotient_nil A nilG)). by rewrite quotient_normal // /normal subsetIl normsI ?normG ?norms_cent. apply/trivgP/subsetP=> _ /setIP[/morphimP[x Nx /setIP[_ Cx]] ->]. rewrite -cycle_subG in Cx => /setIP[GAx CAx]. have{CAx GAx}: <[coset A x]> <| G / A. by rewrite /normal cycle_subG GAx cents_norm // centsC cycle_subG. case/(inv_quotientN nsAG)=> B /= defB sAB nBG. rewrite -cycle_subG defB (maxA B) ?trivg_quotient // nBG. have{} defB : B :=: A * <[x]>. rewrite -quotientK ?cycle_subG ?quotient_cycle // defB quotientGK //. exact: normalS (normal_sub nBG) nsAG. apply/setIidPl; rewrite ?defB -[_ :&: _]center_prod //=. rewrite /center !(setIidPl _) //; apply: cycle_abelian. Qed. (* The two other assertions of Aschbacher 23.15 state properties of the *) (* normal series 1 <| Z = 'Ohm_1(A) <| A with A \in 'SCN(G). *) Section SCNseries. Variables A : {group gT}. Hypothesis SCN_A : A \in 'SCN(G). Let Z := 'Ohm_1(A). Let cAA := SCN_abelian SCN_A. Let sZA: Z \subset A := Ohm_sub 1 A. Let nZA : A \subset 'N(Z) := sub_abelian_norm cAA sZA. (* This is Aschbacher 23.15(2). *) Lemma der1_stab_Ohm1_SCN_series : ('C(Z) :&: 'C_G(A / Z | 'Q))^`(1) \subset A. Proof. case/SCN_P: SCN_A => /andP[sAG nAG] {4} <-. rewrite subsetI {1}setICA comm_subG ?subsetIl //= gen_subG. apply/subsetP=> w /imset2P[u v]. rewrite -groupV -(groupV _ v) /= astabQR //= -/Z !inE groupV. case/and4P=> cZu _ _ sRuZ /and4P[cZv' _ _ sRvZ] ->{w}. apply/centP=> a Aa; rewrite /commute -!mulgA (commgCV v) (mulgA u). rewrite (centP cZu); last by rewrite (subsetP sRvZ) ?mem_commg ?set11 ?groupV. rewrite 2!(mulgA v^-1) mulKVg 4!mulgA invgK (commgC u^-1) mulgA. rewrite -(mulgA _ _ v^-1) -(centP cZv') ?(subsetP sRuZ) ?mem_commg ?set11//. by rewrite -!mulgA invgK mulKVg !mulKg. Qed. (* This is Aschbacher 23.15(3); note that this proof does not depend on the *) (* maximality of A. *) Lemma Ohm1_stab_Ohm1_SCN_series : odd p -> p.-group G -> 'Ohm_1('C_G(Z)) \subset 'C_G(A / Z | 'Q). Proof. have [-> | ntG] := eqsVneq G 1; first by rewrite !(setIidPl (sub1G _)) Ohm1. move=> p_odd pG; have{ntG} [p_pr _ _] := pgroup_pdiv pG ntG. case/SCN_P: SCN_A => /andP[sAG nAG] _; have pA := pgroupS sAG pG. have pCGZ : p.-group 'C_G(Z) by rewrite (pgroupS _ pG) // subsetIl. rewrite {pCGZ}(OhmE 1 pCGZ) gen_subG; apply/subsetP=> x; rewrite 3!inE -andbA. rewrite -!cycle_subG => /and3P[sXG cZX xp1] /=; have cXX := cycle_abelian x. have nZX := cents_norm cZX; have{nAG} nAX := subset_trans sXG nAG. pose XA := <[x]> <*> A; pose C := 'C(<[x]> / Z | 'Q); pose CA := A :&: C. pose Y := <[x]> <*> CA; pose W := 'Ohm_1(Y). have sXC: <[x]> \subset C by rewrite sub_astabQ nZX (quotient_cents _ cXX). have defY : Y = <[x]> * CA by rewrite -norm_joinEl // normsI ?nAX ?normsG. have{nAX} defXA: XA = <[x]> * A := norm_joinEl nAX. suffices{sXC}: XA \subset Y. rewrite subsetI sXG /= sub_astabQ nZX centsC defY group_modl //= -/Z -/C. by rewrite subsetI sub_astabQ defXA quotientMl //= !mulG_subG; case/and4P. have sZCA: Z \subset CA by rewrite subsetI sZA [C]astabQ sub_cosetpre. have cZCA: CA \subset 'C(Z) by rewrite subIset 1?(sub_abelian_cent2 cAA). have sZY: Z \subset Y by rewrite (subset_trans sZCA) ?joing_subr. have{cZCA cZX} cZY: Y \subset 'C(Z) by rewrite join_subG cZX. have{cXX nZX} sY'Z : Y^`(1) \subset Z. rewrite der1_min ?cents_norm //= -/Y defY quotientMl // abelianM /= -/Z -/CA. rewrite !quotient_abelian // ?(abelianS _ cAA) ?subsetIl //=. by rewrite /= quotientGI ?Ohm_sub // quotient_astabQ subsetIr. have{sY'Z cZY} nil_classY: nil_class Y <= 2. by rewrite nil_class2 (subset_trans sY'Z ) // subsetI sZY centsC. have pY: p.-group Y by rewrite (pgroupS _ pG) // join_subG sXG subIset ?sAG. have sXW: <[x]> \subset W. by rewrite [W](OhmE 1 pY) ?genS // sub1set !inE -cycle_subG joing_subl. have{nil_classY pY sXW sZY sZCA} defW: W = <[x]> * Z. rewrite -[W](setIidPr (Ohm_sub _ _)) /= -/Y {1}defY -group_modl //= -/Y -/W. congr (_ * _); apply/eqP; rewrite eqEsubset {1}[Z](OhmE 1 pA). rewrite subsetI setIAC subIset //; first by rewrite sZCA -[Z]Ohm_id OhmS. rewrite sub_gen ?setIS //; apply/subsetP=> w Ww; rewrite inE. by apply/eqP; apply: exponentP w Ww; apply: exponent_Ohm1_class2. have{sXG sAG} sXAG: XA \subset G by rewrite join_subG sXG. have{sXAG} nilXA: nilpotent XA := nilpotentS sXAG (pgroup_nil pG). have sYXA: Y \subset XA by rewrite defY defXA mulgS ?subsetIl. rewrite -[Y](nilpotent_sub_norm nilXA) {nilXA sYXA}//= -/Y -/XA. suffices: 'N_XA('Ohm_1(Y)) \subset Y by apply/subset_trans/setIS/gFnorms. rewrite {XA}defXA -group_modl ?normsG /= -/W ?{W}defW ?mulG_subl //. rewrite {Y}defY mulgS // subsetI subsetIl {CA C}sub_astabQ subIset ?nZA //= -/Z. rewrite (subset_trans (quotient_subnorm _ _ _)) //= quotientMidr /= -/Z. rewrite -quotient_sub1 ?subIset ?cent_norm ?orbT //. rewrite (subset_trans (quotientI _ _ _)) ?coprime_TIg //. rewrite (@pnat_coprime p) // -/(p.-group _) ?quotient_pgroup {pA}//= -pgroupE. rewrite -(setIidPr (cent_sub _)) p'group_quotient_cent_prime //. by rewrite (dvdn_trans (dvdn_quotient _ _)) ?order_dvdn. Qed. End SCNseries. (* This is Aschbacher 23.16. *) Lemma Ohm1_cent_max_normal_abelem Z : odd p -> p.-group G -> [max Z | Z <| G & p.-abelem Z] -> 'Ohm_1('C_G(Z)) = Z. Proof. move=> p_odd pG; set X := 'Ohm_1('C_G(Z)). case/maxgroupP=> /andP[nsZG abelZ] maxZ. have [sZG nZG] := andP nsZG; have [_ cZZ expZp] := and3P abelZ. have{nZG} nsXG: X <| G by rewrite gFnormal_trans ?norm_normalI ?norms_cent. have cZX : X \subset 'C(Z) by apply/gFsub_trans/subsetIr. have{sZG expZp} sZX: Z \subset X. rewrite [X](OhmE 1 (pgroupS _ pG)) ?subsetIl ?sub_gen //. apply/subsetP=> x Zx; rewrite !inE ?(subsetP sZG) ?(subsetP cZZ) //=. by rewrite (exponentP expZp). suffices{sZX} expXp: (exponent X %| p). apply/eqP; rewrite eqEsubset sZX andbT -quotient_sub1 ?cents_norm //= -/X. have pGq: p.-group (G / Z) by rewrite quotient_pgroup. rewrite (TI_center_nil (pgroup_nil pGq)) ?quotient_normal //= -/X setIC. apply/eqP/trivgPn=> [[Zd]]; rewrite inE -!cycle_subG -cycle_eq1 -subG1 /= -/X. case/andP=> /sub_center_normal nsZdG. have{nsZdG} [D defD sZD nsDG] := inv_quotientN nsZG nsZdG; rewrite defD. have sDG := normal_sub nsDG; have nsZD := normalS sZD sDG nsZG. rewrite quotientSGK ?quotient_sub1 ?normal_norm //= -/X => sDX /negP[]. rewrite (maxZ D) // nsDG andbA (pgroupS sDG) ?(dvdn_trans (exponentS sDX)) //. have sZZD: Z \subset 'Z(D) by rewrite subsetI sZD centsC (subset_trans sDX). by rewrite (cyclic_factor_abelian sZZD) //= -defD cycle_cyclic. pose normal_abelian := [pred A : {group gT} | A <| G & abelian A]. have{nsZG cZZ} normal_abelian_Z : normal_abelian Z by apply/andP. have{normal_abelian_Z} [A maxA sZA] := maxgroup_exists normal_abelian_Z. have SCN_A : A \in 'SCN(G) by apply: max_SCN pG maxA. move/maxgroupp: maxA => /andP[nsAG cAA] {normal_abelian}. have pA := pgroupS (normal_sub nsAG) pG. have{abelZ maxZ nsAG cAA sZA} defA1: 'Ohm_1(A) = Z. have: Z \subset 'Ohm_1(A) by rewrite -(Ohm1_id abelZ) OhmS. by apply: maxZ; rewrite Ohm1_abelem ?gFnormal_trans. have{SCN_A} sX'A: X^`(1) \subset A. have sX_CWA1 : X \subset 'C('Ohm_1(A)) :&: 'C_G(A / 'Ohm_1(A) | 'Q). rewrite subsetI /X -defA1 (Ohm1_stab_Ohm1_SCN_series _ p_odd) //=. by rewrite gFsub_trans ?subsetIr. by apply: subset_trans (der1_stab_Ohm1_SCN_series SCN_A); rewrite commgSS. pose genXp := [pred U : {group gT} | 'Ohm_1(U) == U & ~~ (exponent U %| p)]. apply/idPn=> expXp'; have genXp_X: genXp [group of X] by rewrite /= Ohm_id eqxx. have{genXp_X expXp'} [U] := mingroup_exists genXp_X; case/mingroupP; case/andP. move/eqP=> defU1 expUp' minU sUX; case/negP: expUp'. have{nsXG} pU := pgroupS (subset_trans sUX (normal_sub nsXG)) pG. case gsetU1: (group_set 'Ldiv_p(U)). by rewrite -defU1 (OhmE 1 pU) gen_set_id // -sub_LdivT subsetIr. move: gsetU1; rewrite /group_set 2!inE group1 expg1n eqxx; case/subsetPn=> xy. case/imset2P=> x y; rewrite !inE => /andP[Ux xp1] /andP[Uy yp1] ->{xy}. rewrite groupM //= => nt_xyp; pose XY := <[x]> <*> <[y]>. have{yp1 nt_xyp} defXY: XY = U. have sXY_U: XY \subset U by rewrite join_subG !cycle_subG Ux Uy. rewrite [XY]minU //= eqEsubset Ohm_sub (OhmE 1 (pgroupS _ pU)) //. rewrite /= joing_idl joing_idr genS; last first. by rewrite subsetI subset_gen subUset !sub1set !inE xp1 yp1. apply: contra nt_xyp => /exponentP-> //. by rewrite groupMl mem_gen // (set21, set22). have: <[x]> <|<| U by rewrite nilpotent_subnormal ?(pgroup_nil pU) ?cycle_subG. case/subnormalEsupport=> [defU | /=]. by apply: dvdn_trans (exponent_dvdn U) _; rewrite -defU order_dvdn. set V := < U>>; case/andP=> sVU ltVU. have{genXp minU xp1 sVU ltVU} expVp: exponent V %| p. apply: contraR ltVU => expVp'; rewrite [V]minU //= expVp' eqEsubset Ohm_sub. rewrite (OhmE 1 (pgroupS sVU pU)) genS //= subsetI subset_gen class_supportEr. apply/bigcupsP=> z _; apply/subsetP=> v Vv. by rewrite inE -order_dvdn (dvdn_trans (order_dvdG Vv)) // cardJg order_dvdn. have{A pA defA1 sX'A V expVp} Zxy: [~ x, y] \in Z. rewrite -defA1 (OhmE 1 pA) mem_gen // !inE (exponentP expVp). by rewrite (subsetP sX'A) //= mem_commg ?(subsetP sUX). by rewrite groupMl -1?[x^-1]conjg1 mem_gen // imset2_f // ?groupV cycle_id. have{Zxy sUX cZX} cXYxy: [~ x, y] \in 'C(XY). by rewrite centsC in cZX; rewrite defXY (subsetP (centS sUX)) ?(subsetP cZX). rewrite -defU1 exponent_Ohm1_class2 // nil_class2 -defXY der1_joing_cycles //. by rewrite subsetI {1}defXY !cycle_subG groupR. Qed. Lemma critical_class2 H : critical H G -> nil_class H <= 2. Proof. case=> [chH _ sRZ _]. by rewrite nil_class2 (subset_trans _ sRZ) ?commSg // char_sub. Qed. (* This proof of the Thompson critical lemma is adapted from Aschbacher 23.6 *) Lemma Thompson_critical : p.-group G -> {K : {group gT} | critical K G}. Proof. move=> pG; pose qcr A := (A \char G) && ('Phi(A) :|: [~: G, A] \subset 'Z(A)). have [|K]:= @maxgroup_exists _ qcr 1 _. by rewrite /qcr char1 center1 commG1 subUset Phi_sub subxx. case/maxgroupP; rewrite {}/qcr subUset => /and3P[chK sPhiZ sRZ] maxK _. have sKG := char_sub chK; have nKG := char_normal chK. exists K; split=> //; apply/eqP; rewrite eqEsubset andbC setSI //=. have chZ: 'Z(K) \char G by [apply: subcent_char]; have nZG := char_norm chZ. have chC: 'C_G(K) \char G by apply: subcent_char chK. rewrite -quotient_sub1; last by rewrite subIset // char_norm. apply/trivgP; apply: (TI_center_nil (quotient_nil _ (pgroup_nil pG))). by rewrite quotient_normal ?norm_normalI ?norms_cent ?normal_norm. apply: TI_Ohm1; apply/trivgP; rewrite -trivg_quotient -sub_cosetpre_quo //. rewrite morphpreI quotientGK /=; last first. by apply: normalS (char_normal chZ); rewrite ?subsetIl ?setSI. set X := _ :&: _; pose gX := [group of X]. have sXG: X \subset G by rewrite subIset ?subsetIl. have cXK: K \subset 'C(gX) by rewrite centsC 2?subIset // subxx orbT. rewrite subsetI centsC cXK andbT -(mul1g K) -mulSG mul1g -(cent_joinEr cXK). rewrite [_ <*> K]maxK ?joing_subr //= andbC (cent_joinEr cXK). rewrite -center_prod // (subset_trans _ (mulG_subr _ _)). rewrite charM 1?charI ?(char_from_quotient (normal_cosetpre _)) //. by rewrite cosetpreK !gFchar_trans. rewrite (@Phi_mulg p) ?(pgroupS _ pG) // subUset commGC commMG; last first. by rewrite normsR ?(normsG sKG) // cents_norm // centsC. rewrite !mul_subG 1?commGC //. apply: subset_trans (commgS _ (subsetIr _ _)) _. rewrite -quotient_cents2 ?subsetIl // centsC // cosetpreK //. exact/gFsub_trans/subsetIr. have nZX := subset_trans sXG nZG; have pX : p.-group gX by apply: pgroupS pG. rewrite -quotient_sub1 ?gFsub_trans //=. have pXZ: p.-group (gX / 'Z(K)) by apply: morphim_pgroup. rewrite (quotient_Phi pX nZX) subG1 (trivg_Phi pXZ). apply: (abelemS (quotientS _ (subsetIr _ _))); rewrite /= cosetpreK /=. have pZ: p.-group 'Z(G / 'Z(K)). by rewrite (pgroupS (center_sub _)) ?morphim_pgroup. by rewrite Ohm1_abelem ?center_abelian. Qed. Lemma critical_p_stab_Aut H : critical H G -> p.-group G -> p.-group 'C(H | [Aut G]). Proof. move=> [chH sPhiZ sRZ eqCZ] pG; have sHG := char_sub chH. pose G' := (sdpair1 [Aut G] @* G)%G; pose H' := (sdpair1 [Aut G] @* H)%G. apply/pgroupP=> q pr_q; case/Cauchy=> //= f cHF; move: (cHF); rewrite astab_ract. case/setIP=> Af cHFP ofq; rewrite -cycle_subG in cHF; apply: (pgroupP pG) => //. pose F' := (sdpair2 [Aut G] @* <[f]>)%G. have trHF: [~: H', F'] = 1. apply/trivgP; rewrite gen_subG; apply/subsetP=> u; case/imset2P=> x' a'. case/morphimP=> x Gx Hx ->; case/morphimP=> a Aa Fa -> -> {u x' a'}. by rewrite inE commgEl -sdpair_act ?(astab_act (subsetP cHF _ Fa) Hx) ?mulVg. have sGH_H: [~: G', H'] \subset H'. by rewrite -morphimR ?(char_sub chH) // morphimS // commg_subr char_norm. have{trHF sGH_H} trFGH: [~: F', G', H'] = 1. apply: three_subgroup; last by rewrite trHF comm1G. by apply/trivgP; rewrite -trHF commSg. apply/negP=> qG; case: (qG); rewrite -ofq. suffices ->: f = 1 by rewrite order1 dvd1n. apply/permP=> x; rewrite perm1; case Gx: (x \in G); last first. by apply: out_perm (negbT Gx); case/setIdP: Af. have Gfx: f x \in G by rewrite -(im_autm Af) -{1}(autmE Af) mem_morphim. pose y := x^-1 * f x; have Gy: y \in G by rewrite groupMl ?groupV. have [inj1 inj2] := (injm_sdpair1 [Aut G], injm_sdpair2 [Aut G]). have Hy: y \in H. rewrite (subsetP (center_sub H)) // -eqCZ -cycle_subG. rewrite -(injmSK inj1) ?cycle_subG // injm_subcent // subsetI. rewrite morphimS ?morphim_cycle ?cycle_subG //=. suffices: sdpair1 [Aut G] y \in [~: G', F']. by rewrite commGC; apply: subsetP; apply/commG1P. rewrite morphM ?groupV ?morphV //= sdpair_act // -commgEl. by rewrite mem_commg ?mem_morphim ?cycle_id. have fy: f y = y := astabP cHFP _ Hy. have: (f ^+ q) x = x * y ^+ q. elim: (q) => [|i IHi]; first by rewrite perm1 mulg1. rewrite expgSr permM {}IHi -(autmE Af) morphM ?morphX ?groupX //= autmE. by rewrite fy expgS mulgA mulKVg. move/eqP; rewrite -{1}ofq expg_order perm1 eq_mulVg1 mulKg -order_dvdn. case/primeP: pr_q => _ pr_q /pr_q; rewrite order_eq1 -eq_mulVg1. by case: eqP => //= _ /eqP oyq; case: qG; rewrite -oyq order_dvdG. Qed. End SCN. Arguments SCN_P {gT G A}. math-comp-mathcomp-1.12.0/mathcomp/solvable/nilpotent.v000066400000000000000000000673701375767750300231510ustar00rootroot00000000000000(* (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 fintype div bigop prime finset fingroup morphism. From mathcomp Require Import automorphism quotient commutator gproduct. From mathcomp Require Import gfunctor center gseries cyclic. (******************************************************************************) (* This file defines nilpotent and solvable groups, and give some of their *) (* elementary properties; more will be added later (e.g., the nilpotence of *) (* p-groups in sylow.v, or the fact that minimal normal subgroups of solvable *) (* groups are elementary abelian in maximal.v). This file defines: *) (* nilpotent G == G is nilpotent, i.e., [~: H, G] is a proper subgroup of H *) (* for all nontrivial H <| G. *) (* solvable G == G is solvable, i.e., H^`(1) is a proper subgroup of H for *) (* all nontrivial subgroups H of G. *) (* 'L_n(G) == the nth term of the lower central series, namely *) (* [~: G, ..., G] (n Gs) if n > 0, with 'L_0(G) = G. *) (* G is nilpotent iff 'L_n(G) = 1 for some n. *) (* 'Z_n(G) == the nth term of the upper central series, i.e., *) (* with 'Z_0(G) = 1, 'Z_n.+1(G) / 'Z_n(G) = 'Z(G / 'Z_n(G)). *) (* nil_class G == the nilpotence class of G, i.e., the least n such that *) (* 'L_n.+1(G) = 1 (or, equivalently, 'Z_n(G) = G), if G is *) (* nilpotent; we take nil_class G = #|G| when G is not *) (* nilpotent, so nil_class G < #|G| iff G is nilpotent. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section SeriesDefs. Variables (n : nat) (gT : finGroupType) (A : {set gT}). Definition lower_central_at_rec := iter n (fun B => [~: B, A]) A. Definition upper_central_at_rec := iter n (fun B => coset B @*^-1 'Z(A / B)) 1. End SeriesDefs. (* By convention, the lower central series starts at 1 while the upper series *) (* starts at 0 (sic). *) Definition lower_central_at n := lower_central_at_rec n.-1. (* Note: 'nosimpl' MUST be used outside of a section -- the end of section *) (* "cooking" destroys it. *) Definition upper_central_at := nosimpl upper_central_at_rec. Arguments lower_central_at n%N {gT} A%g. Arguments upper_central_at n%N {gT} A%g. Notation "''L_' n ( G )" := (lower_central_at n G) (at level 8, n at level 2, format "''L_' n ( G )") : group_scope. Notation "''Z_' n ( G )" := (upper_central_at n G) (at level 8, n at level 2, format "''Z_' n ( G )") : group_scope. Section PropertiesDefs. Variables (gT : finGroupType) (A : {set gT}). Definition nilpotent := [forall (G : {group gT} | G \subset A :&: [~: G, A]), G :==: 1]. Definition nil_class := index 1 (mkseq (fun n => 'L_n.+1(A)) #|A|). Definition solvable := [forall (G : {group gT} | G \subset A :&: [~: G, G]), G :==: 1]. End PropertiesDefs. Arguments nilpotent {gT} A%g. Arguments nil_class {gT} A%g. Arguments solvable {gT} A%g. Section NilpotentProps. Variable gT: finGroupType. Implicit Types (A B : {set gT}) (G H : {group gT}). Lemma nilpotent1 : nilpotent [1 gT]. Proof. by apply/forall_inP=> H; rewrite commG1 setIid -subG1. Qed. Lemma nilpotentS A B : B \subset A -> nilpotent A -> nilpotent B. Proof. move=> sBA nilA; apply/forall_inP=> H sHR. have:= forallP nilA H; rewrite (subset_trans sHR) //. by apply: subset_trans (setIS _ _) (setSI _ _); rewrite ?commgS. Qed. Lemma nil_comm_properl G H A : nilpotent G -> H \subset G -> H :!=: 1 -> A \subset 'N_G(H) -> [~: H, A] \proper H. Proof. move=> nilG sHG ntH; rewrite subsetI properE; case/andP=> sAG nHA. rewrite (subset_trans (commgS H (subset_gen A))) ?commg_subl ?gen_subG //. apply: contra ntH => sHR; have:= forallP nilG H; rewrite subsetI sHG. by rewrite (subset_trans sHR) ?commgS. Qed. Lemma nil_comm_properr G A H : nilpotent G -> H \subset G -> H :!=: 1 -> A \subset 'N_G(H) -> [~: A, H] \proper H. Proof. by rewrite commGC; apply: nil_comm_properl. Qed. Lemma centrals_nil (s : seq {group gT}) G : G.-central.-series 1%G s -> last 1%G s = G -> nilpotent G. Proof. move=> cGs defG; apply/forall_inP=> H /subsetIP[sHG sHR]. move: sHG; rewrite -{}defG -subG1 -[1]/(gval 1%G). elim: s 1%G cGs => //= L s IHs K /andP[/and3P[sRK sKL sLG] /IHs sHL] sHs. exact: subset_trans sHR (subset_trans (commSg _ (sHL sHs)) sRK). Qed. End NilpotentProps. Section LowerCentral. Variable gT : finGroupType. Implicit Types (A B : {set gT}) (G H : {group gT}). Lemma lcn0 A : 'L_0(A) = A. Proof. by []. Qed. Lemma lcn1 A : 'L_1(A) = A. Proof. by []. Qed. Lemma lcnSn n A : 'L_n.+2(A) = [~: 'L_n.+1(A), A]. Proof. by []. Qed. Lemma lcnSnS n G : [~: 'L_n(G), G] \subset 'L_n.+1(G). Proof. by case: n => //; apply: der1_subG. Qed. Lemma lcnE n A : 'L_n.+1(A) = lower_central_at_rec n A. Proof. by []. Qed. Lemma lcn2 A : 'L_2(A) = A^`(1). Proof. by []. Qed. Lemma lcn_group_set n G : group_set 'L_n(G). Proof. by case: n => [|[|n]]; apply: groupP. Qed. Canonical lower_central_at_group n G := Group (lcn_group_set n G). Lemma lcn_char n G : 'L_n(G) \char G. Proof. by case: n; last elim=> [|n IHn]; rewrite ?char_refl ?lcnSn ?charR. Qed. Lemma lcn_normal n G : 'L_n(G) <| G. Proof. exact/char_normal/lcn_char. Qed. Lemma lcn_sub n G : 'L_n(G) \subset G. Proof. exact/char_sub/lcn_char. Qed. Lemma lcn_norm n G : G \subset 'N('L_n(G)). Proof. exact/char_norm/lcn_char. Qed. Lemma lcn_subS n G : 'L_n.+1(G) \subset 'L_n(G). Proof. case: n => // n; rewrite lcnSn commGC commg_subr. by case/andP: (lcn_normal n.+1 G). Qed. Lemma lcn_normalS n G : 'L_n.+1(G) <| 'L_n(G). Proof. by apply: normalS (lcn_normal _ _); rewrite (lcn_subS, lcn_sub). Qed. Lemma lcn_central n G : 'L_n(G) / 'L_n.+1(G) \subset 'Z(G / 'L_n.+1(G)). Proof. case: n => [|n]; first by rewrite trivg_quotient sub1G. by rewrite subsetI quotientS ?lcn_sub ?quotient_cents2r. Qed. Lemma lcn_sub_leq m n G : n <= m -> 'L_m(G) \subset 'L_n(G). Proof. by move/subnK <-; elim: {m}(m - n) => // m; apply: subset_trans (lcn_subS _ _). Qed. Lemma lcnS n A B : A \subset B -> 'L_n(A) \subset 'L_n(B). Proof. by case: n => // n sAB; elim: n => // n IHn; rewrite !lcnSn genS ?imset2S. Qed. Lemma lcn_cprod n A B G : A \* B = G -> 'L_n(A) \* 'L_n(B) = 'L_n(G). Proof. case: n => // n /cprodP[[H K -> ->{A B}] defG cHK]. have sL := subset_trans (lcn_sub _ _); rewrite cprodE ?(centSS _ _ cHK) ?sL //. symmetry; elim: n => // n; rewrite lcnSn => ->; rewrite commMG /=; last first. by apply: subset_trans (commg_normr _ _); rewrite sL // -defG mulG_subr. rewrite -!(commGC G) -defG -{1}(centC cHK). rewrite !commMG ?normsR ?lcn_norm ?cents_norm // 1?centsC //. by rewrite -!(commGC 'L__(_)) -!lcnSn !(commG1P _) ?mul1g ?sL // centsC. Qed. Lemma lcn_dprod n A B G : A \x B = G -> 'L_n(A) \x 'L_n(B) = 'L_n(G). Proof. move=> defG; have [[K H defA defB] _ _ tiAB] := dprodP defG. rewrite !dprodEcp // in defG *; first exact: lcn_cprod. by rewrite defA defB; apply/trivgP; rewrite -tiAB defA defB setISS ?lcn_sub. Qed. Lemma der_cprod n A B G : A \* B = G -> A^`(n) \* B^`(n) = G^`(n). Proof. by move=> defG; elim: n => {defG}// n; apply: (lcn_cprod 2). Qed. Lemma der_dprod n A B G : A \x B = G -> A^`(n) \x B^`(n) = G^`(n). Proof. by move=> defG; elim: n => {defG}// n; apply: (lcn_dprod 2). Qed. Lemma lcn_bigcprod n I r P (F : I -> {set gT}) G : \big[cprod/1]_(i <- r | P i) F i = G -> \big[cprod/1]_(i <- r | P i) 'L_n(F i) = 'L_n(G). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first exact/esym/trivgP/lcn_sub. by rewrite -(lcn_cprod n dG); have [[_ H _ dH]] := cprodP dG; rewrite dH (IH H). Qed. Lemma lcn_bigdprod n I r P (F : I -> {set gT}) G : \big[dprod/1]_(i <- r | P i) F i = G -> \big[dprod/1]_(i <- r | P i) 'L_n(F i) = 'L_n(G). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first exact/esym/trivgP/lcn_sub. by rewrite -(lcn_dprod n dG); have [[_ H _ dH]] := dprodP dG; rewrite dH (IH H). Qed. Lemma der_bigcprod n I r P (F : I -> {set gT}) G : \big[cprod/1]_(i <- r | P i) F i = G -> \big[cprod/1]_(i <- r | P i) (F i)^`(n) = G^`(n). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first by rewrite gF1. by rewrite -(der_cprod n dG); have [[_ H _ dH]] := cprodP dG; rewrite dH (IH H). Qed. Lemma der_bigdprod n I r P (F : I -> {set gT}) G : \big[dprod/1]_(i <- r | P i) F i = G -> \big[dprod/1]_(i <- r | P i) (F i)^`(n) = G^`(n). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first by rewrite gF1. by rewrite -(der_dprod n dG); have [[_ H _ dH]] := dprodP dG; rewrite dH (IH H). Qed. Lemma nilpotent_class G : nilpotent G = (nil_class G < #|G|). Proof. rewrite /nil_class; set s := mkseq _ _. transitivity (1 \in s); last by rewrite -index_mem size_mkseq. apply/idP/mapP=> {s}/= [nilG | [n _ Ln1]]; last first. apply/forall_inP=> H /subsetIP[sHG sHR]. rewrite -subG1 {}Ln1; elim: n => // n IHn. by rewrite (subset_trans sHR) ?commSg. pose m := #|G|.-1; exists m; first by rewrite mem_iota /= prednK. set n := m; rewrite ['L__(G)]card_le1_trivg //= -(subnn m) -[m in _ - m]/n. elim: n => [|n]; [by rewrite subn0 prednK | rewrite lcnSn subnS]. case: (eqsVneq 'L_n.+1(G) 1) => [-> | ntLn]; first by rewrite comm1G cards1. case: (m - n) => [|m' /= IHn]; first by rewrite leqNgt cardG_gt1 ntLn. rewrite -ltnS (leq_trans (proper_card _) IHn) //. by rewrite (nil_comm_properl nilG) ?lcn_sub // subsetI subxx lcn_norm. Qed. Lemma lcn_nil_classP n G : nilpotent G -> reflect ('L_n.+1(G) = 1) (nil_class G <= n). Proof. rewrite nilpotent_class /nil_class; set s := mkseq _ _. set c := index 1 s => lt_c_G; case: leqP => [le_c_n | lt_n_c]. have Lc1: nth 1 s c = 1 by rewrite nth_index // -index_mem size_mkseq. by left; apply/trivgP; rewrite -Lc1 nth_mkseq ?lcn_sub_leq. right; apply/eqP/negPf; rewrite -(before_find 1 lt_n_c) nth_mkseq //. exact: ltn_trans lt_n_c lt_c_G. Qed. Lemma lcnP G : reflect (exists n, 'L_n.+1(G) = 1) (nilpotent G). Proof. apply: (iffP idP) => [nilG | [n Ln1]]. by exists (nil_class G); apply/lcn_nil_classP. apply/forall_inP=> H /subsetIP[sHG sHR]; rewrite -subG1 -{}Ln1. by elim: n => // n IHn; rewrite (subset_trans sHR) ?commSg. Qed. Lemma abelian_nil G : abelian G -> nilpotent G. Proof. by move=> abG; apply/lcnP; exists 1%N; apply/commG1P. Qed. Lemma nil_class0 G : (nil_class G == 0) = (G :==: 1). Proof. apply/idP/eqP=> [nilG | ->]. by apply/(lcn_nil_classP 0); rewrite ?nilpotent_class (eqP nilG) ?cardG_gt0. by rewrite -leqn0; apply/(lcn_nil_classP 0); rewrite ?nilpotent1. Qed. Lemma nil_class1 G : (nil_class G <= 1) = abelian G. Proof. have [-> | ntG] := eqsVneq G 1. by rewrite abelian1 leq_eqVlt ltnS leqn0 nil_class0 eqxx orbT. apply/idP/idP=> cGG. apply/commG1P; apply/(lcn_nil_classP 1); rewrite // nilpotent_class. by rewrite (leq_ltn_trans cGG) // cardG_gt1. by apply/(lcn_nil_classP 1); rewrite ?abelian_nil //; apply/commG1P. Qed. Lemma cprod_nil A B G : A \* B = G -> nilpotent G = nilpotent A && nilpotent B. Proof. move=> defG; case/cprodP: defG (defG) => [[H K -> ->{A B}] defG _] defGc. apply/idP/andP=> [nilG | [/lcnP[m LmH1] /lcnP[n LnK1]]]. by rewrite !(nilpotentS _ nilG) // -defG (mulG_subr, mulG_subl). apply/lcnP; exists (m + n.+1); apply/trivgP. case/cprodP: (lcn_cprod (m.+1 + n.+1) defGc) => _ <- _. by rewrite mulG_subG /= -{1}LmH1 -LnK1 !lcn_sub_leq ?leq_addl ?leq_addr. Qed. Lemma mulg_nil G H : H \subset 'C(G) -> nilpotent (G * H) = nilpotent G && nilpotent H. Proof. by move=> cGH; rewrite -(cprod_nil (cprodEY cGH)) /= cent_joinEr. Qed. Lemma dprod_nil A B G : A \x B = G -> nilpotent G = nilpotent A && nilpotent B. Proof. by case/dprodP=> [[H K -> ->] <- cHK _]; rewrite mulg_nil. Qed. Lemma bigdprod_nil I r (P : pred I) (A_ : I -> {set gT}) G : \big[dprod/1]_(i <- r | P i) A_ i = G -> (forall i, P i -> nilpotent (A_ i)) -> nilpotent G. Proof. move=> defG nilA; elim/big_rec: _ => [|i B Pi nilB] in G defG *. by rewrite -defG nilpotent1. have [[_ H _ defB] _ _ _] := dprodP defG. by rewrite (dprod_nil defG) nilA //= defB nilB. Qed. End LowerCentral. Notation "''L_' n ( G )" := (lower_central_at_group n G) : Group_scope. Lemma lcn_cont n : GFunctor.continuous (@lower_central_at n). Proof. case: n => //; elim=> // n IHn g0T h0T H phi. by rewrite !lcnSn morphimR ?lcn_sub // commSg ?IHn. Qed. Canonical lcn_igFun n := [igFun by lcn_sub^~ n & lcn_cont n]. Canonical lcn_gFun n := [gFun by lcn_cont n]. Canonical lcn_mgFun n := [mgFun by fun _ G H => @lcnS _ n G H]. Section UpperCentralFunctor. Variable n : nat. Implicit Type gT : finGroupType. Lemma ucn_pmap : exists hZ : GFunctor.pmap, @upper_central_at n = hZ. Proof. elim: n => [|n' [hZ defZ]]; first by exists trivGfun_pgFun. by exists [pgFun of @center %% hZ]; rewrite /= -defZ. Qed. (* Now extract all the intermediate facts of the last proof. *) Lemma ucn_group_set gT (G : {group gT}) : group_set 'Z_n(G). Proof. by have [hZ ->] := ucn_pmap; apply: groupP. Qed. Canonical upper_central_at_group gT G := Group (@ucn_group_set gT G). Lemma ucn_sub gT (G : {group gT}) : 'Z_n(G) \subset G. Proof. by have [hZ ->] := ucn_pmap; apply: gFsub. Qed. Lemma morphim_ucn : GFunctor.pcontinuous (@upper_central_at n). Proof. by have [hZ ->] := ucn_pmap; apply: pmorphimF. Qed. Canonical ucn_igFun := [igFun by ucn_sub & morphim_ucn]. Canonical ucn_gFun := [gFun by morphim_ucn]. Canonical ucn_pgFun := [pgFun by morphim_ucn]. Variable (gT : finGroupType) (G : {group gT}). Lemma ucn_char : 'Z_n(G) \char G. Proof. exact: gFchar. Qed. Lemma ucn_norm : G \subset 'N('Z_n(G)). Proof. exact: gFnorm. Qed. Lemma ucn_normal : 'Z_n(G) <| G. Proof. exact: gFnormal. Qed. End UpperCentralFunctor. Notation "''Z_' n ( G )" := (upper_central_at_group n G) : Group_scope. Section UpperCentral. Variable gT : finGroupType. Implicit Types (A B : {set gT}) (G H : {group gT}). Lemma ucn0 A : 'Z_0(A) = 1. Proof. by []. Qed. Lemma ucnSn n A : 'Z_n.+1(A) = coset 'Z_n(A) @*^-1 'Z(A / 'Z_n(A)). Proof. by []. Qed. Lemma ucnE n A : 'Z_n(A) = upper_central_at_rec n A. Proof. by []. Qed. Lemma ucn_subS n G : 'Z_n(G) \subset 'Z_n.+1(G). Proof. by rewrite -{1}['Z_n(G)]ker_coset morphpreS ?sub1G. Qed. Lemma ucn_sub_geq m n G : n >= m -> 'Z_m(G) \subset 'Z_n(G). Proof. move/subnK <-; elim: {n}(n - m) => // n IHn. exact: subset_trans (ucn_subS _ _). Qed. Lemma ucn_central n G : 'Z_n.+1(G) / 'Z_n(G) = 'Z(G / 'Z_n(G)). Proof. by rewrite ucnSn cosetpreK. Qed. Lemma ucn_normalS n G : 'Z_n(G) <| 'Z_n.+1(G). Proof. by rewrite (normalS _ _ (ucn_normal n G)) ?ucn_subS ?ucn_sub. Qed. Lemma ucn_comm n G : [~: 'Z_n.+1(G), G] \subset 'Z_n(G). Proof. rewrite -quotient_cents2 ?normal_norm ?ucn_normal ?ucn_normalS //. by rewrite ucn_central subsetIr. Qed. Lemma ucn1 G : 'Z_1(G) = 'Z(G). Proof. apply: (quotient_inj (normal1 _) (normal1 _)). by rewrite /= (ucn_central 0) -injmF ?norms1 ?coset1_injm. Qed. Lemma ucnSnR n G : 'Z_n.+1(G) = [set x in G | [~: [set x], G] \subset 'Z_n(G)]. Proof. apply/setP=> x; rewrite inE -(setIidPr (ucn_sub n.+1 G)) inE ucnSn. case Gx: (x \in G) => //=; have nZG := ucn_norm n G. rewrite -sub1set -sub_quotient_pre -?quotient_cents2 ?sub1set ?(subsetP nZG) //. by rewrite subsetI quotientS ?sub1set. Qed. Lemma ucn_cprod n A B G : A \* B = G -> 'Z_n(A) \* 'Z_n(B) = 'Z_n(G). Proof. case/cprodP=> [[H K -> ->{A B}] mulHK cHK]. elim: n => [|n /cprodP[_ /= defZ cZn]]; first exact: cprod1g. set Z := 'Z_n(G) in defZ cZn; rewrite (ucnSn n G) /= -/Z. have /mulGsubP[nZH nZK]: H * K \subset 'N(Z) by rewrite mulHK gFnorm. have <-: 'Z(H / Z) * 'Z(K / Z) = 'Z(G / Z). by rewrite -mulHK quotientMl // center_prod ?quotient_cents. have ZquoZ (B A : {group gT}): B \subset 'C(A) -> 'Z_n(A) * 'Z_n(B) = Z -> 'Z(A / Z) = 'Z_n.+1(A) / Z. - move=> cAB {}defZ; have cAZnB: 'Z_n(B) \subset 'C(A) := gFsub_trans _ cAB. have /second_isom[/=]: A \subset 'N(Z). by rewrite -defZ normsM ?gFnorm ?cents_norm // centsC. suffices ->: Z :&: A = 'Z_n(A). by move=> f inj_f im_f; rewrite -!im_f ?gFsub // ucn_central injm_center. rewrite -defZ -group_modl ?gFsub //; apply/mulGidPl. have [-> | n_gt0] := posnP n; first exact: subsetIl. by apply: subset_trans (ucn_sub_geq A n_gt0); rewrite /= setIC ucn1 setIS. rewrite (ZquoZ H K) 1?centsC 1?(centC cZn) // {ZquoZ}(ZquoZ K H) //. have cZn1: 'Z_n.+1(K) \subset 'C('Z_n.+1(H)) by apply: centSS cHK; apply: gFsub. rewrite -quotientMl ?quotientK ?mul_subG ?gFsub_trans //=. rewrite cprodE // -cent_joinEr ?mulSGid //= cent_joinEr //= -/Z. by rewrite -defZ mulgSS ?ucn_subS. Qed. Lemma ucn_dprod n A B G : A \x B = G -> 'Z_n(A) \x 'Z_n(B) = 'Z_n(G). Proof. move=> defG; have [[K H defA defB] _ _ tiAB] := dprodP defG. rewrite !dprodEcp // in defG *; first exact: ucn_cprod. by rewrite defA defB; apply/trivgP; rewrite -tiAB defA defB setISS ?ucn_sub. Qed. Lemma ucn_bigcprod n I r P (F : I -> {set gT}) G : \big[cprod/1]_(i <- r | P i) F i = G -> \big[cprod/1]_(i <- r | P i) 'Z_n(F i) = 'Z_n(G). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first by rewrite gF1. by rewrite -(ucn_cprod n dG); have [[_ H _ dH]] := cprodP dG; rewrite dH (IH H). Qed. Lemma ucn_bigdprod n I r P (F : I -> {set gT}) G : \big[dprod/1]_(i <- r | P i) F i = G -> \big[dprod/1]_(i <- r | P i) 'Z_n(F i) = 'Z_n(G). Proof. elim/big_rec2: _ G => [_ <- | i A Z _ IH G dG]; first by rewrite gF1. by rewrite -(ucn_dprod n dG); have [[_ H _ dH]] := dprodP dG; rewrite dH (IH H). Qed. Lemma ucn_lcnP n G : ('L_n.+1(G) == 1) = ('Z_n(G) == G). Proof. rewrite !eqEsubset sub1G ucn_sub /= andbT -(ucn0 G); set i := (n in LHS). have: i + 0 = n by [rewrite addn0]; elim: i 0 => [j <- //|i IHi j]. rewrite addSnnS => /IHi <- {IHi}; rewrite ucnSn lcnSn. rewrite -sub_morphim_pre ?gFsub_trans ?gFnorm_trans // subsetI. by rewrite morphimS ?gFsub // quotient_cents2 ?gFsub_trans ?gFnorm_trans. Qed. Lemma ucnP G : reflect (exists n, 'Z_n(G) = G) (nilpotent G). Proof. apply: (iffP (lcnP G)) => -[n /eqP-clGn]; by exists n; apply/eqP; rewrite ucn_lcnP in clGn *. Qed. Lemma ucn_nil_classP n G : nilpotent G -> reflect ('Z_n(G) = G) (nil_class G <= n). Proof. move=> nilG; rewrite (sameP (lcn_nil_classP n nilG) eqP) ucn_lcnP; apply: eqP. Qed. Lemma ucn_id n G : 'Z_n('Z_n(G)) = 'Z_n(G). Proof. exact: gFid. Qed. Lemma ucn_nilpotent n G : nilpotent 'Z_n(G). Proof. by apply/ucnP; exists n; rewrite ucn_id. Qed. Lemma nil_class_ucn n G : nil_class 'Z_n(G) <= n. Proof. by apply/ucn_nil_classP; rewrite ?ucn_nilpotent ?ucn_id. Qed. End UpperCentral. Section MorphNil. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Implicit Type G : {group aT}. Lemma morphim_lcn n G : G \subset D -> f @* 'L_n(G) = 'L_n(f @* G). Proof. move=> sHG; case: n => //; elim=> // n IHn. by rewrite !lcnSn -IHn morphimR // (subset_trans _ sHG) // lcn_sub. Qed. Lemma injm_ucn n G : 'injm f -> G \subset D -> f @* 'Z_n(G) = 'Z_n(f @* G). Proof. exact: injmF. Qed. Lemma morphim_nil G : nilpotent G -> nilpotent (f @* G). Proof. case/ucnP=> n ZnG; apply/ucnP; exists n; apply/eqP. by rewrite eqEsubset ucn_sub /= -{1}ZnG morphim_ucn. Qed. Lemma injm_nil G : 'injm f -> G \subset D -> nilpotent (f @* G) = nilpotent G. Proof. move=> injf sGD; apply/idP/idP; last exact: morphim_nil. case/ucnP=> n; rewrite -injm_ucn // => /injm_morphim_inj defZ. by apply/ucnP; exists n; rewrite defZ ?gFsub_trans. Qed. Lemma nil_class_morphim G : nilpotent G -> nil_class (f @* G) <= nil_class G. Proof. move=> nilG; rewrite (sameP (ucn_nil_classP _ (morphim_nil nilG)) eqP) /=. by rewrite eqEsubset ucn_sub -{1}(ucn_nil_classP _ nilG (leqnn _)) morphim_ucn. Qed. Lemma nil_class_injm G : 'injm f -> G \subset D -> nil_class (f @* G) = nil_class G. Proof. move=> injf sGD; case nilG: (nilpotent G). apply/eqP; rewrite eqn_leq nil_class_morphim //. rewrite (sameP (lcn_nil_classP _ nilG) eqP) -subG1. rewrite -(injmSK injf) ?gFsub_trans // morphim1. by rewrite morphim_lcn // (lcn_nil_classP _ _ (leqnn _)) //= injm_nil. transitivity #|G|; apply/eqP; rewrite eqn_leq. rewrite -(card_injm injf sGD) (leq_trans (index_size _ _)) ?size_mkseq //. by rewrite leqNgt -nilpotent_class injm_nil ?nilG. rewrite (leq_trans (index_size _ _)) ?size_mkseq // leqNgt -nilpotent_class. by rewrite nilG. Qed. End MorphNil. Section QuotientNil. Variables gT : finGroupType. Implicit Types (rT : finGroupType) (G H : {group gT}). Lemma quotient_ucn_add m n G : 'Z_(m + n)(G) / 'Z_n(G) = 'Z_m(G / 'Z_n(G)). Proof. elim: m => [|m IHm]; first exact: trivg_quotient. apply/setP=> Zx; have [x Nx ->{Zx}] := cosetP Zx. have [sZG nZG] := andP (ucn_normal n G). rewrite (ucnSnR m) inE -!sub1set -morphim_set1 //= -quotientR ?sub1set // -IHm. rewrite !quotientSGK ?(ucn_sub_geq, leq_addl, comm_subG _ nZG, sub1set) //=. by rewrite addSn /= ucnSnR inE. Qed. Lemma isog_nil rT G (L : {group rT}) : G \isog L -> nilpotent G = nilpotent L. Proof. by case/isogP=> f injf <-; rewrite injm_nil. Qed. Lemma isog_nil_class rT G (L : {group rT}) : G \isog L -> nil_class G = nil_class L. Proof. by case/isogP=> f injf <-; rewrite nil_class_injm. Qed. Lemma quotient_nil G H : nilpotent G -> nilpotent (G / H). Proof. exact: morphim_nil. Qed. Lemma quotient_center_nil G : nilpotent (G / 'Z(G)) = nilpotent G. Proof. rewrite -ucn1; apply/idP/idP; last exact: quotient_nil. case/ucnP=> c nilGq; apply/ucnP; exists c.+1; have nsZ1G := ucn_normal 1 G. apply: (quotient_inj _ nsZ1G); last by rewrite /= -(addn1 c) quotient_ucn_add. by rewrite (normalS _ _ nsZ1G) ?ucn_sub ?ucn_sub_geq. Qed. Lemma nil_class_quotient_center G : nilpotent (G) -> nil_class (G / 'Z(G)) = (nil_class G).-1. Proof. move=> nilG; have nsZ1G := ucn_normal 1 G. apply/eqP; rewrite -ucn1 eqn_leq; apply/andP; split. apply/ucn_nil_classP; rewrite ?quotient_nil //= -quotient_ucn_add ucn1. by rewrite (ucn_nil_classP _ _ _) ?addn1 ?leqSpred. rewrite -subn1 leq_subLR addnC; apply/ucn_nil_classP => //=. apply: (quotient_inj _ nsZ1G) => /=. by apply: normalS (ucn_sub _ _) nsZ1G; rewrite /= addnS ucn_sub_geq. by rewrite quotient_ucn_add; apply/ucn_nil_classP; rewrite //= quotient_nil. Qed. Lemma nilpotent_sub_norm G H : nilpotent G -> H \subset G -> 'N_G(H) \subset H -> G :=: H. Proof. move=> nilG sHG sNH; apply/eqP; rewrite eqEsubset sHG andbT; apply/negP=> nsGH. have{nsGH} [i sZH []]: exists2 i, 'Z_i(G) \subset H & ~ 'Z_i.+1(G) \subset H. case/ucnP: nilG => n ZnG; rewrite -{}ZnG in nsGH. elim: n => [|i IHi] in nsGH *; first by rewrite sub1G in nsGH. by case sZH: ('Z_i(G) \subset H); [exists i | apply: IHi; rewrite sZH]. apply: subset_trans sNH; rewrite subsetI ucn_sub -commg_subr. by apply: subset_trans sZH; apply: subset_trans (ucn_comm i G); apply: commgS. Qed. Lemma nilpotent_proper_norm G H : nilpotent G -> H \proper G -> H \proper 'N_G(H). Proof. move=> nilG; rewrite properEneq properE subsetI normG => /andP[neHG sHG]. by rewrite sHG; apply: contra neHG => /(nilpotent_sub_norm nilG)->. Qed. Lemma nilpotent_subnormal G H : nilpotent G -> H \subset G -> H <|<| G. Proof. move=> nilG; have [m] := ubnP (#|G| - #|H|). elim: m H => // m IHm H /ltnSE-leGHm sHG. have [->|] := eqVproper sHG; first exact: subnormal_refl. move/(nilpotent_proper_norm nilG); set K := 'N_G(H) => prHK. have snHK: H <|<| K by rewrite normal_subnormal ?normalSG. have sKG: K \subset G by rewrite subsetIl. apply: subnormal_trans snHK (IHm _ (leq_trans _ leGHm) sKG). by rewrite ltn_sub2l ?proper_card ?(proper_sub_trans prHK). Qed. Lemma TI_center_nil G H : nilpotent G -> H <| G -> H :&: 'Z(G) = 1 -> H :=: 1. Proof. move=> nilG /andP[sHG nHG] tiHZ. rewrite -{1}(setIidPl sHG); have{nilG} /ucnP[n <-] := nilG. elim: n => [|n IHn]; apply/trivgP; rewrite ?subsetIr // -tiHZ. rewrite [H :&: 'Z(G)]setIA subsetI setIS ?ucn_sub //= (sameP commG1P trivgP). rewrite -commg_subr commGC in nHG. rewrite -IHn subsetI (subset_trans _ nHG) ?commSg ?subsetIl //=. by rewrite (subset_trans _ (ucn_comm n G)) ?commSg ?subsetIr. Qed. Lemma meet_center_nil G H : nilpotent G -> H <| G -> H :!=: 1 -> H :&: 'Z(G) != 1. Proof. by move=> nilG nsHG; apply: contraNneq => /TI_center_nil->. Qed. Lemma center_nil_eq1 G : nilpotent G -> ('Z(G) == 1) = (G :==: 1). Proof. move=> nilG; apply/eqP/eqP=> [Z1 | ->]; last exact: center1. by rewrite (TI_center_nil nilG) // (setIidPr (center_sub G)). Qed. Lemma cyclic_nilpotent_quo_der1_cyclic G : nilpotent G -> cyclic (G / G^`(1)) -> cyclic G. Proof. move=> nG; rewrite (isog_cyclic (quotient1_isog G)). have [-> // | ntG' cGG'] := (eqVneq G^`(1) 1)%g. suffices: 'L_2(G) \subset G :&: 'L_3(G) by move/(eqfun_inP nG)=> <-. rewrite subsetI lcn_sub /= -quotient_cents2 ?lcn_norm //. apply: cyclic_factor_abelian (lcn_central 2 G) _. by rewrite (isog_cyclic (third_isog _ _ _)) ?lcn_normal // lcn_subS. Qed. End QuotientNil. Section Solvable. Variable gT : finGroupType. Implicit Types G H : {group gT}. Lemma nilpotent_sol G : nilpotent G -> solvable G. Proof. move=> nilG; apply/forall_inP=> H /subsetIP[sHG sHH']. by rewrite (forall_inP nilG) // subsetI sHG (subset_trans sHH') ?commgS. Qed. Lemma abelian_sol G : abelian G -> solvable G. Proof. by move/abelian_nil/nilpotent_sol. Qed. Lemma solvable1 : solvable [1 gT]. Proof. exact: abelian_sol (abelian1 gT). Qed. Lemma solvableS G H : H \subset G -> solvable G -> solvable H. Proof. move=> sHG solG; apply/forall_inP=> K /subsetIP[sKH sKK']. by rewrite (forall_inP solG) // subsetI (subset_trans sKH). Qed. Lemma sol_der1_proper G H : solvable G -> H \subset G -> H :!=: 1 -> H^`(1) \proper H. Proof. move=> solG sHG ntH; rewrite properE comm_subG //; apply: implyP ntH. by have:= forallP solG H; rewrite subsetI sHG implybNN. Qed. Lemma derivedP G : reflect (exists n, G^`(n) = 1) (solvable G). Proof. apply: (iffP idP) => [solG | [n solGn]]; last first. apply/forall_inP=> H /subsetIP[sHG sHH']. rewrite -subG1 -{}solGn; elim: n => // n IHn. exact: subset_trans sHH' (commgSS _ _). suffices IHn n: #|G^`(n)| <= (#|G|.-1 - n).+1. by exists #|G|.-1; rewrite [G^`(_)]card_le1_trivg ?(leq_trans (IHn _)) ?subnn. elim: n => [|n IHn]; first by rewrite subn0 prednK. rewrite dergSn subnS -ltnS. have [-> | ntGn] := eqVneq G^`(n) 1; first by rewrite commG1 cards1. case: (_ - _) IHn => [|n']; first by rewrite leqNgt cardG_gt1 ntGn. by apply: leq_trans (proper_card _); apply: sol_der1_proper (der_sub _ _) _. Qed. End Solvable. Section MorphSol. Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Variable G : {group gT}. Lemma morphim_sol : solvable G -> solvable (f @* G). Proof. move/(solvableS (subsetIr D G)); case/derivedP=> n Gn1; apply/derivedP. by exists n; rewrite /= -morphimIdom -morphim_der ?subsetIl // Gn1 morphim1. Qed. Lemma injm_sol : 'injm f -> G \subset D -> solvable (f @* G) = solvable G. Proof. move=> injf sGD; apply/idP/idP; last exact: morphim_sol. case/derivedP=> n Gn1; apply/derivedP; exists n; apply/trivgP. by rewrite -(injmSK injf) ?gFsub_trans ?morphim_der // Gn1 morphim1. Qed. End MorphSol. Section QuotientSol. Variables gT rT : finGroupType. Implicit Types G H K : {group gT}. Lemma isog_sol G (L : {group rT}) : G \isog L -> solvable G = solvable L. Proof. by case/isogP=> f injf <-; rewrite injm_sol. Qed. Lemma quotient_sol G H : solvable G -> solvable (G / H). Proof. exact: morphim_sol. Qed. Lemma series_sol G H : H <| G -> solvable G = solvable H && solvable (G / H). Proof. case/andP=> sHG nHG; apply/idP/andP=> [solG | [solH solGH]]. by rewrite quotient_sol // (solvableS sHG). apply/forall_inP=> K /subsetIP[sKG sK'K]. suffices sKH: K \subset H by rewrite (forall_inP solH) // subsetI sKH. have nHK := subset_trans sKG nHG. rewrite -quotient_sub1 // subG1 (forall_inP solGH) //. by rewrite subsetI -morphimR ?morphimS. Qed. Lemma metacyclic_sol G : metacyclic G -> solvable G. Proof. case/metacyclicP=> K [cycK nsKG cycGq]. by rewrite (series_sol nsKG) !abelian_sol ?cyclic_abelian. Qed. End QuotientSol. math-comp-mathcomp-1.12.0/mathcomp/solvable/pgroup.v000066400000000000000000001440231375767750300224400ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype bigop finset prime fingroup morphism. From mathcomp Require Import gfunctor automorphism quotient action gproduct. From mathcomp Require Import cyclic. (******************************************************************************) (* Standard group notions and constructions based on the prime decomposition *) (* of the order of the group or its elements: *) (* pi.-group G <=> G is a pi-group, i.e., pi.-nat #|G|. *) (* -> Recall that here and in the sequel pi can be a single prime p. *) (* pi.-subgroup(H) G <=> H is a pi-subgroup of G. *) (* := (H \subset G) && pi.-group H. *) (* -> This is provided mostly as a shorhand, with few associated lemmas. *) (* However, we do establish some results on maximal pi-subgroups. *) (* pi.-elt x <=> x is a pi-element. *) (* := pi.-nat #[x] or pi.-group <[x]>. *) (* x.`_pi == the pi-constituent of x: the (unique) pi-element *) (* y \in <[x]> such that x * y^-1 is a pi'-element. *) (* pi.-Hall(G) H <=> H is a Hall pi-subgroup of G. *) (* := [&& H \subset G, pi.-group H & pi^'.-nat #|G : H|]. *) (* -> This is also eqivalent to H \subset G /\ #|H| = #|G|`_pi. *) (* p.-Sylow(G) P <=> P is a Sylow p-subgroup of G. *) (* -> This is the display and preferred input notation for p.-Hall(G) P. *) (* 'Syl_p(G) == the set of the p-Sylow subgroups of G. *) (* := [set P : {group _} | p.-Sylow(G) P]. *) (* p_group P <=> P is a p-group for some prime p. *) (* Hall G H <=> H is a Hall pi-subgroup of G for some pi. *) (* := coprime #|H| #|G : H| && (H \subset G). *) (* Sylow G P <=> P is a Sylow p-subgroup of G for some p. *) (* := p_group P && Hall G P. *) (* 'O_pi(G) == the pi-core (largest normal pi-subgroup) of G. *) (* pcore_mod pi G H == the pi-core of G mod H. *) (* := G :&: (coset H @*^-1 'O_pi(G / H)). *) (* 'O_{pi2, pi1}(G) == the pi1,pi2-core of G. *) (* := the pi1-core of G mod 'O_pi2(G). *) (* -> We have 'O_{pi2, pi1}(G) / 'O_pi2(G) = 'O_pi1(G / 'O_pi2(G)) *) (* with 'O_pi2(G) <| 'O_{pi2, pi1}(G) <| G. *) (* 'O_{pn, ..., p1}(G) == the p1, ..., pn-core of G. *) (* := the p1-core of G mod 'O_{pn, ..., p2}(G). *) (* Note that notions are always defined on sets even though their name *) (* indicates "group" properties; the actual definition of the notion never *) (* tests for the group property, since this property will always be provided *) (* by a (canonical) group structure. Similarly, p-group properties assume *) (* without test that p is a prime. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section PgroupDefs. (* We defer the definition of the functors ('0_p(G), etc) because they need *) (* to quantify over the finGroupType explicitly. *) Variable gT : finGroupType. Implicit Type (x : gT) (A B : {set gT}) (pi : nat_pred) (p n : nat). Definition pgroup pi A := pi.-nat #|A|. Definition psubgroup pi A B := (B \subset A) && pgroup pi B. Definition p_group A := pgroup (pdiv #|A|) A. Definition p_elt pi x := pi.-nat #[x]. Definition constt x pi := x ^+ (chinese #[x]`_pi #[x]`_pi^' 1 0). Definition Hall A B := (B \subset A) && coprime #|B| #|A : B|. Definition pHall pi A B := [&& B \subset A, pgroup pi B & pi^'.-nat #|A : B|]. Definition Syl p A := [set P : {group gT} | pHall p A P]. Definition Sylow A B := p_group B && Hall A B. End PgroupDefs. Arguments pgroup {gT} pi%N A%g. Arguments psubgroup {gT} pi%N A%g B%g. Arguments p_group {gT} A%g. Arguments p_elt {gT} pi%N x. Arguments constt {gT} x%g pi%N. Arguments Hall {gT} A%g B%g. Arguments pHall {gT} pi%N A%g B%g. Arguments Syl {gT} p%N A%g. Arguments Sylow {gT} A%g B%g. Notation "pi .-group" := (pgroup pi) (at level 2, format "pi .-group") : group_scope. Notation "pi .-subgroup ( A )" := (psubgroup pi A) (at level 8, format "pi .-subgroup ( A )") : group_scope. Notation "pi .-elt" := (p_elt pi) (at level 2, format "pi .-elt") : group_scope. Notation "x .`_ pi" := (constt x pi) (at level 3, format "x .`_ pi") : group_scope. Notation "pi .-Hall ( G )" := (pHall pi G) (at level 8, format "pi .-Hall ( G )") : group_scope. Notation "p .-Sylow ( G )" := (nat_pred_of_nat p).-Hall(G) (at level 8, format "p .-Sylow ( G )") : group_scope. Notation "''Syl_' p ( G )" := (Syl p G) (at level 8, p at level 2, format "''Syl_' p ( G )") : group_scope. Section PgroupProps. Variable gT : finGroupType. Implicit Types (pi rho : nat_pred) (p : nat). Implicit Types (x y z : gT) (A B C D : {set gT}) (G H K P Q R : {group gT}). Lemma trivgVpdiv G : G :=: 1 \/ (exists2 p, prime p & p %| #|G|). Proof. have [leG1|lt1G] := leqP #|G| 1; first by left; apply: card_le1_trivg. by right; exists (pdiv #|G|); rewrite ?pdiv_dvd ?pdiv_prime. Qed. Lemma prime_subgroupVti G H : prime #|G| -> G \subset H \/ H :&: G = 1. Proof. move=> prG; have [|[p p_pr pG]] := trivgVpdiv (H :&: G); first by right. left; rewrite (sameP setIidPr eqP) eqEcard subsetIr. suffices <-: p = #|G| by rewrite dvdn_leq ?cardG_gt0. by apply/eqP; rewrite -dvdn_prime2 // -(LagrangeI G H) setIC dvdn_mulr. Qed. Lemma pgroupE pi A : pi.-group A = pi.-nat #|A|. Proof. by []. Qed. Lemma sub_pgroup pi rho A : {subset pi <= rho} -> pi.-group A -> rho.-group A. Proof. by move=> pi_sub_rho; apply: sub_in_pnat (in1W pi_sub_rho). Qed. Lemma eq_pgroup pi rho A : pi =i rho -> pi.-group A = rho.-group A. Proof. exact: eq_pnat. Qed. Lemma eq_p'group pi rho A : pi =i rho -> pi^'.-group A = rho^'.-group A. Proof. by move/eq_negn; apply: eq_pnat. Qed. Lemma pgroupNK pi A : pi^'^'.-group A = pi.-group A. Proof. exact: pnatNK. Qed. Lemma pi_pgroup p pi A : p.-group A -> p \in pi -> pi.-group A. Proof. exact: pi_pnat. Qed. Lemma pi_p'group p pi A : pi.-group A -> p \in pi^' -> p^'.-group A. Proof. exact: pi_p'nat. Qed. Lemma pi'_p'group p pi A : pi^'.-group A -> p \in pi -> p^'.-group A. Proof. exact: pi'_p'nat. Qed. Lemma p'groupEpi p G : p^'.-group G = (p \notin \pi(G)). Proof. exact: p'natEpi (cardG_gt0 G). Qed. Lemma pgroup_pi G : \pi(G).-group G. Proof. by rewrite /=; apply: pnat_pi. Qed. Lemma partG_eq1 pi G : (#|G|`_pi == 1%N) = pi^'.-group G. Proof. exact: partn_eq1 (cardG_gt0 G). Qed. Lemma pgroupP pi G : reflect (forall p, prime p -> p %| #|G| -> p \in pi) (pi.-group G). Proof. exact: pnatP. Qed. Arguments pgroupP {pi G}. Lemma pgroup1 pi : pi.-group [1 gT]. Proof. by rewrite /pgroup cards1. Qed. Lemma pgroupS pi G H : H \subset G -> pi.-group G -> pi.-group H. Proof. by move=> sHG; apply: pnat_dvd (cardSg sHG). Qed. Lemma oddSg G H : H \subset G -> odd #|G| -> odd #|H|. Proof. by rewrite !odd_2'nat; apply: pgroupS. Qed. Lemma odd_pgroup_odd p G : odd p -> p.-group G -> odd #|G|. Proof. move=> p_odd pG; rewrite odd_2'nat (pi_pnat pG) // !inE. by case: eqP p_odd => // ->. Qed. Lemma card_pgroup p G : p.-group G -> #|G| = (p ^ logn p #|G|)%N. Proof. by move=> pG; rewrite -p_part part_pnat_id. Qed. Lemma properG_ltn_log p G H : p.-group G -> H \proper G -> logn p #|H| < logn p #|G|. Proof. move=> pG; rewrite properEneq eqEcard andbC ltnNge => /andP[sHG]. rewrite sHG /= {1}(card_pgroup pG) {1}(card_pgroup (pgroupS sHG pG)). by apply: contra; case: p {pG} => [|p] leHG; rewrite ?logn0 // leq_pexp2l. Qed. Lemma pgroupM pi G H : pi.-group (G * H) = pi.-group G && pi.-group H. Proof. have GH_gt0: 0 < #|G :&: H| := cardG_gt0 _. rewrite /pgroup -(mulnK #|_| GH_gt0) -mul_cardG -(LagrangeI G H) -mulnA. by rewrite mulKn // -(LagrangeI H G) setIC !pnatM andbCA; case: (pnat _). Qed. Lemma pgroupJ pi G x : pi.-group (G :^ x) = pi.-group G. Proof. by rewrite /pgroup cardJg. Qed. Lemma pgroup_p p P : p.-group P -> p_group P. Proof. case: (leqP #|P| 1); first by move=> /card_le1_trivg-> _; apply: pgroup1. move/pdiv_prime=> pr_q pgP; have:= pgroupP pgP _ pr_q (pdiv_dvd _). by rewrite /p_group => /eqnP->. Qed. Lemma p_groupP P : p_group P -> exists2 p, prime p & p.-group P. Proof. case: (ltnP 1 #|P|); first by move/pdiv_prime; exists (pdiv #|P|). by move/card_le1_trivg=> -> _; exists 2 => //; apply: pgroup1. Qed. Lemma pgroup_pdiv p G : p.-group G -> G :!=: 1 -> [/\ prime p, p %| #|G| & exists m, #|G| = p ^ m.+1]%N. Proof. move=> pG; rewrite trivg_card1; case/p_groupP: (pgroup_p pG) => q q_pr qG. move/implyP: (pgroupP pG q q_pr); case/p_natP: qG => // [[|m] ->] //. by rewrite dvdn_exp // => /eqnP <- _; split; rewrite ?dvdn_exp //; exists m. Qed. Lemma coprime_p'group p K R : coprime #|K| #|R| -> p.-group R -> R :!=: 1 -> p^'.-group K. Proof. move=> coKR pR ntR; have [p_pr _ [e oK]] := pgroup_pdiv pR ntR. by rewrite oK coprime_sym coprime_pexpl // prime_coprime // -p'natE in coKR. Qed. Lemma card_Hall pi G H : pi.-Hall(G) H -> #|H| = #|G|`_pi. Proof. case/and3P=> sHG piH pi'H; rewrite -(Lagrange sHG). by rewrite partnM ?Lagrange // part_pnat_id ?part_p'nat ?muln1. Qed. Lemma pHall_sub pi A B : pi.-Hall(A) B -> B \subset A. Proof. by case/andP. Qed. Lemma pHall_pgroup pi A B : pi.-Hall(A) B -> pi.-group B. Proof. by case/and3P. Qed. Lemma pHallP pi G H : reflect (H \subset G /\ #|H| = #|G|`_pi) (pi.-Hall(G) H). Proof. apply: (iffP idP) => [piH | [sHG oH]]. by split; [apply: pHall_sub piH | apply: card_Hall]. rewrite /pHall sHG -divgS // /pgroup oH. by rewrite -{2}(@partnC pi #|G|) ?mulKn ?part_pnat. Qed. Lemma pHallE pi G H : pi.-Hall(G) H = (H \subset G) && (#|H| == #|G|`_pi). Proof. by apply/pHallP/andP=> [] [->] /eqP. Qed. Lemma coprime_mulpG_Hall pi G K R : K * R = G -> pi.-group K -> pi^'.-group R -> pi.-Hall(G) K /\ pi^'.-Hall(G) R. Proof. move=> defG piK pi'R; apply/andP. rewrite /pHall piK -!divgS /= -defG ?mulG_subl ?mulg_subr //= pnatNK. by rewrite coprime_cardMg ?(pnat_coprime piK) // mulKn ?mulnK //; apply/and3P. Qed. Lemma coprime_mulGp_Hall pi G K R : K * R = G -> pi^'.-group K -> pi.-group R -> pi^'.-Hall(G) K /\ pi.-Hall(G) R. Proof. move=> defG pi'K piR; apply/andP; rewrite andbC; apply/andP. by apply: coprime_mulpG_Hall => //; rewrite -(comm_group_setP _) defG ?groupP. Qed. Lemma eq_in_pHall pi rho G H : {in \pi(G), pi =i rho} -> pi.-Hall(G) H = rho.-Hall(G) H. Proof. move=> eq_pi_rho; apply: andb_id2l => sHG. congr (_ && _); apply: eq_in_pnat => p piHp. by apply: eq_pi_rho; apply: (piSg sHG). by congr (~~ _); apply: eq_pi_rho; apply: (pi_of_dvd (dvdn_indexg G H)). Qed. Lemma eq_pHall pi rho G H : pi =i rho -> pi.-Hall(G) H = rho.-Hall(G) H. Proof. by move=> eq_pi_rho; apply: eq_in_pHall (in1W eq_pi_rho). Qed. Lemma eq_p'Hall pi rho G H : pi =i rho -> pi^'.-Hall(G) H = rho^'.-Hall(G) H. Proof. by move=> eq_pi_rho; apply: eq_pHall (eq_negn _). Qed. Lemma pHallNK pi G H : pi^'^'.-Hall(G) H = pi.-Hall(G) H. Proof. exact: eq_pHall (negnK _). Qed. Lemma subHall_Hall pi rho G H K : rho.-Hall(G) H -> {subset pi <= rho} -> pi.-Hall(H) K -> pi.-Hall(G) K. Proof. move=> hallH pi_sub_rho hallK. rewrite pHallE (subset_trans (pHall_sub hallK) (pHall_sub hallH)) /=. by rewrite (card_Hall hallK) (card_Hall hallH) partn_part. Qed. Lemma subHall_Sylow pi p G H P : pi.-Hall(G) H -> p \in pi -> p.-Sylow(H) P -> p.-Sylow(G) P. Proof. move=> hallH pi_p sylP; have [sHG piH _] := and3P hallH. rewrite pHallE (subset_trans (pHall_sub sylP) sHG) /=. by rewrite (card_Hall sylP) (card_Hall hallH) partn_part // => q; move/eqnP->. Qed. Lemma pHall_Hall pi A B : pi.-Hall(A) B -> Hall A B. Proof. by case/and3P=> sBA piB pi'B; rewrite /Hall sBA (pnat_coprime piB). Qed. Lemma Hall_pi G H : Hall G H -> \pi(H).-Hall(G) H. Proof. by case/andP=> sHG coHG /=; rewrite /pHall sHG /pgroup pnat_pi -?coprime_pi'. Qed. Lemma HallP G H : Hall G H -> exists pi, pi.-Hall(G) H. Proof. by exists \pi(H); apply: Hall_pi. Qed. Lemma sdprod_Hall G K H : K ><| H = G -> Hall G K = Hall G H. Proof. case/sdprod_context=> /andP[sKG _] sHG defG _ tiKH. by rewrite /Hall sKG sHG -!divgS // -defG TI_cardMg // coprime_sym mulKn ?mulnK. Qed. Lemma coprime_sdprod_Hall_l G K H : K ><| H = G -> coprime #|K| #|H| = Hall G K. Proof. case/sdprod_context=> /andP[sKG _] _ defG _ tiKH. by rewrite /Hall sKG -divgS // -defG TI_cardMg ?mulKn. Qed. Lemma coprime_sdprod_Hall_r G K H : K ><| H = G -> coprime #|K| #|H| = Hall G H. Proof. by move=> defG; rewrite (coprime_sdprod_Hall_l defG) (sdprod_Hall defG). Qed. Lemma compl_pHall pi K H G : pi.-Hall(G) K -> (H \in [complements to K in G]) = pi^'.-Hall(G) H. Proof. move=> hallK; apply/complP/idP=> [[tiKH mulKH] | hallH]. have [_] := andP hallK; rewrite /pHall pnatNK -{3}(invGid G) -mulKH mulG_subr. by rewrite invMG !indexMg -indexgI andbC -indexgI setIC tiKH !indexg1. have [[sKG piK _] [sHG pi'H _]] := (and3P hallK, and3P hallH). have tiKH: K :&: H = 1 := coprime_TIg (pnat_coprime piK pi'H). split=> //; apply/eqP; rewrite eqEcard mul_subG //= TI_cardMg //. by rewrite (card_Hall hallK) (card_Hall hallH) partnC. Qed. Lemma compl_p'Hall pi K H G : pi^'.-Hall(G) K -> (H \in [complements to K in G]) = pi.-Hall(G) H. Proof. by move/compl_pHall->; apply: eq_pHall (negnK pi). Qed. Lemma sdprod_normal_p'HallP pi K H G : K <| G -> pi^'.-Hall(G) H -> reflect (K ><| H = G) (pi.-Hall(G) K). Proof. move=> nsKG hallH; rewrite -(compl_p'Hall K hallH). exact: sdprod_normal_complP. Qed. Lemma sdprod_normal_pHallP pi K H G : K <| G -> pi.-Hall(G) H -> reflect (K ><| H = G) (pi^'.-Hall(G) K). Proof. by move=> nsKG hallH; apply: sdprod_normal_p'HallP; rewrite ?pHallNK. Qed. Lemma pHallJ2 pi G H x : pi.-Hall(G :^ x) (H :^ x) = pi.-Hall(G) H. Proof. by rewrite !pHallE conjSg !cardJg. Qed. Lemma pHallJnorm pi G H x : x \in 'N(G) -> pi.-Hall(G) (H :^ x) = pi.-Hall(G) H. Proof. by move=> Nx; rewrite -{1}(normP Nx) pHallJ2. Qed. Lemma pHallJ pi G H x : x \in G -> pi.-Hall(G) (H :^ x) = pi.-Hall(G) H. Proof. by move=> Gx; rewrite -{1}(conjGid Gx) pHallJ2. Qed. Lemma HallJ G H x : x \in G -> Hall G (H :^ x) = Hall G H. Proof. by move=> Gx; rewrite /Hall -!divgI -{1 3}(conjGid Gx) conjSg -conjIg !cardJg. Qed. Lemma psubgroupJ pi G H x : x \in G -> pi.-subgroup(G) (H :^ x) = pi.-subgroup(G) H. Proof. by move=> Gx; rewrite /psubgroup pgroupJ -{1}(conjGid Gx) conjSg. Qed. Lemma p_groupJ P x : p_group (P :^ x) = p_group P. Proof. by rewrite /p_group cardJg pgroupJ. Qed. Lemma SylowJ G P x : x \in G -> Sylow G (P :^ x) = Sylow G P. Proof. by move=> Gx; rewrite /Sylow p_groupJ HallJ. Qed. Lemma p_Sylow p G P : p.-Sylow(G) P -> Sylow G P. Proof. by move=> pP; rewrite /Sylow (pgroup_p (pHall_pgroup pP)) (pHall_Hall pP). Qed. Lemma pHall_subl pi G K H : H \subset K -> K \subset G -> pi.-Hall(G) H -> pi.-Hall(K) H. Proof. by move=> sHK sKG; rewrite /pHall sHK => /and3P[_ ->]; apply/pnat_dvd/indexSg. Qed. Lemma Hall1 G : Hall G 1. Proof. by rewrite /Hall sub1G cards1 coprime1n. Qed. Lemma p_group1 : @p_group gT 1. Proof. by rewrite (@pgroup_p 2) ?pgroup1. Qed. Lemma Sylow1 G : Sylow G 1. Proof. by rewrite /Sylow p_group1 Hall1. Qed. Lemma SylowP G P : reflect (exists2 p, prime p & p.-Sylow(G) P) (Sylow G P). Proof. apply: (iffP idP) => [| [p _]]; last exact: p_Sylow. case/andP=> /p_groupP[p p_pr] /p_natP[[P1 _ | n oP /Hall_pi]]; last first. by rewrite /= oP pi_of_exp // (eq_pHall _ _ (pi_of_prime _)) //; exists p. have{p p_pr P1} ->: P :=: 1 by apply: card1_trivg; rewrite P1. pose p := pdiv #|G|.+1; have p_pr: prime p by rewrite pdiv_prime ?ltnS. exists p; rewrite // pHallE sub1G cards1 part_p'nat //. apply/pgroupP=> q pr_q qG; apply/eqnP=> def_q. have: p %| #|G| + 1 by rewrite addn1 pdiv_dvd. by rewrite dvdn_addr -def_q // Euclid_dvd1. Qed. Lemma p_elt_exp pi x m : pi.-elt (x ^+ m) = (#[x]`_pi^' %| m). Proof. apply/idP/idP=> [pi_xm | /dvdnP[q ->{m}]]; last first. rewrite mulnC; apply: pnat_dvd (part_pnat pi #[x]). by rewrite order_dvdn -expgM mulnC mulnA partnC // -order_dvdn dvdn_mulr. rewrite -(@Gauss_dvdr _ #[x ^+ m]); last first. by rewrite coprime_sym (pnat_coprime pi_xm) ?part_pnat. apply: (@dvdn_trans #[x]); first by rewrite -{2}[#[x]](partnC pi) ?dvdn_mull. by rewrite order_dvdn mulnC expgM expg_order. Qed. Lemma mem_p_elt pi x G : pi.-group G -> x \in G -> pi.-elt x. Proof. by move=> piG Gx; apply: pgroupS piG; rewrite cycle_subG. Qed. Lemma p_eltM_norm pi x y : x \in 'N(<[y]>) -> pi.-elt x -> pi.-elt y -> pi.-elt (x * y). Proof. move=> nyx pi_x pi_y; apply: (@mem_p_elt pi _ (<[x]> <*> <[y]>)%G). by rewrite /= norm_joinEl ?cycle_subG // pgroupM; apply/andP. by rewrite groupM // mem_gen // inE cycle_id ?orbT. Qed. Lemma p_eltM pi x y : commute x y -> pi.-elt x -> pi.-elt y -> pi.-elt (x * y). Proof. move=> cxy; apply: p_eltM_norm; apply: (subsetP (cent_sub _)). by rewrite cent_gen cent_set1; apply/cent1P. Qed. Lemma p_elt1 pi : pi.-elt (1 : gT). Proof. by rewrite /p_elt order1. Qed. Lemma p_eltV pi x : pi.-elt x^-1 = pi.-elt x. Proof. by rewrite /p_elt orderV. Qed. Lemma p_eltX pi x n : pi.-elt x -> pi.-elt (x ^+ n). Proof. by rewrite -{1}[x]expg1 !p_elt_exp dvdn1 => /eqnP->. Qed. Lemma p_eltJ pi x y : pi.-elt (x ^ y) = pi.-elt x. Proof. by congr pnat; rewrite orderJ. Qed. Lemma sub_p_elt pi1 pi2 x : {subset pi1 <= pi2} -> pi1.-elt x -> pi2.-elt x. Proof. by move=> pi12; apply: sub_in_pnat => q _; apply: pi12. Qed. Lemma eq_p_elt pi1 pi2 x : pi1 =i pi2 -> pi1.-elt x = pi2.-elt x. Proof. by move=> pi12; apply: eq_pnat. Qed. Lemma p_eltNK pi x : pi^'^'.-elt x = pi.-elt x. Proof. exact: pnatNK. Qed. Lemma eq_constt pi1 pi2 x : pi1 =i pi2 -> x.`_pi1 = x.`_pi2. Proof. move=> pi12; congr (x ^+ (chinese _ _ 1 0)); apply: eq_partn => // a. by congr (~~ _); apply: pi12. Qed. Lemma consttNK pi x : x.`_pi^'^' = x.`_pi. Proof. by rewrite /constt !partnNK. Qed. Lemma cycle_constt pi x : x.`_pi \in <[x]>. Proof. exact: mem_cycle. Qed. Lemma consttV pi x : (x^-1).`_pi = (x.`_pi)^-1. Proof. by rewrite /constt expgVn orderV. Qed. Lemma constt1 pi : 1.`_pi = 1 :> gT. Proof. exact: expg1n. Qed. Lemma consttJ pi x y : (x ^ y).`_pi = x.`_pi ^ y. Proof. by rewrite /constt orderJ conjXg. Qed. Lemma p_elt_constt pi x : pi.-elt x.`_pi. Proof. by rewrite p_elt_exp /chinese addn0 mul1n dvdn_mulr. Qed. Lemma consttC pi x : x.`_pi * x.`_pi^' = x. Proof. apply/eqP; rewrite -{3}[x]expg1 -expgD eq_expg_mod_order. rewrite partnNK -{5 6}(@partnC pi #[x]) // /chinese !addn0. by rewrite chinese_remainder ?chinese_modl ?chinese_modr ?coprime_partC ?eqxx. Qed. Lemma p'_elt_constt pi x : pi^'.-elt (x * (x.`_pi)^-1). Proof. by rewrite -{1}(consttC pi^' x) consttNK mulgK p_elt_constt. Qed. Lemma order_constt pi (x : gT) : #[x.`_pi] = #[x]`_pi. Proof. rewrite -{2}(consttC pi x) orderM; [|exact: commuteX2|]; last first. by apply: (@pnat_coprime pi); apply: p_elt_constt. by rewrite partnM // part_pnat_id ?part_p'nat ?muln1 //; apply: p_elt_constt. Qed. Lemma consttM pi x y : commute x y -> (x * y).`_pi = x.`_pi * y.`_pi. Proof. move=> cxy; pose m := #|<<[set x; y]>>|; have m_gt0: 0 < m := cardG_gt0 _. pose k := chinese m`_pi m`_pi^' 1 0. suffices kXpi z: z \in <<[set x; y]>> -> z.`_pi = z ^+ k. by rewrite !kXpi ?expgMn // ?groupM ?mem_gen // !inE eqxx ?orbT. move=> xyz; have{xyz} zm: #[z] %| m by rewrite cardSg ?cycle_subG. apply/eqP; rewrite eq_expg_mod_order -{3 4}[#[z]](partnC pi) //. rewrite chinese_remainder ?chinese_modl ?chinese_modr ?coprime_partC //. rewrite -!(modn_dvdm k (partn_dvd _ m_gt0 zm)). rewrite chinese_modl ?chinese_modr ?coprime_partC //. by rewrite !modn_dvdm ?partn_dvd ?eqxx. Qed. Lemma consttX pi x n : (x ^+ n).`_pi = x.`_pi ^+ n. Proof. elim: n => [|n IHn]; first exact: constt1. by rewrite !expgS consttM ?IHn //; apply: commuteX. Qed. Lemma constt1P pi x : reflect (x.`_pi = 1) (pi^'.-elt x). Proof. rewrite -{2}[x]expg1 p_elt_exp -order_constt consttNK order_dvdn expg1. exact: eqP. Qed. Lemma constt_p_elt pi x : pi.-elt x -> x.`_pi = x. Proof. by rewrite -p_eltNK -{3}(consttC pi x) => /constt1P->; rewrite mulg1. Qed. Lemma sub_in_constt pi1 pi2 x : {in \pi(#[x]), {subset pi1 <= pi2}} -> x.`_pi2.`_pi1 = x.`_pi1. Proof. move=> pi12; rewrite -{2}(consttC pi2 x) consttM; last exact: commuteX2. rewrite (constt1P _ x.`_pi2^' _) ?mulg1 //. apply: sub_in_pnat (p_elt_constt _ x) => p; rewrite order_constt => pi_p. by apply/contra/pi12; rewrite -[#[x]](partnC pi2^') // primesM // pi_p. Qed. Lemma prod_constt x : \prod_(0 <= p < #[x].+1) x.`_p = x. Proof. pose lp n := [pred p | p < n]. have: (lp #[x].+1).-elt x by apply/pnatP=> // p _; apply: dvdn_leq. move/constt_p_elt=> def_x; symmetry; rewrite -{1}def_x {def_x}. elim: _.+1 => [|p IHp]. by rewrite big_nil; apply/constt1P; apply/pgroupP. rewrite big_nat_recr //= -{}IHp -(consttC (lp p) x.`__); congr (_ * _). by rewrite sub_in_constt // => q _; apply: leqW. set y := _.`__; rewrite -(consttC p y) (constt1P p^' _ _) ?mulg1. by rewrite 2?sub_in_constt // => q _; move/eqnP->; rewrite !inE ?ltnn. rewrite /p_elt pnatNK !order_constt -partnI. apply: sub_in_pnat (part_pnat _ _) => q _. by rewrite !inE ltnS -leqNgt -eqn_leq. Qed. Lemma max_pgroupJ pi M G x : x \in G -> [max M | pi.-subgroup(G) M] -> [max M :^ x of M | pi.-subgroup(G) M]. Proof. move=> Gx /maxgroupP[piM maxM]; apply/maxgroupP. split=> [|H piH]; first by rewrite psubgroupJ. by rewrite -(conjsgKV x H) conjSg => /maxM/=-> //; rewrite psubgroupJ ?groupV. Qed. Lemma comm_sub_max_pgroup pi H M G : [max M | pi.-subgroup(G) M] -> pi.-group H -> H \subset G -> commute H M -> H \subset M. Proof. case/maxgroupP=> /andP[sMG piM] maxM piH sHG cHM. rewrite -(maxM (H <*> M)%G) /= comm_joingE ?(mulG_subl, mulG_subr) //. by rewrite /psubgroup pgroupM piM piH mul_subG. Qed. Lemma normal_sub_max_pgroup pi H M G : [max M | pi.-subgroup(G) M] -> pi.-group H -> H <| G -> H \subset M. Proof. move=> maxM piH /andP[sHG nHG]. apply: comm_sub_max_pgroup piH sHG _ => //; apply: commute_sym; apply: normC. by apply: subset_trans nHG; case/andP: (maxgroupp maxM). Qed. Lemma norm_sub_max_pgroup pi H M G : [max M | pi.-subgroup(G) M] -> pi.-group H -> H \subset G -> H \subset 'N(M) -> H \subset M. Proof. by move=> maxM piH sHG /normC; apply: comm_sub_max_pgroup piH sHG. Qed. Lemma sub_pHall pi H G K : pi.-Hall(G) H -> pi.-group K -> H \subset K -> K \subset G -> K :=: H. Proof. move=> hallH piK sHK sKG; apply/eqP; rewrite eq_sym eqEcard sHK. by rewrite (card_Hall hallH) -(part_pnat_id piK) dvdn_leq ?partn_dvd ?cardSg. Qed. Lemma Hall_max pi H G : pi.-Hall(G) H -> [max H | pi.-subgroup(G) H]. Proof. move=> hallH; apply/maxgroupP; split=> [|K /andP[sKG piK] sHK]. by rewrite /psubgroup; case/and3P: hallH => ->. exact: (sub_pHall hallH). Qed. Lemma pHall_id pi H G : pi.-Hall(G) H -> pi.-group G -> H :=: G. Proof. by move=> hallH piG; rewrite (sub_pHall hallH piG) ?(pHall_sub hallH). Qed. Lemma psubgroup1 pi G : pi.-subgroup(G) 1. Proof. by rewrite /psubgroup sub1G pgroup1. Qed. Lemma Cauchy p G : prime p -> p %| #|G| -> {x | x \in G & #[x] = p}. Proof. move=> p_pr; have [n] := ubnP #|G|; elim: n G => // n IHn G /ltnSE-leGn pG. pose xpG := [pred x in G | #[x] == p]. have [x /andP[Gx /eqP] | no_x] := pickP xpG; first by exists x. have{pG n leGn IHn} pZ: p %| #|'C_G(G)|. suffices /dvdn_addl <-: p %| #|G :\: 'C(G)| by rewrite cardsID. have /acts_sum_card_orbit <-: [acts G, on G :\: 'C(G) | 'J]. by apply/actsP=> x Gx y; rewrite !inE -!mem_conjgV -centJ conjGid ?groupV. elim/big_rec: _ => // _ _ /imsetP[x /setDP[Gx nCx] ->] /dvdn_addl->. have ltCx: 'C_G[x] \proper G by rewrite properE subsetIl subsetIidl sub_cent1. have /negP: ~ p %| #|'C_G[x]|. case/(IHn _ (leq_trans (proper_card ltCx) leGn))=> y /setIP[Gy _] /eqP-oy. by have /andP[] := no_x y. by apply/implyP; rewrite -index_cent1 indexgI implyNb -Euclid_dvdM ?LagrangeI. have [Q maxQ _]: {Q | [max Q | p^'.-subgroup('C_G(G)) Q] & 1%G \subset Q}. by apply: maxgroup_exists; apply: psubgroup1. case/andP: (maxgroupp maxQ) => sQC; rewrite /pgroup p'natE // => /negP[]. apply: dvdn_trans pZ (cardSg _); apply/subsetP=> x /setIP[Gx Cx]. rewrite -sub1set -gen_subG (normal_sub_max_pgroup maxQ) //; last first. rewrite /normal subsetI !cycle_subG ?Gx ?cents_norm ?subIset ?andbT //=. by rewrite centsC cycle_subG Cx. rewrite /pgroup p'natE //= -[#|_|]/#[x]; apply/dvdnP=> [[m oxm]]. have m_gt0: 0 < m by apply: dvdn_gt0 (order_gt0 x) _; rewrite oxm dvdn_mulr. case/idP: (no_x (x ^+ m)); rewrite /= groupX //= orderXgcd //= oxm. by rewrite gcdnC gcdnMr mulKn. Qed. (* These lemmas actually hold for maximal pi-groups, but below we'll *) (* derive from the Cauchy lemma that a normal max pi-group is Hall. *) Lemma sub_normal_Hall pi G H K : pi.-Hall(G) H -> H <| G -> K \subset G -> (K \subset H) = pi.-group K. Proof. move=> hallH nsHG sKG; apply/idP/idP=> [sKH | piK]. by rewrite (pgroupS sKH) ?(pHall_pgroup hallH). apply: norm_sub_max_pgroup (Hall_max hallH) piK _ _ => //. exact: subset_trans sKG (normal_norm nsHG). Qed. Lemma mem_normal_Hall pi H G x : pi.-Hall(G) H -> H <| G -> x \in G -> (x \in H) = pi.-elt x. Proof. by rewrite -!cycle_subG; apply: sub_normal_Hall. Qed. Lemma uniq_normal_Hall pi H G K : pi.-Hall(G) H -> H <| G -> [max K | pi.-subgroup(G) K] -> K :=: H. Proof. move=> hallH nHG /maxgroupP[/andP[sKG piK] /(_ H) -> //]. exact: (maxgroupp (Hall_max hallH)). by rewrite (sub_normal_Hall hallH). Qed. End PgroupProps. Arguments pgroupP {gT pi G}. Arguments constt1P {gT pi x}. Section NormalHall. Variables (gT : finGroupType) (pi : nat_pred). Implicit Types G H K : {group gT}. Lemma normal_max_pgroup_Hall G H : [max H | pi.-subgroup(G) H] -> H <| G -> pi.-Hall(G) H. Proof. case/maxgroupP=> /andP[sHG piH] maxH nsHG; have [_ nHG] := andP nsHG. rewrite /pHall sHG piH; apply/pnatP=> // p p_pr. rewrite inE /= -pnatE // -card_quotient //. case/Cauchy=> //= Hx; rewrite -sub1set -gen_subG -/<[Hx]> /order. case/inv_quotientS=> //= K -> sHK sKG {Hx}. rewrite card_quotient ?(subset_trans sKG) // => iKH; apply/negP=> pi_p. rewrite -iKH -divgS // (maxH K) ?divnn ?cardG_gt0 // in p_pr. by rewrite /psubgroup sKG /pgroup -(Lagrange sHK) mulnC pnatM iKH pi_p. Qed. Lemma setI_normal_Hall G H K : H <| G -> pi.-Hall(G) H -> K \subset G -> pi.-Hall(K) (H :&: K). Proof. move=> nsHG hallH sKG; apply: normal_max_pgroup_Hall; last first. by rewrite /= setIC (normalGI sKG nsHG). apply/maxgroupP; split=> [|M /andP[sMK piM] sHK_M]. by rewrite /psubgroup subsetIr (pgroupS (subsetIl _ _) (pHall_pgroup hallH)). apply/eqP; rewrite eqEsubset sHK_M subsetI sMK !andbT. by rewrite (sub_normal_Hall hallH) // (subset_trans sMK). Qed. End NormalHall. Section Morphim. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Implicit Types (pi : nat_pred) (G H P : {group aT}). Lemma morphim_pgroup pi G : pi.-group G -> pi.-group (f @* G). Proof. by apply: pnat_dvd; apply: dvdn_morphim. Qed. Lemma morphim_odd G : odd #|G| -> odd #|f @* G|. Proof. by rewrite !odd_2'nat; apply: morphim_pgroup. Qed. Lemma pmorphim_pgroup pi G : pi.-group ('ker f) -> G \subset D -> pi.-group (f @* G) = pi.-group G. Proof. move=> piker sGD; apply/idP/idP=> [pifG|]; last exact: morphim_pgroup. apply: (@pgroupS _ _ (f @*^-1 (f @* G))); first by rewrite -sub_morphim_pre. by rewrite /pgroup card_morphpre ?morphimS // pnatM; apply/andP. Qed. Lemma morphim_p_index pi G H : H \subset D -> pi.-nat #|G : H| -> pi.-nat #|f @* G : f @* H|. Proof. by move=> sHD; apply: pnat_dvd; rewrite index_morphim ?subIset // sHD orbT. Qed. Lemma morphim_pHall pi G H : H \subset D -> pi.-Hall(G) H -> pi.-Hall(f @* G) (f @* H). Proof. move=> sHD /and3P[sHG piH pi'GH]. by rewrite /pHall morphimS // morphim_pgroup // morphim_p_index. Qed. Lemma pmorphim_pHall pi G H : G \subset D -> H \subset D -> pi.-subgroup(H :&: G) ('ker f) -> pi.-Hall(f @* G) (f @* H) = pi.-Hall(G) H. Proof. move=> sGD sHD /andP[/subsetIP[sKH sKG] piK]; rewrite !pHallE morphimSGK //. apply: andb_id2l => sHG; rewrite -(Lagrange sKH) -(Lagrange sKG) partnM //. by rewrite (part_pnat_id piK) !card_morphim !(setIidPr _) // eqn_pmul2l. Qed. Lemma morphim_Hall G H : H \subset D -> Hall G H -> Hall (f @* G) (f @* H). Proof. by move=> sHD /HallP[pi piH]; apply: (@pHall_Hall _ pi); apply: morphim_pHall. Qed. Lemma morphim_pSylow p G P : P \subset D -> p.-Sylow(G) P -> p.-Sylow(f @* G) (f @* P). Proof. exact: morphim_pHall. Qed. Lemma morphim_p_group P : p_group P -> p_group (f @* P). Proof. by move/morphim_pgroup; apply: pgroup_p. Qed. Lemma morphim_Sylow G P : P \subset D -> Sylow G P -> Sylow (f @* G) (f @* P). Proof. by move=> sPD /andP[pP hallP]; rewrite /Sylow morphim_p_group // morphim_Hall. Qed. Lemma morph_p_elt pi x : x \in D -> pi.-elt x -> pi.-elt (f x). Proof. by move=> Dx; apply: pnat_dvd; apply: morph_order. Qed. Lemma morph_constt pi x : x \in D -> f x.`_pi = (f x).`_pi. Proof. move=> Dx; rewrite -{2}(consttC pi x) morphM ?groupX //. rewrite consttM; last by rewrite !morphX //; apply: commuteX2. have: pi.-elt (f x.`_pi) by rewrite morph_p_elt ?groupX ?p_elt_constt //. have: pi^'.-elt (f x.`_pi^') by rewrite morph_p_elt ?groupX ?p_elt_constt //. by move/constt1P->; move/constt_p_elt->; rewrite mulg1. Qed. End Morphim. Section Pquotient. Variables (pi : nat_pred) (gT : finGroupType) (p : nat) (G H K : {group gT}). Hypothesis piK : pi.-group K. Lemma quotient_pgroup : pi.-group (K / H). Proof. exact: morphim_pgroup. Qed. Lemma quotient_pHall : K \subset 'N(H) -> pi.-Hall(G) K -> pi.-Hall(G / H) (K / H). Proof. exact: morphim_pHall. Qed. Lemma quotient_odd : odd #|K| -> odd #|K / H|. Proof. exact: morphim_odd. Qed. Lemma pquotient_pgroup : G \subset 'N(K) -> pi.-group (G / K) = pi.-group G. Proof. by move=> nKG; rewrite pmorphim_pgroup ?ker_coset. Qed. Lemma pquotient_pHall : K <| G -> K <| H -> pi.-Hall(G / K) (H / K) = pi.-Hall(G) H. Proof. case/andP=> sKG nKG; case/andP=> sKH nKH. by rewrite pmorphim_pHall // ker_coset /psubgroup subsetI sKH sKG. Qed. Lemma ltn_log_quotient : p.-group G -> H :!=: 1 -> H \subset G -> logn p #|G / H| < logn p #|G|. Proof. move=> pG ntH sHG; apply: contraLR (ltn_quotient ntH sHG); rewrite -!leqNgt. rewrite {2}(card_pgroup pG) {2}(card_pgroup (morphim_pgroup _ pG)). by case: (posnP p) => [-> //|]; apply: leq_pexp2l. Qed. End Pquotient. (* Application of card_Aut_cyclic to internal faithful action on cyclic *) (* p-subgroups. *) Section InnerAutCyclicPgroup. Variables (gT : finGroupType) (p : nat) (G C : {group gT}). Hypothesis nCG : G \subset 'N(C). Lemma logn_quotient_cent_cyclic_pgroup : p.-group C -> cyclic C -> logn p #|G / 'C_G(C)| <= (logn p #|C|).-1. Proof. move=> pC cycC; have [-> | ntC] := eqsVneq C 1. by rewrite cent1T setIT trivg_quotient cards1 logn1. have [p_pr _ [e oC]] := pgroup_pdiv pC ntC. rewrite -ker_conj_aut (card_isog (first_isog_loc _ _)) //. apply: leq_trans (dvdn_leq_log _ _ (cardSg (Aut_conj_aut _ _))) _ => //. rewrite card_Aut_cyclic // oC totient_pfactor //= logn_Gauss ?pfactorK //. by rewrite prime_coprime // gtnNdvd // -(subnKC (prime_gt1 p_pr)). Qed. Lemma p'group_quotient_cent_prime : prime p -> #|C| %| p -> p^'.-group (G / 'C_G(C)). Proof. move=> p_pr pC; have pgC: p.-group C := pnat_dvd pC (pnat_id p_pr). have [_ dv_p] := primeP p_pr; case/pred2P: {dv_p pC}(dv_p _ pC) => [|pC]. by move/card1_trivg->; rewrite cent1T setIT trivg_quotient pgroup1. have le_oGC := logn_quotient_cent_cyclic_pgroup pgC. rewrite /pgroup -partn_eq1 ?cardG_gt0 // -dvdn1 p_part pfactor_dvdn // logn1. by rewrite (leq_trans (le_oGC _)) ?prime_cyclic // pC ?(pfactorK 1). Qed. End InnerAutCyclicPgroup. Section PcoreDef. (* A functor needs to quantify over the finGroupType just beore the set. *) Variables (pi : nat_pred) (gT : finGroupType) (A : {set gT}). Definition pcore := \bigcap_(G | [max G | pi.-subgroup(A) G]) G. Canonical pcore_group : {group gT} := Eval hnf in [group of pcore]. End PcoreDef. Arguments pcore pi%N {gT} A%g. Arguments pcore_group pi%N {gT} A%G. Notation "''O_' pi ( G )" := (pcore pi G) (at level 8, pi at level 2, format "''O_' pi ( G )") : group_scope. Notation "''O_' pi ( G )" := (pcore_group pi G) : Group_scope. Section PseriesDefs. Variables (pis : seq nat_pred) (gT : finGroupType) (A : {set gT}). Definition pcore_mod pi B := coset B @*^-1 'O_pi(A / B). Canonical pcore_mod_group pi B : {group gT} := Eval hnf in [group of pcore_mod pi B]. Definition pseries := foldr pcore_mod 1 (rev pis). Lemma pseries_group_set : group_set pseries. Proof. by rewrite /pseries; case: rev => [|pi1 pi1']; apply: groupP. Qed. Canonical pseries_group : {group gT} := group pseries_group_set. End PseriesDefs. Arguments pseries pis%SEQ {gT} _%g. Local Notation ConsPred p := (@Cons nat_pred p%N) (only parsing). Notation "''O_{' p1 , .. , pn } ( A )" := (pseries (ConsPred p1 .. (ConsPred pn [::]) ..) A) (at level 8, format "''O_{' p1 , .. , pn } ( A )") : group_scope. Notation "''O_{' p1 , .. , pn } ( A )" := (pseries_group (ConsPred p1 .. (ConsPred pn [::]) ..) A) : Group_scope. Section PCoreProps. Variables (pi : nat_pred) (gT : finGroupType). Implicit Types (A : {set gT}) (G H M K : {group gT}). Lemma pcore_psubgroup G : pi.-subgroup(G) 'O_pi(G). Proof. have [M maxM _]: {M | [max M | pi.-subgroup(G) M] & 1%G \subset M}. by apply: maxgroup_exists; rewrite /psubgroup sub1G pgroup1. have sOM: 'O_pi(G) \subset M by apply: bigcap_inf. have /andP[piM sMG] := maxgroupp maxM. by rewrite /psubgroup (pgroupS sOM) // (subset_trans sOM). Qed. Lemma pcore_pgroup G : pi.-group 'O_pi(G). Proof. by case/andP: (pcore_psubgroup G). Qed. Lemma pcore_sub G : 'O_pi(G) \subset G. Proof. by case/andP: (pcore_psubgroup G). Qed. Lemma pcore_sub_Hall G H : pi.-Hall(G) H -> 'O_pi(G) \subset H. Proof. by move/Hall_max=> maxH; apply: bigcap_inf. Qed. Lemma pcore_max G H : pi.-group H -> H <| G -> H \subset 'O_pi(G). Proof. move=> piH nHG; apply/bigcapsP=> M maxM. exact: normal_sub_max_pgroup piH nHG. Qed. Lemma pcore_pgroup_id G : pi.-group G -> 'O_pi(G) = G. Proof. by move=> piG; apply/eqP; rewrite eqEsubset pcore_sub pcore_max. Qed. Lemma pcore_normal G : 'O_pi(G) <| G. Proof. rewrite /(_ <| G) pcore_sub; apply/subsetP=> x Gx. rewrite inE; apply/bigcapsP=> M maxM; rewrite sub_conjg. by apply: bigcap_inf; apply: max_pgroupJ; rewrite ?groupV. Qed. Lemma normal_Hall_pcore H G : pi.-Hall(G) H -> H <| G -> 'O_pi(G) = H. Proof. move=> hallH nHG; apply/eqP. rewrite eqEsubset (sub_normal_Hall hallH) ?pcore_sub ?pcore_pgroup //=. by rewrite pcore_max //= (pHall_pgroup hallH). Qed. Lemma eq_Hall_pcore G H : pi.-Hall(G) 'O_pi(G) -> pi.-Hall(G) H -> H :=: 'O_pi(G). Proof. move=> hallGpi hallH. exact: uniq_normal_Hall (pcore_normal G) (Hall_max hallH). Qed. Lemma sub_Hall_pcore G K : pi.-Hall(G) 'O_pi(G) -> K \subset G -> (K \subset 'O_pi(G)) = pi.-group K. Proof. by move=> hallGpi; apply: sub_normal_Hall (pcore_normal G). Qed. Lemma mem_Hall_pcore G x : pi.-Hall(G) 'O_pi(G) -> x \in G -> (x \in 'O_pi(G)) = pi.-elt x. Proof. by move=> hallGpi; apply: mem_normal_Hall (pcore_normal G). Qed. Lemma sdprod_Hall_pcoreP H G : pi.-Hall(G) 'O_pi(G) -> reflect ('O_pi(G) ><| H = G) (pi^'.-Hall(G) H). Proof. move=> hallGpi; rewrite -(compl_pHall H hallGpi) complgC. exact: sdprod_normal_complP (pcore_normal G). Qed. Lemma sdprod_pcore_HallP H G : pi^'.-Hall(G) H -> reflect ('O_pi(G) ><| H = G) (pi.-Hall(G) 'O_pi(G)). Proof. exact: sdprod_normal_p'HallP (pcore_normal G). Qed. Lemma pcoreJ G x : 'O_pi(G :^ x) = 'O_pi(G) :^ x. Proof. apply/eqP; rewrite eqEsubset -sub_conjgV. rewrite !pcore_max ?pgroupJ ?pcore_pgroup ?normalJ ?pcore_normal //. by rewrite -(normalJ _ _ x) conjsgKV pcore_normal. Qed. End PCoreProps. Section MorphPcore. Implicit Types (pi : nat_pred) (gT rT : finGroupType). Lemma morphim_pcore pi : GFunctor.pcontinuous (@pcore pi). Proof. move=> gT rT D G f; apply/bigcapsP=> M /normal_sub_max_pgroup; apply. by rewrite morphim_pgroup ?pcore_pgroup. by apply: morphim_normal; apply: pcore_normal. Qed. Lemma pcoreS pi gT (G H : {group gT}) : H \subset G -> H :&: 'O_pi(G) \subset 'O_pi(H). Proof. move=> sHG; rewrite -{2}(setIidPl sHG). by do 2!rewrite -(morphim_idm (subsetIl H _)) morphimIdom; apply: morphim_pcore. Qed. Canonical pcore_igFun pi := [igFun by pcore_sub pi & morphim_pcore pi]. Canonical pcore_gFun pi := [gFun by morphim_pcore pi]. Canonical pcore_pgFun pi := [pgFun by morphim_pcore pi]. Lemma pcore_char pi gT (G : {group gT}) : 'O_pi(G) \char G. Proof. exact: gFchar. Qed. Section PcoreMod. Variable F : GFunctor.pmap. Lemma pcore_mod_sub pi gT (G : {group gT}) : pcore_mod G pi (F _ G) \subset G. Proof. by rewrite sub_morphpre_im ?gFsub_trans ?morphimS ?gFnorm //= ker_coset gFsub. Qed. Lemma quotient_pcore_mod pi gT (G : {group gT}) (B : {set gT}) : pcore_mod G pi B / B = 'O_pi(G / B). Proof. exact/morphpreK/gFsub_trans/morphim_sub. Qed. Lemma morphim_pcore_mod pi gT rT (D G : {group gT}) (f : {morphism D >-> rT}) : f @* pcore_mod G pi (F _ G) \subset pcore_mod (f @* G) pi (F _ (f @* G)). Proof. have sDF: D :&: G \subset 'dom (coset (F _ G)). by rewrite setIC subIset ?gFnorm. have sDFf: D :&: G \subset 'dom (coset (F _ (f @* G)) \o f). by rewrite -sub_morphim_pre ?subsetIl // morphimIdom gFnorm. pose K := 'ker (restrm sDFf (coset (F _ (f @* G)) \o f)). have sFK: 'ker (restrm sDF (coset (F _ G))) \subset K. rewrite /K !ker_restrm ker_comp /= subsetI subsetIl /= -setIA. rewrite -sub_morphim_pre ?subsetIl //. by rewrite morphimIdom !ker_coset (setIidPr _) ?pmorphimF ?gFsub. have sOF := pcore_sub pi (G / F _ G); have sDD: D :&: G \subset D :&: G by []. rewrite -sub_morphim_pre -?quotientE; last first. by apply: subset_trans (gFnorm F _); rewrite morphimS ?pcore_mod_sub. suffices im_fact (H : {group gT}) : F _ G \subset H -> H \subset G -> factm sFK sDD @* (H / F _ G) = f @* H / F _ (f @* G). - rewrite -2?im_fact ?pcore_mod_sub ?gFsub //; try by rewrite -{1}[F _ G]ker_coset morphpreS ?sub1G. by rewrite quotient_pcore_mod morphim_pcore. move=> sFH sHG; rewrite -(morphimIdom _ (H / _)) /= {2}morphim_restrm setIid. rewrite -morphimIG ?ker_coset //. rewrite -(morphim_restrm sDF) morphim_factm morphim_restrm. by rewrite morphim_comp -quotientE -setIA morphimIdom (setIidPr _). Qed. Lemma pcore_mod_res pi gT rT (D : {group gT}) (f : {morphism D >-> rT}) : f @* pcore_mod D pi (F _ D) \subset pcore_mod (f @* D) pi (F _ (f @* D)). Proof. exact: morphim_pcore_mod. Qed. Lemma pcore_mod1 pi gT (G : {group gT}) : pcore_mod G pi 1 = 'O_pi(G). Proof. rewrite /pcore_mod; have inj1 := coset1_injm gT; rewrite -injmF ?norms1 //. by rewrite -(morphim_invmE inj1) morphim_invm ?norms1. Qed. End PcoreMod. Lemma pseries_rcons pi pis gT (A : {set gT}) : pseries (rcons pis pi) A = pcore_mod A pi (pseries pis A). Proof. by rewrite /pseries rev_rcons. Qed. Lemma pseries_subfun pis : GFunctor.closed (@pseries pis) /\ GFunctor.pcontinuous (@pseries pis). Proof. elim/last_ind: pis => [|pis pi [sFpi fFpi]]. by split=> [gT G | gT rT D G f]; rewrite (sub1G, morphim1). pose fF := [gFun by fFpi : GFunctor.continuous [igFun by sFpi & fFpi]]. pose F := [pgFun by fFpi : GFunctor.hereditary fF]. split=> [gT G | gT rT D G f]; rewrite !pseries_rcons ?(pcore_mod_sub F) //. exact: (morphim_pcore_mod F). Qed. Lemma pseries_sub pis : GFunctor.closed (@pseries pis). Proof. by case: (pseries_subfun pis). Qed. Lemma morphim_pseries pis : GFunctor.pcontinuous (@pseries pis). Proof. by case: (pseries_subfun pis). Qed. Lemma pseriesS pis : GFunctor.hereditary (@pseries pis). Proof. exact: (morphim_pseries pis). Qed. Canonical pseries_igFun pis := [igFun by pseries_sub pis & morphim_pseries pis]. Canonical pseries_gFun pis := [gFun by morphim_pseries pis]. Canonical pseries_pgFun pis := [pgFun by morphim_pseries pis]. Lemma pseries_char pis gT (G : {group gT}) : pseries pis G \char G. Proof. exact: gFchar. Qed. Lemma pseries_normal pis gT (G : {group gT}) : pseries pis G <| G. Proof. exact: gFnormal. Qed. Lemma pseriesJ pis gT (G : {group gT}) x : pseries pis (G :^ x) = pseries pis G :^ x. Proof. rewrite -{1}(setIid G) -morphim_conj -(injmF _ (injm_conj G x)) //=. by rewrite morphim_conj (setIidPr (pseries_sub _ _)). Qed. Lemma pseries1 pi gT (G : {group gT}) : 'O_{pi}(G) = 'O_pi(G). Proof. exact: pcore_mod1. Qed. Lemma pseries_pop pi pis gT (G : {group gT}) : 'O_pi(G) = 1 -> pseries (pi :: pis) G = pseries pis G. Proof. by move=> OG1; rewrite /pseries rev_cons -cats1 foldr_cat /= pcore_mod1 OG1. Qed. Lemma pseries_pop2 pi1 pi2 gT (G : {group gT}) : 'O_pi1(G) = 1 -> 'O_{pi1, pi2}(G) = 'O_pi2(G). Proof. by move/pseries_pop->; apply: pseries1. Qed. Lemma pseries_sub_catl pi1s pi2s gT (G : {group gT}) : pseries pi1s G \subset pseries (pi1s ++ pi2s) G. Proof. elim/last_ind: pi2s => [|pi pis IHpi]; rewrite ?cats0 // -rcons_cat. by rewrite pseries_rcons; apply: subset_trans IHpi _; rewrite sub_cosetpre. Qed. Lemma quotient_pseries pis pi gT (G : {group gT}) : pseries (rcons pis pi) G / pseries pis G = 'O_pi(G / pseries pis G). Proof. by rewrite pseries_rcons quotient_pcore_mod. Qed. Lemma pseries_norm2 pi1s pi2s gT (G : {group gT}) : pseries pi2s G \subset 'N(pseries pi1s G). Proof. by rewrite gFsub_trans ?gFnorm. Qed. Lemma pseries_sub_catr pi1s pi2s gT (G : {group gT}) : pseries pi2s G \subset pseries (pi1s ++ pi2s) G. Proof. elim: pi1s => //= pi1 pi1s /subset_trans; apply. elim/last_ind: {pi1s pi2s}(_ ++ _) => [|pis pi IHpi]; first exact: sub1G. rewrite -rcons_cons (pseries_rcons _ (pi1 :: pis)). rewrite -sub_morphim_pre ?pseries_norm2 //. apply: pcore_max; last by rewrite morphim_normal ?pseries_normal. have: pi.-group (pseries (rcons pis pi) G / pseries pis G). by rewrite quotient_pseries pcore_pgroup. by apply: pnat_dvd; rewrite !card_quotient ?pseries_norm2 // indexgS. Qed. Lemma quotient_pseries2 pi1 pi2 gT (G : {group gT}) : 'O_{pi1, pi2}(G) / 'O_pi1(G) = 'O_pi2(G / 'O_pi1(G)). Proof. by rewrite -pseries1 -quotient_pseries. Qed. Lemma quotient_pseries_cat pi1s pi2s gT (G : {group gT}) : pseries (pi1s ++ pi2s) G / pseries pi1s G = pseries pi2s (G / pseries pi1s G). Proof. elim/last_ind: pi2s => [|pi2s pi IHpi]; first by rewrite cats0 trivg_quotient. have psN := pseries_normal _ G; set K := pseries _ G. case: (third_isom (pseries_sub_catl pi1s pi2s G) (psN _)) => //= f inj_f im_f. have nH2H: pseries pi2s (G / K) <| pseries (pi1s ++ rcons pi2s pi) G / K. rewrite -IHpi morphim_normal // -cats1 catA. by apply/andP; rewrite pseries_sub_catl pseries_norm2. apply: (quotient_inj nH2H). by apply/andP; rewrite /= -cats1 pseries_sub_catl pseries_norm2. rewrite /= quotient_pseries /= -IHpi -rcons_cat. rewrite -[G / _ / _](morphim_invm inj_f) //= {2}im_f //. rewrite -(@injmF [igFun of @pcore pi]) /= ?injm_invm ?im_f // -quotient_pseries. by rewrite -im_f ?morphim_invm ?morphimS ?normal_sub. Qed. Lemma pseries_catl_id pi1s pi2s gT (G : {group gT}) : pseries pi1s (pseries (pi1s ++ pi2s) G) = pseries pi1s G. Proof. elim/last_ind: pi1s => [//|pi1s pi IHpi] in pi2s *. apply: (@quotient_inj _ (pseries_group pi1s G)). - rewrite /= -(IHpi (pi :: pi2s)) cat_rcons /(_ <| _) pseries_norm2. by rewrite -cats1 pseries_sub_catl. - by rewrite /= /(_ <| _) pseries_norm2 -cats1 pseries_sub_catl. rewrite /= cat_rcons -(IHpi (pi :: pi2s)) {1}quotient_pseries IHpi. apply/eqP; rewrite quotient_pseries eqEsubset !pcore_max ?pcore_pgroup //=. rewrite -quotient_pseries morphim_normal // /(_ <| _) pseries_norm2. by rewrite -cat_rcons pseries_sub_catl. by rewrite gFnormal_trans ?quotient_normal ?gFnormal. Qed. Lemma pseries_char_catl pi1s pi2s gT (G : {group gT}) : pseries pi1s G \char pseries (pi1s ++ pi2s) G. Proof. by rewrite -(pseries_catl_id pi1s pi2s G) pseries_char. Qed. Lemma pseries_catr_id pi1s pi2s gT (G : {group gT}) : pseries pi2s (pseries (pi1s ++ pi2s) G) = pseries pi2s G. Proof. elim/last_ind: pi2s => [//|pi2s pi IHpi] in G *. have Epis: pseries pi2s (pseries (pi1s ++ rcons pi2s pi) G) = pseries pi2s G. by rewrite -cats1 catA -2!IHpi pseries_catl_id. apply: (@quotient_inj _ (pseries_group pi2s G)). - by rewrite /= -Epis /(_ <| _) pseries_norm2 -cats1 pseries_sub_catl. - by rewrite /= /(_ <| _) pseries_norm2 -cats1 pseries_sub_catl. rewrite /= -Epis {1}quotient_pseries Epis quotient_pseries. apply/eqP; rewrite eqEsubset !pcore_max ?pcore_pgroup //=. rewrite -quotient_pseries morphim_normal // /(_ <| _) pseries_norm2. by rewrite pseries_sub_catr. by rewrite gFnormal_trans ?morphim_normal ?gFnormal. Qed. Lemma pseries_char_catr pi1s pi2s gT (G : {group gT}) : pseries pi2s G \char pseries (pi1s ++ pi2s) G. Proof. by rewrite -(pseries_catr_id pi1s pi2s G) pseries_char. Qed. Lemma pcore_modp pi gT (G H : {group gT}) : H <| G -> pi.-group H -> pcore_mod G pi H = 'O_pi(G). Proof. move=> nsHG piH; have nHG := normal_norm nsHG; apply/eqP. rewrite eqEsubset andbC -sub_morphim_pre ?(gFsub_trans, morphim_pcore) //=. rewrite -[G in 'O_pi(G)](quotientGK nsHG) pcore_max //. by rewrite -(pquotient_pgroup piH) ?subsetIl // cosetpreK pcore_pgroup. by rewrite morphpre_normal ?gFnormal ?gFsub_trans ?morphim_sub. Qed. Lemma pquotient_pcore pi gT (G H : {group gT}) : H <| G -> pi.-group H -> 'O_pi(G / H) = 'O_pi(G) / H. Proof. by move=> nsHG piH; rewrite -quotient_pcore_mod pcore_modp. Qed. Lemma trivg_pcore_quotient pi gT (G : {group gT}) : 'O_pi(G / 'O_pi(G)) = 1. Proof. by rewrite pquotient_pcore ?gFnormal ?pcore_pgroup ?trivg_quotient. Qed. Lemma pseries_rcons_id pis pi gT (G : {group gT}) : pseries (rcons (rcons pis pi) pi) G = pseries (rcons pis pi) G. Proof. apply/eqP; rewrite -!cats1 eqEsubset pseries_sub_catl andbT -catA. rewrite -(quotientSGK _ (pseries_sub_catl _ _ _)) ?pseries_norm2 //. rewrite !quotient_pseries_cat -quotient_sub1 ?pseries_norm2 //. by rewrite quotient_pseries_cat /= !pseries1 trivg_pcore_quotient. Qed. End MorphPcore. Section EqPcore. Variables gT : finGroupType. Implicit Types (pi rho : nat_pred) (G H : {group gT}). Lemma sub_in_pcore pi rho G : {in \pi(G), {subset pi <= rho}} -> 'O_pi(G) \subset 'O_rho(G). Proof. move=> pi_sub_rho; rewrite pcore_max ?pcore_normal //. apply: sub_in_pnat (pcore_pgroup _ _) => p. by move/(piSg (pcore_sub _ _)); apply: pi_sub_rho. Qed. Lemma sub_pcore pi rho G : {subset pi <= rho} -> 'O_pi(G) \subset 'O_rho(G). Proof. by move=> pi_sub_rho; apply: sub_in_pcore (in1W pi_sub_rho). Qed. Lemma eq_in_pcore pi rho G : {in \pi(G), pi =i rho} -> 'O_pi(G) = 'O_rho(G). Proof. move=> eq_pi_rho; apply/eqP; rewrite eqEsubset. by rewrite !sub_in_pcore // => p /eq_pi_rho->. Qed. Lemma eq_pcore pi rho G : pi =i rho -> 'O_pi(G) = 'O_rho(G). Proof. by move=> eq_pi_rho; apply: eq_in_pcore (in1W eq_pi_rho). Qed. Lemma pcoreNK pi G : 'O_pi^'^'(G) = 'O_pi(G). Proof. by apply: eq_pcore; apply: negnK. Qed. Lemma eq_p'core pi rho G : pi =i rho -> 'O_pi^'(G) = 'O_rho^'(G). Proof. by move/eq_negn; apply: eq_pcore. Qed. Lemma sdprod_Hall_p'coreP pi H G : pi^'.-Hall(G) 'O_pi^'(G) -> reflect ('O_pi^'(G) ><| H = G) (pi.-Hall(G) H). Proof. by rewrite -(pHallNK pi G H); apply: sdprod_Hall_pcoreP. Qed. Lemma sdprod_p'core_HallP pi H G : pi.-Hall(G) H -> reflect ('O_pi^'(G) ><| H = G) (pi^'.-Hall(G) 'O_pi^'(G)). Proof. by rewrite -(pHallNK pi G H); apply: sdprod_pcore_HallP. Qed. Lemma pcoreI pi rho G : 'O_[predI pi & rho](G) = 'O_pi('O_rho(G)). Proof. apply/eqP; rewrite eqEsubset !pcore_max //. - by rewrite /pgroup pnatI -!pgroupE !(pcore_pgroup, pgroupS (pcore_sub pi _)). - by rewrite !gFnormal_trans. - by apply: sub_pgroup (pcore_pgroup _ _) => p /andP[]. apply/andP; split; first by apply: sub_pcore => p /andP[]. by rewrite gFnorm_trans ?normsG ?gFsub. Qed. Lemma bigcap_p'core pi G : G :&: \bigcap_(p < #|G|.+1 | (p : nat) \in pi) 'O_p^'(G) = 'O_pi^'(G). Proof. apply/eqP; rewrite eqEsubset subsetI pcore_sub pcore_max /=. - by apply/bigcapsP=> p pi_p; apply: sub_pcore => r; apply: contraNneq => ->. - apply/pgroupP=> q q_pr qGpi'; apply: contraL (eqxx q) => /= pi_q. apply: (pgroupP (pcore_pgroup q^' G)) => //. have qG: q %| #|G| by rewrite (dvdn_trans qGpi') // cardSg ?subsetIl. have ltqG: q < #|G|.+1 by rewrite ltnS dvdn_leq. rewrite (dvdn_trans qGpi') ?cardSg ?subIset //= orbC. by rewrite (bigcap_inf (Ordinal ltqG)). rewrite /normal subsetIl normsI ?normG // norms_bigcap //. by apply/bigcapsP => p _; apply: gFnorm. Qed. Lemma coprime_pcoreC (rT : finGroupType) pi G (R : {group rT}) : coprime #|'O_pi(G)| #|'O_pi^'(R)|. Proof. exact: pnat_coprime (pcore_pgroup _ _) (pcore_pgroup _ _). Qed. Lemma TI_pcoreC pi G H : 'O_pi(G) :&: 'O_pi^'(H) = 1. Proof. by rewrite coprime_TIg ?coprime_pcoreC. Qed. Lemma pcore_setI_normal pi G H : H <| G -> 'O_pi(G) :&: H = 'O_pi(H). Proof. move=> nsHG; apply/eqP; rewrite eqEsubset subsetI pcore_sub setIC. rewrite !pcore_max ?(pgroupS (subsetIr H _)) ?pcore_pgroup ?gFnormal_trans //=. by rewrite norm_normalI ?gFnorm_trans ?normsG ?normal_sub. Qed. End EqPcore. Arguments sdprod_Hall_pcoreP {pi gT H G}. Arguments sdprod_Hall_p'coreP {gT pi H G}. Section Injm. Variables (aT rT : finGroupType) (D : {group aT}) (f : {morphism D >-> rT}). Hypothesis injf : 'injm f. Implicit Types (A : {set aT}) (G H : {group aT}). Lemma injm_pgroup pi A : A \subset D -> pi.-group (f @* A) = pi.-group A. Proof. by move=> sAD; rewrite /pgroup card_injm. Qed. Lemma injm_pelt pi x : x \in D -> pi.-elt (f x) = pi.-elt x. Proof. by move=> Dx; rewrite /p_elt order_injm. Qed. Lemma injm_pHall pi G H : G \subset D -> H \subset D -> pi.-Hall(f @* G) (f @* H) = pi.-Hall(G) H. Proof. by move=> sGD sGH; rewrite !pHallE injmSK ?card_injm. Qed. Lemma injm_pcore pi G : G \subset D -> f @* 'O_pi(G) = 'O_pi(f @* G). Proof. exact: injmF. Qed. Lemma injm_pseries pis G : G \subset D -> f @* pseries pis G = pseries pis (f @* G). Proof. exact: injmF. Qed. End Injm. Section Isog. Variables (aT rT : finGroupType) (G : {group aT}) (H : {group rT}). Lemma isog_pgroup pi : G \isog H -> pi.-group G = pi.-group H. Proof. by move=> isoGH; rewrite /pgroup (card_isog isoGH). Qed. Lemma isog_pcore pi : G \isog H -> 'O_pi(G) \isog 'O_pi(H). Proof. exact: gFisog. Qed. Lemma isog_pseries pis : G \isog H -> pseries pis G \isog pseries pis H. Proof. exact: gFisog. Qed. End Isog. math-comp-mathcomp-1.12.0/mathcomp/solvable/primitive_action.v000066400000000000000000000347741375767750300245040ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat. From mathcomp Require Import div seq fintype tuple finset. From mathcomp Require Import fingroup action gseries. (******************************************************************************) (* n-transitive and primitive actions: *) (* [primitive A, on S | to] <=> *) (* A acts on S in a primitive manner, i.e., A is transitive on S and *) (* A does not act on any nontrivial partition of S. *) (* imprimitivity_system A to S Q <=> *) (* Q is a non-trivial primitivity system for the action of A on S via *) (* to, i.e., Q is a non-trivial partiiton of S on which A acts. *) (* to * n == in the %act scope, the total action induced by the total *) (* action to on n.-tuples. via n_act to n. *) (* n.-dtuple S == the set of n-tuples with distinct values in S. *) (* [transitive^n A, on S | to] <=> *) (* A is n-transitive on S, i.e., A is transitive on n.-dtuple S *) (* == the set of n-tuples with distinct values in S. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Section PrimitiveDef. Variables (aT : finGroupType) (sT : finType). Variables (A : {set aT}) (S : {set sT}) (to : {action aT &-> sT}). Definition imprimitivity_system Q := [&& partition Q S, [acts A, on Q | to^*] & 1 < #|Q| < #|S|]. Definition primitive := [transitive A, on S | to] && ~~ [exists Q, imprimitivity_system Q]. End PrimitiveDef. Arguments imprimitivity_system {aT sT} A%g S%g to%act Q%g. Arguments primitive {aT sT} A%g S%g to%act. Notation "[ 'primitive' A , 'on' S | to ]" := (primitive A S to) (at level 0, format "[ 'primitive' A , 'on' S | to ]") : form_scope. Section Primitive. Variables (aT : finGroupType) (sT : finType). Variables (G : {group aT}) (to : {action aT &-> sT}) (S : {set sT}). Lemma trans_prim_astab x : x \in S -> [transitive G, on S | to] -> [primitive G, on S | to] = maximal_eq 'C_G[x | to] G. Proof. move=> Sx trG; rewrite /primitive trG negb_exists. apply/forallP/maximal_eqP=> /= [primG | [_ maxCx] Q]. split=> [|H sCH sHG]; first exact: subsetIl. pose X := orbit to H x; pose Q := orbit (to^*)%act G X. have Xx: x \in X by apply: orbit_refl. have defH: 'N_(G)(X | to) = H. have trH: [transitive H, on X | to] by apply/imsetP; exists x. have sHN: H \subset 'N_G(X | to) by rewrite subsetI sHG atrans_acts. move/(subgroup_transitiveP Xx sHN): (trH) => /= <-. by rewrite mulSGid //= setIAC subIset ?sCH. apply/imsetP; exists x => //; apply/eqP. by rewrite eqEsubset imsetS // acts_sub_orbit ?subsetIr. have [|/proper_card oCH] := eqVproper sCH; [by left | right]. apply/eqP; rewrite eqEcard sHG leqNgt. apply: contra {primG}(primG Q) => oHG; apply/and3P; split; last first. - rewrite card_orbit astab1_set defH -(@ltn_pmul2l #|H|) ?Lagrange // muln1. rewrite oHG -(@ltn_pmul2l #|H|) ?Lagrange // -(card_orbit_stab to G x). by rewrite -(atransP trG x Sx) mulnC card_orbit ltn_pmul2r. - by apply/actsP=> a Ga Y; apply/orbit_transl/mem_orbit. apply/and3P; split; last 1 first. - rewrite orbit_sym; apply/imsetP=> [[a _]] /= defX. by rewrite defX /setact imset0 inE in Xx. - apply/eqP/setP=> y; apply/bigcupP/idP=> [[_ /imsetP[a Ga ->]] | Sy]. case/imsetP=> _ /imsetP[b Hb ->] ->. by rewrite !(actsP (atrans_acts trG)) //; apply: subsetP Hb. case: (atransP2 trG Sx Sy) => a Ga ->. by exists ((to^*)%act X a); apply: imset_f; rewrite // orbit_refl. apply/trivIsetP=> _ _ /imsetP[a Ga ->] /imsetP[b Gb ->]. apply: contraR => /exists_inP[_ /imsetP[_ /imsetP[a1 Ha1 ->] ->]]. case/imsetP=> _ /imsetP[b1 Hb1 ->] /(canLR (actK _ _)) /(canLR (actK _ _)). rewrite -(canF_eq (actKV _ _)) -!actM (sameP eqP astab1P) => /astab1P Cab. rewrite astab1_set (subsetP (subsetIr G _)) //= defH. rewrite -(groupMr _ (groupVr Hb1)) -mulgA -(groupMl _ Ha1). by rewrite (subsetP sCH) // inE Cab !groupM ?groupV // (subsetP sHG). apply/and3P=> [[/and3P[/eqP defS tIQ ntQ]]]; set sto := (to^*)%act => actQ. rewrite !ltnNge -negb_or => /orP[]. pose X := pblock Q x; have Xx: x \in X by rewrite mem_pblock defS. have QX: X \in Q by rewrite pblock_mem ?defS. have toX Y a: Y \in Q -> a \in G -> to x a \in Y -> sto X a = Y. move=> QY Ga Yxa; rewrite -(contraNeq (trivIsetP tIQ Y (sto X a) _ _)) //. by rewrite (actsP actQ). by apply/existsP; exists (to x a); rewrite /= Yxa; apply: imset_f. have defQ: Q = orbit (to^*)%act G X. apply/eqP; rewrite eqEsubset andbC acts_sub_orbit // QX. apply/subsetP=> Y QY. have /set0Pn[y Yy]: Y != set0 by apply: contraNneq ntQ => <-. have Sy: y \in S by rewrite -defS; apply/bigcupP; exists Y. have [a Ga def_y] := atransP2 trG Sx Sy. by apply/imsetP; exists a; rewrite // (toX Y) // -def_y. rewrite defQ card_orbit; case: (maxCx 'C_G[X | sto]%G) => /= [||->|->]. - apply/subsetP=> a /setIP[Ga cxa]; rewrite inE Ga /=. by apply/astab1P; rewrite (toX X) // (astab1P cxa). - exact: subsetIl. - by right; rewrite -card_orbit (atransP trG). by left; rewrite indexgg. Qed. Lemma prim_trans_norm (H : {group aT}) : [primitive G, on S | to] -> H <| G -> H \subset 'C_G(S | to) \/ [transitive H, on S | to]. Proof. move=> primG /andP[sHG nHG]; rewrite subsetI sHG. have [trG _] := andP primG; have [x Sx defS] := imsetP trG. move: primG; rewrite (trans_prim_astab Sx) // => /maximal_eqP[_]. case/(_ ('C_G[x | to] <*> H)%G) => /= [||cxH|]; first exact: joing_subl. - by rewrite join_subG subsetIl. - have{} cxH: H \subset 'C_G[x | to] by rewrite -cxH joing_subr. rewrite subsetI sHG /= in cxH; left; apply/subsetP=> a Ha. apply/astabP=> y Sy; have [b Gb ->] := atransP2 trG Sx Sy. rewrite actCJV [to x (a ^ _)](astab1P _) ?(subsetP cxH) //. by rewrite -mem_conjg (normsP nHG). rewrite norm_joinEl 1?subIset ?nHG //. by move/(subgroup_transitiveP Sx sHG trG); right. Qed. End Primitive. Section NactionDef. Variables (gT : finGroupType) (sT : finType). Variables (to : {action gT &-> sT}) (n : nat). Definition n_act (t : n.-tuple sT) a := [tuple of map (to^~ a) t]. Fact n_act_is_action : is_action setT n_act. Proof. by apply: is_total_action => [t|t a b]; apply: eq_from_tnth => i; rewrite !tnth_map ?act1 ?actM. Qed. Canonical n_act_action := Action n_act_is_action. End NactionDef. Notation "to * n" := (n_act_action to n) : action_scope. Section NTransitive. Variables (gT : finGroupType) (sT : finType). Variables (n : nat) (A : {set gT}) (S : {set sT}) (to : {action gT &-> sT}). Definition dtuple_on := [set t : n.-tuple sT | uniq t & t \subset S]. Definition ntransitive := [transitive A, on dtuple_on | to * n]. Lemma dtuple_onP t : reflect (injective (tnth t) /\ forall i, tnth t i \in S) (t \in dtuple_on). Proof. rewrite inE subset_all -forallb_tnth -[in uniq t]map_tnth_enum /=. by apply: (iffP andP) => -[/injectiveP-f_inj /forallP]. Qed. Lemma n_act_dtuple t a : a \in 'N(S | to) -> t \in dtuple_on -> n_act to t a \in dtuple_on. Proof. move/astabsP=> toSa /dtuple_onP[t_inj St]; apply/dtuple_onP. split=> [i j | i]; rewrite !tnth_map ?[_ \in S]toSa //. by move/act_inj; apply: t_inj. Qed. End NTransitive. Arguments dtuple_on {sT} n%N S%g. Arguments ntransitive {gT sT} n%N A%g S%g to%act. Arguments n_act {gT sT} to {n} t a. Notation "n .-dtuple ( S )" := (dtuple_on n S) (at level 8, format "n .-dtuple ( S )") : set_scope. Notation "[ 'transitive' ^ n A , 'on' S | to ]" := (ntransitive n A S to) (at level 0, n at level 8, format "[ 'transitive' ^ n A , 'on' S | to ]") : form_scope. Section NTransitveProp. Variables (gT : finGroupType) (sT : finType). Variables (to : {action gT &-> sT}) (G : {group gT}) (S : {set sT}). Lemma card_uniq_tuple n (t : n.-tuple sT) : uniq t -> #|t| = n. Proof. by move/card_uniqP->; apply: size_tuple. Qed. Lemma n_act0 (t : 0.-tuple sT) a : n_act to t a = [tuple]. Proof. exact: tuple0. Qed. Lemma dtuple_on_add n x (t : n.-tuple sT) : ([tuple of x :: t] \in n.+1.-dtuple(S)) = [&& x \in S, x \notin t & t \in n.-dtuple(S)]. Proof. by rewrite !inE memtE !subset_all -!andbA; do !bool_congr. Qed. Lemma dtuple_on_add_D1 n x (t : n.-tuple sT) : ([tuple of x :: t] \in n.+1.-dtuple(S)) = (x \in S) && (t \in n.-dtuple(S :\ x)). Proof. rewrite dtuple_on_add !inE (andbCA (~~ _)); do 2!congr (_ && _). rewrite -!(eq_subset (in_set (mem t))) setDE setIC subsetI; congr (_ && _). by rewrite -setCS setCK sub1set !inE. Qed. Lemma dtuple_on_subset n (S1 S2 : {set sT}) t : S1 \subset S2 -> t \in n.-dtuple(S1) -> t \in n.-dtuple(S2). Proof. by move=> sS12; rewrite !inE => /andP[-> /subset_trans]; apply. Qed. Lemma n_act_add n x (t : n.-tuple sT) a : n_act to [tuple of x :: t] a = [tuple of to x a :: n_act to t a]. Proof. exact: val_inj. Qed. Lemma ntransitive0 : [transitive^0 G, on S | to]. Proof. have dt0: [tuple] \in 0.-dtuple(S) by rewrite inE memtE subset_all. apply/imsetP; exists [tuple of Nil sT] => //. by apply/setP=> x; rewrite [x]tuple0 orbit_refl. Qed. Lemma ntransitive_weak k m : k <= m -> [transitive^m G, on S | to] -> [transitive^k G, on S | to]. Proof. move/subnKC <-; rewrite addnC; elim: {m}(m - k) => // m IHm. rewrite addSn => tr_m1; apply: IHm; move: {m k}(m + k) tr_m1 => m tr_m1. have ext_t t: t \in dtuple_on m S -> exists x, [tuple of x :: t] \in m.+1.-dtuple(S). - move=> dt. have [sSt | /subsetPn[x Sx ntx]] := boolP (S \subset t); last first. by exists x; rewrite dtuple_on_add andbA /= Sx ntx. case/imsetP: tr_m1 dt => t1; rewrite !inE => /andP[Ut1 St1] _ /andP[Ut _]. have /subset_leq_card := subset_trans St1 sSt. by rewrite !card_uniq_tuple // ltnn. case/imsetP: (tr_m1); case/tupleP=> [x t]; rewrite dtuple_on_add. case/and3P=> Sx ntx dt; set xt := [tuple of _] => tr_xt. apply/imsetP; exists t => //. apply/setP=> u; apply/idP/imsetP=> [du | [a Ga ->{u}]]. case: (ext_t u du) => y; rewrite tr_xt. by case/imsetP=> a Ga [_ def_u]; exists a => //; apply: val_inj. have: n_act to xt a \in dtuple_on _ S by rewrite tr_xt imset_f. by rewrite n_act_add dtuple_on_add; case/and3P. Qed. Lemma ntransitive1 m : 0 < m -> [transitive^m G, on S | to] -> [transitive G, on S | to]. Proof. have trdom1 x: ([tuple x] \in 1.-dtuple(S)) = (x \in S). by rewrite dtuple_on_add !inE memtE subset_all andbT. move=> m_gt0 /(ntransitive_weak m_gt0) {m m_gt0}. case/imsetP; case/tupleP=> x t0; rewrite {t0}(tuple0 t0) trdom1 => Sx trx. apply/imsetP; exists x => //; apply/setP=> y; rewrite -trdom1 trx. by apply/imsetP/imsetP=> [[a ? [->]]|[a ? ->]]; exists a => //; apply: val_inj. Qed. Lemma ntransitive_primitive m : 1 < m -> [transitive^m G, on S | to] -> [primitive G, on S | to]. Proof. move=> lt1m /(ntransitive_weak lt1m) {m lt1m}tr2G. have trG: [transitive G, on S | to] by apply: ntransitive1 tr2G. have [x Sx _]:= imsetP trG; rewrite (trans_prim_astab Sx trG). apply/maximal_eqP; split=> [|H]; first exact: subsetIl; rewrite subEproper. case/predU1P; first by [left]; case/andP=> sCH /subsetPn[a Ha nCa] sHG. right; rewrite -(subgroup_transitiveP Sx sHG trG _) ?mulSGid //. have actH := subset_trans sHG (atrans_acts trG). pose y := to x a; have Sy: y \in S by rewrite (actsP actH). have{nCa} yx: y != x by rewrite inE (sameP astab1P eqP) (subsetP sHG) in nCa. apply/imsetP; exists y => //; apply/eqP. rewrite eqEsubset acts_sub_orbit // Sy andbT; apply/subsetP=> z Sz. have [-> | zx] := eqVneq z x; first by rewrite orbit_sym mem_orbit. pose ty := [tuple y; x]; pose tz := [tuple z; x]. have [Sty Stz]: ty \in 2.-dtuple(S) /\ tz \in 2.-dtuple(S). by rewrite !inE !memtE !subset_all /= !mem_seq1 !andbT; split; apply/and3P. case: (atransP2 tr2G Sty Stz) => b Gb [->] /esym/astab1P cxb. by rewrite mem_orbit // (subsetP sCH) // inE Gb. Qed. End NTransitveProp. Section NTransitveProp1. Variables (gT : finGroupType) (sT : finType). Variables (to : {action gT &-> sT}) (G : {group gT}) (S : {set sT}). (* This is the forward implication of Aschbacher (15.12).1 *) Theorem stab_ntransitive m x : 0 < m -> x \in S -> [transitive^m.+1 G, on S | to] -> [transitive^m 'C_G[x | to], on S :\ x | to]. Proof. move=> m_gt0 Sx Gtr; have sSxS: S :\ x \subset S by rewrite subsetDl. case: (imsetP Gtr); case/tupleP=> x1 t1; rewrite dtuple_on_add. case/and3P=> Sx1 nt1x1 dt1 trt1; have Gtr1 := ntransitive1 (ltn0Sn _) Gtr. case: (atransP2 Gtr1 Sx1 Sx) => // a Ga x1ax. pose t := n_act to t1 a. have dxt: [tuple of x :: t] \in m.+1.-dtuple(S). by rewrite trt1 x1ax; apply/imsetP; exists a => //; apply: val_inj. apply/imsetP; exists t; first by rewrite dtuple_on_add_D1 Sx in dxt. apply/setP=> t2; apply/idP/imsetP => [dt2|[b]]. have: [tuple of x :: t2] \in dtuple_on _ S by rewrite dtuple_on_add_D1 Sx. case/(atransP2 Gtr dxt)=> b Gb [xbx tbt2]. by exists b; [rewrite inE Gb; apply/astab1P | apply: val_inj]. case/setIP=> Gb /astab1P xbx ->{t2}. rewrite n_act_dtuple //; last by rewrite dtuple_on_add_D1 Sx in dxt. apply/astabsP=> y; rewrite !inE -{1}xbx (inj_eq (act_inj _ _)). by rewrite (actsP (atrans_acts Gtr1)). Qed. (* This is the converse implication of Aschbacher (15.12).1 *) Theorem stab_ntransitiveI m x : x \in S -> [transitive G, on S | to] -> [transitive^m 'C_G[x | to], on S :\ x | to] -> [transitive^m.+1 G, on S | to]. Proof. move=> Sx Gtr Gntr. have t_to_x t: t \in m.+1.-dtuple(S) -> exists2 a, a \in G & exists2 t', t' \in m.-dtuple(S :\ x) & t = n_act to [tuple of x :: t'] a. - case/tupleP: t => y t St. have Sy: y \in S by rewrite dtuple_on_add_D1 in St; case/andP: St. rewrite -(atransP Gtr _ Sy) in Sx; case/imsetP: Sx => a Ga toya. exists a^-1; first exact: groupVr. exists (n_act to t a); last by rewrite n_act_add toya !actK. move/(n_act_dtuple (subsetP (atrans_acts Gtr) a Ga)): St. by rewrite n_act_add -toya dtuple_on_add_D1 => /andP[]. case: (imsetP Gntr) => t dt S_tG; pose xt := [tuple of x :: t]. have dxt: xt \in m.+1.-dtuple(S) by rewrite dtuple_on_add_D1 Sx. apply/imsetP; exists xt => //; apply/setP=> t2. apply/esym; apply/imsetP/idP=> [[a Ga ->] | ]. by apply: n_act_dtuple; rewrite // (subsetP (atrans_acts Gtr)). case/t_to_x=> a2 Ga2 [t2']; rewrite S_tG. case/imsetP=> a /setIP[Ga /astab1P toxa] -> -> {t2 t2'}. by exists (a * a2); rewrite (groupM, actM) //= !n_act_add toxa. Qed. End NTransitveProp1. math-comp-mathcomp-1.12.0/mathcomp/solvable/sylow.v000066400000000000000000000664641375767750300223150ustar00rootroot00000000000000(* (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 div. From mathcomp Require Import fintype prime bigop finset fingroup morphism. From mathcomp Require Import automorphism quotient action cyclic gproduct. From mathcomp Require Import gfunctor commutator pgroup center nilpotent. (******************************************************************************) (* The Sylow theorem and its consequences, including the Frattini argument, *) (* the nilpotence of p-groups, and the Baer-Suzuki theorem. *) (* This file also defines: *) (* Zgroup G == G is a Z-group, i.e., has only cyclic Sylow p-subgroups. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. (* The mod p lemma for the action of p-groups. *) Section ModP. Variable (aT : finGroupType) (sT : finType) (D : {group aT}). Variable to : action D sT. Lemma pgroup_fix_mod (p : nat) (G : {group aT}) (S : {set sT}) : p.-group G -> [acts G, on S | to] -> #|S| = #|'Fix_(S | to)(G)| %[mod p]. Proof. move=> pG nSG; have sGD: G \subset D := acts_dom nSG. apply/eqP; rewrite -(cardsID 'Fix_to(G)) eqn_mod_dvd (leq_addr, addKn) //. have: [acts G, on S :\: 'Fix_to(G) | to]; last move/acts_sum_card_orbit <-. rewrite actsD // -(setIidPr sGD); apply: subset_trans (acts_subnorm_fix _ _). by rewrite setIS ?normG. apply: dvdn_sum => _ /imsetP[x /setDP[_ nfx] ->]. have [k oGx]: {k | #|orbit to G x| = (p ^ k)%N}. by apply: p_natP; apply: pnat_dvd pG; rewrite card_orbit_in ?dvdn_indexg. case: k oGx => [/card_orbit1 fix_x | k ->]; last by rewrite expnS dvdn_mulr. by case/afixP: nfx => a Ga; apply/set1P; rewrite -fix_x mem_orbit. Qed. End ModP. Section ModularGroupAction. Variables (aT rT : finGroupType) (D : {group aT}) (R : {group rT}). Variables (to : groupAction D R) (p : nat). Implicit Types (G H : {group aT}) (M : {group rT}). Lemma nontrivial_gacent_pgroup G M : p.-group G -> p.-group M -> {acts G, on group M | to} -> M :!=: 1 -> 'C_(M | to)(G) :!=: 1. Proof. move=> pG pM [nMG sMR] ntM; have [p_pr p_dv_M _] := pgroup_pdiv pM ntM. rewrite -cardG_gt1 (leq_trans (prime_gt1 p_pr)) 1?dvdn_leq ?cardG_gt0 //= /dvdn. by rewrite gacentE ?(acts_dom nMG) // setIA (setIidPl sMR) -pgroup_fix_mod. Qed. Lemma pcore_sub_astab_irr G M : p.-group M -> M \subset R -> acts_irreducibly G M to -> 'O_p(G) \subset 'C_G(M | to). Proof. move=> pM sMR /mingroupP[/andP[ntM nMG] minM]. have /andP[sGpG nGpG]: 'O_p(G) <| G := gFnormal _ G. have sGD := acts_dom nMG; have sGpD: 'O_p(G) \subset D := gFsub_trans _ sGD. rewrite subsetI sGpG -gacentC //=; apply/setIidPl; apply: minM (subsetIl _ _). rewrite nontrivial_gacent_pgroup ?pcore_pgroup //=; last first. by split; rewrite ?gFsub_trans. by apply: subset_trans (acts_subnorm_subgacent sGpD nMG); rewrite subsetI subxx. Qed. Lemma pcore_faithful_irr_act G M : p.-group M -> M \subset R -> acts_irreducibly G M to -> [faithful G, on M | to] -> 'O_p(G) = 1. Proof. move=> pM sMR irrG ffulG; apply/trivgP; apply: subset_trans ffulG. exact: pcore_sub_astab_irr. Qed. End ModularGroupAction. Section Sylow. Variables (p : nat) (gT : finGroupType) (G : {group gT}). Implicit Types P Q H K : {group gT}. Theorem Sylow's_theorem : [/\ forall P, [max P | p.-subgroup(G) P] = p.-Sylow(G) P, [transitive G, on 'Syl_p(G) | 'JG], forall P, p.-Sylow(G) P -> #|'Syl_p(G)| = #|G : 'N_G(P)| & prime p -> #|'Syl_p(G)| %% p = 1%N]. Proof. pose maxp A P := [max P | p.-subgroup(A) P]; pose S := [set P | maxp G P]. pose oG := orbit 'JG%act G. have actS: [acts G, on S | 'JG]. apply/subsetP=> x Gx; rewrite 3!inE; apply/subsetP=> P; rewrite 3!inE. exact: max_pgroupJ. have S_pG P: P \in S -> P \subset G /\ p.-group P. by rewrite inE => /maxgroupp/andP[]. have SmaxN P Q: Q \in S -> Q \subset 'N(P) -> maxp 'N_G(P) Q. rewrite inE => /maxgroupP[/andP[sQG pQ] maxQ] nPQ. apply/maxgroupP; rewrite /psubgroup subsetI sQG nPQ. by split=> // R; rewrite subsetI -andbA andbCA => /andP[_]; apply: maxQ. have nrmG P: P \subset G -> P <| 'N_G(P). by move=> sPG; rewrite /normal subsetIr subsetI sPG normG. have sylS P: P \in S -> p.-Sylow('N_G(P)) P. move=> S_P; have [sPG pP] := S_pG P S_P. by rewrite normal_max_pgroup_Hall ?nrmG //; apply: SmaxN; rewrite ?normG. have{SmaxN} defCS P: P \in S -> 'Fix_(S |'JG)(P) = [set P]. move=> S_P; apply/setP=> Q; rewrite {1}in_setI {1}afixJG. apply/andP/set1P=> [[S_Q nQP]|->{Q}]; last by rewrite normG. apply/esym/val_inj; case: (S_pG Q) => //= sQG _. by apply: uniq_normal_Hall (SmaxN Q _ _ _) => //=; rewrite ?sylS ?nrmG. have{defCS} oG_mod: {in S &, forall P Q, #|oG P| = (Q \in oG P) %[mod p]}. move=> P Q S_P S_Q; have [sQG pQ] := S_pG _ S_Q. have soP_S: oG P \subset S by rewrite acts_sub_orbit. have /pgroup_fix_mod-> //: [acts Q, on oG P | 'JG]. apply/actsP=> x /(subsetP sQG) Gx R; apply: orbit_transl. exact: mem_orbit. rewrite -{1}(setIidPl soP_S) -setIA defCS // (cardsD1 Q) setDE. by rewrite -setIA setICr setI0 cards0 addn0 inE set11 andbT. have [P S_P]: exists P, P \in S. have: p.-subgroup(G) 1 by rewrite /psubgroup sub1G pgroup1. by case/(@maxgroup_exists _ (p.-subgroup(G))) => P; exists P; rewrite inE. have trS: [transitive G, on S | 'JG]. apply/imsetP; exists P => //; apply/eqP. rewrite eqEsubset andbC acts_sub_orbit // S_P; apply/subsetP=> Q S_Q. have:= S_P; rewrite inE => /maxgroupP[/andP[_ pP]]. have [-> max1 | ntP _] := eqVneq P 1%G. move/andP/max1: (S_pG _ S_Q) => Q1. by rewrite (group_inj (Q1 (sub1G Q))) orbit_refl. have:= oG_mod _ _ S_P S_P; rewrite (oG_mod _ Q) // orbit_refl. have p_gt1: p > 1 by apply: prime_gt1; case/pgroup_pdiv: pP. by case: (Q \in oG P) => //; rewrite mod0n modn_small. have oS1: prime p -> #|S| %% p = 1%N. move/prime_gt1 => p_gt1. by rewrite -(atransP trS P S_P) (oG_mod P P) // orbit_refl modn_small. have oSiN Q: Q \in S -> #|S| = #|G : 'N_G(Q)|. by move=> S_Q; rewrite -(atransP trS Q S_Q) card_orbit astab1JG. have sylP: p.-Sylow(G) P. rewrite pHallE; case: (S_pG P) => // -> /= pP. case p_pr: (prime p); last first. rewrite p_part lognE p_pr /= -trivg_card1; apply/idPn=> ntP. by case/pgroup_pdiv: pP p_pr => // ->. rewrite -(LagrangeI G 'N(P)) /= mulnC partnM ?cardG_gt0 // part_p'nat. by rewrite mul1n (card_Hall (sylS P S_P)). by rewrite p'natE // -indexgI -oSiN // /dvdn oS1. have eqS Q: maxp G Q = p.-Sylow(G) Q. apply/idP/idP=> [S_Q|]; last exact: Hall_max. have{} S_Q: Q \in S by rewrite inE. rewrite pHallE -(card_Hall sylP); case: (S_pG Q) => // -> _ /=. by case: (atransP2 trS S_P S_Q) => x _ ->; rewrite cardJg. have ->: 'Syl_p(G) = S by apply/setP=> Q; rewrite 2!inE. by split=> // Q sylQ; rewrite -oSiN ?inE ?eqS. Qed. Lemma max_pgroup_Sylow P : [max P | p.-subgroup(G) P] = p.-Sylow(G) P. Proof. by case Sylow's_theorem. Qed. Lemma Sylow_superset Q : Q \subset G -> p.-group Q -> {P : {group gT} | p.-Sylow(G) P & Q \subset P}. Proof. move=> sQG pQ. have [|P] := @maxgroup_exists _ (p.-subgroup(G)) Q; first exact/andP. by rewrite max_pgroup_Sylow; exists P. Qed. Lemma Sylow_exists : {P : {group gT} | p.-Sylow(G) P}. Proof. by case: (Sylow_superset (sub1G G) (pgroup1 _ p)) => P; exists P. Qed. Lemma Syl_trans : [transitive G, on 'Syl_p(G) | 'JG]. Proof. by case Sylow's_theorem. Qed. Lemma Sylow_trans P Q : p.-Sylow(G) P -> p.-Sylow(G) Q -> exists2 x, x \in G & Q :=: P :^ x. Proof. move=> sylP sylQ; have:= (atransP2 Syl_trans) P Q; rewrite !inE. by case=> // x Gx ->; exists x. Qed. Lemma Sylow_subJ P Q : p.-Sylow(G) P -> Q \subset G -> p.-group Q -> exists2 x, x \in G & Q \subset P :^ x. Proof. move=> sylP sQG pQ; have [Px sylPx] := Sylow_superset sQG pQ. by have [x Gx ->] := Sylow_trans sylP sylPx; exists x. Qed. Lemma Sylow_Jsub P Q : p.-Sylow(G) P -> Q \subset G -> p.-group Q -> exists2 x, x \in G & Q :^ x \subset P. Proof. move=> sylP sQG pQ; have [x Gx] := Sylow_subJ sylP sQG pQ. by exists x^-1; rewrite (groupV, sub_conjgV). Qed. Lemma card_Syl P : p.-Sylow(G) P -> #|'Syl_p(G)| = #|G : 'N_G(P)|. Proof. by case: Sylow's_theorem P. Qed. Lemma card_Syl_dvd : #|'Syl_p(G)| %| #|G|. Proof. by case Sylow_exists => P /card_Syl->; apply: dvdn_indexg. Qed. Lemma card_Syl_mod : prime p -> #|'Syl_p(G)| %% p = 1%N. Proof. by case Sylow's_theorem. Qed. Lemma Frattini_arg H P : G <| H -> p.-Sylow(G) P -> G * 'N_H(P) = H. Proof. case/andP=> sGH nGH sylP; rewrite -normC ?subIset ?nGH ?orbT // -astab1JG. move/subgroup_transitiveP: Syl_trans => ->; rewrite ?inE //. apply/imsetP; exists P; rewrite ?inE //. apply/eqP; rewrite eqEsubset -{1}((atransP Syl_trans) P) ?inE // imsetS //=. by apply/subsetP=> _ /imsetP[x Hx ->]; rewrite inE -(normsP nGH x Hx) pHallJ2. Qed. End Sylow. Section MoreSylow. Variables (gT : finGroupType) (p : nat). Implicit Types G H P : {group gT}. Lemma Sylow_setI_normal G H P : G <| H -> p.-Sylow(H) P -> p.-Sylow(G) (G :&: P). Proof. case/normalP=> sGH nGH sylP; have [Q sylQ] := Sylow_exists p G. have /maxgroupP[/andP[sQG pQ] maxQ] := Hall_max sylQ. have [R sylR sQR] := Sylow_superset (subset_trans sQG sGH) pQ. have [[x Hx ->] pR] := (Sylow_trans sylR sylP, pHall_pgroup sylR). rewrite -(nGH x Hx) -conjIg pHallJ2. have /maxQ-> //: Q \subset G :&: R by rewrite subsetI sQG. by rewrite /psubgroup subsetIl (pgroupS _ pR) ?subsetIr. Qed. Lemma normal_sylowP G : reflect (exists2 P : {group gT}, p.-Sylow(G) P & P <| G) (#|'Syl_p(G)| == 1%N). Proof. apply: (iffP idP) => [syl1 | [P sylP nPG]]; last first. by rewrite (card_Syl sylP) (setIidPl _) (indexgg, normal_norm). have [P sylP] := Sylow_exists p G; exists P => //. rewrite /normal (pHall_sub sylP); apply/setIidPl; apply/eqP. rewrite eqEcard subsetIl -(LagrangeI G 'N(P)) -indexgI /=. by rewrite -(card_Syl sylP) (eqP syl1) muln1. Qed. Lemma trivg_center_pgroup P : p.-group P -> 'Z(P) = 1 -> P :=: 1. Proof. move=> pP Z1; apply/eqP/idPn=> ntP. have{ntP} [p_pr p_dv_P _] := pgroup_pdiv pP ntP. suff: p %| #|'Z(P)| by rewrite Z1 cards1 gtnNdvd ?prime_gt1. by rewrite /center /dvdn -afixJ -pgroup_fix_mod // astabsJ normG. Qed. Lemma p2group_abelian P : p.-group P -> logn p #|P| <= 2 -> abelian P. Proof. move=> pP lePp2; pose Z := 'Z(P); have sZP: Z \subset P := center_sub P. have [/(trivg_center_pgroup pP) ->|] := eqVneq Z 1; first exact: abelian1. case/(pgroup_pdiv (pgroupS sZP pP)) => p_pr _ [k oZ]. apply: cyclic_center_factor_abelian. have [->|] := eqVneq (P / Z) 1; first exact: cyclic1. have pPq := quotient_pgroup 'Z(P) pP; case/(pgroup_pdiv pPq) => _ _ [j oPq]. rewrite prime_cyclic // oPq; case: j oPq lePp2 => //= j. rewrite card_quotient ?gFnorm //. by rewrite -(Lagrange sZP) lognM // => ->; rewrite oZ !pfactorK ?addnS. Qed. Lemma card_p2group_abelian P : prime p -> #|P| = (p ^ 2)%N -> abelian P. Proof. move=> primep oP; have pP: p.-group P by rewrite /pgroup oP pnatX pnat_id. by rewrite (p2group_abelian pP) // oP pfactorK. Qed. Lemma Sylow_transversal_gen (T : {set {group gT}}) G : (forall P, P \in T -> P \subset G) -> (forall p, p \in \pi(G) -> exists2 P, P \in T & p.-Sylow(G) P) -> << \bigcup_(P in T) P >> = G. Proof. move=> G_T T_G; apply/eqP; rewrite eqEcard gen_subG. apply/andP; split; first exact/bigcupsP. apply: dvdn_leq (cardG_gt0 _) _; apply/dvdn_partP=> // q /T_G[P T_P sylP]. by rewrite -(card_Hall sylP); apply: cardSg; rewrite sub_gen // bigcup_sup. Qed. Lemma Sylow_gen G : <<\bigcup_(P : {group gT} | Sylow G P) P>> = G. Proof. set T := [set P : {group gT} | Sylow G P]. rewrite -{2}(@Sylow_transversal_gen T G) => [|P | q _]. - by congr <<_>>; apply: eq_bigl => P; rewrite inE. - by rewrite inE => /and3P[]. by case: (Sylow_exists q G) => P sylP; exists P; rewrite // inE (p_Sylow sylP). Qed. End MoreSylow. Section SomeHall. Variable gT : finGroupType. Implicit Types (p : nat) (pi : nat_pred) (G H K P R : {group gT}). Lemma Hall_pJsub p pi G H P : pi.-Hall(G) H -> p \in pi -> P \subset G -> p.-group P -> exists2 x, x \in G & P :^ x \subset H. Proof. move=> hallH pi_p sPG pP. have [S sylS] := Sylow_exists p H; have sylS_G := subHall_Sylow hallH pi_p sylS. have [x Gx sPxS] := Sylow_Jsub sylS_G sPG pP; exists x => //. exact: subset_trans sPxS (pHall_sub sylS). Qed. Lemma Hall_psubJ p pi G H P : pi.-Hall(G) H -> p \in pi -> P \subset G -> p.-group P -> exists2 x, x \in G & P \subset H :^ x. Proof. move=> hallH pi_p sPG pP; have [x Gx sPxH] := Hall_pJsub hallH pi_p sPG pP. by exists x^-1; rewrite ?groupV -?sub_conjg. Qed. Lemma Hall_setI_normal pi G K H : K <| G -> pi.-Hall(G) H -> pi.-Hall(K) (H :&: K). Proof. move=> nsKG hallH; have [sHG piH _] := and3P hallH. have [sHK_H sHK_K] := (subsetIl H K, subsetIr H K). rewrite pHallE sHK_K /= -(part_pnat_id (pgroupS sHK_H piH)); apply/eqP. rewrite (widen_partn _ (subset_leq_card sHK_K)); apply: eq_bigr => p pi_p. have [P sylP] := Sylow_exists p H. have sylPK := Sylow_setI_normal nsKG (subHall_Sylow hallH pi_p sylP). rewrite -!p_part -(card_Hall sylPK); symmetry; apply: card_Hall. by rewrite (pHall_subl _ sHK_K) //= setIC setSI ?(pHall_sub sylP). Qed. Lemma coprime_mulG_setI_norm H G K R : K * R = G -> G \subset 'N(H) -> coprime #|K| #|R| -> (K :&: H) * (R :&: H) = G :&: H. Proof. move=> defG nHG coKR; apply/eqP; rewrite eqEcard mulG_subG /= -defG. rewrite !setSI ?mulG_subl ?mulG_subr //=. rewrite coprime_cardMg ?(coKR, coprimeSg (subsetIl _ _), coprime_sym) //=. pose pi := \pi(K); have piK: pi.-group K by apply: pgroup_pi. have pi'R: pi^'.-group R by rewrite /pgroup -coprime_pi' /=. have [hallK hallR] := coprime_mulpG_Hall defG piK pi'R. have nsHG: H :&: G <| G by rewrite /normal subsetIr normsI ?normG. rewrite -!(setIC H) defG -(partnC pi (cardG_gt0 _)). rewrite -(card_Hall (Hall_setI_normal nsHG hallR)) /= setICA. rewrite -(card_Hall (Hall_setI_normal nsHG hallK)) /= setICA. by rewrite -defG (setIidPl (mulG_subl _ _)) (setIidPl (mulG_subr _ _)). Qed. End SomeHall. Section Nilpotent. Variable gT : finGroupType. Implicit Types (G H K P L : {group gT}) (p q : nat). Lemma pgroup_nil p P : p.-group P -> nilpotent P. Proof. move: {2}_.+1 (ltnSn #|P|) => n. elim: n gT P => // n IHn pT P; rewrite ltnS=> lePn pP. have [Z1 | ntZ] := eqVneq 'Z(P) 1. by rewrite (trivg_center_pgroup pP Z1) nilpotent1. rewrite -quotient_center_nil IHn ?morphim_pgroup // (leq_trans _ lePn) //. rewrite card_quotient ?normal_norm ?center_normal // -divgS ?subsetIl //. by rewrite ltn_Pdiv // ltnNge -trivg_card_le1. Qed. Lemma pgroup_sol p P : p.-group P -> solvable P. Proof. by move/pgroup_nil; apply: nilpotent_sol. Qed. Lemma small_nil_class G : nil_class G <= 5 -> nilpotent G. Proof. move=> leK5; case: (ltnP 5 #|G|) => [lt5G | leG5 {leK5}]. by rewrite nilpotent_class (leq_ltn_trans leK5). apply: pgroup_nil (pdiv #|G|) _ _; apply/andP; split=> //. by case: #|G| leG5 => //; do 5!case=> //. Qed. Lemma nil_class2 G : (nil_class G <= 2) = (G^`(1) \subset 'Z(G)). Proof. rewrite subsetI der_sub; apply/idP/commG1P=> [clG2 | L3G1]. by apply/(lcn_nil_classP 2); rewrite ?small_nil_class ?(leq_trans clG2). by apply/(lcn_nil_classP 2) => //; apply/lcnP; exists 2. Qed. Lemma nil_class3 G : (nil_class G <= 3) = ('L_3(G) \subset 'Z(G)). Proof. rewrite subsetI lcn_sub; apply/idP/commG1P=> [clG3 | L4G1]. by apply/(lcn_nil_classP 3); rewrite ?small_nil_class ?(leq_trans clG3). by apply/(lcn_nil_classP 3) => //; apply/lcnP; exists 3. Qed. Lemma nilpotent_maxp_normal pi G H : nilpotent G -> [max H | pi.-subgroup(G) H] -> H <| G. Proof. move=> nilG /maxgroupP[/andP[sHG piH] maxH]. have nHN: H <| 'N_G(H) by rewrite normal_subnorm. have{maxH} hallH: pi.-Hall('N_G(H)) H. apply: normal_max_pgroup_Hall => //; apply/maxgroupP. rewrite /psubgroup normal_sub // piH; split=> // K. by rewrite subsetI -andbA andbCA => /andP[_ /maxH]. rewrite /normal sHG; apply/setIidPl/esym. apply: nilpotent_sub_norm; rewrite ?subsetIl ?setIS //= char_norms //. by congr (_ \char _): (pcore_char pi 'N_G(H)); apply: normal_Hall_pcore. Qed. Lemma nilpotent_Hall_pcore pi G H : nilpotent G -> pi.-Hall(G) H -> H :=: 'O_pi(G). Proof. move=> nilG hallH; have maxH := Hall_max hallH; apply/eqP. rewrite eqEsubset pcore_max ?(pHall_pgroup hallH) //. by rewrite (normal_sub_max_pgroup maxH) ?pcore_pgroup ?pcore_normal. exact: nilpotent_maxp_normal maxH. Qed. Lemma nilpotent_pcore_Hall pi G : nilpotent G -> pi.-Hall(G) 'O_pi(G). Proof. move=> nilG; case: (@maxgroup_exists _ (psubgroup pi G) 1) => [|H maxH _]. by rewrite /psubgroup sub1G pgroup1. have hallH := normal_max_pgroup_Hall maxH (nilpotent_maxp_normal nilG maxH). by rewrite -(nilpotent_Hall_pcore nilG hallH). Qed. Lemma nilpotent_pcoreC pi G : nilpotent G -> 'O_pi(G) \x 'O_pi^'(G) = G. Proof. move=> nilG; have trO: 'O_pi(G) :&: 'O_pi^'(G) = 1. by apply: coprime_TIg; apply: (@pnat_coprime pi); apply: pcore_pgroup. rewrite dprodE //. apply/eqP; rewrite eqEcard mul_subG ?pcore_sub // (TI_cardMg trO). by rewrite !(card_Hall (nilpotent_pcore_Hall _ _)) // partnC ?leqnn. rewrite (sameP commG1P trivgP) -trO subsetI commg_subl commg_subr. by rewrite !gFsub_trans ?gFnorm. Qed. Lemma sub_nilpotent_cent2 H K G : nilpotent G -> K \subset G -> H \subset G -> coprime #|K| #|H| -> H \subset 'C(K). Proof. move=> nilG sKG sHG; rewrite coprime_pi' // => p'H. have sub_Gp := sub_Hall_pcore (nilpotent_pcore_Hall _ nilG). have [_ _ cGpp' _] := dprodP (nilpotent_pcoreC \pi(K) nilG). by apply: centSS cGpp'; rewrite sub_Gp ?pgroup_pi. Qed. Lemma pi_center_nilpotent G : nilpotent G -> \pi('Z(G)) = \pi(G). Proof. move=> nilG; apply/eq_piP => /= p. apply/idP/idP=> [|pG]; first exact: (piSg (center_sub _)). move: (pG); rewrite !mem_primes !cardG_gt0; case/andP=> p_pr _. pose Z := 'O_p(G) :&: 'Z(G); have ntZ: Z != 1. rewrite meet_center_nil ?pcore_normal // trivg_card_le1 -ltnNge. rewrite (card_Hall (nilpotent_pcore_Hall p nilG)) p_part. by rewrite (ltn_exp2l 0 _ (prime_gt1 p_pr)) logn_gt0. have pZ: p.-group Z := pgroupS (subsetIl _ _) (pcore_pgroup _ _). have{ntZ pZ} [_ pZ _] := pgroup_pdiv pZ ntZ. by rewrite p_pr (dvdn_trans pZ) // cardSg ?subsetIr. Qed. Lemma Sylow_subnorm p G P : p.-Sylow('N_G(P)) P = p.-Sylow(G) P. Proof. apply/idP/idP=> sylP; last first. apply: pHall_subl (subsetIl _ _) (sylP). by rewrite subsetI normG (pHall_sub sylP). have [/subsetIP[sPG sPN] pP _] := and3P sylP. have [Q sylQ sPQ] := Sylow_superset sPG pP; have [sQG pQ _] := and3P sylQ. rewrite -(nilpotent_sub_norm (pgroup_nil pQ) sPQ) {sylQ}//. rewrite subEproper eq_sym eqEcard subsetI sPQ sPN dvdn_leq //. rewrite -(part_pnat_id (pgroupS (subsetIl _ _) pQ)) (card_Hall sylP). by rewrite partn_dvd // cardSg ?setSI. Qed. End Nilpotent. Lemma nil_class_pgroup (gT : finGroupType) (p : nat) (P : {group gT}) : p.-group P -> nil_class P <= maxn 1 (logn p #|P|).-1. Proof. move=> pP; move def_c: (nil_class P) => c. elim: c => // c IHc in gT P def_c pP *; set e := logn p _. have nilP := pgroup_nil pP; have sZP := center_sub P. have [e_le2 | e_gt2] := leqP e 2. by rewrite -def_c leq_max nil_class1 (p2group_abelian pP). have pPq: p.-group (P / 'Z(P)) by apply: quotient_pgroup. rewrite -(subnKC e_gt2) ltnS (leq_trans (IHc _ _ _ pPq)) //. by rewrite nil_class_quotient_center ?def_c. rewrite geq_max /= -add1n -leq_subLR -subn1 -subnDA -subSS leq_sub2r //. rewrite ltn_log_quotient //= -(setIidPr sZP) meet_center_nil //. by rewrite -nil_class0 def_c. Qed. Definition Zgroup (gT : finGroupType) (A : {set gT}) := [forall (V : {group gT} | Sylow A V), cyclic V]. Section Zgroups. Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). Implicit Types G H K : {group gT}. Lemma ZgroupS G H : H \subset G -> Zgroup G -> Zgroup H. Proof. move=> sHG /forallP zgG; apply/forall_inP=> V /SylowP[p p_pr /and3P[sVH]]. case/(Sylow_superset (subset_trans sVH sHG))=> P sylP sVP _. by have:= zgG P; rewrite (p_Sylow sylP); apply: cyclicS. Qed. Lemma morphim_Zgroup G : Zgroup G -> Zgroup (f @* G). Proof. move=> zgG; wlog sGD: G zgG / G \subset D. by rewrite -morphimIdom; apply; rewrite (ZgroupS _ zgG, subsetIl) ?subsetIr. apply/forall_inP=> fV /SylowP[p pr_p sylfV]. have [P sylP] := Sylow_exists p G. have [|z _ ->] := @Sylow_trans p _ _ (f @* P)%G _ _ sylfV. by apply: morphim_pHall (sylP); apply: subset_trans (pHall_sub sylP) sGD. by rewrite cyclicJ morphim_cyclic ?(forall_inP zgG) //; apply/SylowP; exists p. Qed. Lemma nil_Zgroup_cyclic G : Zgroup G -> nilpotent G -> cyclic G. Proof. have [n] := ubnP #|G|; elim: n G => // n IHn G /ltnSE-leGn ZgG nilG. have [->|[p pr_p pG]] := trivgVpdiv G; first by rewrite -cycle1 cycle_cyclic. have /dprodP[_ defG Cpp' _] := nilpotent_pcoreC p nilG. have /cyclicP[x def_p]: cyclic 'O_p(G). have:= forallP ZgG 'O_p(G)%G. by rewrite (p_Sylow (nilpotent_pcore_Hall p nilG)). have /cyclicP[x' def_p']: cyclic 'O_p^'(G). have sp'G := pcore_sub p^' G. apply: IHn (leq_trans _ leGn) (ZgroupS sp'G _) (nilpotentS sp'G _) => //. rewrite proper_card // properEneq sp'G andbT; case: eqP => //= def_p'. by have:= pcore_pgroup p^' G; rewrite def_p' /pgroup p'natE ?pG. apply/cyclicP; exists (x * x'); rewrite -{}defG def_p def_p' cycleM //. by red; rewrite -(centsP Cpp') // (def_p, def_p') cycle_id. by rewrite /order -def_p -def_p' (@pnat_coprime p) //; apply: pcore_pgroup. Qed. End Zgroups. Arguments Zgroup {gT} A%g. Section NilPGroups. Variables (p : nat) (gT : finGroupType). Implicit Type G P N : {group gT}. (* B & G 1.22 p.9 *) Lemma normal_pgroup r P N : p.-group P -> N <| P -> r <= logn p #|N| -> exists Q : {group gT}, [/\ Q \subset N, Q <| P & #|Q| = (p ^ r)%N]. Proof. elim: r gT P N => [|r IHr] gTr P N pP nNP le_r. by exists (1%G : {group gTr}); rewrite sub1G normal1 cards1. have [NZ_1 | ntNZ] := eqVneq (N :&: 'Z(P)) 1. by rewrite (TI_center_nil (pgroup_nil pP)) // cards1 logn1 in le_r. have: p.-group (N :&: 'Z(P)) by apply: pgroupS pP; rewrite /= setICA subsetIl. case/pgroup_pdiv=> // p_pr /Cauchy[// | z]. rewrite -cycle_subG !subsetI => /and3P[szN szP cPz] ozp _. have{cPz} nzP: P \subset 'N(<[z]>) by rewrite cents_norm // centsC. have: N / <[z]> <| P / <[z]> by rewrite morphim_normal. case/IHr=> [||Qb [sQNb nQPb]]; first exact: morphim_pgroup. rewrite card_quotient ?(subset_trans (normal_sub nNP)) // -ltnS. apply: (leq_trans le_r); rewrite -(Lagrange szN) [#|_|]ozp. by rewrite lognM // ?prime_gt0 // logn_prime ?eqxx. case/(inv_quotientN _): nQPb sQNb => [|Q -> szQ nQP]; first exact/andP. have nzQ := subset_trans (normal_sub nQP) nzP. rewrite quotientSGK // card_quotient // => sQN izQ. by exists Q; split=> //; rewrite expnS -izQ -ozp Lagrange. Qed. Theorem Baer_Suzuki x G : x \in G -> (forall y, y \in G -> p.-group <<[set x; x ^ y]>>) -> x \in 'O_p(G). Proof. have [n] := ubnP #|G|; elim: n G x => // n IHn G x /ltnSE-leGn Gx pE. set E := x ^: G; have{} pE: {in E &, forall x1 x2, p.-group <<[set x1; x2]>>}. move=> _ _ /imsetP[y1 Gy1 ->] /imsetP[y2 Gy2 ->]. rewrite -(mulgKV y1 y2) conjgM -2!conjg_set1 -conjUg genJ pgroupJ. by rewrite pE // groupMl ?groupV. have sEG: <> \subset G by rewrite gen_subG class_subG. have nEG: G \subset 'N(E) by apply: class_norm. have Ex: x \in E by apply: class_refl. have [P Px sylP]: exists2 P : {group gT}, x \in P & p.-Sylow(<>) P. have sxxE: <<[set x; x]>> \subset <> by rewrite genS // setUid sub1set. have{sxxE} [P sylP sxxP] := Sylow_superset sxxE (pE _ _ Ex Ex). by exists P => //; rewrite (subsetP sxxP) ?mem_gen ?setU11. case sEP: (E \subset P). apply: subsetP Ex; rewrite -gen_subG; apply: pcore_max. by apply: pgroupS (pHall_pgroup sylP); rewrite gen_subG. by rewrite /normal gen_subG class_subG // norms_gen. pose P_yD D := [pred y in E :\: P | p.-group <>]. pose P_D := [pred D : {set gT} | D \subset P :&: E & [exists y, P_yD D y]]. have{Ex Px}: P_D [set x]. rewrite /= sub1set inE Px Ex; apply/existsP=> /=. by case/subsetPn: sEP => y Ey Py; exists y; rewrite inE Ey Py pE. case/(@maxset_exists _ P_D)=> D /maxsetP[]; rewrite {P_yD P_D}/=. rewrite subsetI sub1set -andbA => /and3P[sDP sDE /existsP[y0]]. set B := _ |: D; rewrite inE -andbA => /and3P[Py0 Ey0 pB] maxD Dx. have sDgE: D \subset <> by apply: sub_gen. have sDG: D \subset G by apply: subset_trans sEG. have sBE: B \subset E by rewrite subUset sub1set Ey0. have sBG: <> \subset G by apply: subset_trans (genS _) sEG. have sDB: D \subset B by rewrite subsetUr. have defD: D :=: P :&: <> :&: E. apply/eqP; rewrite eqEsubset ?subsetI sDP sDE sub_gen //=. apply/setUidPl; apply: maxD; last apply: subsetUl. rewrite subUset subsetI sDP sDE setIAC subsetIl. apply/existsP; exists y0; rewrite inE Py0 Ey0 /= setUA -/B. by rewrite -[<<_>>]joing_idl joingE setKI genGid. have nDD: D \subset 'N(D). apply/subsetP=> z Dz; rewrite inE defD. apply/subsetP=> _ /imsetP[y /setIP[PBy Ey] ->]. rewrite inE groupJ // ?inE ?(subsetP sDP) ?mem_gen ?setU1r //= memJ_norm //. exact: (subsetP (subset_trans sDG nEG)). case nDG: (G \subset 'N(D)). apply: subsetP Dx; rewrite -gen_subG pcore_max ?(pgroupS (genS _) pB) //. by rewrite /normal gen_subG sDG norms_gen. have{n leGn IHn nDG} pN: p.-group <<'N_E(D)>>. apply: pgroupS (pcore_pgroup p 'N_G(D)); rewrite gen_subG /=. apply/subsetP=> x1 /setIP[Ex1 Nx1]; apply: IHn => [||y Ny]. - apply: leq_trans leGn; rewrite proper_card // /proper subsetIl. by rewrite subsetI nDG andbF. - by rewrite inE Nx1 (subsetP sEG) ?mem_gen. have Ex1y: x1 ^ y \in E. by rewrite -mem_conjgV (normsP nEG) // groupV; case/setIP: Ny. apply: pgroupS (genS _) (pE _ _ Ex1 Ex1y). by apply/subsetP=> u; rewrite !inE. have [y1 Ny1 Py1]: exists2 y1, y1 \in 'N_E(D) & y1 \notin P. case sNN: ('N_<>('N_<>(D)) \subset 'N_<>(D)). exists y0 => //; have By0: y0 \in <> by rewrite mem_gen ?setU11. rewrite inE Ey0 -By0 -in_setI. by rewrite -['N__(D)](nilpotent_sub_norm (pgroup_nil pB)) ?subsetIl. case/subsetPn: sNN => z /setIP[Bz NNz]; rewrite inE Bz inE. case/subsetPn=> y; rewrite mem_conjg => Dzy Dy. have:= Dzy; rewrite {1}defD; do 2![case/setIP]=> _ Bzy Ezy. have Ey: y \in E by rewrite -(normsP nEG _ (subsetP sBG z Bz)) mem_conjg. have /setIP[By Ny]: y \in 'N_<>(D). by rewrite -(normP NNz) mem_conjg inE Bzy ?(subsetP nDD). exists y; first by rewrite inE Ey. by rewrite defD 2!inE Ey By !andbT in Dy. have [y2 Ny2 Dy2]: exists2 y2, y2 \in 'N_(P :&: E)(D) & y2 \notin D. case sNN: ('N_P('N_P(D)) \subset 'N_P(D)). have [z /= Ez sEzP] := Sylow_Jsub sylP (genS sBE) pB. have Gz: z \in G by apply: subsetP Ez. have /subsetPn[y Bzy Dy]: ~~ (B :^ z \subset D). apply/negP; move/subset_leq_card; rewrite cardJg cardsU1. by rewrite {1}defD 2!inE (negPf Py0) ltnn. exists y => //; apply: subsetP Bzy. rewrite -setIA setICA subsetI sub_conjg (normsP nEG) ?groupV // sBE. have nilP := pgroup_nil (pHall_pgroup sylP). by rewrite -['N__(_)](nilpotent_sub_norm nilP) ?subsetIl // -gen_subG genJ. case/subsetPn: sNN => z /setIP[Pz NNz]; rewrite 2!inE Pz. case/subsetPn=> y Dzy Dy; exists y => //; apply: subsetP Dzy. rewrite -setIA setICA subsetI sub_conjg (normsP nEG) ?groupV //. by rewrite sDE -(normP NNz); rewrite conjSg subsetI sDP. by apply: subsetP Pz; apply: (subset_trans (pHall_sub sylP)). suff{Dy2} Dy2D: y2 |: D = D by rewrite -Dy2D setU11 in Dy2. apply: maxD; last by rewrite subsetUr. case/setIP: Ny2 => PEy2 Ny2; case/setIP: Ny1 => Ey1 Ny1. rewrite subUset sub1set PEy2 subsetI sDP sDE. apply/existsP; exists y1; rewrite inE Ey1 Py1; apply: pgroupS pN. rewrite genS // !subUset !sub1set !in_setI Ey1 Ny1. by case/setIP: PEy2 => _ ->; rewrite Ny2 subsetI sDE. Qed. End NilPGroups. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/000077500000000000000000000000001375767750300211145ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/ssreflect/AUTHORS000077700000000000000000000000001375767750300236552../../AUTHORSustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/ssreflect/CeCILL-B000077700000000000000000000000001375767750300237272../../CeCILL-Bustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/ssreflect/INSTALL.md000077700000000000000000000000001375767750300246152../../INSTALL.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/ssreflect/INSTALL.pg000066400000000000000000000036301375767750300225540ustar00rootroot00000000000000 CUSTOMIZATION OF THE PROOF GENERAL EMACS INTERFACE ================================================== ProofGeneral (PG) is a generic interface for proof assistants based on the customizable text editor Emacs. The ssreflect distribution includes a small configuration file, pg-ssr.el, which allows to extend PG's syntax highlighting features to the syntax of the ssreflect extension of Coq's tactic language. Versions >= 3.7 of ProofGeneral support this extension. - Follow the installation instructions of PG (see http://proofgeneral.inf.ed.ac.uk/), and unpack the sources of PG in a directory, for instance /ProofGeneral-4.2. - Add the following line to your .emacs configuration file: - under Unix/MacOS: (load-file "/ProofGeneral-4.2/generic/proof-site.el" ) - under Windows+Cygwin: (load-file "C:\\\\ProofGeneral-4.2\\generic\\proof-site.el") where is the location of your own ProofGeneral directory. - Add the following line to your .emacs configuration file (after the previous one): (load-file "/pg-ssr.el") respectively (load-file "\\pg-ssr.el") for Windows+Cygwin users, where is the location of your pg-ssr.el file. Coq sources have a .v extension. Opening any .v file should automatically launch ProofGeneral. Try this on a foo.v file. In case you are linking the code of the ssreflect extension statically (this is not the default situation, and not the recommended option), then the executable Coq top level which includes the ssreflect extension is called 'ssrcoq'. In order to use it in PG: - In the menu 'ProofGeneral', choose the item: 'Advanced/Customize/Coq/Coq Prog Name' Change the value of the variable to /ssrcoq or \\ssrcoq for Windows+Cygwin users, where is the location of the ssrcoq binary. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/Make000066400000000000000000000007771375767750300217270ustar00rootroot00000000000000all_ssreflect.v eqtype.v seq.v ssrAC.v ssrbool.v ssreflect.v ssrfun.v ssrnat.v bigop.v binomial.v choice.v div.v finfun.v fingraph.v finset.v fintype.v generic_quotient.v path.v prime.v tuple.v ssrnotations.v ssrmatching.v order.v -I . -R . mathcomp.ssreflect -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg -ambiguous-paths -arg -w -arg +undeclared-scope -arg -w -arg -non-reversible-notationmath-comp-mathcomp-1.12.0/mathcomp/ssreflect/Makefile000066400000000000000000000002111375767750300225460ustar00rootroot00000000000000# -*- Makefile -*- # setting variables COQPROJECT?=Make COQMAKEOPTIONS=--no-print-directory # Main Makefile include ../Makefile.common math-comp-mathcomp-1.12.0/mathcomp/ssreflect/README.md000077700000000000000000000000001375767750300242732../../README.mdustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/ssreflect/all_ssreflect.v000066400000000000000000000007221375767750300241260ustar00rootroot00000000000000Require Export ssreflect. Require Export ssrbool. Require Export ssrfun. Require Export eqtype. Require Export ssrnat. Require Export seq. Require Export choice. Require Export path. Require Export div. Require Export fintype. Require Export fingraph. Require Export tuple. Require Export finfun. Require Export bigop. Require Export prime. Require Export finset. Require Export order. Require Export binomial. Require Export generic_quotient. Require Export ssrAC. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/bigop.v000066400000000000000000002427571375767750300224240ustar00rootroot00000000000000(* (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 fintype tuple finfun. (******************************************************************************) (* This file provides a generic definition for iterating an operator over a *) (* set of indices (bigop); this big operator is parameterized by the return *) (* type (R), the type of indices (I), the operator (op), the default value on *) (* empty lists (idx), the range of indices (r), the filter applied on this *) (* range (P) and the expression we are iterating (F). The definition is not *) (* to be used directly, but via the wide range of notations provided and *) (* which support a natural use of big operators. *) (* To improve performance of the Coq typechecker on large expressions, the *) (* bigop constant is OPAQUE. It can however be unlocked to reveal the *) (* transparent constant reducebig, to let Coq expand summation on an explicit *) (* sequence with an explicit test. *) (* The lemmas can be classified according to the operator being iterated: *) (* 1. Results independent of the operator: extensionality with respect to *) (* the range of indices, to the filtering predicate or to the expression *) (* being iterated; reindexing, widening or narrowing of the range of *) (* indices; we provide lemmas for the special cases where indices are *) (* natural numbers or bounded natural numbers ("ordinals"). We supply *) (* several "functional" induction principles that can be used with the *) (* ssreflect 1.3 "elim" tactic to do induction over the index range for *) (* up to 3 bigops simultaneously. *) (* 2. Results depending on the properties of the operator: *) (* We distinguish: monoid laws (op is associative, idx is an identity *) (* element), abelian monoid laws (op is also commutative), and laws with *) (* a distributive operation (semirings). Examples of such results are *) (* splitting, permuting, and exchanging bigops. *) (* A special section is dedicated to big operators on natural numbers. *) (******************************************************************************) (* Notations: *) (* The general form for iterated operators is *) (* _ *) (* - is one of \big[op/idx], \sum, \prod, or \max (see below). *) (* - can be any expression. *) (* - binds an index variable in ; is one of *) (* (i <- s) i ranges over the sequence s. *) (* (m <= i < n) i ranges over the nat interval m, m+1, ..., n-1. *) (* (i < n) i ranges over the (finite) type 'I_n (i.e., ordinal n). *) (* (i : T) i ranges over the finite type T. *) (* i or (i) i ranges over its (inferred) finite type. *) (* (i in A) i ranges over the elements that satisfy the collective *) (* predicate A (the domain of A must be a finite type). *) (* (i <- s | ) limits the range to the i for which *) (* holds. can be any expression that coerces to *) (* bool, and may mention the bound index i. All six kinds of *) (* ranges above can have a part. *) (* - One can use the "\big[op/idx]" notations for any operator. *) (* - BIG_F and BIG_P are pattern abbreviations for the and *) (* part of a \big ... expression; for (i in A) and (i in A | C) *) (* ranges the term matched by BIG_P will include the i \in A condition. *) (* - The (locked) head constant of a \big notation is bigop. *) (* - The "\sum", "\prod" and "\max" notations in the %N scope are used for *) (* natural numbers with addition, multiplication and maximum (and their *) (* corresponding neutral elements), respectively. *) (* - The "\sum" and "\prod" reserved notations are overloaded in ssralg in *) (* the %R scope; in mxalgebra, vector & falgebra in the %MS and %VS scopes; *) (* "\prod" is also overloaded in fingroup, in the %g and %G scopes. *) (* - We reserve "\bigcup" and "\bigcap" notations for iterated union and *) (* intersection (of sets, groups, vector spaces, etc). *) (******************************************************************************) (* Tips for using lemmas in this file: *) (* To apply a lemma for a specific operator: if no special property is *) (* required for the operator, simply apply the lemma; if the lemma needs *) (* certain properties for the operator, make sure the appropriate Canonical *) (* instances are declared. *) (******************************************************************************) (* Interfaces for operator properties are packaged in the Monoid submodule: *) (* Monoid.law idx == interface (keyed on the operator) for associative *) (* operators with identity element idx. *) (* Monoid.com_law idx == extension (telescope) of Monoid.law for operators *) (* that are also commutative. *) (* Monoid.mul_law abz == interface for operators with absorbing (zero) *) (* element abz. *) (* Monoid.add_law idx mop == extension of Monoid.com_law for operators over *) (* which operation mop distributes (mop will often also *) (* have a Monoid.mul_law idx structure). *) (* [law of op], [com_law of op], [mul_law of op], [add_law mop of op] == *) (* syntax for cloning Monoid structures. *) (* Monoid.Theory == submodule containing basic generic algebra lemmas *) (* for operators satisfying the Monoid interfaces. *) (* Monoid.simpm == generic monoid simplification rewrite multirule. *) (* Monoid structures are predeclared for many basic operators: (_ && _)%B, *) (* (_ || _)%B, (_ (+) _)%B (exclusive or) , (_ + _)%N, (_ * _)%N, maxn, *) (* gcdn, lcmn and (_ ++ _)%SEQ (list concatenation). *) (******************************************************************************) (* Additional documentation for this file: *) (* Y. Bertot, G. Gonthier, S. Ould Biha and I. Pasca. *) (* Canonical Big Operators. In TPHOLs 2008, LNCS vol. 5170, Springer. *) (* Article available at: *) (* http://hal.inria.fr/docs/00/33/11/93/PDF/main.pdf *) (******************************************************************************) (* Examples of use in: poly.v, matrix.v *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope big_scope. Reserved Notation "\big [ op / idx ]_ i F" (at level 36, F at level 36, op, idx at level 10, i at level 0, right associativity, format "'[' \big [ op / idx ]_ i '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i <- r | P ) F" (at level 36, F at level 36, op, idx at level 10, i, r at level 50, format "'[' \big [ op / idx ]_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i <- r ) F" (at level 36, F at level 36, op, idx at level 10, i, r at level 50, format "'[' \big [ op / idx ]_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" (at level 36, F at level 36, op, idx at level 10, m, i, n at level 50, format "'[' \big [ op / idx ]_ ( m <= i < n | P ) F ']'"). Reserved Notation "\big [ op / idx ]_ ( m <= i < n ) F" (at level 36, F at level 36, op, idx at level 10, i, m, n at level 50, format "'[' \big [ op / idx ]_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i | P ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i : t | P ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i : t | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i : t ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i : t ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i < n | P ) F" (at level 36, F at level 36, op, idx at level 10, i, n at level 50, format "'[' \big [ op / idx ]_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i < n ) F" (at level 36, F at level 36, op, idx at level 10, i, n at level 50, format "'[' \big [ op / idx ]_ ( i < n ) F ']'"). Reserved Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" (at level 36, F at level 36, op, idx at level 10, i, A at level 50, format "'[' \big [ op / idx ]_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i 'in' A ) F" (at level 36, F at level 36, op, idx at level 10, i, A at level 50, format "'[' \big [ op / idx ]_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\sum_ i F" (at level 41, F at level 41, i at level 0, right associativity, format "'[' \sum_ i '/ ' F ']'"). Reserved Notation "\sum_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \sum_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \sum_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\sum_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \sum_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \sum_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\sum_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \sum_ ( i | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). (* only parsing *) Reserved Notation "\sum_ ( i : t ) F" (at level 41, F at level 41, i at level 50). (* only parsing *) Reserved Notation "\sum_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \sum_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \sum_ ( i < n ) '/ ' F ']'"). Reserved Notation "\sum_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \sum_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \sum_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\max_ i F" (at level 41, F at level 41, i at level 0, format "'[' \max_ i '/ ' F ']'"). Reserved Notation "\max_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\max_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\max_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\max_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \max_ ( i | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). (* only parsing *) Reserved Notation "\max_ ( i : t ) F" (at level 41, F at level 41, i at level 50). (* only parsing *) Reserved Notation "\max_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max_ ( i < n ) F ']'"). Reserved Notation "\max_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\prod_ i F" (at level 36, F at level 36, i at level 0, format "'[' \prod_ i '/ ' F ']'"). Reserved Notation "\prod_ ( i <- r | P ) F" (at level 36, F at level 36, i, r at level 50, format "'[' \prod_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\prod_ ( i <- r ) F" (at level 36, F at level 36, i, r at level 50, format "'[' \prod_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\prod_ ( m <= i < n | P ) F" (at level 36, F at level 36, i, m, n at level 50, format "'[' \prod_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\prod_ ( m <= i < n ) F" (at level 36, F at level 36, i, m, n at level 50, format "'[' \prod_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\prod_ ( i | P ) F" (at level 36, F at level 36, i at level 50, format "'[' \prod_ ( i | P ) '/ ' F ']'"). Reserved Notation "\prod_ ( i : t | P ) F" (at level 36, F at level 36, i at level 50). (* only parsing *) Reserved Notation "\prod_ ( i : t ) F" (at level 36, F at level 36, i at level 50). (* only parsing *) Reserved Notation "\prod_ ( i < n | P ) F" (at level 36, F at level 36, i, n at level 50, format "'[' \prod_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\prod_ ( i < n ) F" (at level 36, F at level 36, i, n at level 50, format "'[' \prod_ ( i < n ) '/ ' F ']'"). Reserved Notation "\prod_ ( i 'in' A | P ) F" (at level 36, F at level 36, i, A at level 50, format "'[' \prod_ ( i 'in' A | P ) F ']'"). Reserved Notation "\prod_ ( i 'in' A ) F" (at level 36, F at level 36, i, A at level 50, format "'[' \prod_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\bigcup_ i F" (at level 41, F at level 41, i at level 0, format "'[' \bigcup_ i '/ ' F ']'"). Reserved Notation "\bigcup_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \bigcup_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \bigcup_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( m <= i < n | P ) F" (at level 41, F at level 41, m, i, n at level 50, format "'[' \bigcup_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \bigcup_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcup_ ( i | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcup_ ( i : t | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i : t ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcup_ ( i : t ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \bigcup_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \bigcup_ ( i < n ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \bigcup_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\bigcup_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \bigcup_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\bigcap_ i F" (at level 41, F at level 41, i at level 0, format "'[' \bigcap_ i '/ ' F ']'"). Reserved Notation "\bigcap_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \bigcap_ ( i <- r | P ) F ']'"). Reserved Notation "\bigcap_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \bigcap_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( m <= i < n | P ) F" (at level 41, F at level 41, m, i, n at level 50, format "'[' \bigcap_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \bigcap_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcap_ ( i | P ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcap_ ( i : t | P ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i : t ) F" (at level 41, F at level 41, i at level 50, format "'[' \bigcap_ ( i : t ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \bigcap_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \bigcap_ ( i < n ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \bigcap_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\bigcap_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \bigcap_ ( i 'in' A ) '/ ' F ']'"). Module Monoid. Section Definitions. Variables (T : Type) (idm : T). Structure law := Law { operator : T -> T -> T; _ : associative operator; _ : left_id idm operator; _ : right_id idm operator }. Local Coercion operator : law >-> Funclass. Structure com_law := ComLaw { com_operator : law; _ : commutative com_operator }. Local Coercion com_operator : com_law >-> law. Structure mul_law := MulLaw { mul_operator : T -> T -> T; _ : left_zero idm mul_operator; _ : right_zero idm mul_operator }. Local Coercion mul_operator : mul_law >-> Funclass. Structure add_law (mul : T -> T -> T) := AddLaw { add_operator : com_law; _ : left_distributive mul add_operator; _ : right_distributive mul add_operator }. Local Coercion add_operator : add_law >-> com_law. Let op_id (op1 op2 : T -> T -> T) := phant_id op1 op2. Definition clone_law op := fun (opL : law) & op_id opL op => fun opmA op1m opm1 (opL' := @Law op opmA op1m opm1) & phant_id opL' opL => opL'. Definition clone_com_law op := fun (opL : law) (opC : com_law) & op_id opL op & op_id opC op => fun opmC (opC' := @ComLaw opL opmC) & phant_id opC' opC => opC'. Definition clone_mul_law op := fun (opM : mul_law) & op_id opM op => fun op0m opm0 (opM' := @MulLaw op op0m opm0) & phant_id opM' opM => opM'. Definition clone_add_law mop aop := fun (opC : com_law) (opA : add_law mop) & op_id opC aop & op_id opA aop => fun mopDm mopmD (opA' := @AddLaw mop opC mopDm mopmD) & phant_id opA' opA => opA'. End Definitions. Module Import Exports. Coercion operator : law >-> Funclass. Coercion com_operator : com_law >-> law. Coercion mul_operator : mul_law >-> Funclass. Coercion add_operator : add_law >-> com_law. Notation "[ 'law' 'of' f ]" := (@clone_law _ _ f _ id _ _ _ id) (at level 0, format"[ 'law' 'of' f ]") : form_scope. Notation "[ 'com_law' 'of' f ]" := (@clone_com_law _ _ f _ _ id id _ id) (at level 0, format "[ 'com_law' 'of' f ]") : form_scope. Notation "[ 'mul_law' 'of' f ]" := (@clone_mul_law _ _ f _ id _ _ id) (at level 0, format"[ 'mul_law' 'of' f ]") : form_scope. Notation "[ 'add_law' m 'of' a ]" := (@clone_add_law _ _ m a _ _ id id _ _ id) (at level 0, format "[ 'add_law' m 'of' a ]") : form_scope. End Exports. Section CommutativeAxioms. Variable (T : Type) (zero one : T) (mul add : T -> T -> T) (inv : T -> T). Hypothesis mulC : commutative mul. Lemma mulC_id : left_id one mul -> right_id one mul. Proof. by move=> mul1x x; rewrite mulC. Qed. Lemma mulC_zero : left_zero zero mul -> right_zero zero mul. Proof. by move=> mul0x x; rewrite mulC. Qed. Lemma mulC_dist : left_distributive mul add -> right_distributive mul add. Proof. by move=> mul_addl x y z; rewrite !(mulC x). Qed. End CommutativeAxioms. Module Theory. Section Theory. Variables (T : Type) (idm : T). Section Plain. Variable mul : law idm. Lemma mul1m : left_id idm mul. Proof. by case mul. Qed. Lemma mulm1 : right_id idm mul. Proof. by case mul. Qed. Lemma mulmA : associative mul. Proof. by case mul. Qed. Lemma iteropE n x : iterop n mul x idm = iter n (mul x) idm. Proof. by case: n => // n; rewrite iterSr mulm1 iteropS. Qed. End Plain. Section Commutative. Variable mul : com_law idm. Lemma mulmC : commutative mul. Proof. by case mul. Qed. Lemma mulmCA : left_commutative mul. Proof. by move=> x y z; rewrite !mulmA (mulmC x). Qed. Lemma mulmAC : right_commutative mul. Proof. by move=> x y z; rewrite -!mulmA (mulmC y). Qed. Lemma mulmACA : interchange mul mul. Proof. by move=> x y z t; rewrite -!mulmA (mulmCA y). Qed. End Commutative. Section Mul. Variable mul : mul_law idm. Lemma mul0m : left_zero idm mul. Proof. by case mul. Qed. Lemma mulm0 : right_zero idm mul. Proof. by case mul. Qed. End Mul. Section Add. Variables (mul : T -> T -> T) (add : add_law idm mul). Lemma addmA : associative add. Proof. exact: mulmA. Qed. Lemma addmC : commutative add. Proof. exact: mulmC. Qed. Lemma addmCA : left_commutative add. Proof. exact: mulmCA. Qed. Lemma addmAC : right_commutative add. Proof. exact: mulmAC. Qed. Lemma add0m : left_id idm add. Proof. exact: mul1m. Qed. Lemma addm0 : right_id idm add. Proof. exact: mulm1. Qed. Lemma mulmDl : left_distributive mul add. Proof. by case add. Qed. Lemma mulmDr : right_distributive mul add. Proof. by case add. Qed. End Add. Definition simpm := (mulm1, mulm0, mul1m, mul0m, mulmA). End Theory. Notation "@ 'mulm_addl'" := (deprecate mulm_addl mulmDl) (at level 10, only parsing) : fun_scope. Notation "@ 'mulm_addr'" := (deprecate mulm_addr mulmDr) (at level 10, only parsing) : fun_scope. Notation mulm_addl := (@mulm_addl _ _ _) (only parsing). Notation mulm_addr := (@mulm_addr _ _ _) (only parsing). End Theory. Include Theory. End Monoid. Export Monoid.Exports. Section PervasiveMonoids. Import Monoid. Canonical andb_monoid := Law andbA andTb andbT. Canonical andb_comoid := ComLaw andbC. Canonical andb_muloid := MulLaw andFb andbF. Canonical orb_monoid := Law orbA orFb orbF. Canonical orb_comoid := ComLaw orbC. Canonical orb_muloid := MulLaw orTb orbT. Canonical addb_monoid := Law addbA addFb addbF. Canonical addb_comoid := ComLaw addbC. Canonical orb_addoid := AddLaw andb_orl andb_orr. Canonical andb_addoid := AddLaw orb_andl orb_andr. Canonical addb_addoid := AddLaw andb_addl andb_addr. Canonical addn_monoid := Law addnA add0n addn0. Canonical addn_comoid := ComLaw addnC. Canonical muln_monoid := Law mulnA mul1n muln1. Canonical muln_comoid := ComLaw mulnC. Canonical muln_muloid := MulLaw mul0n muln0. Canonical addn_addoid := AddLaw mulnDl mulnDr. Canonical maxn_monoid := Law maxnA max0n maxn0. Canonical maxn_comoid := ComLaw maxnC. Canonical maxn_addoid := AddLaw maxnMl maxnMr. Canonical gcdn_monoid := Law gcdnA gcd0n gcdn0. Canonical gcdn_comoid := ComLaw gcdnC. Canonical gcdnDoid := AddLaw muln_gcdl muln_gcdr. Canonical lcmn_monoid := Law lcmnA lcm1n lcmn1. Canonical lcmn_comoid := ComLaw lcmnC. Canonical lcmn_addoid := AddLaw muln_lcml muln_lcmr. Canonical cat_monoid T := Law (@catA T) (@cat0s T) (@cats0 T). End PervasiveMonoids. (* Unit test for the [...law of ...] Notations Definition myp := addn. Definition mym := muln. Canonical myp_mon := [law of myp]. Canonical myp_cmon := [com_law of myp]. Canonical mym_mul := [mul_law of mym]. Canonical myp_add := [add_law _ of myp]. Print myp_add. Print Canonical Projections. *) Delimit Scope big_scope with BIG. Open Scope big_scope. (* The bigbody wrapper is a workaround for a quirk of the Coq pretty-printer, *) (* which would fail to redisplay the \big notation when the or *) (* do not depend on the bound index. The BigBody constructor *) (* packages both in in a term in which i occurs; it also depends on the *) (* iterated , as this can give more information on the expected type of *) (* the , thus allowing for the insertion of coercions. *) Variant bigbody R I := BigBody of I & (R -> R -> R) & bool & R. Definition applybig {R I} (body : bigbody R I) x := let: BigBody _ op b v := body in if b then op v x else x. Definition reducebig R I idx r (body : I -> bigbody R I) := foldr (applybig \o body) idx r. Module Type BigOpSig. Parameter bigop : forall R I, R -> seq I -> (I -> bigbody R I) -> R. Axiom bigopE : bigop = reducebig. End BigOpSig. Module BigOp : BigOpSig. Definition bigop := reducebig. Lemma bigopE : bigop = reducebig. Proof. by []. Qed. End BigOp. Notation bigop := BigOp.bigop (only parsing). Canonical bigop_unlock := Unlockable BigOp.bigopE. Definition index_iota m n := iota m (n - m). Lemma mem_index_iota m n i : i \in index_iota m n = (m <= i < n). Proof. rewrite mem_iota; case le_m_i: (m <= i) => //=. by rewrite -leq_subLR subSn // -subn_gt0 -subnDA subnKC // subn_gt0. Qed. (* Legacy mathcomp scripts have been relying on the fact that enum A and *) (* filter A (index_enum T) are convertible. This is likely to change in the *) (* next mathcomp release when enum, pick, subset and card are generalised to *) (* predicates with finite support in a choiceType - in fact the two will only *) (* be equal up to permutation in this new theory. *) (* It is therefore advisable to stop relying on this, and use the new *) (* facilities provided in this library: lemmas big_enumP, big_enum, big_image *) (* and such. Users wishing to test compliance should change the Defined in *) (* index_enum_key to Qed, and comment out the filter_index_enum compatibility *) (* definition below (or Import Deprecation.Reject). *) Fact index_enum_key : unit. Proof. split. Defined. (* Qed. *) Definition index_enum (T : finType) := locked_with index_enum_key (Finite.enum T). Lemma deprecated_filter_index_enum T P : filter P (index_enum T) = enum P. Proof. by rewrite [index_enum T]unlock. Qed. Lemma mem_index_enum T i : i \in index_enum T. Proof. by rewrite [index_enum T]unlock -enumT mem_enum. Qed. Hint Resolve mem_index_enum : core. Lemma index_enum_uniq T : uniq (index_enum T). Proof. by rewrite [index_enum T]unlock -enumT enum_uniq. Qed. Notation "\big [ op / idx ]_ ( i <- r | P ) F" := (bigop idx r (fun i => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ ( i <- r ) F" := (bigop idx r (fun i => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" := (bigop idx (index_iota m n) (fun i : nat => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ ( m <= i < n ) F" := (bigop idx (index_iota m n) (fun i : nat => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( i | P ) F" := (bigop idx (index_enum _) (fun i => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ i F" := (bigop idx (index_enum _) (fun i => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( i : t | P ) F" := (bigop idx (index_enum _) (fun i : t => BigBody i op P%B F)) (only parsing) : big_scope. Notation "\big [ op / idx ]_ ( i : t ) F" := (bigop idx (index_enum _) (fun i : t => BigBody i op true F)) (only parsing) : big_scope. Notation "\big [ op / idx ]_ ( i < n | P ) F" := (\big[op/idx]_(i : ordinal n | P%B) F) : big_scope. Notation "\big [ op / idx ]_ ( i < n ) F" := (\big[op/idx]_(i : ordinal n) F) : big_scope. Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" := (\big[op/idx]_(i | (i \in A) && P) F) : big_scope. Notation "\big [ op / idx ]_ ( i 'in' A ) F" := (\big[op/idx]_(i | i \in A) F) : big_scope. Notation BIG_F := (F in \big[_/_]_(i <- _ | _) F i)%pattern. Notation BIG_P := (P in \big[_/_]_(i <- _ | P i) _)%pattern. Local Notation "+%N" := addn (at level 0, only parsing). Notation "\sum_ ( i <- r | P ) F" := (\big[+%N/0%N]_(i <- r | P%B) F%N) : nat_scope. Notation "\sum_ ( i <- r ) F" := (\big[+%N/0%N]_(i <- r) F%N) : nat_scope. Notation "\sum_ ( m <= i < n | P ) F" := (\big[+%N/0%N]_(m <= i < n | P%B) F%N) : nat_scope. Notation "\sum_ ( m <= i < n ) F" := (\big[+%N/0%N]_(m <= i < n) F%N) : nat_scope. Notation "\sum_ ( i | P ) F" := (\big[+%N/0%N]_(i | P%B) F%N) : nat_scope. Notation "\sum_ i F" := (\big[+%N/0%N]_i F%N) : nat_scope. Notation "\sum_ ( i : t | P ) F" := (\big[+%N/0%N]_(i : t | P%B) F%N) (only parsing) : nat_scope. Notation "\sum_ ( i : t ) F" := (\big[+%N/0%N]_(i : t) F%N) (only parsing) : nat_scope. Notation "\sum_ ( i < n | P ) F" := (\big[+%N/0%N]_(i < n | P%B) F%N) : nat_scope. Notation "\sum_ ( i < n ) F" := (\big[+%N/0%N]_(i < n) F%N) : nat_scope. Notation "\sum_ ( i 'in' A | P ) F" := (\big[+%N/0%N]_(i in A | P%B) F%N) : nat_scope. Notation "\sum_ ( i 'in' A ) F" := (\big[+%N/0%N]_(i in A) F%N) : nat_scope. Local Notation "*%N" := muln (at level 0, only parsing). Notation "\prod_ ( i <- r | P ) F" := (\big[*%N/1%N]_(i <- r | P%B) F%N) : nat_scope. Notation "\prod_ ( i <- r ) F" := (\big[*%N/1%N]_(i <- r) F%N) : nat_scope. Notation "\prod_ ( m <= i < n | P ) F" := (\big[*%N/1%N]_(m <= i < n | P%B) F%N) : nat_scope. Notation "\prod_ ( m <= i < n ) F" := (\big[*%N/1%N]_(m <= i < n) F%N) : nat_scope. Notation "\prod_ ( i | P ) F" := (\big[*%N/1%N]_(i | P%B) F%N) : nat_scope. Notation "\prod_ i F" := (\big[*%N/1%N]_i F%N) : nat_scope. Notation "\prod_ ( i : t | P ) F" := (\big[*%N/1%N]_(i : t | P%B) F%N) (only parsing) : nat_scope. Notation "\prod_ ( i : t ) F" := (\big[*%N/1%N]_(i : t) F%N) (only parsing) : nat_scope. Notation "\prod_ ( i < n | P ) F" := (\big[*%N/1%N]_(i < n | P%B) F%N) : nat_scope. Notation "\prod_ ( i < n ) F" := (\big[*%N/1%N]_(i < n) F%N) : nat_scope. Notation "\prod_ ( i 'in' A | P ) F" := (\big[*%N/1%N]_(i in A | P%B) F%N) : nat_scope. Notation "\prod_ ( i 'in' A ) F" := (\big[*%N/1%N]_(i in A) F%N) : nat_scope. Notation "\max_ ( i <- r | P ) F" := (\big[maxn/0%N]_(i <- r | P%B) F%N) : nat_scope. Notation "\max_ ( i <- r ) F" := (\big[maxn/0%N]_(i <- r) F%N) : nat_scope. Notation "\max_ ( i | P ) F" := (\big[maxn/0%N]_(i | P%B) F%N) : nat_scope. Notation "\max_ i F" := (\big[maxn/0%N]_i F%N) : nat_scope. Notation "\max_ ( i : I | P ) F" := (\big[maxn/0%N]_(i : I | P%B) F%N) (only parsing) : nat_scope. Notation "\max_ ( i : I ) F" := (\big[maxn/0%N]_(i : I) F%N) (only parsing) : nat_scope. Notation "\max_ ( m <= i < n | P ) F" := (\big[maxn/0%N]_(m <= i < n | P%B) F%N) : nat_scope. Notation "\max_ ( m <= i < n ) F" := (\big[maxn/0%N]_(m <= i < n) F%N) : nat_scope. Notation "\max_ ( i < n | P ) F" := (\big[maxn/0%N]_(i < n | P%B) F%N) : nat_scope. Notation "\max_ ( i < n ) F" := (\big[maxn/0%N]_(i < n) F%N) : nat_scope. Notation "\max_ ( i 'in' A | P ) F" := (\big[maxn/0%N]_(i in A | P%B) F%N) : nat_scope. Notation "\max_ ( i 'in' A ) F" := (\big[maxn/0%N]_(i in A) F%N) : nat_scope. (* Induction loading *) Lemma big_load R (K K' : R -> Type) idx op I r (P : pred I) F : K (\big[op/idx]_(i <- r | P i) F i) * K' (\big[op/idx]_(i <- r | P i) F i) -> K' (\big[op/idx]_(i <- r | P i) F i). Proof. by case. Qed. Arguments big_load [R] K [K'] idx op [I]. Section Elim3. Variables (R1 R2 R3 : Type) (K : R1 -> R2 -> R3 -> Type). Variables (id1 : R1) (op1 : R1 -> R1 -> R1). Variables (id2 : R2) (op2 : R2 -> R2 -> R2). Variables (id3 : R3) (op3 : R3 -> R3 -> R3). Hypothesis Kid : K id1 id2 id3. Lemma big_rec3 I r (P : pred I) F1 F2 F3 (K_F : forall i y1 y2 y3, P i -> K y1 y2 y3 -> K (op1 (F1 i) y1) (op2 (F2 i) y2) (op3 (F3 i) y3)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i) (\big[op3/id3]_(i <- r | P i) F3 i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. Hypothesis Kop : forall x1 x2 x3 y1 y2 y3, K x1 x2 x3 -> K y1 y2 y3-> K (op1 x1 y1) (op2 x2 y2) (op3 x3 y3). Lemma big_ind3 I r (P : pred I) F1 F2 F3 (K_F : forall i, P i -> K (F1 i) (F2 i) (F3 i)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i) (\big[op3/id3]_(i <- r | P i) F3 i). Proof. by apply: big_rec3 => i x1 x2 x3 /K_F; apply: Kop. Qed. End Elim3. Arguments big_rec3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ [I r P F1 F2 F3]. Arguments big_ind3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ _ [I r P F1 F2 F3]. Section Elim2. Variables (R1 R2 : Type) (K : R1 -> R2 -> Type) (f : R2 -> R1). Variables (id1 : R1) (op1 : R1 -> R1 -> R1). Variables (id2 : R2) (op2 : R2 -> R2 -> R2). Hypothesis Kid : K id1 id2. Lemma big_rec2 I r (P : pred I) F1 F2 (K_F : forall i y1 y2, P i -> K y1 y2 -> K (op1 (F1 i) y1) (op2 (F2 i) y2)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. Hypothesis Kop : forall x1 x2 y1 y2, K x1 x2 -> K y1 y2 -> K (op1 x1 y1) (op2 x2 y2). Lemma big_ind2 I r (P : pred I) F1 F2 (K_F : forall i, P i -> K (F1 i) (F2 i)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). Proof. by apply: big_rec2 => i x1 x2 /K_F; apply: Kop. Qed. Hypotheses (f_op : {morph f : x y / op2 x y >-> op1 x y}) (f_id : f id2 = id1). Lemma big_morph I r (P : pred I) F : f (\big[op2/id2]_(i <- r | P i) F i) = \big[op1/id1]_(i <- r | P i) f (F i). Proof. by rewrite unlock; elim: r => //= i r <-; rewrite -f_op -fun_if. Qed. End Elim2. Arguments big_rec2 [R1 R2] K [id1 op1 id2 op2] _ [I r P F1 F2]. Arguments big_ind2 [R1 R2] K [id1 op1 id2 op2] _ _ [I r P F1 F2]. Arguments big_morph [R1 R2] f [id1 op1 id2 op2] _ _ [I]. Section Elim1. Variables (R : Type) (K : R -> Type) (f : R -> R). Variables (idx : R) (op op' : R -> R -> R). Hypothesis Kid : K idx. Lemma big_rec I r (P : pred I) F (Kop : forall i x, P i -> K x -> K (op (F i) x)) : K (\big[op/idx]_(i <- r | P i) F i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: Kop. Qed. Hypothesis Kop : forall x y, K x -> K y -> K (op x y). Lemma big_ind I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : K (\big[op/idx]_(i <- r | P i) F i). Proof. by apply: big_rec => // i x /K_F /Kop; apply. Qed. Hypothesis Kop' : forall x y, K x -> K y -> op x y = op' x y. Lemma eq_big_op I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : \big[op/idx]_(i <- r | P i) F i = \big[op'/idx]_(i <- r | P i) F i. Proof. by elim/(big_load K): _; elim/big_rec2: _ => // i _ y Pi [Ky <-]; auto. Qed. Hypotheses (fM : {morph f : x y / op x y}) (f_id : f idx = idx). Lemma big_endo I r (P : pred I) F : f (\big[op/idx]_(i <- r | P i) F i) = \big[op/idx]_(i <- r | P i) f (F i). Proof. exact: big_morph. Qed. End Elim1. Arguments big_rec [R] K [idx op] _ [I r P F]. Arguments big_ind [R] K [idx op] _ _ [I r P F]. Arguments eq_big_op [R] K [idx op] op' _ _ _ [I]. Arguments big_endo [R] f [idx op] _ _ [I]. Section Extensionality. Variables (R : Type) (idx : R) (op : R -> R -> R). Section SeqExtension. Variable I : Type. Lemma foldrE r : foldr op idx r = \big[op/idx]_(x <- r) x. Proof. by rewrite unlock. Qed. Lemma big_filter r (P : pred I) F : \big[op/idx]_(i <- filter P r) F i = \big[op/idx]_(i <- r | P i) F i. Proof. by rewrite unlock; elim: r => //= i r <-; case (P i). Qed. Lemma big_filter_cond r (P1 P2 : pred I) F : \big[op/idx]_(i <- filter P1 r | P2 i) F i = \big[op/idx]_(i <- r | P1 i && P2 i) F i. Proof. rewrite -big_filter -(big_filter r); congr bigop. by rewrite -filter_predI; apply: eq_filter => i; apply: andbC. Qed. Lemma eq_bigl r (P1 P2 : pred I) F : P1 =1 P2 -> \big[op/idx]_(i <- r | P1 i) F i = \big[op/idx]_(i <- r | P2 i) F i. Proof. by move=> eqP12; rewrite -!(big_filter r) (eq_filter eqP12). Qed. (* A lemma to permute aggregate conditions. *) Lemma big_andbC r (P Q : pred I) F : \big[op/idx]_(i <- r | P i && Q i) F i = \big[op/idx]_(i <- r | Q i && P i) F i. Proof. by apply: eq_bigl => i; apply: andbC. Qed. Lemma eq_bigr r (P : pred I) F1 F2 : (forall i, P i -> F1 i = F2 i) -> \big[op/idx]_(i <- r | P i) F1 i = \big[op/idx]_(i <- r | P i) F2 i. Proof. by move=> eqF12; elim/big_rec2: _ => // i x _ /eqF12-> ->. Qed. Lemma eq_big r (P1 P2 : pred I) F1 F2 : P1 =1 P2 -> (forall i, P1 i -> F1 i = F2 i) -> \big[op/idx]_(i <- r | P1 i) F1 i = \big[op/idx]_(i <- r | P2 i) F2 i. Proof. by move/eq_bigl <-; move/eq_bigr->. Qed. Lemma congr_big r1 r2 (P1 P2 : pred I) F1 F2 : r1 = r2 -> P1 =1 P2 -> (forall i, P1 i -> F1 i = F2 i) -> \big[op/idx]_(i <- r1 | P1 i) F1 i = \big[op/idx]_(i <- r2 | P2 i) F2 i. Proof. by move=> <-{r2}; apply: eq_big. Qed. Lemma big_nil (P : pred I) F : \big[op/idx]_(i <- [::] | P i) F i = idx. Proof. by rewrite unlock. Qed. Lemma big_cons i r (P : pred I) F : let x := \big[op/idx]_(j <- r | P j) F j in \big[op/idx]_(j <- i :: r | P j) F j = if P i then op (F i) x else x. Proof. by rewrite unlock. Qed. Lemma big_map J (h : J -> I) r (P : pred I) F : \big[op/idx]_(i <- map h r | P i) F i = \big[op/idx]_(j <- r | P (h j)) F (h j). Proof. by rewrite unlock; elim: r => //= j r ->. Qed. Lemma big_nth x0 r (P : pred I) F : \big[op/idx]_(i <- r | P i) F i = \big[op/idx]_(0 <= i < size r | P (nth x0 r i)) (F (nth x0 r i)). Proof. by rewrite -[r in LHS](mkseq_nth x0) big_map /index_iota subn0. Qed. Lemma big_hasC r (P : pred I) F : ~~ has P r -> \big[op/idx]_(i <- r | P i) F i = idx. Proof. by rewrite -big_filter has_count -size_filter -eqn0Ngt unlock => /nilP->. Qed. Lemma big_pred0_eq (r : seq I) F : \big[op/idx]_(i <- r | false) F i = idx. Proof. by rewrite big_hasC // has_pred0. Qed. Lemma big_pred0 r (P : pred I) F : P =1 xpred0 -> \big[op/idx]_(i <- r | P i) F i = idx. Proof. by move/eq_bigl->; apply: big_pred0_eq. Qed. Lemma big_cat_nested r1 r2 (P : pred I) F : let x := \big[op/idx]_(i <- r2 | P i) F i in \big[op/idx]_(i <- r1 ++ r2 | P i) F i = \big[op/x]_(i <- r1 | P i) F i. Proof. by rewrite unlock /reducebig foldr_cat. Qed. Lemma big_catl r1 r2 (P : pred I) F : ~~ has P r2 -> \big[op/idx]_(i <- r1 ++ r2 | P i) F i = \big[op/idx]_(i <- r1 | P i) F i. Proof. by rewrite big_cat_nested => /big_hasC->. Qed. Lemma big_catr r1 r2 (P : pred I) F : ~~ has P r1 -> \big[op/idx]_(i <- r1 ++ r2 | P i) F i = \big[op/idx]_(i <- r2 | P i) F i. Proof. rewrite -big_filter -(big_filter r2) filter_cat. by rewrite has_count -size_filter; case: filter. Qed. End SeqExtension. Lemma big_map_id J (h : J -> R) r (P : pred R) : \big[op/idx]_(i <- map h r | P i) i = \big[op/idx]_(j <- r | P (h j)) h j. Proof. exact: big_map. Qed. (* The following lemmas can be used to localise extensionality to a specific *) (* index sequence. This is done by ssreflect rewriting, before applying *) (* congruence or induction lemmas. *) Lemma big_seq_cond (I : eqType) r (P : pred I) F : \big[op/idx]_(i <- r | P i) F i = \big[op/idx]_(i <- r | (i \in r) && P i) F i. Proof. by rewrite -!(big_filter r); congr bigop; apply: eq_in_filter => i ->. Qed. Lemma big_seq (I : eqType) (r : seq I) F : \big[op/idx]_(i <- r) F i = \big[op/idx]_(i <- r | i \in r) F i. Proof. by rewrite big_seq_cond big_andbC. Qed. Lemma eq_big_seq (I : eqType) (r : seq I) F1 F2 : {in r, F1 =1 F2} -> \big[op/idx]_(i <- r) F1 i = \big[op/idx]_(i <- r) F2 i. Proof. by move=> eqF; rewrite !big_seq (eq_bigr _ eqF). Qed. (* Similar lemmas for exposing integer indexing in the predicate. *) Lemma big_nat_cond m n (P : pred nat) F : \big[op/idx]_(m <= i < n | P i) F i = \big[op/idx]_(m <= i < n | (m <= i < n) && P i) F i. Proof. by rewrite big_seq_cond; apply: eq_bigl => i; rewrite mem_index_iota. Qed. Lemma big_nat m n F : \big[op/idx]_(m <= i < n) F i = \big[op/idx]_(m <= i < n | m <= i < n) F i. Proof. by rewrite big_nat_cond big_andbC. Qed. Lemma congr_big_nat m1 n1 m2 n2 P1 P2 F1 F2 : m1 = m2 -> n1 = n2 -> (forall i, m1 <= i < n2 -> P1 i = P2 i) -> (forall i, P1 i && (m1 <= i < n2) -> F1 i = F2 i) -> \big[op/idx]_(m1 <= i < n1 | P1 i) F1 i = \big[op/idx]_(m2 <= i < n2 | P2 i) F2 i. Proof. move=> <- <- eqP12 eqF12; rewrite big_seq_cond (big_seq_cond _ P2). apply: eq_big => i; rewrite ?inE /= !mem_index_iota. by apply: andb_id2l; apply: eqP12. by rewrite andbC; apply: eqF12. Qed. Lemma eq_big_nat m n F1 F2 : (forall i, m <= i < n -> F1 i = F2 i) -> \big[op/idx]_(m <= i < n) F1 i = \big[op/idx]_(m <= i < n) F2 i. Proof. by move=> eqF; apply: congr_big_nat. Qed. Lemma big_geq m n (P : pred nat) F : m >= n -> \big[op/idx]_(m <= i < n | P i) F i = idx. Proof. by move=> ge_m_n; rewrite /index_iota (eqnP ge_m_n) big_nil. Qed. Lemma big_ltn_cond m n (P : pred nat) F : m < n -> let x := \big[op/idx]_(m.+1 <= i < n | P i) F i in \big[op/idx]_(m <= i < n | P i) F i = if P m then op (F m) x else x. Proof. by case: n => [//|n] le_m_n; rewrite /index_iota subSn // big_cons. Qed. Lemma big_ltn m n F : m < n -> \big[op/idx]_(m <= i < n) F i = op (F m) (\big[op/idx]_(m.+1 <= i < n) F i). Proof. by move=> lt_mn; apply: big_ltn_cond. Qed. Lemma big_addn m n a (P : pred nat) F : \big[op/idx]_(m + a <= i < n | P i) F i = \big[op/idx]_(m <= i < n - a | P (i + a)) F (i + a). Proof. rewrite /index_iota -subnDA addnC iotaDl big_map. by apply: eq_big => ? *; rewrite addnC. Qed. Lemma big_add1 m n (P : pred nat) F : \big[op/idx]_(m.+1 <= i < n | P i) F i = \big[op/idx]_(m <= i < n.-1 | P (i.+1)) F (i.+1). Proof. by rewrite -addn1 big_addn subn1; apply: eq_big => ? *; rewrite addn1. Qed. Lemma big_nat_recl n m F : m <= n -> \big[op/idx]_(m <= i < n.+1) F i = op (F m) (\big[op/idx]_(m <= i < n) F i.+1). Proof. by move=> lemn; rewrite big_ltn // big_add1. Qed. Lemma big_mkord n (P : pred nat) F : \big[op/idx]_(0 <= i < n | P i) F i = \big[op/idx]_(i < n | P i) F i. Proof. rewrite /index_iota subn0 -(big_map (@nat_of_ord n)). by congr bigop; rewrite /index_enum 2!unlock val_ord_enum. Qed. Lemma big_nat_widen m n1 n2 (P : pred nat) F : n1 <= n2 -> \big[op/idx]_(m <= i < n1 | P i) F i = \big[op/idx]_(m <= i < n2 | P i && (i < n1)) F i. Proof. move=> len12; symmetry; rewrite -big_filter filter_predI big_filter. have [ltn_trans eq_by_mem] := (ltn_trans, irr_sorted_eq ltn_trans ltnn). congr bigop; apply: eq_by_mem; rewrite ?sorted_filter ?iota_ltn_sorted // => i. rewrite mem_filter !mem_index_iota andbCA andbA andb_idr => // /andP[_]. by move/leq_trans->. Qed. Lemma big_ord_widen_cond n1 n2 (P : pred nat) (F : nat -> R) : n1 <= n2 -> \big[op/idx]_(i < n1 | P i) F i = \big[op/idx]_(i < n2 | P i && (i < n1)) F i. Proof. by move/big_nat_widen=> len12; rewrite -big_mkord len12 big_mkord. Qed. Lemma big_ord_widen n1 n2 (F : nat -> R) : n1 <= n2 -> \big[op/idx]_(i < n1) F i = \big[op/idx]_(i < n2 | i < n1) F i. Proof. by move=> le_n12; apply: (big_ord_widen_cond (predT)). Qed. Lemma big_ord_widen_leq n1 n2 (P : pred 'I_(n1.+1)) F : n1 < n2 -> \big[op/idx]_(i < n1.+1 | P i) F i = \big[op/idx]_(i < n2 | P (inord i) && (i <= n1)) F (inord i). Proof. move=> len12; pose g G i := G (inord i : 'I_(n1.+1)). rewrite -(big_ord_widen_cond (g _ P) (g _ F) len12) {}/g. by apply: eq_big => i *; rewrite inord_val. Qed. Lemma big_ord0 P F : \big[op/idx]_(i < 0 | P i) F i = idx. Proof. by rewrite big_pred0 => [|[]]. Qed. Lemma big_mask_tuple I n m (t : n.-tuple I) (P : pred I) F : \big[op/idx]_(i <- mask m t | P i) F i = \big[op/idx]_(i < n | nth false m i && P (tnth t i)) F (tnth t i). Proof. rewrite [t in LHS]tuple_map_ord/= -map_mask big_map. by rewrite mask_enum_ord big_filter_cond/= enumT. Qed. Lemma big_mask I r m (P : pred I) (F : I -> R) (r_ := tnth (in_tuple r)) : \big[op/idx]_(i <- mask m r | P i) F i = \big[op/idx]_(i < size r | nth false m i && P (r_ i)) F (r_ i). Proof. exact: (big_mask_tuple _ (in_tuple r)). Qed. Lemma big_tnth I r (P : pred I) F (r_ := tnth (in_tuple r)) : \big[op/idx]_(i <- r | P i) F i = \big[op/idx]_(i < size r | P (r_ i)) (F (r_ i)). Proof. rewrite /= -[r in LHS](mask_true (leqnn (size r))) big_mask//. by apply: eq_bigl => i /=; rewrite nth_nseq ltn_ord. Qed. Lemma big_index_uniq (I : eqType) (r : seq I) (E : 'I_(size r) -> R) : uniq r -> \big[op/idx]_i E i = \big[op/idx]_(x <- r) oapp E idx (insub (index x r)). Proof. move=> Ur; apply/esym; rewrite big_tnth. by under [LHS]eq_bigr do rewrite index_uniq// valK. Qed. Lemma big_tuple I n (t : n.-tuple I) (P : pred I) F : \big[op/idx]_(i <- t | P i) F i = \big[op/idx]_(i < n | P (tnth t i)) F (tnth t i). Proof. by rewrite big_tnth tvalK; case: _ / (esym _). Qed. Lemma big_ord_narrow_cond n1 n2 (P : pred 'I_n2) F (le_n12 : n1 <= n2) : let w := widen_ord le_n12 in \big[op/idx]_(i < n2 | P i && (i < n1)) F i = \big[op/idx]_(i < n1 | P (w i)) F (w i). Proof. case: n1 => [|n1] /= in le_n12 *. by rewrite big_ord0 big_pred0 // => i; rewrite andbF. rewrite (big_ord_widen_leq _ _ le_n12); apply: eq_big => i. by apply: andb_id2r => le_i_n1; congr P; apply: val_inj; rewrite /= inordK. by case/andP=> _ le_i_n1; congr F; apply: val_inj; rewrite /= inordK. Qed. Lemma big_ord_narrow_cond_leq n1 n2 (P : pred _) F (le_n12 : n1 <= n2) : let w := @widen_ord n1.+1 n2.+1 le_n12 in \big[op/idx]_(i < n2.+1 | P i && (i <= n1)) F i = \big[op/idx]_(i < n1.+1 | P (w i)) F (w i). Proof. exact: (@big_ord_narrow_cond n1.+1 n2.+1). Qed. Lemma big_ord_narrow n1 n2 F (le_n12 : n1 <= n2) : let w := widen_ord le_n12 in \big[op/idx]_(i < n2 | i < n1) F i = \big[op/idx]_(i < n1) F (w i). Proof. exact: (big_ord_narrow_cond (predT)). Qed. Lemma big_ord_narrow_leq n1 n2 F (le_n12 : n1 <= n2) : let w := @widen_ord n1.+1 n2.+1 le_n12 in \big[op/idx]_(i < n2.+1 | i <= n1) F i = \big[op/idx]_(i < n1.+1) F (w i). Proof. exact: (big_ord_narrow_cond_leq (predT)). Qed. Lemma big_ord_recl n F : \big[op/idx]_(i < n.+1) F i = op (F ord0) (\big[op/idx]_(i < n) F (@lift n.+1 ord0 i)). Proof. pose G i := F (inord i); have eqFG i: F i = G i by rewrite /G inord_val. under eq_bigr do rewrite eqFG; under [in RHS]eq_bigr do rewrite eqFG. by rewrite -(big_mkord _ (fun _ => _) G) eqFG big_ltn // big_add1 /= big_mkord. Qed. Lemma big_nseq_cond I n a (P : pred I) F : \big[op/idx]_(i <- nseq n a | P i) F i = if P a then iter n (op (F a)) idx else idx. Proof. by rewrite unlock; elim: n => /= [|n ->]; case: (P a). Qed. Lemma big_nseq I n a (F : I -> R): \big[op/idx]_(i <- nseq n a) F i = iter n (op (F a)) idx. Proof. exact: big_nseq_cond. Qed. End Extensionality. Variant big_enum_spec (I : finType) (P : pred I) : seq I -> Type := BigEnumSpec e of forall R idx op (F : I -> R), \big[op/idx]_(i <- e) F i = \big[op/idx]_(i | P i) F i & uniq e /\ (forall i, i \in e = P i) & (let cP := [pred i | P i] in perm_eq e (enum cP) /\ size e = #|cP|) : big_enum_spec P e. (* This lemma can be used to introduce an enumeration into a non-abelian *) (* bigop, in one of three ways: *) (* have [e big_e [Ue mem_e] [e_enum size_e]] := big_enumP P. *) (* gives a permutation e of enum P alongside a equation big_e for converting *) (* between bigops iterating on (i <- e) and ones on (i | P i). Usually not *) (* all properties of e are needed, but see below the big_distr_big_dep proof *) (* where most are. *) (* rewrite -big_filter; have [e ...] := big_enumP. *) (* uses big_filter to do this conversion first, and then abstracts the *) (* resulting filter P (index_enum T) enumeration as an e with the same *) (* properties (see big_enum_cond below for an example of this usage). *) (* Finally *) (* rewrite -big_filter; case def_e: _ / big_enumP => [e ...] *) (* does the same while remembering the definition of e. *) Lemma big_enumP I P : big_enum_spec P (filter P (index_enum I)). Proof. set e := filter P _; have Ue: uniq e by apply/filter_uniq/index_enum_uniq. have mem_e i: i \in e = P i by rewrite mem_filter mem_index_enum andbT. split=> // [R idx op F | cP]; first by rewrite big_filter. suffices De: perm_eq e (enum cP) by rewrite (perm_size De) cardE. by apply/uniq_perm=> // [|i]; rewrite ?enum_uniq ?mem_enum ?mem_e. Qed. Section BigConst. Variables (R : Type) (idx : R) (op : R -> R -> R). Lemma big_const_seq I r (P : pred I) x : \big[op/idx]_(i <- r | P i) x = iter (count P r) (op x) idx. Proof. by rewrite unlock; elim: r => //= i r ->; case: (P i). Qed. Lemma big_const (I : finType) (A : {pred I}) x : \big[op/idx]_(i in A) x = iter #|A| (op x) idx. Proof. by have [e <- _ [_ <-]] := big_enumP A; rewrite big_const_seq count_predT. Qed. Lemma big_const_nat m n x : \big[op/idx]_(m <= i < n) x = iter (n - m) (op x) idx. Proof. by rewrite big_const_seq count_predT size_iota. Qed. Lemma big_const_ord n x : \big[op/idx]_(i < n) x = iter n (op x) idx. Proof. by rewrite big_const card_ord. Qed. End BigConst. Section MonoidProperties. Import Monoid.Theory. Variable R : Type. Variable idx : R. Local Notation "1" := idx. Section Plain. Variable op : Monoid.law 1. Local Notation "*%M" := op (at level 0). Local Notation "x * y" := (op x y). Lemma foldlE x r : foldl *%M x r = \big[*%M/1]_(y <- x :: r) y. Proof. by rewrite -foldrE; elim: r => [|y r IHr]/= in x *; rewrite ?mulm1 ?mulmA ?IHr. Qed. Lemma foldl_idx r : foldl *%M 1 r = \big[*%M/1]_(x <- r) x. Proof. by rewrite foldlE big_cons mul1m. Qed. Lemma eq_big_idx_seq idx' I r (P : pred I) F : right_id idx' *%M -> has P r -> \big[*%M/idx']_(i <- r | P i) F i =\big[*%M/1]_(i <- r | P i) F i. Proof. move=> op_idx'; rewrite -!(big_filter _ _ r) has_count -size_filter. case/lastP: (filter P r) => {r}// r i _. by rewrite -cats1 !(big_cat_nested, big_cons, big_nil) op_idx' mulm1. Qed. Lemma eq_big_idx idx' (I : finType) i0 (P : pred I) F : P i0 -> right_id idx' *%M -> \big[*%M/idx']_(i | P i) F i =\big[*%M/1]_(i | P i) F i. Proof. by move=> Pi0 op_idx'; apply: eq_big_idx_seq => //; apply/hasP; exists i0. Qed. Lemma big1_eq I r (P : pred I) : \big[*%M/1]_(i <- r | P i) 1 = 1. Proof. by rewrite big_const_seq; elim: (count _ _) => //= n ->; apply: mul1m. Qed. Lemma big1 I r (P : pred I) F : (forall i, P i -> F i = 1) -> \big[*%M/1]_(i <- r | P i) F i = 1. Proof. by move/(eq_bigr _)->; apply: big1_eq. Qed. Lemma big1_seq (I : eqType) r (P : pred I) F : (forall i, P i && (i \in r) -> F i = 1) -> \big[*%M/1]_(i <- r | P i) F i = 1. Proof. by move=> eqF1; rewrite big_seq_cond big_andbC big1. Qed. Lemma big_seq1 I (i : I) F : \big[*%M/1]_(j <- [:: i]) F j = F i. Proof. by rewrite unlock /= mulm1. Qed. Lemma big_mkcond I r (P : pred I) F : \big[*%M/1]_(i <- r | P i) F i = \big[*%M/1]_(i <- r) (if P i then F i else 1). Proof. by rewrite unlock; elim: r => //= i r ->; case P; rewrite ?mul1m. Qed. Lemma big_mkcondr I r (P Q : pred I) F : \big[*%M/1]_(i <- r | P i && Q i) F i = \big[*%M/1]_(i <- r | P i) (if Q i then F i else 1). Proof. by rewrite -big_filter_cond big_mkcond big_filter. Qed. Lemma big_mkcondl I r (P Q : pred I) F : \big[*%M/1]_(i <- r | P i && Q i) F i = \big[*%M/1]_(i <- r | Q i) (if P i then F i else 1). Proof. by rewrite big_andbC big_mkcondr. Qed. Lemma big_uncond I (r : seq I) (P : pred I) F : (forall i, ~~ P i -> F i = 1) -> \big[*%M/1]_(i <- r | P i) F i = \big[*%M/1]_(i <- r) F i. Proof. move=> F_eq1; rewrite big_mkcond; apply: eq_bigr => i. by case: (P i) (F_eq1 i) => // ->. Qed. Lemma big_rmcond_in (I : eqType) (r : seq I) (P : pred I) F : (forall i, i \in r -> ~~ P i -> F i = 1) -> \big[*%M/1]_(i <- r | P i) F i = \big[*%M/1]_(i <- r) F i. Proof. move=> F_eq1; rewrite big_seq_cond [RHS]big_seq_cond !big_mkcondl big_uncond//. by move=> i /F_eq1; case: ifP => // _ ->. Qed. Lemma big_cat I r1 r2 (P : pred I) F : \big[*%M/1]_(i <- r1 ++ r2 | P i) F i = \big[*%M/1]_(i <- r1 | P i) F i * \big[*%M/1]_(i <- r2 | P i) F i. Proof. rewrite !(big_mkcond _ P) unlock. by elim: r1 => /= [|i r1 ->]; rewrite (mul1m, mulmA). Qed. Lemma big_allpairs_dep I1 (I2 : I1 -> Type) J (h : forall i1, I2 i1 -> J) (r1 : seq I1) (r2 : forall i1, seq (I2 i1)) (F : J -> R) : \big[*%M/1]_(i <- [seq h i1 i2 | i1 <- r1, i2 <- r2 i1]) F i = \big[*%M/1]_(i1 <- r1) \big[*%M/1]_(i2 <- r2 i1) F (h i1 i2). Proof. elim: r1 => [|i1 r1 IHr1]; first by rewrite !big_nil. by rewrite big_cat IHr1 big_cons big_map. Qed. Lemma big_allpairs I1 I2 (r1 : seq I1) (r2 : seq I2) F : \big[*%M/1]_(i <- [seq (i1, i2) | i1 <- r1, i2 <- r2]) F i = \big[*%M/1]_(i1 <- r1) \big[op/idx]_(i2 <- r2) F (i1, i2). Proof. exact: big_allpairs_dep. Qed. Lemma big_pred1_eq (I : finType) (i : I) F : \big[*%M/1]_(j | j == i) F j = F i. Proof. have [e1 <- _ [e_enum _]] := big_enumP (pred1 i). by rewrite (perm_small_eq _ e_enum) enum1 ?big_seq1. Qed. Lemma big_pred1 (I : finType) i (P : pred I) F : P =1 pred1 i -> \big[*%M/1]_(j | P j) F j = F i. Proof. by move/(eq_bigl _ _)->; apply: big_pred1_eq. Qed. Lemma big_cat_nat n m p (P : pred nat) F : m <= n -> n <= p -> \big[*%M/1]_(m <= i < p | P i) F i = (\big[*%M/1]_(m <= i < n | P i) F i) * (\big[*%M/1]_(n <= i < p | P i) F i). Proof. move=> le_mn le_np; rewrite -big_cat -{2}(subnKC le_mn) -iotaD subnDA. by rewrite subnKC // leq_sub. Qed. Lemma big_nat1 n F : \big[*%M/1]_(n <= i < n.+1) F i = F n. Proof. by rewrite big_ltn // big_geq // mulm1. Qed. Lemma big_nat_recr n m F : m <= n -> \big[*%M/1]_(m <= i < n.+1) F i = (\big[*%M/1]_(m <= i < n) F i) * F n. Proof. by move=> lemn; rewrite (@big_cat_nat n) ?leqnSn // big_nat1. Qed. Lemma big_ord_recr n F : \big[*%M/1]_(i < n.+1) F i = (\big[*%M/1]_(i < n) F (widen_ord (leqnSn n) i)) * F ord_max. Proof. transitivity (\big[*%M/1]_(0 <= i < n.+1) F (inord i)). by rewrite big_mkord; apply: eq_bigr=> i _; rewrite inord_val. rewrite big_nat_recr // big_mkord; congr (_ * F _); last first. by apply: val_inj; rewrite /= inordK. by apply: eq_bigr => [] i _; congr F; apply: ord_inj; rewrite inordK //= leqW. Qed. Lemma big_sumType (I1 I2 : finType) (P : pred (I1 + I2)) F : \big[*%M/1]_(i | P i) F i = (\big[*%M/1]_(i | P (inl _ i)) F (inl _ i)) * (\big[*%M/1]_(i | P (inr _ i)) F (inr _ i)). Proof. by rewrite ![index_enum _]unlock [@Finite.enum in LHS]unlock big_cat !big_map. Qed. Lemma big_split_ord m n (P : pred 'I_(m + n)) F : \big[*%M/1]_(i | P i) F i = (\big[*%M/1]_(i | P (lshift n i)) F (lshift n i)) * (\big[*%M/1]_(i | P (rshift m i)) F (rshift m i)). Proof. rewrite -(big_map _ _ (lshift n) _ P F) -(big_map _ _ (@rshift m _) _ P F). rewrite -big_cat; congr bigop; apply: (inj_map val_inj). rewrite map_cat -!map_comp (map_comp (addn m)) /=. by rewrite ![index_enum _]unlock unlock !val_ord_enum -iotaDl addn0 iotaD. Qed. Lemma big_flatten I rr (P : pred I) F : \big[*%M/1]_(i <- flatten rr | P i) F i = \big[*%M/1]_(r <- rr) \big[*%M/1]_(i <- r | P i) F i. Proof. by elim: rr => [|r rr IHrr]; rewrite ?big_nil //= big_cat big_cons -IHrr. Qed. End Plain. Section Abelian. Variable op : Monoid.com_law 1. Local Notation "'*%M'" := op (at level 0). Local Notation "x * y" := (op x y). Lemma perm_big (I : eqType) r1 r2 (P : pred I) F : perm_eq r1 r2 -> \big[*%M/1]_(i <- r1 | P i) F i = \big[*%M/1]_(i <- r2 | P i) F i. Proof. move/permP; rewrite !(big_mkcond _ _ P). elim: r1 r2 => [|i r1 IHr1] r2 eq_r12. by case: r2 eq_r12 => // i r2 /(_ (pred1 i)); rewrite /= eqxx. have r2i: i \in r2 by rewrite -has_pred1 has_count -eq_r12 /= eqxx. case/splitPr: r2 / r2i => [r3 r4] in eq_r12 *; rewrite big_cat /= !big_cons. rewrite mulmCA; congr (_ * _); rewrite -big_cat; apply: IHr1 => a. by move/(_ a): eq_r12; rewrite !count_cat /= addnCA; apply: addnI. Qed. Lemma big_enum_cond (I : finType) (A : {pred I}) (P : pred I) F : \big[*%M/1]_(i <- enum A | P i) F i = \big[*%M/1]_(i in A | P i) F i. Proof. by rewrite -big_filter_cond; have [e _ _ [/perm_big->]] := big_enumP. Qed. Lemma big_enum (I : finType) (A : {pred I}) F : \big[*%M/1]_(i <- enum A) F i = \big[*%M/1]_(i in A) F i. Proof. by rewrite big_enum_cond big_andbC. Qed. Lemma big_uniq (I : finType) (r : seq I) F : uniq r -> \big[*%M/1]_(i <- r) F i = \big[*%M/1]_(i in r) F i. Proof. move=> uniq_r; rewrite -big_enum; apply: perm_big. by rewrite uniq_perm ?enum_uniq // => i; rewrite mem_enum. Qed. Lemma big_rem (I : eqType) r x (P : pred I) F : x \in r -> \big[*%M/1]_(y <- r | P y) F y = (if P x then F x else 1) * \big[*%M/1]_(y <- rem x r | P y) F y. Proof. by move/perm_to_rem/(perm_big _)->; rewrite !(big_mkcond _ _ P) big_cons. Qed. Lemma big_undup (I : eqType) (r : seq I) (P : pred I) F : idempotent *%M -> \big[*%M/1]_(i <- undup r | P i) F i = \big[*%M/1]_(i <- r | P i) F i. Proof. move=> idM; rewrite -!(big_filter _ _ _ P) filter_undup. elim: {P r}(filter P r) => //= i r IHr. case: ifP => [r_i | _]; rewrite !big_cons {}IHr //. by rewrite (big_rem _ _ r_i) mulmA idM. Qed. Lemma eq_big_idem (I : eqType) (r1 r2 : seq I) (P : pred I) F : idempotent *%M -> r1 =i r2 -> \big[*%M/1]_(i <- r1 | P i) F i = \big[*%M/1]_(i <- r2 | P i) F i. Proof. move=> idM eq_r; rewrite -big_undup // -(big_undup r2) //; apply/perm_big. by rewrite uniq_perm ?undup_uniq // => i; rewrite !mem_undup eq_r. Qed. Lemma big_undup_iterop_count (I : eqType) (r : seq I) (P : pred I) F : \big[*%M/1]_(i <- undup r | P i) iterop (count_mem i r) *%M (F i) 1 = \big[*%M/1]_(i <- r | P i) F i. Proof. rewrite -[RHS](perm_big _ F (perm_count_undup _)) big_flatten big_map. by rewrite big_mkcond; apply: eq_bigr => i _; rewrite big_nseq_cond iteropE. Qed. Lemma big_split I r (P : pred I) F1 F2 : \big[*%M/1]_(i <- r | P i) (F1 i * F2 i) = \big[*%M/1]_(i <- r | P i) F1 i * \big[*%M/1]_(i <- r | P i) F2 i. Proof. by elim/big_rec3: _ => [|i x y _ _ ->]; rewrite ?mulm1 // mulmCA -!mulmA mulmCA. Qed. Lemma bigID I r (a P : pred I) F : \big[*%M/1]_(i <- r | P i) F i = \big[*%M/1]_(i <- r | P i && a i) F i * \big[*%M/1]_(i <- r | P i && ~~ a i) F i. Proof. rewrite !(big_mkcond _ _ _ F) -big_split. by apply: eq_bigr => i; case: (a i); rewrite !simpm. Qed. Arguments bigID [I r]. Lemma bigU (I : finType) (A B : pred I) F : [disjoint A & B] -> \big[*%M/1]_(i in [predU A & B]) F i = (\big[*%M/1]_(i in A) F i) * (\big[*%M/1]_(i in B) F i). Proof. move=> dAB; rewrite (bigID (mem A)). congr (_ * _); apply: eq_bigl => i; first by rewrite orbK. by have:= pred0P dAB i; rewrite andbC /= !inE; case: (i \in A). Qed. Lemma bigD1 (I : finType) j (P : pred I) F : P j -> \big[*%M/1]_(i | P i) F i = F j * \big[*%M/1]_(i | P i && (i != j)) F i. Proof. move=> Pj; rewrite (bigID (pred1 j)); congr (_ * _). by apply: big_pred1 => i; rewrite /= andbC; case: eqP => // ->. Qed. Arguments bigD1 [I] j [P F]. Lemma bigD1_seq (I : eqType) (r : seq I) j F : j \in r -> uniq r -> \big[*%M/1]_(i <- r) F i = F j * \big[*%M/1]_(i <- r | i != j) F i. Proof. by move=> /big_rem-> /rem_filter->; rewrite big_filter. Qed. Lemma cardD1x (I : finType) (A : pred I) j : A j -> #|SimplPred A| = 1 + #|[pred i | A i & i != j]|. Proof. move=> Aj; rewrite (cardD1 j) [j \in A]Aj; congr (_ + _). by apply: eq_card => i; rewrite inE /= andbC. Qed. Arguments cardD1x [I A]. Lemma partition_big (I J : finType) (P : pred I) p (Q : pred J) F : (forall i, P i -> Q (p i)) -> \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | Q j) \big[*%M/1]_(i | P i && (p i == j)) F i. Proof. move=> Qp; transitivity (\big[*%M/1]_(i | P i && Q (p i)) F i). by apply: eq_bigl => i; case Pi: (P i); rewrite // Qp. have [n leQn] := ubnP #|Q|; elim: n => // n IHn in Q {Qp} leQn *. case: (pickP Q) => [j Qj | Q0]; last first. by rewrite !big_pred0 // => i; rewrite Q0 andbF. rewrite (bigD1 j) // -IHn; last by rewrite ltnS (cardD1x j Qj) in leQn. rewrite (bigID (fun i => p i == j)); congr (_ * _); apply: eq_bigl => i. by case: eqP => [-> | _]; rewrite !(Qj, simpm). by rewrite andbA. Qed. Arguments partition_big [I J P] p Q [F]. Lemma big_image_cond I (J : finType) (h : J -> I) (A : pred J) (P : pred I) F : \big[*%M/1]_(i <- [seq h j | j in A] | P i) F i = \big[*%M/1]_(j in A | P (h j)) F (h j). Proof. by rewrite big_map big_enum_cond. Qed. Lemma big_image I (J : finType) (h : J -> I) (A : pred J) F : \big[*%M/1]_(i <- [seq h j | j in A]) F i = \big[*%M/1]_(j in A) F (h j). Proof. by rewrite big_map big_enum. Qed. Lemma big_image_cond_id (J : finType) (h : J -> R) (A : pred J) (P : pred R) : \big[*%M/1]_(i <- [seq h j | j in A] | P i) i = \big[*%M/1]_(j in A | P (h j)) h j. Proof. exact: big_image_cond. Qed. Lemma big_image_id (J : finType) (h : J -> R) (A : pred J) : \big[*%M/1]_(i <- [seq h j | j in A]) i = \big[*%M/1]_(j in A) h j. Proof. exact: big_image. Qed. Lemma reindex_omap (I J : finType) (h : J -> I) h' (P : pred I) F : (forall i, P i -> omap h (h' i) = some i) -> \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | P (h j) && (h' (h j) == some j)) F (h j). Proof. move=> h'K; have [n lePn] := ubnP #|P|; elim: n => // n IHn in P h'K lePn *. case: (pickP P) => [i Pi | P0]; last first. by rewrite !big_pred0 // => j; rewrite P0. have := h'K i Pi; case h'i_eq : (h' i) => [/= j|//] [hj_eq]. rewrite (bigD1 i Pi) (bigD1 j) hj_eq ?Pi ?h'i_eq ?eqxx //=; congr (_ * _). rewrite {}IHn => [|k /andP[]|]; [|by auto | by rewrite (cardD1x i) in lePn]. apply: eq_bigl => k; rewrite andbC -andbA (andbCA (P _)); case: eqP => //= hK. congr (_ && ~~ _); apply/eqP/eqP => [|->//]. by move=> /(congr1 h'); rewrite h'i_eq hK => -[]. Qed. Arguments reindex_omap [I J] h h' [P F]. Lemma reindex_onto (I J : finType) (h : J -> I) h' (P : pred I) F : (forall i, P i -> h (h' i) = i) -> \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | P (h j) && (h' (h j) == j)) F (h j). Proof. by move=> h'K; rewrite (reindex_omap h (some \o h'))//= => i Pi; rewrite h'K. Qed. Arguments reindex_onto [I J] h h' [P F]. Lemma reindex (I J : finType) (h : J -> I) (P : pred I) F : {on [pred i | P i], bijective h} -> \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | P (h j)) F (h j). Proof. case=> h' hK h'K; rewrite (reindex_onto h h' h'K). by apply: eq_bigl => j; rewrite !inE; case Pi: (P _); rewrite //= hK ?eqxx. Qed. Arguments reindex [I J] h [P F]. Lemma reindex_inj (I : finType) (h : I -> I) (P : pred I) F : injective h -> \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | P (h j)) F (h j). Proof. by move=> injh; apply: reindex (onW_bij _ (injF_bij injh)). Qed. Arguments reindex_inj [I h P F]. Lemma bigD1_ord n j (P : pred 'I_n) F : P j -> \big[*%M/1]_(i < n | P i) F i = F j * \big[*%M/1]_(i < n.-1 | P (lift j i)) F (lift j i). Proof. move=> Pj; rewrite (bigD1 j Pj) (reindex_omap (lift j) (unlift j))/=. by under eq_bigl do rewrite liftK eq_sym eqxx neq_lift ?andbT. by move=> i; case: unliftP => [k ->|->]; rewrite ?eqxx ?andbF. Qed. Lemma big_enum_val_cond (I : finType) (A : pred I) (P : pred I) F : \big[op/idx]_(x in A | P x) F x = \big[op/idx]_(i < #|A| | P (enum_val i)) F (enum_val i). Proof. have [A_eq0|/card_gt0P[x0 x0A]] := posnP #|A|. rewrite !big_pred0 // => i; last by rewrite card0_eq. by have: false by move: i => []; rewrite A_eq0. rewrite (reindex (enum_val : 'I_#|A| -> I)). by apply: eq_big => [x|x Px]; rewrite ?enum_valP. by apply: subon_bij (enum_val_bij_in x0A) => y /andP[]. Qed. Arguments big_enum_val_cond [I A] P F. Lemma big_enum_rank_cond (I : finType) (A : pred I) x (xA : x \in A) P F (h := enum_rank_in xA) : \big[op/idx]_(i < #|A| | P i) F i = \big[op/idx]_(s in A | P (h s)) F (h s). Proof. rewrite big_enum_val_cond {}/h. by apply: eq_big => [i|i Pi]; rewrite ?enum_valK_in. Qed. Arguments big_enum_rank_cond [I A x] xA P F. Lemma big_enum_val (I : finType) (A : pred I) F : \big[op/idx]_(x in A) F x = \big[op/idx]_(i < #|A|) F (enum_val i). Proof. by rewrite -(big_enum_val_cond predT) big_mkcondr. Qed. Arguments big_enum_val [I A] F. Lemma big_enum_rank (I : finType) (A : pred I) x (xA : x \in A) F (h := enum_rank_in xA) : \big[op/idx]_(i < #|A|) F i = \big[op/idx]_(s in A) F (h s). Proof. by rewrite (big_enum_rank_cond xA) big_mkcondr. Qed. Arguments big_enum_rank [I A x] xA F. Lemma big_nat_rev m n P F : \big[*%M/1]_(m <= i < n | P i) F i = \big[*%M/1]_(m <= i < n | P (m + n - i.+1)) F (m + n - i.+1). Proof. case: (ltnP m n) => ltmn; last by rewrite !big_geq. rewrite -{3 4}(subnK (ltnW ltmn)) addnA. do 2!rewrite (big_addn _ _ 0) big_mkord; rewrite (reindex_inj rev_ord_inj) /=. by apply: eq_big => [i | i _]; rewrite /= -addSn subnDr addnC addnBA. Qed. Lemma sig_big_dep (I : finType) (J : I -> finType) (P : pred I) (Q : forall {i}, pred (J i)) (F : forall {i}, J i -> R) : \big[op/idx]_(i | P i) \big[op/idx]_(j : J i | Q j) F j = \big[op/idx]_(p : {i : I & J i} | P (tag p) && Q (tagged p)) F (tagged p). Proof. pose s := [seq Tagged J j | i <- index_enum I, j <- index_enum (J i)]. rewrite [LHS]big_mkcond big_mkcondl [RHS]big_mkcond -[RHS](@perm_big _ s). rewrite big_allpairs_dep/=; apply: eq_bigr => i _; rewrite -big_mkcond/=. by case: P; rewrite // big1. rewrite uniq_perm ?index_enum_uniq//. by rewrite allpairs_uniq_dep// => [|i|[i j] []]; rewrite ?index_enum_uniq. by move=> [i j]; rewrite ?mem_index_enum; apply/allpairsPdep; exists i, j. Qed. Lemma pair_big_dep (I J : finType) (P : pred I) (Q : I -> pred J) F : \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q i j) F i j = \big[*%M/1]_(p | P p.1 && Q p.1 p.2) F p.1 p.2. Proof. rewrite sig_big_dep; apply: (reindex (fun x => Tagged (fun=> J) x.2)). by exists (fun x => (projT1 x, projT2 x)) => -[]. Qed. Lemma pair_big (I J : finType) (P : pred I) (Q : pred J) F : \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q j) F i j = \big[*%M/1]_(p | P p.1 && Q p.2) F p.1 p.2. Proof. exact: pair_big_dep. Qed. Lemma pair_bigA (I J : finType) (F : I -> J -> R) : \big[*%M/1]_i \big[*%M/1]_j F i j = \big[*%M/1]_p F p.1 p.2. Proof. exact: pair_big_dep. Qed. Lemma exchange_big_dep I J rI rJ (P : pred I) (Q : I -> pred J) (xQ : pred J) F : (forall i j, P i -> Q i j -> xQ j) -> \big[*%M/1]_(i <- rI | P i) \big[*%M/1]_(j <- rJ | Q i j) F i j = \big[*%M/1]_(j <- rJ | xQ j) \big[*%M/1]_(i <- rI | P i && Q i j) F i j. Proof. move=> PQxQ; pose p u := (u.2, u.1). under [LHS]eq_bigr do rewrite big_tnth; rewrite [LHS]big_tnth. under [RHS]eq_bigr do rewrite big_tnth; rewrite [RHS]big_tnth. rewrite !pair_big_dep (reindex_onto (p _ _) (p _ _)) => [|[]] //=. apply: eq_big => [] [j i] //=; symmetry; rewrite eqxx andbT andb_idl //. by case/andP; apply: PQxQ. Qed. Arguments exchange_big_dep [I J rI rJ P Q] xQ [F]. Lemma exchange_big I J rI rJ (P : pred I) (Q : pred J) F : \big[*%M/1]_(i <- rI | P i) \big[*%M/1]_(j <- rJ | Q j) F i j = \big[*%M/1]_(j <- rJ | Q j) \big[*%M/1]_(i <- rI | P i) F i j. Proof. rewrite (exchange_big_dep Q) //. by under eq_bigr => i Qi do under eq_bigl do rewrite Qi andbT. Qed. Lemma exchange_big_dep_nat m1 n1 m2 n2 (P : pred nat) (Q : rel nat) (xQ : pred nat) F : (forall i j, m1 <= i < n1 -> m2 <= j < n2 -> P i -> Q i j -> xQ j) -> \big[*%M/1]_(m1 <= i < n1 | P i) \big[*%M/1]_(m2 <= j < n2 | Q i j) F i j = \big[*%M/1]_(m2 <= j < n2 | xQ j) \big[*%M/1]_(m1 <= i < n1 | P i && Q i j) F i j. Proof. move=> PQxQ; under eq_bigr do rewrite big_seq_cond. rewrite big_seq_cond /= (exchange_big_dep xQ) => [|i j]; last first. by rewrite !mem_index_iota => /andP[mn_i Pi] /andP[mn_j /PQxQ->]. rewrite 2!(big_seq_cond _ _ _ xQ); apply: eq_bigr => j /andP[-> _] /=. by rewrite [rhs in _ = rhs]big_seq_cond; apply: eq_bigl => i; rewrite -andbA. Qed. Arguments exchange_big_dep_nat [m1 n1 m2 n2 P Q] xQ [F]. Lemma exchange_big_nat m1 n1 m2 n2 (P Q : pred nat) F : \big[*%M/1]_(m1 <= i < n1 | P i) \big[*%M/1]_(m2 <= j < n2 | Q j) F i j = \big[*%M/1]_(m2 <= j < n2 | Q j) \big[*%M/1]_(m1 <= i < n1 | P i) F i j. Proof. rewrite (exchange_big_dep_nat Q) //. by under eq_bigr => i Qi do under eq_bigl do rewrite Qi andbT. Qed. End Abelian. End MonoidProperties. Arguments big_filter [R idx op I]. Arguments big_filter_cond [R idx op I]. Arguments congr_big [R idx op I r1] r2 [P1] P2 [F1] F2. Arguments eq_big [R idx op I r P1] P2 [F1] F2. Arguments eq_bigl [R idx op I r P1] P2. Arguments eq_bigr [R idx op I r P F1] F2. Arguments eq_big_idx [R idx op idx' I] i0 [P F]. Arguments big_seq_cond [R idx op I r]. Arguments eq_big_seq [R idx op I r F1] F2. Arguments congr_big_nat [R idx op m1 n1] m2 n2 [P1] P2 [F1] F2. Arguments big_map [R idx op I J] h [r]. Arguments big_nth [R idx op I] x0 [r]. Arguments big_catl [R idx op I r1 r2 P F]. Arguments big_catr [R idx op I r1 r2 P F]. Arguments big_geq [R idx op m n P F]. Arguments big_ltn_cond [R idx op m n P F]. Arguments big_ltn [R idx op m n F]. Arguments big_addn [R idx op]. Arguments big_mkord [R idx op n]. Arguments big_nat_widen [R idx op] . Arguments big_ord_widen_cond [R idx op n1]. Arguments big_ord_widen [R idx op n1]. Arguments big_ord_widen_leq [R idx op n1]. Arguments big_ord_narrow_cond [R idx op n1 n2 P F]. Arguments big_ord_narrow_cond_leq [R idx op n1 n2 P F]. Arguments big_ord_narrow [R idx op n1 n2 F]. Arguments big_ord_narrow_leq [R idx op n1 n2 F]. Arguments big_mkcond [R idx op I r]. Arguments big1_eq [R idx op I]. Arguments big1_seq [R idx op I]. Arguments big1 [R idx op I]. Arguments big_pred1 [R idx op I] i [P F]. Arguments perm_big [R idx op I r1] r2 [P F]. Arguments big_uniq [R idx op I] r [F]. Arguments big_rem [R idx op I r] x [P F]. Arguments bigID [R idx op I r]. Arguments bigU [R idx op I]. Arguments bigD1 [R idx op I] j [P F]. Arguments bigD1_seq [R idx op I r] j [F]. Arguments bigD1_ord [R idx op n] j [P F]. Arguments partition_big [R idx op I J P] p Q [F]. Arguments reindex_omap [R idx op I J] h h' [P F]. Arguments reindex_onto [R idx op I J] h h' [P F]. Arguments reindex [R idx op I J] h [P F]. Arguments reindex_inj [R idx op I h P F]. Arguments big_enum_val_cond [R idx op I A] P F. Arguments big_enum_rank_cond [R idx op I A x] xA P F. Arguments big_enum_val [R idx op I A] F. Arguments big_enum_rank [R idx op I A x] xA F. Arguments sig_big_dep [R idx op I J]. Arguments pair_big_dep [R idx op I J]. Arguments pair_big [R idx op I J]. Arguments big_allpairs_dep {R idx op I1 I2 J h r1 r2 F}. Arguments big_allpairs {R idx op I1 I2 r1 r2 F}. Arguments exchange_big_dep [R idx op I J rI rJ P Q] xQ [F]. Arguments exchange_big_dep_nat [R idx op m1 n1 m2 n2 P Q] xQ [F]. Arguments big_ord_recl [R idx op]. Arguments big_ord_recr [R idx op]. Arguments big_nat_recl [R idx op]. Arguments big_nat_recr [R idx op]. Section Distributivity. Import Monoid.Theory. Variable R : Type. Variables zero one : R. Local Notation "0" := zero. Local Notation "1" := one. Variable times : Monoid.mul_law 0. Local Notation "*%M" := times (at level 0). Local Notation "x * y" := (times x y). Variable plus : Monoid.add_law 0 *%M. Local Notation "+%M" := plus (at level 0). Local Notation "x + y" := (plus x y). Lemma big_distrl I r a (P : pred I) F : \big[+%M/0]_(i <- r | P i) F i * a = \big[+%M/0]_(i <- r | P i) (F i * a). Proof. by rewrite (big_endo ( *%M^~ a)) ?mul0m // => x y; apply: mulmDl. Qed. Lemma big_distrr I r a (P : pred I) F : a * \big[+%M/0]_(i <- r | P i) F i = \big[+%M/0]_(i <- r | P i) (a * F i). Proof. by rewrite big_endo ?mulm0 // => x y; apply: mulmDr. Qed. Lemma big_distrlr I J rI rJ (pI : pred I) (pJ : pred J) F G : (\big[+%M/0]_(i <- rI | pI i) F i) * (\big[+%M/0]_(j <- rJ | pJ j) G j) = \big[+%M/0]_(i <- rI | pI i) \big[+%M/0]_(j <- rJ | pJ j) (F i * G j). Proof. by rewrite big_distrl; under eq_bigr do rewrite big_distrr. Qed. Lemma big_distr_big_dep (I J : finType) j0 (P : pred I) (Q : I -> pred J) F : \big[*%M/1]_(i | P i) \big[+%M/0]_(j | Q i j) F i j = \big[+%M/0]_(f in pfamily j0 P Q) \big[*%M/1]_(i | P i) F i (f i). Proof. pose fIJ := {ffun I -> J}; pose Pf := pfamily j0 (_ : seq I) Q. have [r big_r [Ur mem_r] _] := big_enumP P. symmetry; transitivity (\big[+%M/0]_(f in Pf r) \big[*%M/1]_(i <- r) F i (f i)). by apply: eq_big => // f; apply: eq_forallb => i; rewrite /= mem_r. rewrite -{P mem_r}big_r; elim: r Ur => /= [_ | i r IHr]. rewrite (big_pred1 [ffun=> j0]) ?big_nil //= => f. apply/familyP/eqP=> /= [Df |->{f} i]; last by rewrite ffunE !inE. by apply/ffunP=> i; rewrite ffunE; apply/eqP/Df. case/andP=> /negbTE nri; rewrite big_cons big_distrl => {}/IHr<-. rewrite (partition_big (fun f : fIJ => f i) (Q i)) => [|f]; last first. by move/familyP/(_ i); rewrite /= inE /= eqxx. pose seti j (f : fIJ) := [ffun k => if k == i then j else f k]. apply: eq_bigr => j Qij. rewrite (reindex_onto (seti j) (seti j0)) => [|f /andP[_ /eqP fi]]; last first. by apply/ffunP=> k; rewrite !ffunE; case: eqP => // ->. rewrite big_distrr; apply: eq_big => [f | f eq_f]; last first. rewrite big_cons ffunE eqxx !big_seq; congr (_ * _). by apply: eq_bigr => k; rewrite ffunE; case: eqP nri => // -> ->. rewrite !ffunE !eqxx andbT; apply/andP/familyP=> /= [[Pjf fij0] k | Pff]. have:= familyP Pjf k; rewrite /= ffunE inE; case: eqP => // -> _. by rewrite nri -(eqP fij0) !ffunE !inE !eqxx. split; [apply/familyP | apply/eqP/ffunP] => k; have:= Pff k; rewrite !ffunE. by rewrite inE; case: eqP => // ->. by case: eqP => // ->; rewrite nri /= => /eqP. Qed. Lemma big_distr_big (I J : finType) j0 (P : pred I) (Q : pred J) F : \big[*%M/1]_(i | P i) \big[+%M/0]_(j | Q j) F i j = \big[+%M/0]_(f in pffun_on j0 P Q) \big[*%M/1]_(i | P i) F i (f i). Proof. rewrite (big_distr_big_dep j0); apply: eq_bigl => f. by apply/familyP/familyP=> Pf i; case: ifP (Pf i). Qed. Lemma bigA_distr_big_dep (I J : finType) (Q : I -> pred J) F : \big[*%M/1]_i \big[+%M/0]_(j | Q i j) F i j = \big[+%M/0]_(f in family Q) \big[*%M/1]_i F i (f i). Proof. have [j _ | J0] := pickP J; first by rewrite (big_distr_big_dep j). have Q0 i: Q i =i pred0 by move=> /J0/esym/notF[]. transitivity (iter #|I| ( *%M 0) 1). by rewrite -big_const; apply/eq_bigr=> i; have /(big_pred0 _)-> := Q0 i. have [i _ | I0] := pickP I. rewrite (cardD1 i) //= mul0m big_pred0 // => f. by apply/familyP=> /(_ i); rewrite Q0. have f: I -> J by move=> /I0/esym/notF[]. rewrite eq_card0 // (big_pred1 (finfun f)) ?big_pred0 // => g. by apply/familyP/eqP=> _; first apply/ffunP; move=> /I0/esym/notF[]. Qed. Lemma bigA_distr_big (I J : finType) (Q : pred J) (F : I -> J -> R) : \big[*%M/1]_i \big[+%M/0]_(j | Q j) F i j = \big[+%M/0]_(f in ffun_on Q) \big[*%M/1]_i F i (f i). Proof. exact: bigA_distr_big_dep. Qed. Lemma bigA_distr_bigA (I J : finType) F : \big[*%M/1]_(i : I) \big[+%M/0]_(j : J) F i j = \big[+%M/0]_(f : {ffun I -> J}) \big[*%M/1]_i F i (f i). Proof. by rewrite bigA_distr_big; apply: eq_bigl => ?; apply/familyP. Qed. End Distributivity. Arguments big_distrl [R zero times plus I r]. Arguments big_distrr [R zero times plus I r]. Arguments big_distr_big_dep [R zero one times plus I J]. Arguments big_distr_big [R zero one times plus I J]. Arguments bigA_distr_big_dep [R zero one times plus I J]. Arguments bigA_distr_big [R zero one times plus I J]. Arguments bigA_distr_bigA [R zero one times plus I J]. Section BigBool. Section Seq. Variables (I : Type) (r : seq I) (P B : pred I). Lemma big_has : \big[orb/false]_(i <- r) B i = has B r. Proof. by rewrite unlock. Qed. Lemma big_all : \big[andb/true]_(i <- r) B i = all B r. Proof. by rewrite unlock. Qed. Lemma big_has_cond : \big[orb/false]_(i <- r | P i) B i = has (predI P B) r. Proof. by rewrite big_mkcond unlock. Qed. Lemma big_all_cond : \big[andb/true]_(i <- r | P i) B i = all [pred i | P i ==> B i] r. Proof. by rewrite big_mkcond unlock. Qed. End Seq. Section FinType. Variables (I : finType) (P B : pred I). Lemma big_orE : \big[orb/false]_(i | P i) B i = [exists (i | P i), B i]. Proof. by rewrite big_has_cond; apply/hasP/existsP=> [] [i]; exists i. Qed. Lemma big_andE : \big[andb/true]_(i | P i) B i = [forall (i | P i), B i]. Proof. rewrite big_all_cond; apply/allP/forallP=> /= allB i; rewrite allB //. exact: mem_index_enum. Qed. End FinType. End BigBool. Section NatConst. Variables (I : finType) (A : pred I). Lemma sum_nat_const n : \sum_(i in A) n = #|A| * n. Proof. by rewrite big_const iter_addn_0 mulnC. Qed. Lemma sum1_card : \sum_(i in A) 1 = #|A|. Proof. by rewrite sum_nat_const muln1. Qed. Lemma sum1_count J (r : seq J) (a : pred J) : \sum_(j <- r | a j) 1 = count a r. Proof. by rewrite big_const_seq iter_addn_0 mul1n. Qed. Lemma sum1_size J (r : seq J) : \sum_(j <- r) 1 = size r. Proof. by rewrite sum1_count count_predT. Qed. Lemma prod_nat_const n : \prod_(i in A) n = n ^ #|A|. Proof. by rewrite big_const -Monoid.iteropE. Qed. Lemma sum_nat_const_nat n1 n2 n : \sum_(n1 <= i < n2) n = (n2 - n1) * n. Proof. by rewrite big_const_nat iter_addn_0 mulnC. Qed. Lemma prod_nat_const_nat n1 n2 n : \prod_(n1 <= i < n2) n = n ^ (n2 - n1). Proof. by rewrite big_const_nat -Monoid.iteropE. Qed. End NatConst. Lemma sumnE r : sumn r = \sum_(i <- r) i. Proof. exact: foldrE. Qed. Lemma leqif_sum (I : finType) (P C : pred I) (E1 E2 : I -> nat) : (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. by elim/big_rec3: _ => // i Ci m1 m2 /leE12; apply: leqif_add. Qed. Lemma leq_sum I r (P : pred I) (E1 E2 : I -> nat) : (forall i, P i -> E1 i <= E2 i) -> \sum_(i <- r | P i) E1 i <= \sum_(i <- r | P i) E2 i. Proof. by move=> leE12; elim/big_ind2: _ => // m1 m2 n1 n2; apply: leq_add. Qed. Lemma sum_nat_eq0 (I : finType) (P : pred I) (E : I -> nat) : (\sum_(i | P i) E i == 0)%N = [forall (i | P i), E i == 0%N]. Proof. by rewrite eq_sym -(@leqif_sum I P _ (fun _ => 0%N) E) ?big1_eq. Qed. Lemma prodn_cond_gt0 I r (P : pred I) F : (forall i, P i -> 0 < F i) -> 0 < \prod_(i <- r | P i) F i. Proof. by move=> Fpos; elim/big_ind: _ => // n1 n2; rewrite muln_gt0 => ->. Qed. Lemma prodn_gt0 I r (P : pred I) F : (forall i, 0 < F i) -> 0 < \prod_(i <- r | P i) F i. Proof. by move=> Fpos; apply: prodn_cond_gt0. Qed. Lemma leq_bigmax_cond (I : finType) (P : pred I) F i0 : P i0 -> F i0 <= \max_(i | P i) F i. Proof. by move=> Pi0; rewrite (bigD1 i0) ?leq_maxl. Qed. Arguments leq_bigmax_cond [I P F]. Lemma leq_bigmax (I : finType) F (i0 : I) : F i0 <= \max_i F i. Proof. exact: leq_bigmax_cond. Qed. Arguments leq_bigmax [I F]. Lemma bigmax_leqP (I : finType) (P : pred I) m F : reflect (forall i, P i -> F i <= m) (\max_(i | P i) F i <= m). Proof. apply: (iffP idP) => leFm => [i Pi|]. by apply: leq_trans leFm; apply: leq_bigmax_cond. by elim/big_ind: _ => // m1 m2; rewrite geq_max => ->. Qed. Lemma bigmax_sup (I : finType) i0 (P : pred I) m F : P i0 -> m <= F i0 -> m <= \max_(i | P i) F i. Proof. by move=> Pi0 le_m_Fi0; apply: leq_trans (leq_bigmax_cond i0 Pi0). Qed. Arguments bigmax_sup [I] i0 [P m F]. Lemma bigmax_eq_arg (I : finType) i0 (P : pred I) F : P i0 -> \max_(i | P i) F i = F [arg max_(i > i0 | P i) F i]. Proof. move=> Pi0; case: arg_maxnP => //= i Pi maxFi. by apply/eqP; rewrite eqn_leq leq_bigmax_cond // andbT; apply/bigmax_leqP. Qed. Arguments bigmax_eq_arg [I] i0 [P F]. Lemma eq_bigmax_cond (I : finType) (A : pred I) F : #|A| > 0 -> {i0 | i0 \in A & \max_(i in A) F i = F i0}. Proof. case: (pickP A) => [i0 Ai0 _ | ]; last by move/eq_card0->. by exists [arg max_(i > i0 in A) F i]; [case: arg_maxnP | apply: bigmax_eq_arg]. Qed. Lemma eq_bigmax (I : finType) F : #|I| > 0 -> {i0 : I | \max_i F i = F i0}. Proof. by case/(eq_bigmax_cond F) => x _ ->; exists x. Qed. Lemma expn_sum m I r (P : pred I) F : (m ^ (\sum_(i <- r | P i) F i) = \prod_(i <- r | P i) m ^ F i)%N. Proof. exact: (big_morph _ (expnD m)). Qed. Lemma dvdn_biglcmP (I : finType) (P : pred I) F m : reflect (forall i, P i -> F i %| m) (\big[lcmn/1%N]_(i | P i) F i %| m). Proof. apply: (iffP idP) => [dvFm i Pi | dvFm]. by rewrite (bigD1 i) // dvdn_lcm in dvFm; case/andP: dvFm. by elim/big_ind: _ => // p q p_m; rewrite dvdn_lcm p_m. Qed. Lemma biglcmn_sup (I : finType) i0 (P : pred I) F m : P i0 -> m %| F i0 -> m %| \big[lcmn/1%N]_(i | P i) F i. Proof. by move=> Pi0 m_Fi0; rewrite (dvdn_trans m_Fi0) // (bigD1 i0) ?dvdn_lcml. Qed. Arguments biglcmn_sup [I] i0 [P F m]. Lemma dvdn_biggcdP (I : finType) (P : pred I) F m : reflect (forall i, P i -> m %| F i) (m %| \big[gcdn/0]_(i | P i) F i). Proof. apply: (iffP idP) => [dvmF i Pi | dvmF]. by rewrite (bigD1 i) // dvdn_gcd in dvmF; case/andP: dvmF. by elim/big_ind: _ => // p q m_p; rewrite dvdn_gcd m_p. Qed. Lemma biggcdn_inf (I : finType) i0 (P : pred I) F m : P i0 -> F i0 %| m -> \big[gcdn/0]_(i | P i) F i %| m. Proof. by move=> Pi0; apply: dvdn_trans; rewrite (bigD1 i0) ?dvdn_gcdl. Qed. Arguments biggcdn_inf [I] i0 [P F m]. Notation filter_index_enum := ((fun _ => @deprecated_filter_index_enum _) (deprecate filter_index_enum big_enumP)) (only parsing). Notation big_rmcond := ((fun _ _ _ _ => @big_rmcond_in _ _ _ _) (deprecate big_rmcond big_rmcond_in)) (only parsing). Notation big_uncond_in := ((fun _ _ _ _ => @big_rmcond_in _ _ _ _) (deprecate big_uncond_in big_rmcond_in)) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/binomial.v000066400000000000000000000577251375767750300231150ustar00rootroot00000000000000(* (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 div fintype tuple finfun bigop prime finset. (******************************************************************************) (* This files contains the definition of: *) (* 'C(n, m) == the binomial coefficient n choose m. *) (* n ^_ m == the falling (or lower) factorial of n with m terms, i.e., *) (* the product n * (n - 1) * ... * (n - m + 1). *) (* Note that n ^_ m = 0 if m > n, and 'C(n, m) = n ^_ m %/ m`!. *) (* *) (* In additions to the properties of these functions, we prove a few seminal *) (* results such as triangular_sum, Wilson and Pascal; their proofs are good *) (* examples of how to manipulate expressions with bigops. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (** More properties of the factorial **) Lemma fact_smonotone m n : 0 < m -> m < n -> m`! < n`!. Proof. case: m => // m _; elim: n m => // n IHn [|m] lt_m_n. by rewrite -[_.+1]muln1 leq_mul ?fact_gt0. by rewrite ltn_mul ?IHn. Qed. Lemma fact_prod n : n`! = \prod_(1 <= i < n.+1) i. Proof. elim: n => [|n IHn] //; first by rewrite big_nil. by apply/esym; rewrite factS IHn // !big_add1 big_nat_recr //= mulnC. Qed. Lemma logn_fact p n : prime p -> logn p n`! = \sum_(1 <= k < n.+1) n %/ p ^ k. Proof. move=> p_prime; transitivity (\sum_(1 <= i < n.+1) logn p i). rewrite big_add1; elim: n => /= [|n IHn]; first by rewrite logn1 big_geq. by rewrite big_nat_recr // -IHn /= factS mulnC lognM ?fact_gt0. transitivity (\sum_(1 <= i < n.+1) \sum_(1 <= k < n.+1) (p ^ k %| i)). apply: eq_big_nat => i /andP[i_gt0 le_i_n]; rewrite logn_count_dvd //. rewrite -!big_mkcond (big_nat_widen _ _ n.+1) 1?ltnW //; apply: eq_bigl => k. by apply: andb_idr => /dvdn_leq/(leq_trans (ltn_expl _ (prime_gt1 _)))->. by rewrite exchange_big_nat; apply: eq_bigr => i _; rewrite divn_count_dvd. Qed. Theorem Wilson p : p > 1 -> prime p = (p %| ((p.-1)`!).+1). Proof. have dFact n: 0 < n -> (n.-1)`! = \prod_(0 <= i < n | i != 0) i. move=> n_gt0; rewrite -big_filter fact_prod; symmetry; apply: congr_big => //. rewrite /index_iota subn1 -[n]prednK //=; apply/all_filterP. by rewrite all_predC has_pred1 mem_iota. move=> lt1p; have p_gt0 := ltnW lt1p. apply/idP/idP=> [pr_p | dv_pF]; last first. apply/primeP; split=> // d dv_dp; have: d <= p by apply: dvdn_leq. rewrite orbC leq_eqVlt => /orP[-> // | ltdp]. have:= dvdn_trans dv_dp dv_pF; rewrite dFact // big_mkord. rewrite (bigD1 (Ordinal ltdp)) /=; last by rewrite -lt0n (dvdn_gt0 p_gt0). by rewrite orbC -addn1 dvdn_addr ?dvdn_mulr // dvdn1 => ->. pose Fp1 := Ordinal lt1p; pose Fp0 := Ordinal p_gt0. have ltp1p: p.-1 < p by [rewrite prednK]; pose Fpn1 := Ordinal ltp1p. case eqF1n1: (Fp1 == Fpn1); first by rewrite -{1}[p]prednK -1?((1 =P p.-1) _). have toFpP m: m %% p < p by rewrite ltn_mod. pose toFp := Ordinal (toFpP _); pose mFp (i j : 'I_p) := toFp (i * j). have Fp_mod (i : 'I_p) : i %% p = i by apply: modn_small. have mFpA: associative mFp. by move=> i j k; apply: val_inj; rewrite /= modnMml modnMmr mulnA. have mFpC: commutative mFp by move=> i j; apply: val_inj; rewrite /= mulnC. have mFp1: left_id Fp1 mFp by move=> i; apply: val_inj; rewrite /= mul1n. have mFp1r: right_id Fp1 mFp by move=> i; apply: val_inj; rewrite /= muln1. pose mFpLaw := Monoid.Law mFpA mFp1 mFp1r. pose mFpM := Monoid.operator (@Monoid.ComLaw _ _ mFpLaw mFpC). pose vFp (i : 'I_p) := toFp (egcdn i p).1. have vFpV i: i != Fp0 -> mFp (vFp i) i = Fp1. rewrite -val_eqE /= -lt0n => i_gt0; apply: val_inj => /=. rewrite modnMml; case: egcdnP => //= _ km -> _; rewrite {km}modnMDl. suffices: coprime i p by move/eqnP->; rewrite modn_small. rewrite coprime_sym prime_coprime //; apply/negP=> /(dvdn_leq i_gt0). by rewrite leqNgt ltn_ord. have vFp0 i: i != Fp0 -> vFp i != Fp0. by move/vFpV; apply/contra_eq_neq => ->; rewrite -val_eqE /= mul0n mod0n. have vFpK: {in predC1 Fp0, involutive vFp}. move=> i n0i; rewrite /= -[vFp _]mFp1r -(vFpV _ n0i) mFpA. by rewrite vFpV (vFp0, mFp1). have le_pmFp (i : 'I_p) m: i <= p + m. by apply: leq_trans (ltnW _) (leq_addr _ _). have eqFp (i j : 'I_p): (i == j) = (p %| p + i - j). by rewrite -eqn_mod_dvd ?(modnDl, Fp_mod). have vFpId i: (vFp i == i :> nat) = xpred2 Fp1 Fpn1 i. have [->{i} | ni0] := eqVneq i Fp0. by rewrite -!val_eqE /= egcd0n modn_small //= -(subnKC lt1p). rewrite 2!eqFp -Euclid_dvdM // -[_ - p.-1]subSS prednK //. have lt0i: 0 < i by rewrite lt0n. rewrite -addnS addKn -addnBA // mulnDl -{2}(addn1 i) -subn_sqr. rewrite addnBA ?leq_sqr // mulnS -addnA -mulnn -mulnDl. rewrite -(subnK (le_pmFp (vFp i) i)) mulnDl addnCA. rewrite -[1 ^ 2]/(Fp1 : nat) -addnBA // dvdn_addl. by rewrite Euclid_dvdM // -eqFp eq_sym orbC /dvdn Fp_mod eqn0Ngt lt0i. by rewrite -eqn_mod_dvd // Fp_mod modnDl -(vFpV _ ni0). suffices [mod_fact]: toFp (p.-1)`! = Fpn1. by rewrite /dvdn -addn1 -modnDml mod_fact addn1 prednK // modnn. rewrite dFact //; rewrite ((big_morph toFp) Fp1 mFpM) //; first last. - by apply: val_inj; rewrite /= modn_small. - by move=> i j; apply: val_inj; rewrite /= modnMm. rewrite big_mkord (eq_bigr id) => [|i _]; last by apply: val_inj => /=. pose ltv i := vFp i < i; rewrite (bigID ltv) -/mFpM [mFpM _ _]mFpC. rewrite (bigD1 Fp1) -/mFpM; last by rewrite [ltv _]ltn_neqAle vFpId. rewrite [mFpM _ _]mFp1 (bigD1 Fpn1) -?mFpA -/mFpM; last first. rewrite -lt0n -ltnS prednK // lt1p. by rewrite [ltv _]ltn_neqAle vFpId eqxx orbT eq_sym eqF1n1. rewrite (reindex_onto vFp vFp) -/mFpM => [|i]; last by do 3!case/andP; auto. rewrite (eq_bigl (xpredD1 ltv Fp0)) => [|i]; last first. rewrite andbC -!andbA -2!negb_or -vFpId orbC -leq_eqVlt -ltnNge. have [->|ni0] := eqVneq i; last by rewrite vFpK // eqxx vFp0. by case: eqP => // ->; rewrite !andbF. rewrite -{2}[mFp]/mFpM -[mFpM _ _]big_split -/mFpM. by rewrite big1 ?mFp1r //= => i /andP [/vFpV]. Qed. (** The falling factorial *) Fixpoint ffact_rec n m := if m is m'.+1 then n * ffact_rec n.-1 m' else 1. Definition falling_factorial := nosimpl ffact_rec. Notation "n ^_ m" := (falling_factorial n m) (at level 30, right associativity) : nat_scope. Lemma ffactE : falling_factorial = ffact_rec. Proof. by []. Qed. Lemma ffactn0 n : n ^_ 0 = 1. Proof. by []. Qed. Lemma ffact0n m : 0 ^_ m = (m == 0). Proof. by case: m. Qed. Lemma ffactnS n m : n ^_ m.+1 = n * n.-1 ^_ m. Proof. by []. Qed. Lemma ffactSS n m : n.+1 ^_ m.+1 = n.+1 * n ^_ m. Proof. by []. Qed. Lemma ffactn1 n : n ^_ 1 = n. Proof. exact: muln1. Qed. Lemma ffactnSr n m : n ^_ m.+1 = n ^_ m * (n - m). Proof. elim: n m => [|n IHn] [|m] //=; first by rewrite ffactn1 mul1n. by rewrite !ffactSS IHn mulnA. Qed. Lemma ffact_prod n m : n ^_ m = \prod_(i < m) (n - i). Proof. elim: m n => [n | m IH [|n] //]; first by rewrite ffactn0 big_ord0. by rewrite big_ord_recr /= sub0n muln0. by rewrite ffactSS IH big_ord_recl subn0. Qed. Lemma ffact_gt0 n m : (0 < n ^_ m) = (m <= n). Proof. by elim: n m => [|n IHn] [|m] //=; rewrite ffactSS muln_gt0 IHn. Qed. Lemma ffact_small n m : n < m -> n ^_ m = 0. Proof. by rewrite ltnNge -ffact_gt0; case: posnP. Qed. Lemma ffactnn n : n ^_ n = n`!. Proof. by elim: n => [|n IHn] //; rewrite ffactnS IHn. Qed. Lemma ffact_fact n m : m <= n -> n ^_ m * (n - m)`! = n`!. Proof. by elim: n m => [|n IHn] [|m] //= le_m_n; rewrite ?mul1n // -mulnA IHn. Qed. Lemma ffact_factd n m : m <= n -> n ^_ m = n`! %/ (n - m)`!. Proof. by move/ffact_fact <-; rewrite mulnK ?fact_gt0. Qed. (** Binomial coefficients *) Fixpoint binomial_rec n m := match n, m with | n'.+1, m'.+1 => binomial_rec n' m + binomial_rec n' m' | _, 0 => 1 | 0, _.+1 => 0 end. Arguments binomial_rec : simpl nomatch. Definition binomial := nosimpl binomial_rec. Notation "''C' ( n , m )" := (binomial n m) (at level 8, format "''C' ( n , m )") : nat_scope. Lemma binE : binomial = binomial_rec. Proof. by []. Qed. Lemma bin0 n : 'C(n, 0) = 1. Proof. by case: n. Qed. Lemma bin0n m : 'C(0, m) = (m == 0). Proof. by case: m. Qed. Lemma binS n m : 'C(n.+1, m.+1) = 'C(n, m.+1) + 'C(n, m). Proof. by []. Qed. Lemma bin1 n : 'C(n, 1) = n. Proof. by elim: n => //= n IHn; rewrite binS bin0 IHn addn1. Qed. Lemma bin_gt0 n m : (0 < 'C(n, m)) = (m <= n). Proof. by elim: n m => [|n IHn] [|m] //; rewrite addn_gt0 !IHn orbC ltn_neqAle andKb. Qed. Lemma leq_bin2l n1 n2 m : n1 <= n2 -> 'C(n1, m) <= 'C(n2, m). Proof. by elim: n1 n2 m => [|n1 IHn] [|n2] [|n] le_n12 //; rewrite leq_add ?IHn. Qed. Lemma bin_small n m : n < m -> 'C(n, m) = 0. Proof. by rewrite ltnNge -bin_gt0; case: posnP. Qed. Lemma binn n : 'C(n, n) = 1. Proof. by elim: n => [|n IHn] //; rewrite binS bin_small. Qed. (* Multiply to move diagonally down and right in the Pascal triangle. *) Lemma mul_bin_diag n m : n * 'C(n.-1, m) = m.+1 * 'C(n, m.+1). Proof. rewrite [RHS]mulnC; elim: n m => [|[|n] IHn] [|m] //=; first by rewrite bin1. by rewrite mulSn [in _ * _]binS mulnDr addnCA !IHn -mulnS -mulnDl -binS. Qed. Lemma bin_fact n m : m <= n -> 'C(n, m) * (m`! * (n - m)`!) = n`!. Proof. elim: n m => [|n IHn] [|m] // le_m_n; first by rewrite bin0 !mul1n. by rewrite !factS -!mulnA mulnCA mulnA -mul_bin_diag -mulnA IHn. Qed. (* In fact the only exception for bin_factd is n = 0 and m = 1 *) Lemma bin_factd n m : 0 < n -> 'C(n, m) = n`! %/ (m`! * (n - m)`!). Proof. have [/bin_fact<-|*] := leqP m n; first by rewrite mulnK ?muln_gt0 ?fact_gt0. by rewrite divnMA bin_small ?divn_small ?fact_gt0 ?fact_smonotone. Qed. Lemma bin_ffact n m : 'C(n, m) * m`! = n ^_ m. Proof. have [lt_n_m | le_m_n] := ltnP n m; first by rewrite bin_small ?ffact_small. by rewrite ffact_factd // -(bin_fact le_m_n) mulnA mulnK ?fact_gt0. Qed. Lemma bin_ffactd n m : 'C(n, m) = n ^_ m %/ m`!. Proof. by rewrite -bin_ffact mulnK ?fact_gt0. Qed. Lemma bin_sub n m : m <= n -> 'C(n, n - m) = 'C(n, m). Proof. by move=> le_m_n; rewrite !bin_ffactd !ffact_factd ?leq_subr // divnAC subKn. Qed. (* Multiply to move down in the Pascal triangle. *) Lemma mul_bin_down n m : n * 'C(n.-1, m) = (n - m) * 'C(n, m). Proof. case: n => //= n; have [lt_n_m | le_m_n] := ltnP n m. by rewrite (eqnP lt_n_m) mulnC bin_small. by rewrite -!['C(_, m)]bin_sub ?leqW ?subSn ?mul_bin_diag. Qed. (* Multiply to move left in the Pascal triangle. *) Lemma mul_bin_left n m : m.+1 * 'C(n, m.+1) = (n - m) * 'C(n, m). Proof. by rewrite -mul_bin_diag mul_bin_down. Qed. Lemma binSn n : 'C(n.+1, n) = n.+1. Proof. by rewrite -bin_sub ?leqnSn // subSnn bin1. Qed. Lemma bin2 n : 'C(n, 2) = (n * n.-1)./2. Proof. by rewrite -[n.-1]bin1 mul_bin_diag -divn2 mulKn. Qed. Lemma bin2odd n : odd n -> 'C(n, 2) = n * n.-1./2. Proof. by case: n => // n oddn; rewrite bin2 -!divn2 muln_divA ?dvdn2. Qed. Lemma prime_dvd_bin k p : prime p -> 0 < k < p -> p %| 'C(p, k). Proof. move=> p_pr /andP[k_gt0 lt_k_p]. suffices /Gauss_dvdr<-: coprime p (p - k) by rewrite -mul_bin_down dvdn_mulr. by rewrite prime_coprime // dvdn_subr 1?ltnW // gtnNdvd. Qed. Lemma triangular_sum n : \sum_(0 <= i < n) i = 'C(n, 2). Proof. elim: n => [|n IHn]; first by rewrite big_geq. by rewrite big_nat_recr // IHn binS bin1. Qed. Lemma textbook_triangular_sum n : \sum_(0 <= i < n) i = 'C(n, 2). Proof. rewrite bin2; apply: canRL half_double _. rewrite -addnn {1}big_nat_rev -big_split big_mkord /= ?add0n. rewrite (eq_bigr (fun _ => n.-1)); first by rewrite sum_nat_const card_ord. by case: n => [|n] [i le_i_n] //=; rewrite subSS subnK. Qed. Theorem Pascal a b n : (a + b) ^ n = \sum_(i < n.+1) 'C(n, i) * (a ^ (n - i) * b ^ i). Proof. elim: n => [|n IHn]; rewrite big_ord_recl muln1 ?big_ord0 //. rewrite expnS {}IHn /= mulnDl !big_distrr /= big_ord_recl muln1 subn0. rewrite !big_ord_recr /= !binn !subnn bin0 !subn0 !mul1n -!expnS -addnA. congr (_ + _); rewrite addnA -big_split /=; congr (_ + _). apply: eq_bigr => i _; rewrite mulnCA (mulnA a) -expnS subnSK //=. by rewrite (mulnC b) -2!mulnA -expnSr -mulnDl. Qed. Definition expnDn := Pascal. Lemma Vandermonde k l i : \sum_(j < i.+1) 'C(k, j) * 'C(l, i - j) = 'C(k + l , i). Proof. pose f k i := \sum_(j < i.+1) 'C(k, j) * 'C(l, i - j). suffices{k i} fxx k i: f k.+1 i.+1 = f k i.+1 + f k i. elim: k i => [i | k IHk [|i]]; last by rewrite -/(f _ _) fxx /f !IHk -binS. by rewrite big_ord_recl big1_eq addn0 mul1n subn0. by rewrite big_ord_recl big_ord0 addn0 !bin0 muln1. rewrite {}/f big_ord_recl (big_ord_recl (i.+1)) !bin0 !mul1n. rewrite -addnA -big_split /=; congr (_ + _). by apply: eq_bigr => j _; rewrite -mulnDl. Qed. Lemma subn_exp m n k : m ^ k - n ^ k = (m - n) * (\sum_(i < k) m ^ (k.-1 -i) * n ^ i). Proof. case: k => [|k]; first by rewrite big_ord0 muln0. rewrite mulnBl !big_distrr big_ord_recl big_ord_recr /= subn0 muln1. rewrite subnn mul1n -!expnS subnDA; congr (_ - _); apply: canRL (addnK _) _. congr (_ + _); apply: eq_bigr => i _. by rewrite (mulnCA n) -expnS mulnA -expnS subnSK /=. Qed. Lemma predn_exp m k : (m ^ k).-1 = m.-1 * (\sum_(i < k) m ^ i). Proof. rewrite -!subn1 -[in LHS](exp1n k) subn_exp; congr (_ * _). symmetry; rewrite (reindex_inj rev_ord_inj); apply: eq_bigr => i _ /=. by rewrite -subn1 -subnDA exp1n muln1. Qed. Lemma dvdn_pred_predX n e : (n.-1 %| (n ^ e).-1)%N. Proof. by rewrite predn_exp dvdn_mulr. Qed. Lemma modn_summ I r (P : pred I) F d : \sum_(i <- r | P i) F i %% d = \sum_(i <- r | P i) F i %[mod d]. Proof. by apply/eqP; elim/big_rec2: _ => // i m n _; rewrite modnDml eqn_modDl. Qed. Lemma prime_modn_expSn p n : prime p -> n.+1 ^ p = (n ^ p).+1 %[mod p]. Proof. case: p => // p pP. rewrite -[(_ ^ _).+1]addn0 (expnDn 1) big_ord_recr big_ord_recl /=. rewrite subnn binn exp1n !mul1n addnAC -modnDmr; congr ((_ + _) %% _). apply/eqP/dvdn_sum => -[i ?] _; exact/dvdn_mulr/prime_dvd_bin. Qed. Lemma fermat_little a p : prime p -> a ^ p = a %[mod p]. Proof. move=> pP. elim: a => [|a IH]; first by rewrite exp0n // prime_gt0. by rewrite prime_modn_expSn // -addn1 -modnDml IH modnDml addn1. Qed. (* Combinatorial characterizations. *) Section Combinations. Implicit Types T D : finType. Lemma card_uniq_tuples T n (A : pred T) : #|[set t : n.-tuple T | all A t & uniq t]| = #|A| ^_ n. Proof. elim: n A => [|n IHn] A. by rewrite (@eq_card1 _ [tuple]) // => t; rewrite [t]tuple0 inE. rewrite -sum1dep_card (partition_big (@thead _ _) A) /= => [|t]; last first. by case/tupleP: t => x t; do 2!case/andP. rewrite ffactnS -sum_nat_const; apply: eq_bigr => x Ax. rewrite (cardD1 x) [x \in A]Ax /= -(IHn [predD1 A & x]) -sum1dep_card. rewrite (reindex (fun t : n.-tuple T => [tuple of x :: t])) /=; last first. pose ttail (t : n.+1.-tuple T) := [tuple of behead t]. exists ttail => [t _ | t /andP[_ /eqP <-]]; first exact: val_inj. by rewrite -tuple_eta. apply: eq_bigl=> t; rewrite Ax theadE eqxx andbT /= andbA; congr (_ && _). by rewrite all_predI all_predC has_pred1 andbC. Qed. Lemma card_inj_ffuns_on D T (R : pred T) : #|[set f : {ffun D -> T} in ffun_on R | injectiveb f]| = #|R| ^_ #|D|. Proof. rewrite -card_uniq_tuples. have bijFF: {on (_ : pred _), bijective (@Finfun D T)}. by exists fgraph => x _; [apply: FinfunK | apply: fgraphK]. rewrite -(on_card_preimset (bijFF _)); apply: eq_card => /= t. rewrite !inE -(big_andE predT) -big_image /= big_all. by rewrite -[t in RHS]FinfunK -codom_ffun. Qed. Lemma card_inj_ffuns D T : #|[set f : {ffun D -> T} | injectiveb f]| = #|T| ^_ #|D|. Proof. rewrite -card_inj_ffuns_on; apply: eq_card => f. by rewrite 2!inE; case: ffun_onP. Qed. Lemma cards_draws T (B : {set T}) k : #|[set A : {set T} | A \subset B & #|A| == k]| = 'C(#|B|, k). Proof. have [ltTk | lekT] := ltnP #|B| k. rewrite bin_small // eq_card0 // => A. rewrite inE eqn_leq [k <= _]leqNgt. have [AsubB /=|//] := boolP (A \subset B). by rewrite (leq_ltn_trans (subset_leq_card AsubB)) ?andbF. apply/eqP; rewrite -(eqn_pmul2r (fact_gt0 k)) bin_ffact // eq_sym. rewrite -sum_nat_cond_const -{1 3}(card_ord k). rewrite -card_inj_ffuns_on -sum1dep_card. pose imIk (f : {ffun 'I_k -> T}) := f @: 'I_k. rewrite (partition_big imIk (fun A => (A \subset B) && (#|A| == k))) /= => [|f]; last first. move=> /andP [/ffun_onP f_ffun /injectiveP inj_f]. rewrite card_imset ?card_ord // eqxx andbT. by apply/subsetP => x /imsetP [i _ ->]; rewrite f_ffun. apply/eqP; apply: eq_bigr => A /andP [AsubB /eqP cardAk]. have [f0 inj_f0 im_f0]: exists2 f, injective f & f @: 'I_k = A. rewrite -cardAk; exists enum_val; first exact: enum_val_inj. apply/setP=> a; apply/imsetP/idP=> [[i _ ->] | Aa]; first exact: enum_valP. by exists (enum_rank_in Aa a); rewrite ?enum_rankK_in. rewrite (reindex (fun p : {ffun _} => [ffun i => f0 (p i)])) /=; last first. pose ff0' f i := odflt i [pick j | f i == f0 j]. exists (fun f => [ffun i => ff0' f i]) => [p _ | f]. apply/ffunP=> i; rewrite ffunE /ff0'; case: pickP => [j | /(_ (p i))]. by rewrite ffunE (inj_eq inj_f0) => /eqP. by rewrite ffunE eqxx. rewrite -im_f0 => /andP[/andP[/ffun_onP f_ffun /injectiveP injf] /eqP im_f]. apply/ffunP=> i; rewrite !ffunE /ff0'; case: pickP => [y /eqP //|]. have /imsetP[j _ eq_f0j_fi]: f i \in f0 @: 'I_k by rewrite -im_f imset_f. by move/(_ j)/eqP. rewrite -ffactnn -card_inj_ffuns -sum1dep_card; apply: eq_bigl => p. rewrite -andbA. apply/and3P/injectiveP=> [[_ /injectiveP inj_f0p _] i j eq_pij | inj_p]. by apply: inj_f0p; rewrite !ffunE eq_pij. set f := finfun _. have injf: injective f by move=> i j; rewrite !ffunE => /inj_f0; apply: inj_p. have imIkf : imIk f == A. rewrite eqEcard card_imset // cardAk card_ord leqnn andbT -im_f0. by apply/subsetP=> x /imsetP[i _ ->]; rewrite ffunE imset_f. split; [|exact/injectiveP|exact: imIkf]. apply/ffun_onP => x; apply: (subsetP AsubB). by rewrite -(eqP imIkf) imset_f. Qed. Lemma card_draws T k : #|[set A : {set T} | #|A| == k]| = 'C(#|T|, k). Proof. by rewrite -cardsT -cards_draws; apply: eq_card => A; rewrite !inE subsetT. Qed. Lemma card_ltn_sorted_tuples m n : #|[set t : m.-tuple 'I_n | sorted ltn (map val t)]| = 'C(n, m). Proof. have [-> | n_gt0] := posnP n; last pose i0 := Ordinal n_gt0. case: m => [|m]; last by apply: eq_card0; case/tupleP=> [[]]. by apply: (@eq_card1 _ [tuple]) => t; rewrite [t]tuple0 inE. rewrite -[n in RHS]card_ord -card_draws. pose f_t (t : m.-tuple 'I_n) := [set i in t]. pose f_A (A : {set 'I_n}) := [tuple of mkseq (nth i0 (enum A)) m]. have val_fA (A : {set 'I_n}) : #|A| = m -> val (f_A A) = enum A. by move=> Am; rewrite -[enum _](mkseq_nth i0) -cardE Am. have inc_A (A : {set 'I_n}) : sorted ltn (map val (enum A)). rewrite -[enum _](eq_filter (mem_enum _)). rewrite -(eq_filter (mem_map val_inj _)) -filter_map. by rewrite (sorted_filter ltn_trans) // unlock val_ord_enum iota_ltn_sorted. rewrite -!sum1dep_card (reindex_onto f_t f_A) /= => [|A]; last first. by move/eqP=> cardAm; apply/setP=> x; rewrite inE -(mem_enum (mem A)) -val_fA. apply: eq_bigl => t. apply/idP/idP => [inc_t|/andP [/eqP t_m /eqP <-]]; last by rewrite val_fA. have ft_m: #|f_t t| = m. rewrite cardsE (card_uniqP _) ?size_tuple // -(map_inj_uniq val_inj). exact: (sorted_uniq ltn_trans ltnn). rewrite ft_m eqxx -val_eqE val_fA // -(inj_eq (inj_map val_inj)) /=. apply/eqP/(irr_sorted_eq ltn_trans ltnn) => // y. by apply/mapP/mapP=> [] [x t_x ->]; exists x; rewrite // mem_enum inE in t_x *. Qed. Lemma card_sorted_tuples m n : #|[set t : m.-tuple 'I_n.+1 | sorted leq (map val t)]| = 'C(m + n, m). Proof. set In1 := 'I_n.+1; pose x0 : In1 := ord0. have add_mnP (i : 'I_m) (x : In1) : i + x < m + n. by rewrite -ltnS -addSn -!addnS leq_add. pose add_mn t i := Ordinal (add_mnP i (tnth t i)). pose add_mn_nat (t : m.-tuple In1) i := i + nth x0 t i. have add_mnC t: val \o add_mn t =1 add_mn_nat t \o val. by move=> i; rewrite /= (tnth_nth x0). pose f_add t := [tuple of map (add_mn t) (ord_tuple m)]. rewrite -card_ltn_sorted_tuples -!sum1dep_card (reindex f_add) /=. apply: eq_bigl => t; rewrite -map_comp (eq_map (add_mnC t)) map_comp. rewrite enumT unlock val_ord_enum -[in LHS](drop0 t). have [m0 | m_gt0] := posnP m. by rewrite {2}m0 /= drop_oversize // size_tuple m0. have def_m := subnK m_gt0; rewrite -{2}def_m addn1 /= {1}/add_mn_nat. move: 0 (m - 1) def_m => i k; rewrite -[in RHS](size_tuple t) => def_m. rewrite (drop_nth x0) /=; last by rewrite -def_m leq_addl. elim: k i (nth x0 t i) def_m => [|k IHk] i x /=. by rewrite add0n => ->; rewrite drop_size. rewrite addSnnS => def_m; rewrite -addSn leq_add2l -IHk //. by rewrite (drop_nth x0) // -def_m leq_addl. pose sub_mn (t : m.-tuple 'I_(m + n)) i : In1 := inord (tnth t i - i). exists (fun t => [tuple of map (sub_mn t) (ord_tuple m)]) => [t _ | t]. apply: eq_from_tnth => i; apply: val_inj. by rewrite /sub_mn !(tnth_ord_tuple, tnth_map) addKn inord_val. rewrite inE /= => inc_t; apply: eq_from_tnth => i; apply: val_inj. rewrite tnth_map tnth_ord_tuple /= tnth_map tnth_ord_tuple. suffices [le_i_ti le_ti_ni]: i <= tnth t i /\ tnth t i <= i + n. by rewrite /sub_mn inordK ?subnKC // ltnS leq_subLR. pose y0 := tnth t i; rewrite (tnth_nth y0) -(nth_map _ (val i)) ?size_tuple //. case def_e: (map _ _) => [|x e] /=; first by rewrite nth_nil ?leq_addr. set nth_i := nth (i : nat); rewrite def_e in inc_t; split. have: i < size (x :: e) by rewrite -def_e size_map size_tuple ltn_ord. elim: (val i) => //= j IHj lt_j_e. by apply: leq_trans (pathP (val i) inc_t _ lt_j_e); rewrite ltnS IHj 1?ltnW. move: (_ - _) (subnK (valP i)) => k /=. elim: k (val i) => /= [|k IHk] j; rewrite -ltnS -addSn ?add0n => def_m. by rewrite def_m -def_e /nth_i (nth_map y0) ?ltn_ord // size_tuple -def_m. rewrite (leq_trans _ (IHk _ _)) -1?addSnnS //; apply: (pathP _ inc_t). rewrite -ltnS (leq_trans (leq_addl k _)) // -addSnnS def_m. by rewrite -(size_tuple t) -(size_map val) def_e. Qed. Lemma card_partial_ord_partitions m n : #|[set t : m.-tuple 'I_n.+1 | \sum_(i <- t) i <= n]| = 'C(m + n, m). Proof. symmetry; set In1 := 'I_n.+1; pose x0 : In1 := ord0. pose add_mn (i j : In1) : In1 := inord (i + j). pose f_add (t : m.-tuple In1) := [tuple of scanl add_mn x0 t]. rewrite -card_sorted_tuples -!sum1dep_card (reindex f_add) /=. apply: eq_bigl => t; rewrite -[\sum_(i <- t) i]add0n. transitivity (path leq x0 (map val (f_add t))) => /=; first by case: map. rewrite -{1 2}[0]/(val x0); elim: {t}(val t) (x0) => /= [|x t IHt] s. by rewrite big_nil addn0 -ltnS ltn_ord. rewrite big_cons addnA IHt /= val_insubd ltnS. have [_ | ltn_n_sx] := leqP (s + x) n; first by rewrite leq_addr. rewrite -(leq_add2r x) leqNgt (leq_trans (valP x)) //=. by rewrite leqNgt (leq_trans ltn_n_sx) ?leq_addr. pose sub_mn (i j : In1) := Ordinal (leq_ltn_trans (leq_subr i j) (valP j)). exists (fun t : m.-tuple In1 => [tuple of pairmap sub_mn x0 t]) => /= t inc_t. apply: val_inj => /=; have{inc_t}: path leq x0 (map val (f_add t)). by move: inc_t; rewrite inE /=; case: map. rewrite [map _ _]/=; elim: {t}(val t) (x0) => //= x t IHt s. case/andP=> le_s_sx /IHt->; congr (_ :: _); apply: val_inj => /=. move: le_s_sx; rewrite val_insubd. case le_sx_n: (_ < n.+1); first by rewrite addKn. by case: (val s) le_sx_n; rewrite ?ltn_ord. apply: val_inj => /=; have{inc_t}: path leq x0 (map val t). by move: inc_t; rewrite inE /=; case: map. elim: {t}(val t) (x0) => //= x t IHt s /andP[le_s_sx inc_t]. suffices ->: add_mn s (sub_mn s x) = x by rewrite IHt. by apply: val_inj; rewrite /add_mn /= subnKC ?inord_val. Qed. Lemma card_ord_partitions m n : #|[set t : m.+1.-tuple 'I_n.+1 | \sum_(i <- t) i == n]| = 'C(m + n, m). Proof. symmetry; set In1 := 'I_n.+1; pose x0 : In1 := ord0. pose f_add (t : m.-tuple In1) := [tuple of sub_ord (\sum_(x <- t) x) :: t]. rewrite -card_partial_ord_partitions -!sum1dep_card (reindex f_add) /=. by apply: eq_bigl => t; rewrite big_cons /= addnC (sameP maxn_idPr eqP) maxnE. exists (fun t : m.+1.-tuple In1 => [tuple of behead t]) => [t _|]. exact: val_inj. case/tupleP=> x t; rewrite inE /= big_cons => /eqP def_n. by apply: val_inj; congr (_ :: _); apply: val_inj; rewrite /= -{1}def_n addnK. Qed. End Combinations. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/choice.v000066400000000000000000000704721375767750300225470ustar00rootroot00000000000000(* (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. (******************************************************************************) (* This file contains the definitions of: *) (* choiceType == interface for types with a choice operator. *) (* countType == interface for countable types (implies choiceType). *) (* subCountType == interface for types that are both subType and countType. *) (* xchoose exP == a standard x such that P x, given exP : exists x : T, P x *) (* when T is a choiceType. The choice depends only on the *) (* extent of P (in particular, it is independent of exP). *) (* choose P x0 == if P x0, a standard x such that P x. *) (* pickle x == a nat encoding the value x : T, where T is a countType. *) (* unpickle n == a partial inverse to pickle: unpickle (pickle x) = Some x *) (* pickle_inv n == a sharp partial inverse to pickle pickle_inv n = Some x *) (* if and only if pickle x = n. *) (* choiceMixin T == type of choice mixins; the exact contents is *) (* documented below in the Choice submodule. *) (* ChoiceType T m == the packed choiceType class for T and mixin m. *) (* [choiceType of T for cT] == clone for T of the choiceType cT. *) (* [choiceType of T] == clone for T of the choiceType inferred for T. *) (* CountType T m == the packed countType class for T and mixin m. *) (* [countType of T for cT] == clone for T of the countType cT. *) (* [count Type of T] == clone for T of the countType inferred for T. *) (* [choiceMixin of T by <:] == Choice mixin for T when T has a subType p *) (* structure with p : pred cT and cT has a Choice *) (* structure; the corresponding structure is Canonical.*) (* [countMixin of T by <:] == Count mixin for a subType T of a countType. *) (* PcanChoiceMixin fK == Choice mixin for T, given f : T -> cT where cT has *) (* a Choice structure, a left inverse partial function *) (* g and fK : pcancel f g. *) (* CanChoiceMixin fK == Choice mixin for T, given f : T -> cT, g and *) (* fK : cancel f g. *) (* PcanCountMixin fK == Count mixin for T, given f : T -> cT where cT has *) (* a Countable structure, a left inverse partial *) (* function g and fK : pcancel f g. *) (* CanCountMixin fK == Count mixin for T, given f : T -> cT, g and *) (* fK : cancel f g. *) (* GenTree.tree T == generic n-ary tree type with nat-labeled nodes and *) (* T-labeled leaves, for example GenTree.Leaf (x : T), *) (* GenTree.Node 5 [:: t; t']. GenTree.tree is equipped *) (* with canonical eqType, choiceType, and countType *) (* instances, and so simple datatypes can be similarly *) (* equipped by encoding into GenTree.tree and using *) (* the mixins above. *) (* CodeSeq.code == bijection from seq nat to nat. *) (* CodeSeq.decode == bijection inverse to CodeSeq.code. *) (* In addition to the lemmas relevant to these definitions, this file also *) (* contains definitions of a Canonical choiceType and countType instances for *) (* all basic datatypes (e.g., nat, bool, subTypes, pairs, sums, etc.). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (* Technical definitions about coding and decoding of nat sequences, which *) (* are used below to define various Canonical instances of the choice and *) (* countable interfaces. *) Module CodeSeq. (* Goedel-style one-to-one encoding of seq nat into nat. *) (* The code for [:: n1; ...; nk] has binary representation *) (* 1 0 ... 0 1 ... 1 0 ... 0 1 0 ... 0 *) (* <-----> <-----> <-----> *) (* nk 0s n2 0s n1 0s *) Definition code := foldr (fun n m => 2 ^ n * m.*2.+1) 0. Fixpoint decode_rec (v q r : nat) {struct q} := match q, r with | 0, _ => [:: v] | q'.+1, 0 => v :: [rec 0, q', q'] | q'.+1, 1 => [rec v.+1, q', q'] | q'.+1, r'.+2 => [rec v, q', r'] end where "[ 'rec' v , q , r ]" := (decode_rec v q r). Arguments decode_rec : simpl nomatch. Definition decode n := if n is 0 then [::] else [rec 0, n.-1, n.-1]. Lemma decodeK : cancel decode code. Proof. have m2s: forall n, n.*2 - n = n by move=> n; rewrite -addnn addnK. case=> //= n; rewrite -[n.+1]mul1n -(expn0 2) -[n in RHS]m2s. elim: n {2 4}n {1 3}0 => [|q IHq] [|[|r]] v //=; rewrite {}IHq ?mul1n ?m2s //. by rewrite expnSr -mulnA mul2n. Qed. Lemma codeK : cancel code decode. Proof. elim=> //= v s IHs; rewrite -[_ * _]prednK ?muln_gt0 ?expn_gt0 //=. set two := 2; rewrite -[v in RHS]addn0; elim: v 0 => [|v IHv {IHs}] q. rewrite mul1n add0n /= -{}[in RHS]IHs; case: (code s) => // u; pose n := u.+1. by transitivity [rec q, n + u.+1, n.*2]; [rewrite addnn | elim: n => //=]. rewrite expnS -mulnA mul2n -{1}addnn -[_ * _]prednK ?muln_gt0 ?expn_gt0 //. set u := _.-1 in IHv *; set n := u; rewrite [in u1 in _ + u1]/n. by rewrite [in RHS]addSnnS -{}IHv; elim: n. Qed. Lemma ltn_code s : all (fun j => j < code s) s. Proof. elim: s => //= i s IHs; rewrite -[_.+1]muln1 leq_mul 1?ltn_expl //=. apply: sub_all IHs => j /leqW lejs; rewrite -[j.+1]mul1n leq_mul ?expn_gt0 //. by rewrite ltnS -[j]mul1n -mul2n leq_mul. Qed. Lemma gtn_decode n : all (ltn^~ n) (decode n). Proof. by rewrite -{1}[n]decodeK ltn_code. Qed. End CodeSeq. Section OtherEncodings. (* Miscellaneous encodings: option T -c-> seq T, T1 * T2 -c-> {i : T1 & T2} *) (* T1 + T2 -c-> option T1 * option T2, unit -c-> bool; bool -c-> nat is *) (* already covered in ssrnat by the nat_of_bool coercion, the odd predicate, *) (* and their "cancellation" lemma oddb. We use these encodings to propagate *) (* canonical structures through these type constructors so that ultimately *) (* all Choice and Countable instanced derive from nat and the seq and sigT *) (* constructors. *) Variables T T1 T2 : Type. Definition seq_of_opt := @oapp T _ (nseq 1) [::]. Lemma seq_of_optK : cancel seq_of_opt ohead. Proof. by case. Qed. Definition tag_of_pair (p : T1 * T2) := @Tagged T1 p.1 (fun _ => T2) p.2. Definition pair_of_tag (u : {i : T1 & T2}) := (tag u, tagged u). Lemma tag_of_pairK : cancel tag_of_pair pair_of_tag. Proof. by case. Qed. Lemma pair_of_tagK : cancel pair_of_tag tag_of_pair. Proof. by case. Qed. Definition opair_of_sum (s : T1 + T2) := match s with inl x => (Some x, None) | inr y => (None, Some y) end. Definition sum_of_opair p := oapp (some \o @inr T1 T2) (omap (@inl _ T2) p.1) p.2. Lemma opair_of_sumK : pcancel opair_of_sum sum_of_opair. Proof. by case. Qed. Lemma bool_of_unitK : cancel (fun _ => true) (fun _ => tt). Proof. by case. Qed. End OtherEncodings. Prenex Implicits seq_of_opt tag_of_pair pair_of_tag opair_of_sum sum_of_opair. Prenex Implicits seq_of_optK tag_of_pairK pair_of_tagK opair_of_sumK. (* Generic variable-arity tree type, providing an encoding target for *) (* miscellaneous user datatypes. The GenTree.tree type can be combined with *) (* a sigT type to model multi-sorted concrete datatypes. *) Module GenTree. Section Def. Variable T : Type. Unset Elimination Schemes. Inductive tree := Leaf of T | Node of nat & seq tree. Definition tree_rect K IH_leaf IH_node := fix loop t : K t := match t with | Leaf x => IH_leaf x | Node n f0 => let fix iter_pair f : foldr (fun t => prod (K t)) unit f := if f is t :: f' then (loop t, iter_pair f') else tt in IH_node n f0 (iter_pair f0) end. Definition tree_rec (K : tree -> Set) := @tree_rect K. Definition tree_ind K IH_leaf IH_node := fix loop t : K t : Prop := match t with | Leaf x => IH_leaf x | Node n f0 => let fix iter_conj f : foldr (fun t => and (K t)) True f := if f is t :: f' then conj (loop t) (iter_conj f') else Logic.I in IH_node n f0 (iter_conj f0) end. Fixpoint encode t : seq (nat + T) := match t with | Leaf x => [:: inr _ x] | Node n f => inl _ n.+1 :: rcons (flatten (map encode f)) (inl _ 0) end. Definition decode_step c fs := match c with | inr x => (Leaf x :: fs.1, fs.2) | inl 0 => ([::], fs.1 :: fs.2) | inl n.+1 => (Node n fs.1 :: head [::] fs.2, behead fs.2) end. Definition decode c := ohead (foldr decode_step ([::], [::]) c).1. Lemma codeK : pcancel encode decode. Proof. move=> t; rewrite /decode; set fs := (_, _). suffices ->: foldr decode_step fs (encode t) = (t :: fs.1, fs.2) by []. elim: t => //= n f IHt in (fs) *; elim: f IHt => //= t f IHf []. by rewrite rcons_cat foldr_cat => -> /= /IHf[-> -> ->]. Qed. End Def. End GenTree. Arguments GenTree.codeK : clear implicits. Definition tree_eqMixin (T : eqType) := PcanEqMixin (GenTree.codeK T). Canonical tree_eqType (T : eqType) := EqType (GenTree.tree T) (tree_eqMixin T). (* Structures for Types with a choice function, and for Types with countably *) (* many elements. The two concepts are closely linked: we indeed make *) (* Countable a subclass of Choice, as countable choice is valid in CiC. This *) (* apparent redundancy is needed to ensure the consistency of the Canonical *) (* inference, as the canonical Choice for a given type may differ from the *) (* countable choice for its canonical Countable structure, e.g., for options. *) (* The Choice interface exposes two choice functions; for T : choiceType *) (* and P : pred T, we provide: *) (* xchoose : (exists x, P x) -> T *) (* choose : pred T -> T -> T *) (* While P (xchoose exP) will always hold, P (choose P x0) will be true if *) (* and only if P x0 holds. Both xchoose and choose are extensional in P and *) (* do not depend on the witness exP or x0 (provided P x0 holds). Note that *) (* xchoose is slightly more powerful, but less convenient to use. *) (* However, neither choose nor xchoose are composable: it would not be *) (* be possible to extend the Choice structure to arbitrary pairs using only *) (* these functions, for instance. Internally, the interfaces provides a *) (* subtly stronger operation, Choice.InternalTheory.find, which performs a *) (* limited search using an integer parameter only rather than a full value as *) (* [x]choose does. This is not a restriction in a constructive theory, where *) (* all types are concrete and hence countable. In the case of an axiomatic *) (* theory, such as that of the Coq reals library, postulating a suitable *) (* axiom of choice suppresses the need for guidance. Nevertheless this *) (* operation is just what is needed to make the Choice interface compose. *) (* The Countable interface provides three functions; for T : countType we *) (* get pickle : T -> nat, and unpickle, pickle_inv : nat -> option T. *) (* The functions provide an effective embedding of T in nat: unpickle is a *) (* left inverse to pickle, which satisfies pcancel pickle unpickle, i.e., *) (* unpickle \o pickle =1 some; pickle_inv is a more precise inverse for which *) (* we also have ocancel pickle_inv pickle. Both unpickle and pickle need to *) (* be partial functions to allow for possibly empty types such as {x | P x}. *) (* The names of these functions underline the correspondence with the *) (* notion of "Serializable" types in programming languages. *) (* Finally, we need to provide a join class to let type inference unify *) (* subType and countType class constraints, e.g., for a countable subType of *) (* an uncountable choiceType (the issue does not arise earlier with eqType or *) (* choiceType because in practice the base type of an Equality/Choice subType *) (* is always an Equality/Choice Type). *) Module Choice. Section ClassDef. Record mixin_of T := Mixin { find : pred T -> nat -> option T; _ : forall P n x, find P n = Some x -> P x; _ : forall P : pred T, (exists x, P x) -> exists n, find P n; _ : forall P Q : pred T, P =1 Q -> find P =1 find Q }. Set Primitive Projections. Record class_of T := Class {base : Equality.class_of T; mixin : mixin_of T}. Unset Primitive Projections. Local Coercion base : class_of >-> Equality.class_of. 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. Definition clone c of phant_id class c := @Pack T c. Definition pack m := fun b bT & phant_id (Equality.class bT) b => Pack (@Class T b m). (* Inheritance *) Definition eqType := @Equality.Pack cT class. End ClassDef. Module Import Exports. Coercion base : class_of >-> Equality.class_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Notation choiceType := type. Notation choiceMixin := mixin_of. Notation ChoiceType T m := (@pack T m _ _ id). Notation "[ 'choiceType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'choiceType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'choiceType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'choiceType' 'of' T ]") : form_scope. End Exports. Module InternalTheory. Section InternalTheory. (* Inner choice function. *) Definition find T := find (mixin (class T)). Variable T : choiceType. Implicit Types P Q : pred T. Lemma correct P n x : find P n = Some x -> P x. Proof. by case: T => _ [_ []] //= in P n x *. Qed. Lemma complete P : (exists x, P x) -> (exists n, find P n). Proof. by case: T => _ [_ []] //= in P *. Qed. Lemma extensional P Q : P =1 Q -> find P =1 find Q. Proof. by case: T => _ [_ []] //= in P Q *. Qed. Fact xchoose_subproof P exP : {x | find P (ex_minn (@complete P exP)) = Some x}. Proof. by case: (ex_minnP (complete exP)) => n; case: (find P n) => // x; exists x. Qed. End InternalTheory. End InternalTheory. End Choice. Export Choice.Exports. Section ChoiceTheory. Implicit Type T : choiceType. Import Choice.InternalTheory CodeSeq. Local Notation dc := decode. Section OneType. Variable T : choiceType. Implicit Types P Q : pred T. Definition xchoose P exP := sval (@xchoose_subproof T P exP). Lemma xchooseP P exP : P (@xchoose P exP). Proof. by rewrite /xchoose; case: (xchoose_subproof exP) => x /= /correct. Qed. Lemma eq_xchoose P Q exP exQ : P =1 Q -> @xchoose P exP = @xchoose Q exQ. Proof. rewrite /xchoose => eqPQ. case: (xchoose_subproof exP) => x; case: (xchoose_subproof exQ) => y /=. case: ex_minnP => n; rewrite -(extensional eqPQ) => Pn minQn. case: ex_minnP => m; rewrite !(extensional eqPQ) => Qm minPm. by case: (eqVneq m n) => [-> -> [] //|]; rewrite eqn_leq minQn ?minPm. Qed. Lemma sigW P : (exists x, P x) -> {x | P x}. Proof. by move=> exP; exists (xchoose exP); apply: xchooseP. Qed. Lemma sig2W P Q : (exists2 x, P x & Q x) -> {x | P x & Q x}. Proof. move=> exPQ; have [|x /andP[]] := @sigW (predI P Q); last by exists x. by have [x Px Qx] := exPQ; exists x; apply/andP. Qed. Lemma sig_eqW (vT : eqType) (lhs rhs : T -> vT) : (exists x, lhs x = rhs x) -> {x | lhs x = rhs x}. Proof. move=> exP; suffices [x /eqP Ex]: {x | lhs x == rhs x} by exists x. by apply: sigW; have [x /eqP Ex] := exP; exists x. Qed. Lemma sig2_eqW (vT : eqType) (P : pred T) (lhs rhs : T -> vT) : (exists2 x, P x & lhs x = rhs x) -> {x | P x & lhs x = rhs x}. Proof. move=> exP; suffices [x Px /eqP Ex]: {x | P x & lhs x == rhs x} by exists x. by apply: sig2W; have [x Px /eqP Ex] := exP; exists x. Qed. Definition choose P x0 := if insub x0 : {? x | P x} is Some (exist x Px) then xchoose (ex_intro [eta P] x Px) else x0. Lemma chooseP P x0 : P x0 -> P (choose P x0). Proof. by move=> Px0; rewrite /choose insubT xchooseP. Qed. Lemma choose_id P x0 y0 : P x0 -> P y0 -> choose P x0 = choose P y0. Proof. by move=> Px0 Py0; rewrite /choose !insubT /=; apply: eq_xchoose. Qed. Lemma eq_choose P Q : P =1 Q -> choose P =1 choose Q. Proof. rewrite /choose => eqPQ x0. do [case: insubP; rewrite eqPQ] => [[x Px] Qx0 _| ?]; last by rewrite insubN. by rewrite insubT; apply: eq_xchoose. Qed. Section CanChoice. Variables (sT : Type) (f : sT -> T). Lemma PcanChoiceMixin f' : pcancel f f' -> choiceMixin sT. Proof. move=> fK; pose liftP sP := [pred x | oapp sP false (f' x)]. pose sf sP := [fun n => obind f' (find (liftP sP) n)]. exists sf => [sP n x | sP [y sPy] | sP sQ eqPQ n] /=. - by case Df: (find _ n) => //= [?] Dx; have:= correct Df; rewrite /= Dx. - have [|n Pn] := @complete T (liftP sP); first by exists (f y); rewrite /= fK. exists n; case Df: (find _ n) Pn => //= [x] _. by have:= correct Df => /=; case: (f' x). by congr (obind _ _); apply: extensional => x /=; case: (f' x) => /=. Qed. Definition CanChoiceMixin f' (fK : cancel f f') := PcanChoiceMixin (can_pcan fK). End CanChoice. Section SubChoice. Variables (P : pred T) (sT : subType P). Definition sub_choiceMixin := PcanChoiceMixin (@valK T P sT). Definition sub_choiceClass := @Choice.Class sT (sub_eqMixin sT) sub_choiceMixin. Canonical sub_choiceType := Choice.Pack sub_choiceClass. End SubChoice. Fact seq_choiceMixin : choiceMixin (seq T). Proof. pose r f := [fun xs => fun x : T => f (x :: xs) : option (seq T)]. pose fix f sP ns xs {struct ns} := if ns is n :: ns1 then let fr := r (f sP ns1) xs in obind fr (find fr n) else if sP xs then Some xs else None. exists (fun sP nn => f sP (dc nn) nil) => [sP n ys | sP [ys] | sP sQ eqPQ n]. - elim: {n}(dc n) nil => [|n ns IHs] xs /=; first by case: ifP => // sPxs [<-]. by case: (find _ n) => //= [x]; apply: IHs. - rewrite -(cats0 ys); elim/last_ind: ys nil => [|ys y IHs] xs /=. by move=> sPxs; exists 0; rewrite /= sPxs. rewrite cat_rcons => /IHs[n1 sPn1] {IHs}. have /complete[n]: exists z, f sP (dc n1) (z :: xs) by exists y. case Df: (find _ n)=> // [x] _; exists (code (n :: dc n1)). by rewrite codeK /= Df /= (correct Df). elim: {n}(dc n) nil => [|n ns IHs] xs /=; first by rewrite eqPQ. rewrite (@extensional _ _ (r (f sQ ns) xs)) => [|x]; last by rewrite IHs. by case: find => /=. Qed. Canonical seq_choiceType := Eval hnf in ChoiceType (seq T) seq_choiceMixin. End OneType. Section TagChoice. Variables (I : choiceType) (T_ : I -> choiceType). Fact tagged_choiceMixin : choiceMixin {i : I & T_ i}. Proof. pose mkT i (x : T_ i) := Tagged T_ x. pose ft tP n i := omap (mkT i) (find (tP \o mkT i) n). pose fi tP ni nt := obind (ft tP nt) (find (ft tP nt) ni). pose f tP n := if dc n is [:: ni; nt] then fi tP ni nt else None. exists f => [tP n u | tP [[i x] tPxi] | sP sQ eqPQ n]. - rewrite /f /fi; case: (dc n) => [|ni [|nt []]] //=. case: (find _ _) => //= [i]; rewrite /ft. by case Df: (find _ _) => //= [x] [<-]; have:= correct Df. - have /complete[nt tPnt]: exists y, (tP \o mkT i) y by exists x. have{tPnt}: exists j, ft tP nt j by exists i; rewrite /ft; case: find tPnt. case/complete=> ni tPn; exists (code [:: ni; nt]); rewrite /f codeK /fi. by case Df: find tPn => //= [j] _; have:= correct Df. rewrite /f /fi; case: (dc n) => [|ni [|nt []]] //=. rewrite (@extensional _ _ (ft sQ nt)) => [|i]. by case: find => //= i; congr (omap _ _); apply: extensional => x /=. by congr (omap _ _); apply: extensional => x /=. Qed. Canonical tagged_choiceType := Eval hnf in ChoiceType {i : I & T_ i} tagged_choiceMixin. End TagChoice. Fact nat_choiceMixin : choiceMixin nat. Proof. pose f := [fun (P : pred nat) n => if P n then Some n else None]. exists f => [P n m | P [n Pn] | P Q eqPQ n] /=; last by rewrite eqPQ. by case: ifP => // Pn [<-]. by exists n; rewrite Pn. Qed. Canonical nat_choiceType := Eval hnf in ChoiceType nat nat_choiceMixin. Definition bool_choiceMixin := CanChoiceMixin oddb. Canonical bool_choiceType := Eval hnf in ChoiceType bool bool_choiceMixin. Canonical bitseq_choiceType := Eval hnf in [choiceType of bitseq]. Definition unit_choiceMixin := CanChoiceMixin bool_of_unitK. Canonical unit_choiceType := Eval hnf in ChoiceType unit unit_choiceMixin. Definition void_choiceMixin := PcanChoiceMixin (of_voidK unit). Canonical void_choiceType := Eval hnf in ChoiceType void void_choiceMixin. Definition option_choiceMixin T := CanChoiceMixin (@seq_of_optK T). Canonical option_choiceType T := Eval hnf in ChoiceType (option T) (option_choiceMixin T). Definition sig_choiceMixin T (P : pred T) : choiceMixin {x | P x} := sub_choiceMixin _. Canonical sig_choiceType T (P : pred T) := Eval hnf in ChoiceType {x | P x} (sig_choiceMixin P). Definition prod_choiceMixin T1 T2 := CanChoiceMixin (@tag_of_pairK T1 T2). Canonical prod_choiceType T1 T2 := Eval hnf in ChoiceType (T1 * T2) (prod_choiceMixin T1 T2). Definition sum_choiceMixin T1 T2 := PcanChoiceMixin (@opair_of_sumK T1 T2). Canonical sum_choiceType T1 T2 := Eval hnf in ChoiceType (T1 + T2) (sum_choiceMixin T1 T2). Definition tree_choiceMixin T := PcanChoiceMixin (GenTree.codeK T). Canonical tree_choiceType T := ChoiceType (GenTree.tree T) (tree_choiceMixin T). End ChoiceTheory. Prenex Implicits xchoose choose. Notation "[ 'choiceMixin' 'of' T 'by' <: ]" := (sub_choiceMixin _ : choiceMixin T) (at level 0, format "[ 'choiceMixin' 'of' T 'by' <: ]") : form_scope. Module Countable. Record mixin_of (T : Type) : Type := Mixin { pickle : T -> nat; unpickle : nat -> option T; pickleK : pcancel pickle unpickle }. Definition EqMixin T m := PcanEqMixin (@pickleK T m). Definition ChoiceMixin T m := PcanChoiceMixin (@pickleK T m). Section ClassDef. Set Primitive Projections. Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of T }. Unset Primitive Projections. Local Coercion base : class_of >-> Choice.class_of. Structure type : Type := Pack {sort : Type; _ : 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. Definition clone c of phant_id class c := @Pack T c. Definition pack m := fun bT b & phant_id (Choice.class bT) b => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. End ClassDef. Module Exports. Coercion base : class_of >-> Choice.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Notation countType := type. Notation CountType T m := (@pack T m _ _ id). Notation CountMixin := Mixin. Notation CountChoiceMixin := ChoiceMixin. Notation "[ 'countType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'countType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'countType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'countType' 'of' T ]") : form_scope. End Exports. End Countable. Export Countable.Exports. Definition unpickle T := Countable.unpickle (Countable.class T). Definition pickle T := Countable.pickle (Countable.class T). Arguments unpickle {T} n. Arguments pickle {T} x. Section CountableTheory. Variable T : countType. Lemma pickleK : @pcancel nat T pickle unpickle. Proof. exact: Countable.pickleK. Qed. Definition pickle_inv n := obind (fun x : T => if pickle x == n then Some x else None) (unpickle n). Lemma pickle_invK : ocancel pickle_inv pickle. Proof. by rewrite /pickle_inv => n; case def_x: (unpickle n) => //= [x]; case: eqP. Qed. Lemma pickleK_inv : pcancel pickle pickle_inv. Proof. by rewrite /pickle_inv => x; rewrite pickleK /= eqxx. Qed. Lemma pcan_pickleK sT f f' : @pcancel T sT f f' -> pcancel (pickle \o f) (pcomp f' unpickle). Proof. by move=> fK x; rewrite /pcomp pickleK /= fK. Qed. Definition PcanCountMixin sT f f' (fK : pcancel f f') := @CountMixin sT _ _ (pcan_pickleK fK). Definition CanCountMixin sT f f' (fK : cancel f f') := @PcanCountMixin sT _ _ (can_pcan fK). Definition sub_countMixin P sT := PcanCountMixin (@valK T P sT). Definition pickle_seq s := CodeSeq.code (map (@pickle T) s). Definition unpickle_seq n := Some (pmap (@unpickle T) (CodeSeq.decode n)). Lemma pickle_seqK : pcancel pickle_seq unpickle_seq. Proof. by move=> s; rewrite /unpickle_seq CodeSeq.codeK (map_pK pickleK). Qed. Definition seq_countMixin := CountMixin pickle_seqK. Canonical seq_countType := Eval hnf in CountType (seq T) seq_countMixin. End CountableTheory. Notation "[ 'countMixin' 'of' T 'by' <: ]" := (sub_countMixin _ : Countable.mixin_of T) (at level 0, format "[ 'countMixin' 'of' T 'by' <: ]") : form_scope. Arguments pickle_inv {T} n. Arguments pickleK {T} x. Arguments pickleK_inv {T} x. Arguments pickle_invK {T} n : rename. Section SubCountType. Variables (T : choiceType) (P : pred T). Import Countable. Structure subCountType : Type := SubCountType {subCount_sort :> subType P; _ : mixin_of subCount_sort}. Coercion sub_countType (sT : subCountType) := Eval hnf in pack (let: SubCountType _ m := sT return mixin_of sT in m) id. Canonical sub_countType. Definition pack_subCountType U := fun sT cT & sub_sort sT * sort cT -> U * U => fun b m & phant_id (Class b m) (class cT) => @SubCountType sT m. End SubCountType. (* This assumes that T has both countType and subType structures. *) Notation "[ 'subCountType' 'of' T ]" := (@pack_subCountType _ _ T _ _ id _ _ id) (at level 0, format "[ 'subCountType' 'of' T ]") : form_scope. Section TagCountType. Variables (I : countType) (T_ : I -> countType). Definition pickle_tagged (u : {i : I & T_ i}) := CodeSeq.code [:: pickle (tag u); pickle (tagged u)]. Definition unpickle_tagged s := if CodeSeq.decode s is [:: ni; nx] then obind (fun i => omap (@Tagged I i T_) (unpickle nx)) (unpickle ni) else None. Lemma pickle_taggedK : pcancel pickle_tagged unpickle_tagged. Proof. by case=> i x; rewrite /unpickle_tagged CodeSeq.codeK /= pickleK /= pickleK. Qed. Definition tag_countMixin := CountMixin pickle_taggedK. Canonical tag_countType := Eval hnf in CountType {i : I & T_ i} tag_countMixin. End TagCountType. (* The remaining Canonicals for standard datatypes. *) Section CountableDataTypes. Implicit Type T : countType. Lemma nat_pickleK : pcancel id (@Some nat). Proof. by []. Qed. Definition nat_countMixin := CountMixin nat_pickleK. Canonical nat_countType := Eval hnf in CountType nat nat_countMixin. Definition bool_countMixin := CanCountMixin oddb. Canonical bool_countType := Eval hnf in CountType bool bool_countMixin. Canonical bitseq_countType := Eval hnf in [countType of bitseq]. Definition unit_countMixin := CanCountMixin bool_of_unitK. Canonical unit_countType := Eval hnf in CountType unit unit_countMixin. Definition void_countMixin := PcanCountMixin (of_voidK unit). Canonical void_countType := Eval hnf in CountType void void_countMixin. Definition option_countMixin T := CanCountMixin (@seq_of_optK T). Canonical option_countType T := Eval hnf in CountType (option T) (option_countMixin T). Definition sig_countMixin T (P : pred T) := [countMixin of {x | P x} by <:]. Canonical sig_countType T (P : pred T) := Eval hnf in CountType {x | P x} (sig_countMixin P). Canonical sig_subCountType T (P : pred T) := Eval hnf in [subCountType of {x | P x}]. Definition prod_countMixin T1 T2 := CanCountMixin (@tag_of_pairK T1 T2). Canonical prod_countType T1 T2 := Eval hnf in CountType (T1 * T2) (prod_countMixin T1 T2). Definition sum_countMixin T1 T2 := PcanCountMixin (@opair_of_sumK T1 T2). Canonical sum_countType T1 T2 := Eval hnf in CountType (T1 + T2) (sum_countMixin T1 T2). Definition tree_countMixin T := PcanCountMixin (GenTree.codeK T). Canonical tree_countType T := CountType (GenTree.tree T) (tree_countMixin T). End CountableDataTypes. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/div.v000066400000000000000000001145731375767750300221000ustar00rootroot00000000000000(* (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. (******************************************************************************) (* This file deals with divisibility for natural numbers. *) (* It contains the definitions of: *) (* edivn m d == the pair composed of the quotient and remainder *) (* of the Euclidean division of m by d. *) (* m %/ d == quotient of the Euclidean division of m by d. *) (* m %% d == remainder of the Euclidean division of m by d. *) (* m = n %[mod d] <-> m equals n modulo d. *) (* m == n %[mod d] <=> m equals n modulo d (boolean version). *) (* m <> n %[mod d] <-> m differs from n modulo d. *) (* m != n %[mod d] <=> m differs from n modulo d (boolean version). *) (* d %| m <=> d divides m. *) (* gcdn m n == the GCD of m and n. *) (* egcdn m n == the extended GCD (Bezout coefficient pair) of m and n. *) (* If egcdn m n = (u, v), then gcdn m n = m * u - n * v. *) (* lcmn m n == the LCM of m and n. *) (* coprime m n <=> m and n are coprime (:= gcdn m n == 1). *) (* chinese m n r s == witness of the chinese remainder theorem. *) (* We adjoin an m to operator suffixes to indicate a nested %% (modn), as in *) (* modnDml : m %% d + n = m + n %[mod d]. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (** Euclidean division *) Definition edivn_rec d := fix loop m q := if m - d is m'.+1 then loop m' q.+1 else (q, m). Definition edivn m d := if d > 0 then edivn_rec d.-1 m 0 else (0, m). Variant edivn_spec m d : nat * nat -> Type := EdivnSpec q r of m = q * d + r & (d > 0) ==> (r < d) : edivn_spec m d (q, r). Lemma edivnP m d : edivn_spec m d (edivn m d). Proof. rewrite -[m in edivn_spec m]/(0 * d + m) /edivn; case: d => //= d. elim/ltn_ind: m 0 => -[|m] IHm q //=; rewrite subn_if_gt. case: ltnP => // le_dm; rewrite -[in m.+1](subnKC le_dm) -addSn. by rewrite addnA -mulSnr; apply/IHm/leq_subr. Qed. Lemma edivn_eq d q r : r < d -> edivn (q * d + r) d = (q, r). Proof. move=> lt_rd; have d_gt0: 0 < d by apply: leq_trans lt_rd. case: edivnP lt_rd => q' r'; rewrite d_gt0 /=. wlog: q q' r r' / q <= q' by case/orP: (leq_total q q'); last symmetry; eauto. have [||-> _ /addnI ->] //= := ltngtP q q'. rewrite -(leq_pmul2r d_gt0) => /leq_add lt_qr _ eq_qr _ /lt_qr {lt_qr}. by rewrite addnS ltnNge mulSn -addnA eq_qr addnCA addnA leq_addr. Qed. Definition divn m d := (edivn m d).1. Notation "m %/ d" := (divn m d) : nat_scope. (* We redefine modn so that it is structurally decreasing. *) Definition modn_rec d := fix loop m := if m - d is m'.+1 then loop m' else m. Definition modn m d := if d > 0 then modn_rec d.-1 m else m. Notation "m %% d" := (modn m d) : nat_scope. Notation "m = n %[mod d ]" := (m %% d = n %% d) : nat_scope. Notation "m == n %[mod d ]" := (m %% d == n %% d) : nat_scope. Notation "m <> n %[mod d ]" := (m %% d <> n %% d) : nat_scope. Notation "m != n %[mod d ]" := (m %% d != n %% d) : nat_scope. Lemma modn_def m d : m %% d = (edivn m d).2. Proof. case: d => //= d; rewrite /modn /edivn /=; elim/ltn_ind: m 0 => -[|m] IHm q //=. by rewrite !subn_if_gt; case: (d <= m) => //; apply/IHm/leq_subr. Qed. Lemma edivn_def m d : edivn m d = (m %/ d, m %% d). Proof. by rewrite /divn modn_def; case: (edivn m d). Qed. Lemma divn_eq m d : m = m %/ d * d + m %% d. Proof. by rewrite /divn modn_def; case: edivnP. Qed. Lemma div0n d : 0 %/ d = 0. Proof. by case: d. Qed. Lemma divn0 m : m %/ 0 = 0. Proof. by []. Qed. Lemma mod0n d : 0 %% d = 0. Proof. by case: d. Qed. Lemma modn0 m : m %% 0 = m. Proof. by []. Qed. Lemma divn_small m d : m < d -> m %/ d = 0. Proof. by move=> lt_md; rewrite /divn (edivn_eq 0). Qed. Lemma divnMDl q m d : 0 < d -> (q * d + m) %/ d = q + m %/ d. Proof. move=> d_gt0; rewrite [in LHS](divn_eq m d) addnA -mulnDl. by rewrite /divn edivn_eq // modn_def; case: edivnP; rewrite d_gt0. Qed. Lemma mulnK m d : 0 < d -> m * d %/ d = m. Proof. by move=> d_gt0; rewrite -[m * d]addn0 divnMDl // div0n addn0. Qed. Lemma mulKn m d : 0 < d -> d * m %/ d = m. Proof. by move=> d_gt0; rewrite mulnC mulnK. Qed. Lemma expnB p m n : p > 0 -> m >= n -> p ^ (m - n) = p ^ m %/ p ^ n. Proof. by move=> p_gt0 /subnK-Dm; rewrite -[in RHS]Dm expnD mulnK // expn_gt0 p_gt0. Qed. Lemma modn1 m : m %% 1 = 0. Proof. by rewrite modn_def; case: edivnP => ? []. Qed. Lemma divn1 m : m %/ 1 = m. Proof. by rewrite [RHS](@divn_eq m 1) // modn1 addn0 muln1. Qed. Lemma divnn d : d %/ d = (0 < d). Proof. by case: d => // d; rewrite -[n in n %/ _]muln1 mulKn. Qed. Lemma divnMl p m d : p > 0 -> p * m %/ (p * d) = m %/ d. Proof. move=> p_gt0; have [->|d_gt0] := posnP d; first by rewrite muln0. rewrite [RHS]/divn; case: edivnP; rewrite d_gt0 /= => q r ->{m} lt_rd. rewrite mulnDr mulnCA divnMDl; last by rewrite muln_gt0 p_gt0. by rewrite addnC divn_small // ltn_pmul2l. Qed. Arguments divnMl [p m d]. Lemma divnMr p m d : p > 0 -> m * p %/ (d * p) = m %/ d. Proof. by move=> p_gt0; rewrite -!(mulnC p) divnMl. Qed. Arguments divnMr [p m d]. Lemma ltn_mod m d : (m %% d < d) = (0 < d). Proof. by case: d => // d; rewrite modn_def; case: edivnP. Qed. Lemma ltn_pmod m d : 0 < d -> m %% d < d. Proof. by rewrite ltn_mod. Qed. Lemma leq_trunc_div m d : m %/ d * d <= m. Proof. by rewrite [m in _ <= m](divn_eq m d) leq_addr. Qed. Lemma leq_mod m d : m %% d <= m. Proof. by rewrite [m in _ <= m](divn_eq m d) leq_addl. Qed. Lemma leq_div m d : m %/ d <= m. Proof. by case: d => // d; apply: leq_trans (leq_pmulr _ _) (leq_trunc_div _ _). Qed. Lemma ltn_ceil m d : 0 < d -> m < (m %/ d).+1 * d. Proof. by move=> d_gt0; rewrite [in m.+1](divn_eq m d) -addnS mulSnr leq_add2l ltn_mod. Qed. Lemma ltn_divLR m n d : d > 0 -> (m %/ d < n) = (m < n * d). Proof. move=> d_gt0; apply/idP/idP. by rewrite -(leq_pmul2r d_gt0); apply: leq_trans (ltn_ceil _ _). rewrite !ltnNge -(@leq_pmul2r d n) //; apply: contra => le_nd_floor. exact: leq_trans le_nd_floor (leq_trunc_div _ _). Qed. Lemma leq_divRL m n d : d > 0 -> (m <= n %/ d) = (m * d <= n). Proof. by move=> d_gt0; rewrite leqNgt ltn_divLR // -leqNgt. Qed. Lemma ltn_Pdiv m d : 1 < d -> 0 < m -> m %/ d < m. Proof. by move=> d_gt1 m_gt0; rewrite ltn_divLR ?ltn_Pmulr // ltnW. Qed. Lemma divn_gt0 d m : 0 < d -> (0 < m %/ d) = (d <= m). Proof. by move=> d_gt0; rewrite leq_divRL ?mul1n. Qed. Lemma leq_div2r d m n : m <= n -> m %/ d <= n %/ d. Proof. have [-> //| d_gt0 le_mn] := posnP d. by rewrite leq_divRL // (leq_trans _ le_mn) -?leq_divRL. Qed. Lemma leq_div2l m d e : 0 < d -> d <= e -> m %/ e <= m %/ d. Proof. move/leq_divRL=> -> le_de. by apply: leq_trans (leq_trunc_div m e); apply: leq_mul. Qed. Lemma edivnD m n d (offset := m %% d + n %% d >= d) : 0 < d -> edivn (m + n) d = (m %/ d + n %/ d + offset, m %% d + n %% d - offset * d). Proof. rewrite {}/offset; case: d => // d _; rewrite /divn !modn_def. case: (edivnP m d.+1) (edivnP n d.+1) => [/= q r -> r_lt] [/= p s -> s_lt]. rewrite addnACA -mulnDl; have [r_le s_le] := (ltnW r_lt, ltnW s_lt). have [d_ge|d_lt] := leqP; first by rewrite addn0 mul0n subn0 edivn_eq. rewrite addn1 mul1n -[in LHS](subnKC d_lt) addnA -mulSnr edivn_eq//. by rewrite ltn_subLR// -addnS leq_add. Qed. Lemma divnD m n d : 0 < d -> (m + n) %/ d = (m %/ d) + (n %/ d) + (m %% d + n %% d >= d). Proof. by move=> /(@edivnD m n); rewrite edivn_def => -[]. Qed. Lemma modnD m n d : 0 < d -> (m + n) %% d = m %% d + n %% d - (m %% d + n %% d >= d) * d. Proof. by move=> /(@edivnD m n); rewrite edivn_def => -[]. Qed. Lemma leqDmod m n d : 0 < d -> (d <= m %% d + n %% d) = ((m + n) %% d < n %% d). Proof. move=> d_gt0; rewrite modnD//. have [d_le|_] := leqP d; last by rewrite subn0 ltnNge leq_addl. by rewrite -(ltn_add2r d) mul1n (subnK d_le) addnC ltn_add2l ltn_pmod. Qed. Lemma divnB n m d : 0 < d -> (m - n) %/ d = (m %/ d) - (n %/ d) - (m %% d < n %% d). Proof. move=> d_gt0; have [mn|/ltnW nm] := leqP m n. by rewrite (eqP mn) (eqP (leq_div2r _ _)) ?div0n. by rewrite -[in m %/ d](subnK nm) divnD// addnAC addnK leqDmod ?subnK ?addnK. Qed. Lemma modnB m n d : 0 < d -> n <= m -> (m - n) %% d = (m %% d < n %% d) * d + m %% d - n %% d. Proof. move=> d_gt0 nm; rewrite -[in m %% _](subnK nm) -leqDmod// modnD//. have [d_le|_] := leqP d; last by rewrite mul0n add0n subn0 addnK. by rewrite mul1n addnBA// addnC !addnK. Qed. Lemma edivnB m n d (offset := m %% d < n %% d) : 0 < d -> n <= m -> edivn (m - n) d = (m %/ d - n %/ d - offset, offset * d + m %% d - n %% d). Proof. by move=> d_gt0 le_nm; rewrite edivn_def divnB// modnB. Qed. Lemma leq_divDl p m n : (m + n) %/ p <= m %/ p + n %/ p + 1. Proof. by have [->//|p_gt0] := posnP p; rewrite divnD// !leq_add// leq_b1. Qed. Lemma geq_divBl k m p : k %/ p - m %/ p <= (k - m) %/ p + 1. Proof. rewrite leq_subLR addnA; apply: leq_trans (leq_divDl _ _ _). by rewrite -maxnE leq_div2r ?leq_maxr. Qed. Lemma divnMA m n p : m %/ (n * p) = m %/ n %/ p. Proof. case: n p => [|n] [|p]; rewrite ?muln0 ?div0n //. rewrite [in RHS](divn_eq m (n.+1 * p.+1)) mulnA mulnAC !divnMDl //. by rewrite [_ %/ p.+1]divn_small ?addn0 // ltn_divLR // mulnC ltn_mod. Qed. Lemma divnAC m n p : m %/ n %/ p = m %/ p %/ n. Proof. by rewrite -!divnMA mulnC. Qed. Lemma modn_small m d : m < d -> m %% d = m. Proof. by move=> lt_md; rewrite [RHS](divn_eq m d) divn_small. Qed. Lemma modn_mod m d : m %% d = m %[mod d]. Proof. by case: d => // d; apply: modn_small; rewrite ltn_mod. Qed. Lemma modnMDl p m d : p * d + m = m %[mod d]. Proof. have [->|d_gt0] := posnP d; first by rewrite muln0. by rewrite [in LHS](divn_eq m d) addnA -mulnDl modn_def edivn_eq // ltn_mod. Qed. Lemma muln_modr p m d : p * (m %% d) = (p * m) %% (p * d). Proof. have [->//|p_gt0] := posnP p; apply: (@addnI (p * (m %/ d * d))). by rewrite -mulnDr -divn_eq mulnCA -(divnMl p_gt0) -divn_eq. Qed. Lemma muln_modl p m d : (m %% d) * p = (m * p) %% (d * p). Proof. by rewrite -!(mulnC p); apply: muln_modr. Qed. Lemma modn_divl m n d : (m %/ d) %% n = m %% (n * d) %/ d. Proof. case: d n => [|d] [|n] //; rewrite [in LHS]/divn [in LHS]modn_def. case: (edivnP m d.+1) edivnP => [/= _ r -> le_rd] [/= q s -> le_sn]. rewrite mulnDl -mulnA -addnA modnMDl modn_small ?divnMDl ?divn_small ?addn0//. by rewrite mulSnr -addnS leq_add ?leq_mul2r. Qed. Lemma modnDl m d : d + m = m %[mod d]. Proof. by rewrite -[m %% _](modnMDl 1) mul1n. Qed. Lemma modnDr m d : m + d = m %[mod d]. Proof. by rewrite addnC modnDl. Qed. Lemma modnn d : d %% d = 0. Proof. by rewrite [d %% d](modnDr 0) mod0n. Qed. Lemma modnMl p d : p * d %% d = 0. Proof. by rewrite -[p * d]addn0 modnMDl mod0n. Qed. Lemma modnMr p d : d * p %% d = 0. Proof. by rewrite mulnC modnMl. Qed. Lemma modnDml m n d : m %% d + n = m + n %[mod d]. Proof. by rewrite [in RHS](divn_eq m d) -addnA modnMDl. Qed. Lemma modnDmr m n d : m + n %% d = m + n %[mod d]. Proof. by rewrite !(addnC m) modnDml. Qed. Lemma modnDm m n d : m %% d + n %% d = m + n %[mod d]. Proof. by rewrite modnDml modnDmr. Qed. Lemma eqn_modDl p m n d : (p + m == p + n %[mod d]) = (m == n %[mod d]). Proof. case: d => [|d]; first by rewrite !modn0 eqn_add2l. apply/eqP/eqP=> eq_mn; last by rewrite -modnDmr eq_mn modnDmr. rewrite -(modnMDl p m) -(modnMDl p n) !mulnSr -!addnA. by rewrite -modnDmr eq_mn modnDmr. Qed. Lemma eqn_modDr p m n d : (m + p == n + p %[mod d]) = (m == n %[mod d]). Proof. by rewrite -!(addnC p) eqn_modDl. Qed. Lemma modnMml m n d : m %% d * n = m * n %[mod d]. Proof. by rewrite [in RHS](divn_eq m d) mulnDl mulnAC modnMDl. Qed. Lemma modnMmr m n d : m * (n %% d) = m * n %[mod d]. Proof. by rewrite !(mulnC m) modnMml. Qed. Lemma modnMm m n d : m %% d * (n %% d) = m * n %[mod d]. Proof. by rewrite modnMml modnMmr. Qed. Lemma modn2 m : m %% 2 = odd m. Proof. by elim: m => //= m IHm; rewrite -addn1 -modnDml IHm; case odd. Qed. Lemma divn2 m : m %/ 2 = m./2. Proof. by rewrite [in RHS](divn_eq m 2) modn2 muln2 addnC half_bit_double. Qed. Lemma odd_mod m d : odd d = false -> odd (m %% d) = odd m. Proof. by move=> d_even; rewrite [in RHS](divn_eq m d) oddD oddM d_even andbF. Qed. Lemma modnXm m n a : (a %% n) ^ m = a ^ m %[mod n]. Proof. by elim: m => // m IHm; rewrite !expnS -modnMmr IHm modnMml modnMmr. Qed. (** Divisibility **) Definition dvdn d m := m %% d == 0. Notation "m %| d" := (dvdn m d) : nat_scope. Lemma dvdnP d m : reflect (exists k, m = k * d) (d %| m). Proof. apply: (iffP eqP) => [md0 | [k ->]]; last by rewrite modnMl. by exists (m %/ d); rewrite [LHS](divn_eq m d) md0 addn0. Qed. Arguments dvdnP {d m}. Lemma dvdn0 d : d %| 0. Proof. by case: d. Qed. Lemma dvd0n n : (0 %| n) = (n == 0). Proof. by case: n. Qed. Lemma dvdn1 d : (d %| 1) = (d == 1). Proof. by case: d => [|[|d]] //; rewrite /dvdn modn_small. Qed. Lemma dvd1n m : 1 %| m. Proof. by rewrite /dvdn modn1. Qed. Lemma dvdn_gt0 d m : m > 0 -> d %| m -> d > 0. Proof. by case: d => // /prednK <-. Qed. Lemma dvdnn m : m %| m. Proof. by rewrite /dvdn modnn. Qed. Lemma dvdn_mull d m n : d %| n -> d %| m * n. Proof. by case/dvdnP=> n' ->; rewrite /dvdn mulnA modnMl. Qed. Lemma dvdn_mulr d m n : d %| m -> d %| m * n. Proof. by move=> d_m; rewrite mulnC dvdn_mull. Qed. Hint Resolve dvdn0 dvd1n dvdnn dvdn_mull dvdn_mulr : core. Lemma dvdn_mul d1 d2 m1 m2 : d1 %| m1 -> d2 %| m2 -> d1 * d2 %| m1 * m2. Proof. by move=> /dvdnP[q1 ->] /dvdnP[q2 ->]; rewrite mulnCA -mulnA 2?dvdn_mull. Qed. Lemma dvdn_trans n d m : d %| n -> n %| m -> d %| m. Proof. by move=> d_dv_n /dvdnP[n1 ->]; apply: dvdn_mull. Qed. Lemma dvdn_eq d m : (d %| m) = (m %/ d * d == m). Proof. apply/eqP/eqP=> [modm0 | <-]; last exact: modnMl. by rewrite [RHS](divn_eq m d) modm0 addn0. Qed. Lemma dvdn2 n : (2 %| n) = ~~ odd n. Proof. by rewrite /dvdn modn2; case (odd n). Qed. Lemma dvdn_odd m n : m %| n -> odd n -> odd m. Proof. by move=> m_dv_n; apply: contraTT; rewrite -!dvdn2 => /dvdn_trans->. Qed. Lemma divnK d m : d %| m -> m %/ d * d = m. Proof. by rewrite dvdn_eq; move/eqP. Qed. Lemma leq_divLR d m n : d %| m -> (m %/ d <= n) = (m <= n * d). Proof. by case: d m => [|d] [|m] ///divnK=> {2}<-; rewrite leq_pmul2r. Qed. Lemma ltn_divRL d m n : d %| m -> (n < m %/ d) = (n * d < m). Proof. by move=> dv_d_m; rewrite !ltnNge leq_divLR. Qed. Lemma eqn_div d m n : d > 0 -> d %| m -> (n == m %/ d) = (n * d == m). Proof. by move=> d_gt0 dv_d_m; rewrite -(eqn_pmul2r d_gt0) divnK. Qed. Lemma eqn_mul d m n : d > 0 -> d %| m -> (m == n * d) = (m %/ d == n). Proof. by move=> d_gt0 dv_d_m; rewrite eq_sym -eqn_div // eq_sym. Qed. Lemma divn_mulAC d m n : d %| m -> m %/ d * n = m * n %/ d. Proof. case: d m => [[] //| d m] dv_d_m; apply/eqP. by rewrite eqn_div ?dvdn_mulr // mulnAC divnK. Qed. Lemma muln_divA d m n : d %| n -> m * (n %/ d) = m * n %/ d. Proof. by move=> dv_d_m; rewrite !(mulnC m) divn_mulAC. Qed. Lemma muln_divCA d m n : d %| m -> d %| n -> m * (n %/ d) = n * (m %/ d). Proof. by move=> dv_d_m dv_d_n; rewrite mulnC divn_mulAC ?muln_divA. Qed. Lemma divnA m n p : p %| n -> m %/ (n %/ p) = m * p %/ n. Proof. by case: p => [|p] dv_n; rewrite -[in RHS](divnK dv_n) // divnMr. Qed. Lemma modn_dvdm m n d : d %| m -> n %% m = n %[mod d]. Proof. by case/dvdnP=> q def_m; rewrite [in RHS](divn_eq n m) def_m mulnA modnMDl. Qed. Lemma dvdn_leq d m : 0 < m -> d %| m -> d <= m. Proof. by move=> m_gt0 /dvdnP[[|k] Dm]; rewrite Dm // leq_addr in m_gt0 *. Qed. Lemma gtnNdvd n d : 0 < n -> n < d -> (d %| n) = false. Proof. by move=> n_gt0 lt_nd; rewrite /dvdn eqn0Ngt modn_small ?n_gt0. Qed. Lemma eqn_dvd m n : (m == n) = (m %| n) && (n %| m). Proof. case: m n => [|m] [|n] //; apply/idP/andP => [/eqP -> //| []]. by rewrite eqn_leq => Hmn Hnm; do 2 rewrite dvdn_leq //. Qed. Lemma dvdn_pmul2l p d m : 0 < p -> (p * d %| p * m) = (d %| m). Proof. by case: p => // p _; rewrite /dvdn -muln_modr // muln_eq0. Qed. Arguments dvdn_pmul2l [p d m]. Lemma dvdn_pmul2r p d m : 0 < p -> (d * p %| m * p) = (d %| m). Proof. by move=> p_gt0; rewrite -!(mulnC p) dvdn_pmul2l. Qed. Arguments dvdn_pmul2r [p d m]. Lemma dvdn_divLR p d m : 0 < p -> p %| d -> (d %/ p %| m) = (d %| m * p). Proof. by move=> /(@dvdn_pmul2r p _ m) <- /divnK->. Qed. Lemma dvdn_divRL p d m : p %| m -> (d %| m %/ p) = (d * p %| m). Proof. have [-> | /(@dvdn_pmul2r p d) <- /divnK-> //] := posnP p. by rewrite divn0 muln0 dvdn0. Qed. Lemma dvdn_div d m : d %| m -> m %/ d %| m. Proof. by move/divnK=> {2}<-; apply: dvdn_mulr. Qed. Lemma dvdn_exp2l p m n : m <= n -> p ^ m %| p ^ n. Proof. by move/subnK <-; rewrite expnD dvdn_mull. Qed. Lemma dvdn_Pexp2l p m n : p > 1 -> (p ^ m %| p ^ n) = (m <= n). Proof. move=> p_gt1; case: leqP => [|gt_n_m]; first exact: dvdn_exp2l. by rewrite gtnNdvd ?ltn_exp2l ?expn_gt0 // ltnW. Qed. Lemma dvdn_exp2r m n k : m %| n -> m ^ k %| n ^ k. Proof. by case/dvdnP=> q ->; rewrite expnMn dvdn_mull. Qed. Lemma divn_modl m n d : d %| n -> (m %% n) %/ d = (m %/ d) %% (n %/ d). Proof. by move=> dvd_dn; rewrite modn_divl divnK. Qed. Lemma dvdn_addr m d n : d %| m -> (d %| m + n) = (d %| n). Proof. by case/dvdnP=> q ->; rewrite /dvdn modnMDl. Qed. Lemma dvdn_addl n d m : d %| n -> (d %| m + n) = (d %| m). Proof. by rewrite addnC; apply: dvdn_addr. Qed. Lemma dvdn_add d m n : d %| m -> d %| n -> d %| m + n. Proof. by move/dvdn_addr->. Qed. Lemma dvdn_add_eq d m n : d %| m + n -> (d %| m) = (d %| n). Proof. by move=> dv_d_mn; apply/idP/idP => [/dvdn_addr | /dvdn_addl] <-. Qed. Lemma dvdn_subr d m n : n <= m -> d %| m -> (d %| m - n) = (d %| n). Proof. by move=> le_n_m dv_d_m; apply: dvdn_add_eq; rewrite subnK. Qed. Lemma dvdn_subl d m n : n <= m -> d %| n -> (d %| m - n) = (d %| m). Proof. by move=> le_n_m dv_d_m; rewrite -(dvdn_addl _ dv_d_m) subnK. Qed. Lemma dvdn_sub d m n : d %| m -> d %| n -> d %| m - n. Proof. by case: (leqP n m) => [le_nm /dvdn_subr <- // | /ltnW/eqnP ->]; rewrite dvdn0. Qed. Lemma dvdn_exp k d m : 0 < k -> d %| m -> d %| (m ^ k). Proof. by case: k => // k _ d_dv_m; rewrite expnS dvdn_mulr. Qed. Lemma dvdn_fact m n : 0 < m <= n -> m %| n`!. Proof. case: m => //= m; elim: n => //= n IHn; rewrite ltnS. have [/IHn/dvdn_mull->||-> _] // := ltngtP m n; exact: dvdn_mulr. Qed. Hint Resolve dvdn_add dvdn_sub dvdn_exp : core. Lemma eqn_mod_dvd d m n : n <= m -> (m == n %[mod d]) = (d %| m - n). Proof. by move/subnK=> Dm; rewrite -[n in LHS]add0n -[in LHS]Dm eqn_modDr mod0n. Qed. Lemma divnDMl q m d : 0 < d -> (m + q * d) %/ d = (m %/ d) + q. Proof. by move=> d_gt0; rewrite addnC divnMDl// addnC. Qed. Lemma divnMBl q m d : 0 < d -> (q * d - m) %/ d = q - (m %/ d) - (~~ (d %| m)). Proof. by move=> d_gt0; rewrite divnB// mulnK// modnMl lt0n. Qed. Lemma divnBMl q m d : (m - q * d) %/ d = (m %/ d) - q. Proof. by case: d => [|d]//=; rewrite divnB// mulnK// modnMl ltn0 subn0. Qed. Lemma divnDl m n d : d %| m -> (m + n) %/ d = m %/ d + n %/ d. Proof. by case: d => // d /divnK-Dm; rewrite -[in LHS]Dm divnMDl. Qed. Lemma divnDr m n d : d %| n -> (m + n) %/ d = m %/ d + n %/ d. Proof. by move=> dv_n; rewrite addnC divnDl // addnC. Qed. Lemma divnBl m n d : d %| m -> (m - n) %/ d = m %/ d - (n %/ d) - (~~ (d %| n)). Proof. by case: d => [|d] // /divnK-Dm; rewrite -[in LHS]Dm divnMBl. Qed. Lemma divnBr m n d : d %| n -> (m - n) %/ d = m %/ d - n %/ d. Proof. by case: d => [|d]// /divnK-Dm; rewrite -[in LHS]Dm divnBMl. Qed. Lemma edivnS m d : 0 < d -> edivn m.+1 d = if d %| m.+1 then ((m %/ d).+1, 0) else (m %/ d, (m %% d).+1). Proof. case: d => [|[|d]] //= _; first by rewrite edivn_def modn1 dvd1n !divn1. rewrite -addn1 /dvdn modn_def edivnD//= (@modn_small 1)// (@divn_small 1)//. rewrite addn1 addn0 ltnS; have [||<-] := ltngtP d.+1. - by rewrite ltnNge -ltnS ltn_pmod. - by rewrite addn0 mul0n subn0. - by rewrite addn1 mul1n subnn. Qed. Lemma modnS m d : m.+1 %% d = if d %| m.+1 then 0 else (m %% d).+1. Proof. by case: d => [|d]//; rewrite modn_def edivnS//; case: ifP. Qed. Lemma divnS m d : 0 < d -> m.+1 %/ d = (d %| m.+1) + m %/ d. Proof. by move=> d_gt0; rewrite /divn edivnS//; case: ifP. Qed. Lemma divn_pred m d : m.-1 %/ d = (m %/ d) - (d %| m). Proof. by case: d m => [|d] [|m]; rewrite ?divn1 ?dvd1n ?subn1//= divnS// addnC addnK. Qed. Lemma modn_pred m d : d != 1 -> 0 < m -> m.-1 %% d = if d %| m then d.-1 else (m %% d).-1. Proof. rewrite -subn1; case: d m => [|[|d]] [|m]//= _ _. by rewrite ?modn1 ?dvd1n ?modn0 ?subn1. rewrite modnB// (@modn_small 1)// [_ < _]leqn0 /dvdn mulnbl/= subn1. by case: eqP => // ->; rewrite addn0. Qed. Lemma edivn_pred m d : d != 1 -> 0 < m -> edivn m.-1 d = if d %| m then ((m %/ d).-1, d.-1) else (m %/ d, (m %% d).-1). Proof. move=> d_neq1 m_gt0; rewrite edivn_def divn_pred modn_pred//. by case: ifP; rewrite ?subn0 ?subn1. Qed. (***********************************************************************) (* A function that computes the gcd of 2 numbers *) (***********************************************************************) Fixpoint gcdn_rec m n := let n' := n %% m in if n' is 0 then m else if m - n'.-1 is m'.+1 then gcdn_rec (m' %% n') n' else n'. Definition gcdn := nosimpl gcdn_rec. Lemma gcdnE m n : gcdn m n = if m == 0 then n else gcdn (n %% m) m. Proof. rewrite /gcdn; elim/ltn_ind: m n => -[|m] IHm [|n] //=. case def_p: (_ %% _) => // [p]. have{def_p} lt_pm: p.+1 < m.+1 by rewrite -def_p ltn_pmod. rewrite {}IHm // subn_if_gt ltnW //=; congr gcdn_rec. by rewrite -(subnK (ltnW lt_pm)) modnDr. Qed. Lemma gcdnn : idempotent gcdn. Proof. by case=> // n; rewrite gcdnE modnn. Qed. Lemma gcdnC : commutative gcdn. Proof. move=> m n; wlog lt_nm: m n / n < m by have [? ->|? <-|-> //] := ltngtP n m. by rewrite gcdnE -[in m == 0](ltn_predK lt_nm) modn_small. Qed. Lemma gcd0n : left_id 0 gcdn. Proof. by case. Qed. Lemma gcdn0 : right_id 0 gcdn. Proof. by case. Qed. Lemma gcd1n : left_zero 1 gcdn. Proof. by move=> n; rewrite gcdnE modn1. Qed. Lemma gcdn1 : right_zero 1 gcdn. Proof. by move=> n; rewrite gcdnC gcd1n. Qed. Lemma dvdn_gcdr m n : gcdn m n %| n. Proof. elim/ltn_ind: m n => -[|m] IHm [|n] //=. rewrite gcdnE; case def_p: (_ %% _) => [|p]; first by rewrite /dvdn def_p. have lt_pm: p < m by rewrite -ltnS -def_p ltn_pmod. rewrite /= (divn_eq n.+1 m.+1) def_p dvdn_addr ?dvdn_mull //; last exact: IHm. by rewrite gcdnE /= IHm // (ltn_trans (ltn_pmod _ _)). Qed. Lemma dvdn_gcdl m n : gcdn m n %| m. Proof. by rewrite gcdnC dvdn_gcdr. Qed. Lemma gcdn_gt0 m n : (0 < gcdn m n) = (0 < m) || (0 < n). Proof. by case: m n => [|m] [|n] //; apply: (@dvdn_gt0 _ m.+1) => //; apply: dvdn_gcdl. Qed. Lemma gcdnMDl k m n : gcdn m (k * m + n) = gcdn m n. Proof. by rewrite !(gcdnE m) modnMDl mulnC; case: m. Qed. Lemma gcdnDl m n : gcdn m (m + n) = gcdn m n. Proof. by rewrite -[m in m + n]mul1n gcdnMDl. Qed. Lemma gcdnDr m n : gcdn m (n + m) = gcdn m n. Proof. by rewrite addnC gcdnDl. Qed. Lemma gcdnMl n m : gcdn n (m * n) = n. Proof. by case: n => [|n]; rewrite gcdnE modnMl // muln0. Qed. Lemma gcdnMr n m : gcdn n (n * m) = n. Proof. by rewrite mulnC gcdnMl. Qed. Lemma gcdn_idPl {m n} : reflect (gcdn m n = m) (m %| n). Proof. by apply: (iffP idP) => [/dvdnP[q ->] | <-]; rewrite (gcdnMl, dvdn_gcdr). Qed. Lemma gcdn_idPr {m n} : reflect (gcdn m n = n) (n %| m). Proof. by rewrite gcdnC; apply: gcdn_idPl. Qed. Lemma expn_min e m n : e ^ minn m n = gcdn (e ^ m) (e ^ n). Proof. by case: leqP => [|/ltnW] /(dvdn_exp2l e) /gcdn_idPl; rewrite gcdnC. Qed. Lemma gcdn_modr m n : gcdn m (n %% m) = gcdn m n. Proof. by rewrite [in RHS](divn_eq n m) gcdnMDl. Qed. Lemma gcdn_modl m n : gcdn (m %% n) n = gcdn m n. Proof. by rewrite !(gcdnC _ n) gcdn_modr. Qed. (* Extended gcd, which computes Bezout coefficients. *) Fixpoint Bezout_rec km kn qs := if qs is q :: qs' then Bezout_rec kn (NatTrec.add_mul q kn km) qs' else (km, kn). Fixpoint egcdn_rec m n s qs := if s is s'.+1 then let: (q, r) := edivn m n in if r > 0 then egcdn_rec n r s' (q :: qs) else if odd (size qs) then qs else q.-1 :: qs else [::0]. Definition egcdn m n := Bezout_rec 0 1 (egcdn_rec m n n [::]). Variant egcdn_spec m n : nat * nat -> Type := EgcdnSpec km kn of km * m = kn * n + gcdn m n & kn * gcdn m n < m : egcdn_spec m n (km, kn). Lemma egcd0n n : egcdn 0 n = (1, 0). Proof. by case: n. Qed. Lemma egcdnP m n : m > 0 -> egcdn_spec m n (egcdn m n). Proof. have [-> /= | n_gt0 m_gt0] := posnP n; first by split; rewrite // mul1n gcdn0. rewrite /egcdn; set s := (s in egcdn_rec _ _ s); pose bz := Bezout_rec n m [::]. have: n < s.+1 by []; move defSpec: (egcdn_spec bz.2 bz.1) s => Spec s. elim: s => [[]|s IHs] //= in n m (qs := [::]) bz defSpec n_gt0 m_gt0 *. case: edivnP => q r def_m; rewrite n_gt0 ltnS /= => lt_rn le_ns1. case: posnP => [r0 {s le_ns1 IHs lt_rn}|r_gt0]; last first. by apply: IHs => //=; [rewrite natTrecE -def_m | rewrite (leq_trans lt_rn)]. rewrite {r}r0 addn0 in def_m; set b := odd _; pose d := gcdn m n. pose km := ~~ b : nat; pose kn := if b then 1 else q.-1. rewrite [bz in Spec bz](_ : _ = Bezout_rec km kn qs); last first. by rewrite /kn /km; case: (b) => //=; rewrite natTrecE addn0 muln1. have def_d: d = n by rewrite /d def_m gcdnC gcdnE modnMl gcd0n -[n]prednK. have: km * m + 2 * b * d = kn * n + d. rewrite {}/kn {}/km def_m def_d -mulSnr; case: b; rewrite //= addn0 mul1n. by rewrite prednK //; apply: dvdn_gt0 m_gt0 _; rewrite def_m dvdn_mulr. have{def_m}: kn * d <= m. have q_gt0 : 0 < q by rewrite def_m muln_gt0 n_gt0 ?andbT in m_gt0. by rewrite /kn; case b; rewrite def_d def_m leq_pmul2r // leq_pred. have{def_d}: km * d <= n by rewrite -[n]mul1n def_d leq_pmul2r // leq_b1. move: km {q}kn m_gt0 n_gt0 defSpec; rewrite {}/b {}/d {}/bz. elim: qs m n => [|q qs IHq] n r kn kr n_gt0 r_gt0 /=. set d := gcdn n r; rewrite mul0n addn0 => <- le_kn_r _ def_d; split=> //. have d_gt0: 0 < d by rewrite gcdn_gt0 n_gt0. have /ltn_pmul2l<-: 0 < kn by rewrite -(ltn_pmul2r n_gt0) def_d ltn_addl. by rewrite def_d -addn1 leq_add // mulnCA leq_mul2l le_kn_r orbT. rewrite !natTrecE; set m := _ + r; set km := _ + kn; pose d := gcdn m n. have ->: gcdn n r = d by rewrite [d]gcdnC gcdnMDl. have m_gt0: 0 < m by rewrite addn_gt0 r_gt0 orbT. have d_gt0: 0 < d by rewrite gcdn_gt0 m_gt0. move=> {}/IHq IHq le_kn_r le_kr_n def_d; apply: IHq => //; rewrite -/d. by rewrite mulnDl leq_add // -mulnA leq_mul2l le_kr_n orbT. apply: (@addIn d); rewrite mulnDr -addnA addnACA -def_d addnACA mulnA. rewrite -!mulnDl -mulnDr -addnA [kr * _]mulnC; congr addn. by rewrite addnC addn_negb muln1 mul2n addnn. Qed. Lemma Bezoutl m n : m > 0 -> {a | a < m & m %| gcdn m n + a * n}. Proof. move=> m_gt0; case: (egcdnP n m_gt0) => km kn def_d lt_kn_m. exists kn; last by rewrite addnC -def_d dvdn_mull. apply: leq_ltn_trans lt_kn_m. by rewrite -{1}[kn]muln1 leq_mul2l gcdn_gt0 m_gt0 orbT. Qed. Lemma Bezoutr m n : n > 0 -> {a | a < n & n %| gcdn m n + a * m}. Proof. by rewrite gcdnC; apply: Bezoutl. Qed. (* Back to the gcd. *) Lemma dvdn_gcd p m n : p %| gcdn m n = (p %| m) && (p %| n). Proof. apply/idP/andP=> [dv_pmn | [dv_pm dv_pn]]. by rewrite !(dvdn_trans dv_pmn) ?dvdn_gcdl ?dvdn_gcdr. have [->|n_gt0] := posnP n; first by rewrite gcdn0. case: (Bezoutr m n_gt0) => // km _ /(dvdn_trans dv_pn). by rewrite dvdn_addl // dvdn_mull. Qed. Lemma gcdnAC : right_commutative gcdn. Proof. suffices dvd m n p: gcdn (gcdn m n) p %| gcdn (gcdn m p) n. by move=> m n p; apply/eqP; rewrite eqn_dvd !dvd. rewrite !dvdn_gcd dvdn_gcdr. by rewrite !(dvdn_trans (dvdn_gcdl _ p)) ?dvdn_gcdl ?dvdn_gcdr. Qed. Lemma gcdnA : associative gcdn. Proof. by move=> m n p; rewrite !(gcdnC m) gcdnAC. Qed. Lemma gcdnCA : left_commutative gcdn. Proof. by move=> m n p; rewrite !gcdnA (gcdnC m). Qed. Lemma gcdnACA : interchange gcdn gcdn. Proof. by move=> m n p q; rewrite -!gcdnA (gcdnCA n). Qed. Lemma muln_gcdr : right_distributive muln gcdn. Proof. move=> p m n; have [-> //|p_gt0] := posnP p. elim/ltn_ind: m n => m IHm n; rewrite gcdnE [RHS]gcdnE muln_eq0 (gtn_eqF p_gt0). by case: posnP => // m_gt0; rewrite -muln_modr //=; apply/IHm/ltn_pmod. Qed. Lemma muln_gcdl : left_distributive muln gcdn. Proof. by move=> m n p; rewrite -!(mulnC p) muln_gcdr. Qed. Lemma gcdn_def d m n : d %| m -> d %| n -> (forall d', d' %| m -> d' %| n -> d' %| d) -> gcdn m n = d. Proof. move=> dv_dm dv_dn gdv_d; apply/eqP. by rewrite eqn_dvd dvdn_gcd dv_dm dv_dn gdv_d ?dvdn_gcdl ?dvdn_gcdr. Qed. Lemma muln_divCA_gcd n m : n * (m %/ gcdn n m) = m * (n %/ gcdn n m). Proof. by rewrite muln_divCA ?dvdn_gcdl ?dvdn_gcdr. Qed. (* We derive the lcm directly. *) Definition lcmn m n := m * n %/ gcdn m n. Lemma lcmnC : commutative lcmn. Proof. by move=> m n; rewrite /lcmn mulnC gcdnC. Qed. Lemma lcm0n : left_zero 0 lcmn. Proof. by move=> n; apply: div0n. Qed. Lemma lcmn0 : right_zero 0 lcmn. Proof. by move=> n; rewrite lcmnC lcm0n. Qed. Lemma lcm1n : left_id 1 lcmn. Proof. by move=> n; rewrite /lcmn gcd1n mul1n divn1. Qed. Lemma lcmn1 : right_id 1 lcmn. Proof. by move=> n; rewrite lcmnC lcm1n. Qed. Lemma muln_lcm_gcd m n : lcmn m n * gcdn m n = m * n. Proof. by apply/eqP; rewrite divnK ?dvdn_mull ?dvdn_gcdr. Qed. Lemma lcmn_gt0 m n : (0 < lcmn m n) = (0 < m) && (0 < n). Proof. by rewrite -muln_gt0 ltn_divRL ?dvdn_mull ?dvdn_gcdr. Qed. Lemma muln_lcmr : right_distributive muln lcmn. Proof. case=> // m n p; rewrite /lcmn -muln_gcdr -!mulnA divnMl // mulnCA. by rewrite muln_divA ?dvdn_mull ?dvdn_gcdr. Qed. Lemma muln_lcml : left_distributive muln lcmn. Proof. by move=> m n p; rewrite -!(mulnC p) muln_lcmr. Qed. Lemma lcmnA : associative lcmn. Proof. move=> m n p; rewrite [LHS]/lcmn [RHS]/lcmn mulnC. rewrite !divn_mulAC ?dvdn_mull ?dvdn_gcdr // -!divnMA ?dvdn_mulr ?dvdn_gcdl //. rewrite mulnC mulnA !muln_gcdr; congr (_ %/ _). by rewrite ![_ * lcmn _ _]mulnC !muln_lcm_gcd !muln_gcdl -!(mulnC m) gcdnA. Qed. Lemma lcmnCA : left_commutative lcmn. Proof. by move=> m n p; rewrite !lcmnA (lcmnC m). Qed. Lemma lcmnAC : right_commutative lcmn. Proof. by move=> m n p; rewrite -!lcmnA (lcmnC n). Qed. Lemma lcmnACA : interchange lcmn lcmn. Proof. by move=> m n p q; rewrite -!lcmnA (lcmnCA n). Qed. Lemma dvdn_lcml d1 d2 : d1 %| lcmn d1 d2. Proof. by rewrite /lcmn -muln_divA ?dvdn_gcdr ?dvdn_mulr. Qed. Lemma dvdn_lcmr d1 d2 : d2 %| lcmn d1 d2. Proof. by rewrite lcmnC dvdn_lcml. Qed. Lemma dvdn_lcm d1 d2 m : lcmn d1 d2 %| m = (d1 %| m) && (d2 %| m). Proof. case: d1 d2 => [|d1] [|d2]; try by case: m => [|m]; rewrite ?lcmn0 ?andbF. rewrite -(@dvdn_pmul2r (gcdn d1.+1 d2.+1)) ?gcdn_gt0 // muln_lcm_gcd. by rewrite muln_gcdr dvdn_gcd {1}mulnC andbC !dvdn_pmul2r. Qed. Lemma lcmnMl m n : lcmn m (m * n) = m * n. Proof. by case: m => // m; rewrite /lcmn gcdnMr mulKn. Qed. Lemma lcmnMr m n : lcmn n (m * n) = m * n. Proof. by rewrite mulnC lcmnMl. Qed. Lemma lcmn_idPr {m n} : reflect (lcmn m n = n) (m %| n). Proof. by apply: (iffP idP) => [/dvdnP[q ->] | <-]; rewrite (lcmnMr, dvdn_lcml). Qed. Lemma lcmn_idPl {m n} : reflect (lcmn m n = m) (n %| m). Proof. by rewrite lcmnC; apply: lcmn_idPr. Qed. Lemma expn_max e m n : e ^ maxn m n = lcmn (e ^ m) (e ^ n). Proof. by case: leqP => [|/ltnW] /(dvdn_exp2l e) /lcmn_idPl; rewrite lcmnC. Qed. (* Coprime factors *) Definition coprime m n := gcdn m n == 1. Lemma coprime1n n : coprime 1 n. Proof. by rewrite /coprime gcd1n. Qed. Lemma coprimen1 n : coprime n 1. Proof. by rewrite /coprime gcdn1. Qed. Lemma coprime_sym m n : coprime m n = coprime n m. Proof. by rewrite /coprime gcdnC. Qed. Lemma coprime_modl m n : coprime (m %% n) n = coprime m n. Proof. by rewrite /coprime gcdn_modl. Qed. Lemma coprime_modr m n : coprime m (n %% m) = coprime m n. Proof. by rewrite /coprime gcdn_modr. Qed. Lemma coprime2n n : coprime 2 n = odd n. Proof. by rewrite -coprime_modr modn2; case: (odd n). Qed. Lemma coprimen2 n : coprime n 2 = odd n. Proof. by rewrite coprime_sym coprime2n. Qed. Lemma coprimeSn n : coprime n.+1 n. Proof. by rewrite -coprime_modl (modnDr 1) coprime_modl coprime1n. Qed. Lemma coprimenS n : coprime n n.+1. Proof. by rewrite coprime_sym coprimeSn. Qed. Lemma coprimePn n : n > 0 -> coprime n.-1 n. Proof. by case: n => // n _; rewrite coprimenS. Qed. Lemma coprimenP n : n > 0 -> coprime n n.-1. Proof. by case: n => // n _; rewrite coprimeSn. Qed. Lemma coprimeP n m : n > 0 -> reflect (exists u, u.1 * n - u.2 * m = 1) (coprime n m). Proof. move=> n_gt0; apply: (iffP eqP) => [<-| [[kn km] /= kn_km_1]]. by have [kn km kg _] := egcdnP m n_gt0; exists (kn, km); rewrite kg addKn. apply gcdn_def; rewrite ?dvd1n // => d dv_d_n dv_d_m. by rewrite -kn_km_1 dvdn_subr ?dvdn_mull // ltnW // -subn_gt0 kn_km_1. Qed. Lemma modn_coprime k n : 0 < k -> (exists u, (k * u) %% n = 1) -> coprime k n. Proof. move=> k_gt0 [u Hu]; apply/coprimeP=> //. by exists (u, k * u %/ n); rewrite /= mulnC {1}(divn_eq (k * u) n) addKn. Qed. Lemma Gauss_dvd m n p : coprime m n -> (m * n %| p) = (m %| p) && (n %| p). Proof. by move=> co_mn; rewrite -muln_lcm_gcd (eqnP co_mn) muln1 dvdn_lcm. Qed. Lemma Gauss_dvdr m n p : coprime m n -> (m %| n * p) = (m %| p). Proof. case: n => [|n] co_mn; first by case: m co_mn => [|[]] // _; rewrite !dvd1n. by symmetry; rewrite mulnC -(@dvdn_pmul2r n.+1) ?Gauss_dvd // andbC dvdn_mull. Qed. Lemma Gauss_dvdl m n p : coprime m p -> (m %| n * p) = (m %| n). Proof. by rewrite mulnC; apply: Gauss_dvdr. Qed. Lemma dvdn_double_leq m n : m %| n -> odd m -> ~~ odd n -> 0 < n -> m.*2 <= n. Proof. move=> m_dv_n odd_m even_n n_gt0. by rewrite -muln2 dvdn_leq // Gauss_dvd ?coprimen2 ?m_dv_n ?dvdn2. Qed. Lemma dvdn_double_ltn m n : m %| n.-1 -> odd m -> odd n -> 1 < n -> m.*2 < n. Proof. by case: n => //; apply: dvdn_double_leq. Qed. Lemma Gauss_gcdr p m n : coprime p m -> gcdn p (m * n) = gcdn p n. Proof. move=> co_pm; apply/eqP; rewrite eqn_dvd !dvdn_gcd !dvdn_gcdl /=. rewrite andbC dvdn_mull ?dvdn_gcdr //= -(@Gauss_dvdr _ m) ?dvdn_gcdr //. by rewrite /coprime gcdnAC (eqnP co_pm) gcd1n. Qed. Lemma Gauss_gcdl p m n : coprime p n -> gcdn p (m * n) = gcdn p m. Proof. by move=> co_pn; rewrite mulnC Gauss_gcdr. Qed. Lemma coprimeMr p m n : coprime p (m * n) = coprime p m && coprime p n. Proof. case co_pm: (coprime p m) => /=; first by rewrite /coprime Gauss_gcdr. apply/eqP=> co_p_mn; case/eqnP: co_pm; apply gcdn_def => // d dv_dp dv_dm. by rewrite -co_p_mn dvdn_gcd dv_dp dvdn_mulr. Qed. Lemma coprimeMl p m n : coprime (m * n) p = coprime m p && coprime n p. Proof. by rewrite -!(coprime_sym p) coprimeMr. Qed. Lemma coprime_pexpl k m n : 0 < k -> coprime (m ^ k) n = coprime m n. Proof. case: k => // k _; elim: k => [|k IHk]; first by rewrite expn1. by rewrite expnS coprimeMl -IHk; case coprime. Qed. Lemma coprime_pexpr k m n : 0 < k -> coprime m (n ^ k) = coprime m n. Proof. by move=> k_gt0; rewrite !(coprime_sym m) coprime_pexpl. Qed. Lemma coprimeXl k m n : coprime m n -> coprime (m ^ k) n. Proof. by case: k => [|k] co_pm; rewrite ?coprime1n // coprime_pexpl. Qed. Lemma coprimeXr k m n : coprime m n -> coprime m (n ^ k). Proof. by rewrite !(coprime_sym m); apply: coprimeXl. Qed. Lemma coprime_dvdl m n p : m %| n -> coprime n p -> coprime m p. Proof. by case/dvdnP=> d ->; rewrite coprimeMl => /andP[]. Qed. Lemma coprime_dvdr m n p : m %| n -> coprime p n -> coprime p m. Proof. by rewrite !(coprime_sym p); apply: coprime_dvdl. Qed. Lemma coprime_egcdn n m : n > 0 -> coprime (egcdn n m).1 (egcdn n m).2. Proof. move=> n_gt0; case: (egcdnP m n_gt0) => kn km /= /eqP. have [/dvdnP[u defn] /dvdnP[v defm]] := (dvdn_gcdl n m, dvdn_gcdr n m). rewrite -[gcdn n m]mul1n {1}defm {1}defn !mulnA -mulnDl addnC. rewrite eqn_pmul2r ?gcdn_gt0 ?n_gt0 //; case: kn => // kn /eqP def_knu _. by apply/coprimeP=> //; exists (u, v); rewrite mulnC def_knu mulnC addnK. Qed. Lemma dvdn_pexp2r m n k : k > 0 -> (m ^ k %| n ^ k) = (m %| n). Proof. move=> k_gt0; apply/idP/idP=> [dv_mn_k|]; last exact: dvdn_exp2r. have [->|n_gt0] := posnP n; first by rewrite dvdn0. have [n' def_n] := dvdnP (dvdn_gcdr m n); set d := gcdn m n in def_n. have [m' def_m] := dvdnP (dvdn_gcdl m n); rewrite -/d in def_m. have d_gt0: d > 0 by rewrite gcdn_gt0 n_gt0 orbT. rewrite def_m def_n !expnMn dvdn_pmul2r ?expn_gt0 ?d_gt0 // in dv_mn_k. have: coprime (m' ^ k) (n' ^ k). rewrite coprime_pexpl // coprime_pexpr // /coprime -(eqn_pmul2r d_gt0) mul1n. by rewrite muln_gcdl -def_m -def_n. rewrite /coprime -gcdn_modr (eqnP dv_mn_k) gcdn0 -(exp1n k). by rewrite (inj_eq (expIn k_gt0)) def_m; move/eqP->; rewrite mul1n dvdn_gcdr. Qed. Section Chinese. (***********************************************************************) (* The chinese remainder theorem *) (***********************************************************************) Variables m1 m2 : nat. Hypothesis co_m12 : coprime m1 m2. Lemma chinese_remainder x y : (x == y %[mod m1 * m2]) = (x == y %[mod m1]) && (x == y %[mod m2]). Proof. wlog le_yx : x y / y <= x; last by rewrite !eqn_mod_dvd // Gauss_dvd. by have [?|/ltnW ?] := leqP y x; last rewrite !(eq_sym (x %% _)); apply. Qed. (***********************************************************************) (* A function that solves the chinese remainder problem *) (***********************************************************************) Definition chinese r1 r2 := r1 * m2 * (egcdn m2 m1).1 + r2 * m1 * (egcdn m1 m2).1. Lemma chinese_modl r1 r2 : chinese r1 r2 = r1 %[mod m1]. Proof. rewrite /chinese; case: (posnP m2) co_m12 => [-> /eqnP | m2_gt0 _]. by rewrite gcdn0 => ->; rewrite !modn1. case: egcdnP => // k2 k1 def_m1 _. rewrite mulnAC -mulnA def_m1 gcdnC (eqnP co_m12) mulnDr mulnA muln1. by rewrite addnAC (mulnAC _ m1) -mulnDl modnMDl. Qed. Lemma chinese_modr r1 r2 : chinese r1 r2 = r2 %[mod m2]. Proof. rewrite /chinese; case: (posnP m1) co_m12 => [-> /eqnP | m1_gt0 _]. by rewrite gcd0n => ->; rewrite !modn1. case: (egcdnP m2) => // k1 k2 def_m2 _. rewrite addnC mulnAC -mulnA def_m2 (eqnP co_m12) mulnDr mulnA muln1. by rewrite addnAC (mulnAC _ m2) -mulnDl modnMDl. Qed. Lemma chinese_mod x : x = chinese (x %% m1) (x %% m2) %[mod m1 * m2]. Proof. apply/eqP; rewrite chinese_remainder //. by rewrite chinese_modl chinese_modr !modn_mod !eqxx. Qed. End Chinese. Notation "@ 'coprime_expl'" := (deprecate coprime_expl coprimeXl) (at level 10, only parsing) : fun_scope. Notation "@ 'coprime_expr'" := (deprecate coprime_expr coprimeXr) (at level 10, only parsing) : fun_scope. Notation coprime_mull := (deprecate coprime_mull coprimeMl) (only parsing). Notation coprime_mulr := (deprecate coprime_mulr coprimeMr) (only parsing). Notation coprime_expl := (fun k => @coprime_expl k _ _) (only parsing). Notation coprime_expr := (fun k => @coprime_expr k _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/eqtype.v000066400000000000000000001136231375767750300226200ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool. (******************************************************************************) (* This file defines two "base" combinatorial interfaces: *) (* eqType == the structure for types with a decidable equality. *) (* subType P == the structure for types isomorphic to {x : T | P x} with *) (* P : pred T for some type T. *) (* The following are used to construct eqType instances: *) (* EqType T m == the packed eqType class for type T and mixin m. *) (* --> As eqType is a root class, equality mixins and classes coincide. *) (* Equality.axiom e <-> e : rel T is a valid comparison decision procedure *) (* for type T: reflect (x = y) (e x y) for all x y : T. *) (* EqMixin eP == the equality mixin for eP : Equality.axiom e. *) (* --> Such manifest equality mixins should be declared Canonical to allow *) (* for generic folding of equality predicates (see lemma eqE below). *) (* [eqType of T for eT] == clone for T of eT, where eT is an eqType for a *) (* type convertible, but usually not identical, to T. *) (* [eqType of T] == clone for T of the eqType inferred for T, possibly *) (* after unfolding some definitions. *) (* [eqMixin of T] == mixin of the eqType inferred for T. *) (* comparable T <-> equality on T is decidable. *) (* := forall x y : T, decidable (x = y) *) (* comparableMixin compT == equality mixin for compT : comparable T. *) (* InjEqMixin injf == an Equality mixin for T, using an f : T -> U where *) (* U has an eqType structure and injf : injective f. *) (* PcanEqMixin fK == an Equality mixin similarly derived from f and a left *) (* inverse partial function g and fK : pcancel f g. *) (* CanEqMixin fK == an Equality mixin similarly derived from f and a left *) (* inverse function g and fK : cancel f g. *) (* --> Equality mixins derived by the above should never be made Canonical as *) (* they provide only comparisons with a generic head constant. *) (* The eqType interface supports the following operations: *) (* x == y <=> x compares equal to y (this is a boolean test). *) (* x == y :> T <=> x == y at type T. *) (* x != y <=> x and y compare unequal. *) (* x != y :> T <=> x and y compare unequal at type T. *) (* x =P y :: a proof of reflect (x = y) (x == y); x =P y coerces *) (* to x == y -> x = y. *) (* eq_op == the boolean relation behind the == notation. *) (* pred1 a == the singleton predicate [pred x | x == a]. *) (* pred2, pred3, pred4 == pair, triple, quad predicates. *) (* predC1 a == [pred x | x != a]. *) (* [predU1 a & A] == [pred x | (x == a) || (x \in A)]. *) (* [predD1 A & a] == [pred x | x != a & x \in A]. *) (* predU1 a P, predD1 P a == applicative versions of the above. *) (* frel f == the relation associated with f : T -> T. *) (* := [rel x y | f x == y]. *) (* invariant f k == elements of T whose k-class is f-invariant. *) (* := [pred x | k (f x) == k x] with f : T -> T. *) (* [fun x : T => e0 with a1 |-> e1, .., a_n |-> e_n] *) (* [eta f with a1 |-> e1, .., a_n |-> e_n] == *) (* the auto-expanding function that maps x = a_i to e_i, and other values *) (* of x to e0 (resp. f x). In the first form the `: T' is optional and x *) (* can occur in a_i or e_i. *) (* Equality on an eqType is proof-irrelevant (lemma eq_irrelevance). *) (* The eqType interface is implemented for most standard datatypes: *) (* bool, unit, void, option, prod (denoted A * B), sum (denoted A + B), *) (* sig (denoted {x | P}), sigT (denoted {i : I & T}). We also define *) (* tagged_as u v == v cast as T_(tag u) if tag v == tag u, else u. *) (* -> We have u == v <=> (tag u == tag v) && (tagged u == tagged_as u v). *) (* The subType interface supports the following operations: *) (* val == the generic injection from a subType S of T into T. *) (* For example, if u : {x : T | P}, then val u : T. *) (* val is injective because P is proof-irrelevant (P is in bool, *) (* and the is_true coercion expands to P = true). *) (* valP == the generic proof of P (val u) for u : subType P. *) (* Sub x Px == the generic constructor for a subType P; Px is a proof of P x *) (* and P should be inferred from the expected return type. *) (* insub x == the generic partial projection of T into a subType S of T. *) (* This returns an option S; if S : subType P then *) (* insub x = Some u with val u = x if P x, *) (* None if ~~ P x *) (* The insubP lemma encapsulates this dichotomy. *) (* P should be inferred from the expected return type. *) (* innew x == total (non-option) variant of insub when P = predT. *) (* {? x | P} == option {x | P} (syntax for casting insub x). *) (* insubd u0 x == the generic projection with default value u0. *) (* := odflt u0 (insub x). *) (* insigd A0 x == special case of insubd for S == {x | x \in A}, where A0 is *) (* a proof of x0 \in A. *) (* insub_eq x == transparent version of insub x that expands to Some/None *) (* when P x can evaluate. *) (* The subType P interface is most often implemented using one of: *) (* [subType for S_val] *) (* where S_val : S -> T is the first projection of a type S isomorphic to *) (* {x : T | P}. *) (* [newType for S_val] *) (* where S_val : S -> T is the projection of a type S isomorphic to *) (* wrapped T; in this case P must be predT. *) (* [subType for S_val by Srect], [newType for S_val by Srect] *) (* variants of the above where the eliminator is explicitly provided. *) (* Here S no longer needs to be syntactically identical to {x | P x} or *) (* wrapped T, but it must have a derived constructor S_Sub satisfying an *) (* eliminator Srect identical to the one the Coq Inductive command would *) (* have generated, and S_val (S_Sub x Px) (resp. S_val (S_sub x) for the *) (* newType form) must be convertible to x. *) (* variant of the above when S is a wrapper type for T (so P = predT). *) (* [subType of S], [subType of S for S_val] *) (* clones the canonical subType structure for S; if S_val is specified, *) (* then it replaces the inferred projector. *) (* Subtypes inherit the eqType structure of their base types; the generic *) (* structure should be explicitly instantiated using the *) (* [eqMixin of S by <:] *) (* construct to declare the equality mixin; this pattern is repeated for all *) (* the combinatorial interfaces (Choice, Countable, Finite). As noted above, *) (* such mixins should not be made Canonical. *) (* We add the following to the standard suffixes documented in ssrbool.v: *) (* 1, 2, 3, 4 -- explicit enumeration predicate for 1 (singleton), 2, 3, or *) (* 4 values. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope eq_scope. Declare Scope fun_delta_scope. Module Equality. Definition axiom T (e : rel T) := forall x y, reflect (x = y) (e x y). Structure mixin_of T := Mixin {op : rel T; _ : axiom op}. Notation class_of := mixin_of (only parsing). Section ClassDef. Structure type := Pack {sort; _ : class_of sort}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: Pack _ c := cT return class_of cT in c. Definition clone := fun c & cT -> T & phant_id (@Pack T c) cT => Pack c. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Notation eqType := type. Notation EqMixin := Mixin. Notation EqType T m := (@Pack T m). Notation "[ 'eqMixin' 'of' T ]" := (class _ : mixin_of T) (at level 0, format "[ 'eqMixin' 'of' T ]") : form_scope. Notation "[ 'eqType' 'of' T 'for' C ]" := (@clone T C _ idfun id) (at level 0, format "[ 'eqType' 'of' T 'for' C ]") : form_scope. Notation "[ 'eqType' 'of' T ]" := (@clone T _ _ id id) (at level 0, format "[ 'eqType' 'of' T ]") : form_scope. End Exports. End Equality. Export Equality.Exports. Definition eq_op T := Equality.op (Equality.class T). (* eqE is a generic lemma that can be used to fold back recursive comparisons *) (* after using partial evaluation to simplify comparisons on concrete *) (* instances. The eqE lemma can be used e.g. like so: rewrite !eqE /= -!eqE. *) (* For instance, with the above rewrite, n.+1 == n.+1 gets simplified to *) (* n == n. For this to work, we need to declare equality _mixins_ *) (* as canonical. Canonical declarations remove the need for specific *) (* inverses to eqE (like eqbE, eqnE, eqseqE, etc.) for new recursive *) (* comparisons, but can only be used for manifest mixing with a bespoke *) (* comparison function, and so is incompatible with PcanEqMixin and the like *) (* - this is why the tree_eqMixin for GenTree.tree in library choice is not *) (* declared Canonical. *) Lemma eqE T x : eq_op x = Equality.op (Equality.class T) x. Proof. by []. Qed. Lemma eqP T : Equality.axiom (@eq_op T). Proof. by case: T => ? []. Qed. Arguments eqP {T x y}. Delimit Scope eq_scope with EQ. Open Scope eq_scope. Notation "x == y" := (eq_op x y) (at level 70, no associativity) : bool_scope. Notation "x == y :> T" := ((x : T) == (y : T)) (at level 70, y at next level) : bool_scope. Notation "x != y" := (~~ (x == y)) (at level 70, no associativity) : bool_scope. Notation "x != y :> T" := (~~ (x == y :> T)) (at level 70, y at next level) : bool_scope. Notation "x =P y" := (eqP : reflect (x = y) (x == y)) (at level 70, no associativity) : eq_scope. Notation "x =P y :> T" := (eqP : reflect (x = y :> T) (x == y :> T)) (at level 70, y at next level, no associativity) : eq_scope. Prenex Implicits eq_op eqP. Lemma eq_refl (T : eqType) (x : T) : x == x. Proof. exact/eqP. Qed. Notation eqxx := eq_refl. Lemma eq_sym (T : eqType) (x y : T) : (x == y) = (y == x). Proof. exact/eqP/eqP. Qed. Hint Resolve eq_refl eq_sym : core. Variant eq_xor_neq (T : eqType) (x y : T) : bool -> bool -> Set := | EqNotNeq of x = y : eq_xor_neq x y true true | NeqNotEq of x != y : eq_xor_neq x y false false. Lemma eqVneq (T : eqType) (x y : T) : eq_xor_neq x y (y == x) (x == y). Proof. by rewrite eq_sym; case: (altP eqP); constructor. Qed. Arguments eqVneq {T} x y, {T x y}. Section Contrapositives. Variables (T1 T2 : eqType). Implicit Types (A : pred T1) (b : bool) (P : Prop) (x : T1) (z : T2). Lemma contraTeq b x y : (x != y -> ~~ b) -> b -> x = y. Proof. by move=> imp hyp; apply/eqP; apply: contraTT hyp. Qed. Lemma contraNeq b x y : (x != y -> b) -> ~~ b -> x = y. Proof. by move=> imp hyp; apply/eqP; apply: contraNT hyp. Qed. Lemma contraFeq b x y : (x != y -> b) -> b = false -> x = y. Proof. by move=> imp /negbT; apply: contraNeq. Qed. Lemma contraPeq P x y : (x != y -> ~ P) -> P -> x = y. Proof. by move=> imp HP; apply: contraTeq isT => /imp /(_ HP). Qed. Lemma contra_not_eq P x y : (x != y -> P) -> ~ P -> x = y. Proof. by move=> imp; apply: contraPeq => /imp HP /(_ HP). Qed. Lemma contra_not_neq P x y : (x = y -> P) -> ~ P -> x != y. Proof. by move=> imp; apply: contra_notN => /eqP. Qed. Lemma contraTneq b x y : (x = y -> ~~ b) -> b -> x != y. Proof. by move=> imp; apply: contraTN => /eqP. Qed. Lemma contraNneq b x y : (x = y -> b) -> ~~ b -> x != y. Proof. by move=> imp; apply: contraNN => /eqP. Qed. Lemma contraFneq b x y : (x = y -> b) -> b = false -> x != y. Proof. by move=> imp /negbT; apply: contraNneq. Qed. Lemma contraPneq P x y : (x = y -> ~ P) -> P -> x != y. Proof. by move=> imp; apply: contraPN => /eqP. Qed. Lemma contra_eqN b x y : (b -> x != y) -> x = y -> ~~ b. Proof. by move=> imp /eqP; apply: contraL. Qed. Lemma contra_eqF b x y : (b -> x != y) -> x = y -> b = false. Proof. by move=> imp /eqP; apply: contraTF. Qed. Lemma contra_eqT b x y : (~~ b -> x != y) -> x = y -> b. Proof. by move=> imp /eqP; apply: contraLR. Qed. Lemma contra_neqN b x y : (b -> x = y) -> x != y -> ~~ b. Proof. by move=> imp; apply: contraNN => /imp->. Qed. Lemma contra_neqF b x y : (b -> x = y) -> x != y -> b = false. Proof. by move=> imp; apply: contraNF => /imp->. Qed. Lemma contra_neqT b x y : (~~ b -> x = y) -> x != y -> b. Proof. by move=> imp; apply: contraNT => /imp->. Qed. Lemma contra_eq_not P x y : (P -> x != y) -> x = y -> ~ P. Proof. by move=> imp /eqP; apply: contraTnot. Qed. Lemma contra_neq_not P x y : (P -> x = y) -> x != y -> ~ P. Proof. by move=> imp;apply: contraNnot => /imp->. Qed. Lemma contra_eq z1 z2 x1 x2 : (x1 != x2 -> z1 != z2) -> z1 = z2 -> x1 = x2. Proof. by move=> imp /eqP; apply: contraTeq. Qed. Lemma contra_neq z1 z2 x1 x2 : (x1 = x2 -> z1 = z2) -> z1 != z2 -> x1 != x2. Proof. by move=> imp; apply: contraNneq => /imp->. Qed. Lemma contra_neq_eq z1 z2 x1 x2 : (x1 != x2 -> z1 = z2) -> z1 != z2 -> x1 = x2. Proof. by move=> imp; apply: contraNeq => /imp->. Qed. Lemma contra_eq_neq z1 z2 x1 x2 : (z1 = z2 -> x1 != x2) -> x1 = x2 -> z1 != z2. Proof. by move=> imp; apply: contra_eqN => /eqP /imp. Qed. Lemma memPn A x : reflect {in A, forall y, y != x} (x \notin A). Proof. apply: (iffP idP) => [notDx y | notDx]; first by apply: contraTneq => ->. exact: contraL (notDx x) _. Qed. Lemma memPnC A x : reflect {in A, forall y, x != y} (x \notin A). Proof. by apply: (iffP (memPn A x)) => A'x y /A'x; rewrite eq_sym. Qed. Lemma ifN_eq R x y vT vF : x != y -> (if x == y then vT else vF) = vF :> R. Proof. exact: ifN. Qed. Lemma ifN_eqC R x y vT vF : x != y -> (if y == x then vT else vF) = vF :> R. Proof. by rewrite eq_sym; apply: ifN. Qed. End Contrapositives. Arguments memPn {T1 A x}. Arguments memPnC {T1 A x}. Theorem eq_irrelevance (T : eqType) x y : forall e1 e2 : x = y :> T, e1 = e2. Proof. pose proj z e := if x =P z is ReflectT e0 then e0 else e. suff: injective (proj y) by rewrite /proj => injp e e'; apply: injp; case: eqP. pose join (e : x = _) := etrans (esym e). apply: can_inj (join x y (proj x (erefl x))) _. by case: y /; case: _ / (proj x _). Qed. Corollary eq_axiomK (T : eqType) (x : T) : all_equal_to (erefl x). Proof. by move=> eq_x_x; apply: eq_irrelevance. Qed. (* We use the module system to circumvent a silly limitation that *) (* forbids using the same constant to coerce to different targets. *) Module Type EqTypePredSig. Parameter sort : eqType -> predArgType. End EqTypePredSig. Module MakeEqTypePred (eqmod : EqTypePredSig). Coercion eqmod.sort : eqType >-> predArgType. End MakeEqTypePred. Module Export EqTypePred := MakeEqTypePred Equality. Lemma unit_eqP : Equality.axiom (fun _ _ : unit => true). Proof. by do 2!case; left. Qed. Definition unit_eqMixin := EqMixin unit_eqP. Canonical unit_eqType := Eval hnf in EqType unit unit_eqMixin. (* Comparison for booleans. *) (* This is extensionally equal, but not convertible to Bool.eqb. *) Definition eqb b := addb (~~ b). Lemma eqbP : Equality.axiom eqb. Proof. by do 2!case; constructor. Qed. Canonical bool_eqMixin := EqMixin eqbP. Canonical bool_eqType := Eval hnf in EqType bool bool_eqMixin. Lemma eqbE : eqb = eq_op. Proof. by []. Qed. Lemma bool_irrelevance (b : bool) (p1 p2 : b) : p1 = p2. Proof. exact: eq_irrelevance. Qed. Lemma negb_add b1 b2 : ~~ (b1 (+) b2) = (b1 == b2). Proof. by rewrite -addNb. Qed. Lemma negb_eqb b1 b2 : (b1 != b2) = b1 (+) b2. Proof. by rewrite -addNb negbK. Qed. Lemma eqb_id b : (b == true) = b. Proof. by case: b. Qed. Lemma eqbF_neg b : (b == false) = ~~ b. Proof. by case: b. Qed. Lemma eqb_negLR b1 b2 : (~~ b1 == b2) = (b1 == ~~ b2). Proof. by case: b1; case: b2. Qed. (* Equality-based predicates. *) Notation xpred1 := (fun a1 x => x == a1). Notation xpred2 := (fun a1 a2 x => (x == a1) || (x == a2)). Notation xpred3 := (fun a1 a2 a3 x => [|| x == a1, x == a2 | x == a3]). Notation xpred4 := (fun a1 a2 a3 a4 x => [|| x == a1, x == a2, x == a3 | x == a4]). Notation xpredU1 := (fun a1 (p : pred _) x => (x == a1) || p x). Notation xpredC1 := (fun a1 x => x != a1). Notation xpredD1 := (fun (p : pred _) a1 x => (x != a1) && p x). Section EqPred. Variable T : eqType. Definition pred1 (a1 : T) := SimplPred (xpred1 a1). Definition pred2 (a1 a2 : T) := SimplPred (xpred2 a1 a2). Definition pred3 (a1 a2 a3 : T) := SimplPred (xpred3 a1 a2 a3). Definition pred4 (a1 a2 a3 a4 : T) := SimplPred (xpred4 a1 a2 a3 a4). Definition predU1 (a1 : T) p := SimplPred (xpredU1 a1 p). Definition predC1 (a1 : T) := SimplPred (xpredC1 a1). Definition predD1 p (a1 : T) := SimplPred (xpredD1 p a1). Lemma pred1E : pred1 =2 eq_op. Proof. by move=> x y; apply: eq_sym. Qed. Variables (T2 : eqType) (x y : T) (z u : T2) (b : bool). Lemma predU1P : reflect (x = y \/ b) ((x == y) || b). Proof. by apply: (iffP orP); do [case=> [/eqP|]; [left | right]]. Qed. Lemma pred2P : reflect (x = y \/ z = u) ((x == y) || (z == u)). Proof. by apply: (iffP orP); do [case=> /eqP; [left | right]]. Qed. Lemma predD1P : reflect (x <> y /\ b) ((x != y) && b). Proof. by apply: (iffP andP)=> [] [] // /eqP. Qed. Lemma predU1l : x = y -> (x == y) || b. Proof. by move->; rewrite eqxx. Qed. Lemma predU1r : b -> (x == y) || b. Proof. by move->; rewrite orbT. Qed. End EqPred. Arguments predU1P {T x y b}. Arguments pred2P {T T2 x y z u}. Arguments predD1P {T x y b}. Prenex Implicits pred1 pred2 pred3 pred4 predU1 predC1 predD1. Notation "[ 'predU1' x & A ]" := (predU1 x [mem A]) (at level 0, format "[ 'predU1' x & A ]") : fun_scope. Notation "[ 'predD1' A & x ]" := (predD1 [mem A] x) (at level 0, format "[ 'predD1' A & x ]") : fun_scope. (* Lemmas for reflected equality and functions. *) Section EqFun. Section Exo. Variables (aT rT : eqType) (D : pred aT) (f : aT -> rT) (g : rT -> aT). Lemma inj_eq : injective f -> forall x y, (f x == f y) = (x == y). Proof. by move=> inj_f x y; apply/eqP/eqP=> [|-> //]; apply: inj_f. Qed. Lemma can_eq : cancel f g -> forall x y, (f x == f y) = (x == y). Proof. by move/can_inj; apply: inj_eq. Qed. Lemma bij_eq : bijective f -> forall x y, (f x == f y) = (x == y). Proof. by move/bij_inj; apply: inj_eq. Qed. Lemma can2_eq : cancel f g -> cancel g f -> forall x y, (f x == y) = (x == g y). Proof. by move=> fK gK x y; rewrite -[y in LHS]gK; apply: can_eq. Qed. Lemma inj_in_eq : {in D &, injective f} -> {in D &, forall x y, (f x == f y) = (x == y)}. Proof. by move=> inj_f x y Dx Dy; apply/eqP/eqP=> [|-> //]; apply: inj_f. Qed. Lemma can_in_eq : {in D, cancel f g} -> {in D &, forall x y, (f x == f y) = (x == y)}. Proof. by move/can_in_inj; apply: inj_in_eq. Qed. End Exo. Section Endo. Variable T : eqType. Definition frel f := [rel x y : T | f x == y]. Lemma inv_eq f : involutive f -> forall x y : T, (f x == y) = (x == f y). Proof. by move=> fK; apply: can2_eq. Qed. Lemma eq_frel f f' : f =1 f' -> frel f =2 frel f'. Proof. by move=> eq_f x y; rewrite /= eq_f. Qed. End Endo. Variable aT : Type. (* The invariant of a function f wrt a projection k is the pred of points *) (* that have the same projection as their image. *) Definition invariant (rT : eqType) f (k : aT -> rT) := [pred x | k (f x) == k x]. Variables (rT1 rT2 : eqType) (f : aT -> aT) (h : rT1 -> rT2) (k : aT -> rT1). Lemma invariant_comp : subpred (invariant f k) (invariant f (h \o k)). Proof. by move=> x eq_kfx; rewrite /= (eqP eq_kfx). Qed. Lemma invariant_inj : injective h -> invariant f (h \o k) =1 invariant f k. Proof. by move=> inj_h x; apply: (inj_eq inj_h). Qed. End EqFun. Prenex Implicits frel. (* The coercion to rel must be explicit for derived Notations to unparse. *) Notation coerced_frel f := (rel_of_simpl_rel (frel f)) (only parsing). Section FunWith. Variables (aT : eqType) (rT : Type). Variant fun_delta : Type := FunDelta of aT & rT. Definition fwith x y (f : aT -> rT) := [fun z => if z == x then y else f z]. Definition app_fdelta df f z := let: FunDelta x y := df in if z == x then y else f z. End FunWith. Prenex Implicits fwith. Notation "x |-> y" := (FunDelta x y) (at level 190, no associativity, format "'[hv' x '/ ' |-> y ']'") : fun_delta_scope. Delimit Scope fun_delta_scope with FUN_DELTA. Arguments app_fdelta {aT rT%type} df%FUN_DELTA f z. Notation "[ 'fun' z : T => F 'with' d1 , .. , dn ]" := (SimplFunDelta (fun z : T => app_fdelta d1%FUN_DELTA .. (app_fdelta dn%FUN_DELTA (fun _ => F)) ..)) (at level 0, z ident, only parsing) : fun_scope. Notation "[ 'fun' z => F 'with' d1 , .. , dn ]" := (SimplFunDelta (fun z => app_fdelta d1%FUN_DELTA .. (app_fdelta dn%FUN_DELTA (fun _ => F)) ..)) (at level 0, z ident, format "'[hv' [ '[' 'fun' z => '/ ' F ']' '/' 'with' '[' d1 , '/' .. , '/' dn ']' ] ']'" ) : fun_scope. Notation "[ 'eta' f 'with' d1 , .. , dn ]" := (SimplFunDelta (fun _ => app_fdelta d1%FUN_DELTA .. (app_fdelta dn%FUN_DELTA f) ..)) (at level 0, format "'[hv' [ '[' 'eta' '/ ' f ']' '/' 'with' '[' d1 , '/' .. , '/' dn ']' ] ']'" ) : fun_scope. (* Various EqType constructions. *) Section ComparableType. Variable T : Type. Definition comparable := forall x y : T, decidable (x = y). Hypothesis compare_T : comparable. Definition compareb x y : bool := compare_T x y. Lemma compareP : Equality.axiom compareb. Proof. by move=> x y; apply: sumboolP. Qed. Definition comparableMixin := EqMixin compareP. End ComparableType. Definition eq_comparable (T : eqType) : comparable T := fun x y => decP (x =P y). Section SubType. Variables (T : Type) (P : pred T). Structure subType : Type := SubType { sub_sort :> Type; val : sub_sort -> T; Sub : forall x, P x -> sub_sort; _ : forall K (_ : forall x Px, K (@Sub x Px)) u, K u; _ : forall x Px, val (@Sub x Px) = x }. (* Generic proof that the second property holds by conversion. *) (* The vrefl_rect alias is used to flag generic proofs of the first property. *) Lemma vrefl : forall x, P x -> x = x. Proof. by []. Qed. Definition vrefl_rect := vrefl. Definition clone_subType U v := fun sT & sub_sort sT -> U => fun c Urec cK (sT' := @SubType U v c Urec cK) & phant_id sT' sT => sT'. Section Theory. Variable sT : subType. Local Notation val := (@val sT). Local Notation Sub x Px := (@Sub sT x Px). Variant Sub_spec : sT -> Type := SubSpec x Px : Sub_spec (Sub x Px). Lemma SubP u : Sub_spec u. Proof. by case: sT Sub_spec SubSpec u => /= U _ mkU rec _. Qed. Lemma SubK x Px : val (Sub x Px) = x. Proof. by case: sT. Qed. Definition insub x := if idP is ReflectT Px then Some (Sub x Px) else None. Definition insubd u0 x := odflt u0 (insub x). Variant insub_spec x : option sT -> Type := | InsubSome u of P x & val u = x : insub_spec x (Some u) | InsubNone of ~~ P x : insub_spec x None. Lemma insubP x : insub_spec x (insub x). Proof. by rewrite /insub; case: {-}_ / idP; [left; rewrite ?SubK | right; apply/negP]. Qed. Lemma insubT x Px : insub x = Some (Sub x Px). Proof. do [case: insubP => [/SubP[y Py] _ <- | /negP// ]; rewrite SubK] in Px *. by rewrite (bool_irrelevance Px Py). Qed. Lemma insubF x : P x = false -> insub x = None. Proof. by move/idP; case: insubP. Qed. Lemma insubN x : ~~ P x -> insub x = None. Proof. by move/negPf/insubF. Qed. Lemma isSome_insub : ([eta insub] : pred T) =1 P. Proof. by apply: fsym => x; case: insubP => // /negPf. Qed. Lemma insubK : ocancel insub val. Proof. by move=> x; case: insubP. Qed. Lemma valP u : P (val u). Proof. by case/SubP: u => x Px; rewrite SubK. Qed. Lemma valK : pcancel val insub. Proof. by case/SubP=> x Px; rewrite SubK; apply: insubT. Qed. Lemma val_inj : injective val. Proof. exact: pcan_inj valK. Qed. Lemma valKd u0 : cancel val (insubd u0). Proof. by move=> u; rewrite /insubd valK. Qed. Lemma val_insubd u0 x : val (insubd u0 x) = if P x then x else val u0. Proof. by rewrite /insubd; case: insubP => [u -> | /negPf->]. Qed. Lemma insubdK u0 : {in P, cancel (insubd u0) val}. Proof. by move=> x Px; rewrite /= val_insubd [P x]Px. Qed. Let insub_eq_aux x isPx : P x = isPx -> option sT := if isPx as b return _ = b -> _ then fun Px => Some (Sub x Px) else fun=> None. Definition insub_eq x := insub_eq_aux (erefl (P x)). Lemma insub_eqE : insub_eq =1 insub. Proof. rewrite /insub_eq => x; set b := P x; rewrite [in LHS]/b in (Db := erefl b) *. by case: b in Db *; [rewrite insubT | rewrite insubF]. Qed. End Theory. End SubType. Arguments SubType {T P} sub_sort val Sub rec SubK. Arguments val {T P sT} u : rename. Arguments Sub {T P sT} x Px : rename. Arguments vrefl {T P} x Px. Arguments vrefl_rect {T P} x Px. Arguments clone_subType [T P] U v [sT] _ [c Urec cK]. Arguments insub {T P sT} x. Arguments insubd {T P sT} u0 x. Arguments insubT [T] P [sT x]. Arguments val_inj {T P sT} [u1 u2] eq_u12 : rename. Arguments valK {T P sT} u : rename. Arguments valKd {T P sT} u0 u : rename. Arguments insubK {T P} sT x. Arguments insubdK {T P sT} u0 [x] Px. Local Notation inlined_sub_rect := (fun K K_S u => let (x, Px) as u return K u := u in K_S x Px). Local Notation inlined_new_rect := (fun K K_S u => let (x) as u return K u := u in K_S x). Reserved Notation "[ 'subType' 'for' v ]" (at level 0, format "[ 'subType' 'for' v ]"). Notation "[ 'subType' 'for' v ]" := (SubType _ v _ inlined_sub_rect vrefl_rect) (only parsing) : form_scope. Notation "[ 'subType' 'for' v ]" := (SubType _ v _ _ vrefl_rect) (only printing) : form_scope. Notation "[ 'subType' 'for' v 'by' rec ]" := (SubType _ v _ rec vrefl) (at level 0, format "[ 'subType' 'for' v 'by' rec ]") : form_scope. Notation "[ 'subType' 'of' U 'for' v ]" := (clone_subType U v id idfun) (at level 0, format "[ 'subType' 'of' U 'for' v ]") : form_scope. Notation "[ 'subType' 'of' U ]" := (clone_subType U _ id id) (at level 0, format "[ 'subType' 'of' U ]") : form_scope. Definition NewType T U v c Urec := let Urec' P IH := Urec P (fun x : T => IH x isT : P _) in SubType U v (fun x _ => c x) Urec'. Arguments NewType [T U]. Reserved Notation "[ 'newType' 'for' v ]" (at level 0, format "[ 'newType' 'for' v ]"). Notation "[ 'newType' 'for' v ]" := (NewType v _ inlined_new_rect vrefl_rect) (only parsing) : form_scope. Notation "[ 'newType' 'for' v ]" := (NewType v _ _ vrefl_rect) (only printing) : form_scope. Notation "[ 'newType' 'for' v 'by' rec ]" := (NewType v _ rec vrefl) (at level 0, format "[ 'newType' 'for' v 'by' rec ]") : form_scope. Definition innew T nT x := @Sub T predT nT x (erefl true). Arguments innew {T nT}. Lemma innew_val T nT : cancel val (@innew T nT). Proof. by move=> u; apply: val_inj; apply: SubK. Qed. (* Prenex Implicits and renaming. *) Notation sval := (@proj1_sig _ _). Notation "@ 'sval'" := (@proj1_sig) (at level 10, format "@ 'sval'"). Section SigProj. Variables (T : Type) (P Q : T -> Prop). Lemma svalP : forall u : sig P, P (sval u). Proof. by case. Qed. Definition s2val (u : sig2 P Q) := let: exist2 x _ _ := u in x. Lemma s2valP u : P (s2val u). Proof. by case: u. Qed. Lemma s2valP' u : Q (s2val u). Proof. by case: u. Qed. End SigProj. Prenex Implicits svalP s2val s2valP s2valP'. Canonical sig_subType T (P : pred T) : subType [eta P] := Eval hnf in [subType for @sval T [eta [eta P]]]. (* Shorthand for sigma types over collective predicates. *) Notation "{ x 'in' A }" := {x | x \in A} (at level 0, x at level 99, format "{ x 'in' A }") : type_scope. Notation "{ x 'in' A | P }" := {x | (x \in A) && P} (at level 0, x at level 99, format "{ x 'in' A | P }") : type_scope. (* Shorthand for the return type of insub. *) Notation "{ ? x : T | P }" := (option {x : T | is_true P}) (at level 0, x at level 99, only parsing) : type_scope. Notation "{ ? x | P }" := {? x : _ | P} (at level 0, x at level 99, format "{ ? x | P }") : type_scope. Notation "{ ? x 'in' A }" := {? x | x \in A} (at level 0, x at level 99, format "{ ? x 'in' A }") : type_scope. Notation "{ ? x 'in' A | P }" := {? x | (x \in A) && P} (at level 0, x at level 99, format "{ ? x 'in' A | P }") : type_scope. (* A variant of injection with default that infers a collective predicate *) (* from the membership proof for the default value. *) Definition insigd T (A : mem_pred T) x (Ax : in_mem x A) := insubd (exist [eta A] x Ax). (* There should be a rel definition for the subType equality op, but this *) (* seems to cause the simpl tactic to diverge on expressions involving == *) (* on 4+ nested subTypes in a "strict" position (e.g., after ~~). *) (* Definition feq f := [rel x y | f x == f y]. *) Section TransferEqType. Variables (T : Type) (eT : eqType) (f : T -> eT). Lemma inj_eqAxiom : injective f -> Equality.axiom (fun x y => f x == f y). Proof. by move=> f_inj x y; apply: (iffP eqP) => [|-> //]; apply: f_inj. Qed. Definition InjEqMixin f_inj := EqMixin (inj_eqAxiom f_inj). Definition PcanEqMixin g (fK : pcancel f g) := InjEqMixin (pcan_inj fK). Definition CanEqMixin g (fK : cancel f g) := InjEqMixin (can_inj fK). End TransferEqType. Section SubEqType. Variables (T : eqType) (P : pred T) (sT : subType P). Local Notation ev_ax := (fun T v => @Equality.axiom T (fun x y => v x == v y)). Lemma val_eqP : ev_ax sT val. Proof. exact: inj_eqAxiom val_inj. Qed. Definition sub_eqMixin := EqMixin val_eqP. Canonical sub_eqType := Eval hnf in EqType sT sub_eqMixin. Definition SubEqMixin := (let: SubType _ v _ _ _ as sT' := sT return ev_ax sT' val -> Equality.class_of sT' in fun vP : ev_ax _ v => EqMixin vP ) val_eqP. Lemma val_eqE (u v : sT) : (val u == val v) = (u == v). Proof. by []. Qed. End SubEqType. Arguments val_eqP {T P sT x y}. Notation "[ 'eqMixin' 'of' T 'by' <: ]" := (SubEqMixin _ : Equality.class_of T) (at level 0, format "[ 'eqMixin' 'of' T 'by' <: ]") : form_scope. Definition void_eqMixin := PcanEqMixin (of_voidK unit). Canonical void_eqType := EqType void void_eqMixin. Section SigEqType. Variables (T : eqType) (P : pred T). Definition sig_eqMixin := Eval hnf in [eqMixin of {x | P x} by <:]. Canonical sig_eqType := Eval hnf in EqType {x | P x} sig_eqMixin. End SigEqType. Section ProdEqType. Variable T1 T2 : eqType. Definition pair_eq : rel (T1 * T2) := fun u v => (u.1 == v.1) && (u.2 == v.2). Lemma pair_eqP : Equality.axiom pair_eq. Proof. move=> [x1 x2] [y1 y2] /=; apply: (iffP andP) => [[]|[<- <-]] //=. by do 2!move/eqP->. Qed. Canonical prod_eqMixin := EqMixin pair_eqP. Canonical prod_eqType := Eval hnf in EqType (T1 * T2) prod_eqMixin. Lemma pair_eqE : pair_eq = eq_op :> rel _. Proof. by []. Qed. Lemma xpair_eqE (x1 y1 : T1) (x2 y2 : T2) : ((x1, x2) == (y1, y2)) = ((x1 == y1) && (x2 == y2)). Proof. by []. Qed. Lemma pair_eq1 (u v : T1 * T2) : u == v -> u.1 == v.1. Proof. by case/andP. Qed. Lemma pair_eq2 (u v : T1 * T2) : u == v -> u.2 == v.2. Proof. by case/andP. Qed. End ProdEqType. Arguments pair_eq {T1 T2} u v /. Arguments pair_eqP {T1 T2}. Definition predX T1 T2 (p1 : pred T1) (p2 : pred T2) := [pred z | p1 z.1 & p2 z.2]. Notation "[ 'predX' A1 & A2 ]" := (predX [mem A1] [mem A2]) (at level 0, format "[ 'predX' A1 & A2 ]") : fun_scope. Section OptionEqType. Variable T : eqType. Definition opt_eq (u v : option T) : bool := oapp (fun x => oapp (eq_op x) false v) (~~ v) u. Lemma opt_eqP : Equality.axiom opt_eq. Proof. case=> [x|] [y|] /=; by [constructor | apply: (iffP eqP) => [|[]] ->]. Qed. Canonical option_eqMixin := EqMixin opt_eqP. Canonical option_eqType := Eval hnf in EqType (option T) option_eqMixin. End OptionEqType. Arguments opt_eq {T} !u !v. Section TaggedAs. Variables (I : eqType) (T_ : I -> Type). Implicit Types u v : {i : I & T_ i}. Definition tagged_as u v := if tag u =P tag v is ReflectT eq_uv then eq_rect_r T_ (tagged v) eq_uv else tagged u. Lemma tagged_asE u x : tagged_as u (Tagged T_ x) = x. Proof. by rewrite /tagged_as /=; case: eqP => // eq_uu; rewrite [eq_uu]eq_axiomK. Qed. End TaggedAs. Section TagEqType. Variables (I : eqType) (T_ : I -> eqType). Implicit Types u v : {i : I & T_ i}. Definition tag_eq u v := (tag u == tag v) && (tagged u == tagged_as u v). Lemma tag_eqP : Equality.axiom tag_eq. Proof. rewrite /tag_eq => [] [i x] [j] /=. case: eqP => [<-|Hij] y; last by right; case. by apply: (iffP eqP) => [->|<-]; rewrite tagged_asE. Qed. Canonical tag_eqMixin := EqMixin tag_eqP. Canonical tag_eqType := Eval hnf in EqType {i : I & T_ i} tag_eqMixin. Lemma tag_eqE : tag_eq = eq_op. Proof. by []. Qed. Lemma eq_tag u v : u == v -> tag u = tag v. Proof. by move/eqP->. Qed. Lemma eq_Tagged u x :(u == Tagged _ x) = (tagged u == x). Proof. by rewrite -tag_eqE /tag_eq eqxx tagged_asE. Qed. End TagEqType. Arguments tag_eq {I T_} !u !v. Arguments tag_eqP {I T_ x y}. Section SumEqType. Variables T1 T2 : eqType. Implicit Types u v : T1 + T2. Definition sum_eq u v := match u, v with | inl x, inl y | inr x, inr y => x == y | _, _ => false end. Lemma sum_eqP : Equality.axiom sum_eq. Proof. case=> x [] y /=; by [right | apply: (iffP eqP) => [->|[->]]]. Qed. Canonical sum_eqMixin := EqMixin sum_eqP. Canonical sum_eqType := Eval hnf in EqType (T1 + T2) sum_eqMixin. Lemma sum_eqE : sum_eq = eq_op. Proof. by []. Qed. End SumEqType. Arguments sum_eq {T1 T2} !u !v. Arguments sum_eqP {T1 T2 x y}. Section MonoHomoTheory. Variables (aT rT : eqType) (f : aT -> rT). Variables (aR aR' : rel aT) (rR rR' : rel rT). Hypothesis aR_refl : reflexive aR. Hypothesis rR_refl : reflexive rR. Hypothesis aR'E : forall x y, aR' x y = (x != y) && (aR x y). Hypothesis rR'E : forall x y, rR' x y = (x != y) && (rR x y). Let aRE x y : aR x y = (x == y) || (aR' x y). Proof. by rewrite aR'E; case: eqVneq => //= ->; apply: aR_refl. Qed. Let rRE x y : rR x y = (x == y) || (rR' x y). Proof. by rewrite rR'E; case: eqVneq => //= ->; apply: rR_refl. Qed. Section InDom. Variable D : pred aT. Section DifferentDom. Variable D' : pred aT. Lemma homoW_in : {in D & D', {homo f : x y / aR' x y >-> rR' x y}} -> {in D & D', {homo f : x y / aR x y >-> rR x y}}. Proof. move=> mf x y xD yD /=; rewrite aRE => /orP[/eqP->|/mf]; by rewrite rRE ?eqxx // orbC => ->. Qed. Lemma inj_homo_in : {in D & D', injective f} -> {in D & D', {homo f : x y / aR x y >-> rR x y}} -> {in D & D', {homo f : x y / aR' x y >-> rR' x y}}. Proof. move=> fI mf x y xD yD /=; rewrite aR'E rR'E => /andP[neq_xy xy]. by rewrite mf ?andbT //; apply: contra_neq neq_xy => /fI; apply. Qed. End DifferentDom. Hypothesis aR_anti : antisymmetric aR. Hypothesis rR_anti : antisymmetric rR. Lemma mono_inj_in : {in D &, {mono f : x y / aR x y >-> rR x y}} -> {in D &, injective f}. Proof. by move=> mf x y ?? eqf; apply/aR_anti; rewrite -!mf// eqf rR_refl. Qed. Lemma anti_mono_in : {in D &, {mono f : x y / aR x y >-> rR x y}} -> {in D &, {mono f : x y / aR' x y >-> rR' x y}}. Proof. move=> mf x y ??; rewrite rR'E aR'E mf// (@inj_in_eq _ _ D)//. exact: mono_inj_in. Qed. Lemma total_homo_mono_in : total aR -> {in D &, {homo f : x y / aR' x y >-> rR' x y}} -> {in D &, {mono f : x y / aR x y >-> rR x y}}. Proof. move=> aR_tot mf x y xD yD. have [->|neq_xy] := eqVneq x y; first by rewrite ?eqxx ?aR_refl ?rR_refl. have [xy|] := (boolP (aR x y)); first by rewrite rRE mf ?orbT// aR'E neq_xy. have /orP [->//|] := aR_tot x y. rewrite aRE eq_sym (negPf neq_xy) /= => /mf -/(_ yD xD). rewrite rR'E => /andP[Nfxfy fyfx] _; apply: contra_neqF Nfxfy => fxfy. by apply/rR_anti; rewrite fyfx fxfy. Qed. End InDom. Let D := @predT aT. Lemma homoW : {homo f : x y / aR' x y >-> rR' x y} -> {homo f : x y / aR x y >-> rR x y}. Proof. by move=> mf ???; apply: (@homoW_in D D) => // ????; apply: mf. Qed. Lemma inj_homo : injective f -> {homo f : x y / aR x y >-> rR x y} -> {homo f : x y / aR' x y >-> rR' x y}. Proof. by move=> fI mf ???; apply: (@inj_homo_in D D) => //????; [apply: fI|apply: mf]. Qed. Hypothesis aR_anti : antisymmetric aR. Hypothesis rR_anti : antisymmetric rR. Lemma mono_inj : {mono f : x y / aR x y >-> rR x y} -> injective f. Proof. by move=> mf x y eqf; apply/aR_anti; rewrite -!mf eqf rR_refl. Qed. Lemma anti_mono : {mono f : x y / aR x y >-> rR x y} -> {mono f : x y / aR' x y >-> rR' x y}. Proof. by move=> mf x y; rewrite rR'E aR'E mf inj_eq //; apply: mono_inj. Qed. Lemma total_homo_mono : total aR -> {homo f : x y / aR' x y >-> rR' x y} -> {mono f : x y / aR x y >-> rR x y}. Proof. move=> /(@total_homo_mono_in D rR_anti) hmf hf => x y. by apply: hmf => // ?? _ _; apply: hf. Qed. End MonoHomoTheory. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/finfun.v000066400000000000000000000474301375767750300226000ustar00rootroot00000000000000(* (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 tuple. (******************************************************************************) (* This file implements a type for functions with a finite domain: *) (* {ffun aT -> rT} where aT should have a finType structure, *) (* {ffun forall x : aT, rT} for dependent functions over a finType aT, *) (* and {ffun funT} where funT expands to a product over a finType. *) (* Any eqType, choiceType, countType and finType structures on rT extend to *) (* {ffun aT -> rT} as Leibnitz equality and extensional equalities coincide. *) (* (T ^ n)%type is notation for {ffun 'I_n -> T}, which is isomorphic *) (* to n.-tuple T, but is structurally positive and thus can be used to *) (* define inductive types, e.g., Inductive tree := node n of tree ^ n (see *) (* mid-file for an expanded example). *) (* --> More generally, {ffun fT} is always structurally positive. *) (* {ffun fT} inherits combinatorial structures of rT, i.e., eqType, *) (* choiceType, countType, and finType. However, due to some limitations of *) (* the Coq 8.9 unification code the structures are only inherited in the *) (* NON dependent case, when rT does not depend on x. *) (* For f : {ffun fT} with fT := forall x : aT, rT we define *) (* f x == the image of x under f (f coerces to a CiC function) *) (* --> The coercion is structurally decreasing, e.g., Coq will accept *) (* Fixpoint size t := let: node n f := t in sumn (codom (size \o f)) + 1. *) (* as structurally decreasing on t of the inductive tree type above. *) (* {dffun fT} == alias for {ffun fT} that inherits combinatorial *) (* structures on rT, when rT DOES depend on x. *) (* total_fun g == the function induced by a dependent function g of type *) (* forall x, rT on the total space {x : aT & rT}. *) (* := fun x => Tagged (fun x => rT) (g x). *) (* tfgraph f == the total function graph of f, i.e., the #|aT|.-tuple *) (* of all the (dependent pair) values of total_fun f. *) (* finfun g == the f extensionally equal to g, and the RECOMMENDED *) (* interface for building elements of {ffun fT}. *) (* [ffun x : aT => E] := finfun (fun x : aT => E). *) (* There should be an explicit type constraint on E if *) (* type does not depend on x, due to the Coq unification *) (* limitations referred to above. *) (* ffun0 aT0 == the trivial finfun, from a proof aT0 that #|aT| = 0. *) (* f \in family F == f belongs to the family F (f x \in F x for all x) *) (* There are additional operations for non-dependent finite functions, *) (* i.e., f in {ffun aT -> rT}. *) (* [ffun x => E] := finfun (fun x => E). *) (* The type of E must not depend on x; this restriction *) (* is a mitigation of the aforementioned Coq unification *) (* limitations. *) (* [ffun=> E] := [ffun _ => E] (E should not have a dependent type). *) (* fgraph f == the function graph of f, i.e., the #|aT|.-tuple *) (* listing the values of f x, for x ranging over enum aT. *) (* Finfun G == the finfun f whose (simple) function graph is G. *) (* f \in ffun_on R == the range of f is a subset of R. *) (* y.-support f == the y-support of f, i.e., [pred x | f x != y]. *) (* Thus, y.-support f \subset D means f has y-support D. *) (* We will put Notation support := 0.-support in ssralg. *) (* f \in pffun_on y D R == f is a y-partial function from D to R: *) (* f has y-support D and f x \in R for all x \in D. *) (* f \in pfamily y D F == f belongs to the y-partial family from D to F: *) (* f has y-support D and f x \in F x for all x \in D. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Def. Variables (aT : finType) (rT : aT -> Type). Inductive finfun_on : seq aT -> Type := | finfun_nil : finfun_on [::] | finfun_cons x s of rT x & finfun_on s : finfun_on (x :: s). Local Fixpoint finfun_rec (g : forall x, rT x) s : finfun_on s := if s is x1 :: s1 then finfun_cons (g x1) (finfun_rec g s1) else finfun_nil. Local Fixpoint fun_of_fin_rec x s (f_s : finfun_on s) : x \in s -> rT x := if f_s is finfun_cons x1 s1 y1 f_s1 then if eqP is ReflectT Dx in reflect _ Dxb return Dxb || (x \in s1) -> rT x then fun=> ecast x (rT x) (esym Dx) y1 else fun_of_fin_rec f_s1 else fun isF => False_rect (rT x) (notF isF). Variant finfun_of (ph : phant (forall x, rT x)) : predArgType := FinfunOf of finfun_on (enum aT). Definition dfinfun_of ph := finfun_of ph. Definition fun_of_fin ph (f : finfun_of ph) x := let: FinfunOf f_aT := f in fun_of_fin_rec f_aT (mem_enum aT x). End Def. Coercion fun_of_fin : finfun_of >-> Funclass. Identity Coercion unfold_dfinfun_of : dfinfun_of >-> finfun_of. Arguments fun_of_fin {aT rT ph} f x. Notation "{ 'ffun' fT }" := (finfun_of (Phant fT)) (at level 0, format "{ 'ffun' '[hv' fT ']' }") : type_scope. Notation "{ 'dffun' fT }" := (dfinfun_of (Phant fT)) (at level 0, format "{ 'dffun' '[hv' fT ']' }") : type_scope. Definition exp_finIndexType := ordinal_finType. Notation "T ^ n" := (@finfun_of (exp_finIndexType n) (fun=> T) (Phant _)) : type_scope. Local Notation finPi aT rT := (forall x : Finite.sort aT, rT x) (only parsing). Local Notation finfun_def := (fun aT rT g => FinfunOf (Phant (finPi aT rT)) (finfun_rec g (enum aT))). Module Type FinfunDefSig. Parameter finfun : forall aT rT, finPi aT rT -> {ffun finPi aT rT}. Axiom finfunE : finfun = finfun_def. End FinfunDefSig. Module FinfunDef : FinfunDefSig. Definition finfun := finfun_def. Lemma finfunE : finfun = finfun_def. Proof. by []. Qed. End FinfunDef. Notation finfun := FinfunDef.finfun. Canonical finfun_unlock := Unlockable FinfunDef.finfunE. Arguments finfun {aT rT} g. Notation "[ 'ffun' x : aT => E ]" := (finfun (fun x : aT => E)) (at level 0, x ident) : fun_scope. Notation "[ 'ffun' x => E ]" := (@finfun _ (fun=> _) (fun x => E)) (at level 0, x ident, format "[ 'ffun' x => E ]") : fun_scope. Notation "[ 'ffun' => E ]" := [ffun _ => E] (at level 0, format "[ 'ffun' => E ]") : fun_scope. (* Example outcommented. (* Examples of using finite functions as containers in recursive inductive *) (* types, and making use of the fact that the type and accessor are *) (* structurally positive and decreasing, respectively. *) Unset Elimination Schemes. Inductive tree := node n of tree ^ n. Fixpoint size t := let: node n f := t in sumn (codom (size \o f)) + 1. Example tree_step (K : tree -> Type) := forall n st (t := node st) & forall i : 'I_n, K (st i), K t. Example tree_rect K (Kstep : tree_step K) : forall t, K t. Proof. by fix IHt 1 => -[n st]; apply/Kstep=> i; apply: IHt. Defined. (* An artificial example use of dependent functions. *) Inductive tri_tree n := tri_row of {ffun forall i : 'I_n, tri_tree i}. Fixpoint tri_size n (t : tri_tree n) := let: tri_row f := t in sumn [seq tri_size (f i) | i : 'I_n] + 1. Example tri_tree_step (K : forall n, tri_tree n -> Type) := forall n st (t := tri_row st) & forall i : 'I_n, K i (st i), K n t. Example tri_tree_rect K (Kstep : tri_tree_step K) : forall n t, K n t. Proof. by fix IHt 2 => n [st]; apply/Kstep=> i; apply: IHt. Defined. Set Elimination Schemes. (* End example. *) *) (* The correspondence between finfun_of and CiC dependent functions. *) Section DepPlainTheory. Variables (aT : finType) (rT : aT -> Type). Notation fT := {ffun finPi aT rT}. Implicit Type f : fT. Fact ffun0 (aT0 : #|aT| = 0) : fT. Proof. by apply/finfun=> x; have:= card0_eq aT0 x. Qed. Lemma ffunE g x : (finfun g : fT) x = g x. Proof. rewrite unlock /=; set s := enum aT; set s_x : mem_seq s x := mem_enum _ _. by elim: s s_x => //= x1 s IHs; case: eqP => [|_]; [case: x1 / | apply: IHs]. Qed. Lemma ffunP (f1 f2 : fT) : (forall x, f1 x = f2 x) <-> f1 = f2. Proof. suffices ffunK f g: (forall x, f x = g x) -> f = finfun g. by split=> [/ffunK|] -> //; apply/esym/ffunK. case: f => f Dg; rewrite unlock; congr FinfunOf. have{} Dg x (aTx : mem_seq (enum aT) x): g x = fun_of_fin_rec f aTx. by rewrite -Dg /= (bool_irrelevance (mem_enum _ _) aTx). elim: (enum aT) / f (enum_uniq aT) => //= x1 s y f IHf /andP[s'x1 Us] in Dg *. rewrite Dg ?eqxx //=; case: eqP => // /eq_axiomK-> /= _. rewrite {}IHf // => x s_x; rewrite Dg ?s_x ?orbT //. by case: eqP (memPn s'x1 x s_x) => // _ _ /(bool_irrelevance s_x) <-. Qed. Lemma ffunK : @cancel (finPi aT rT) fT fun_of_fin finfun. Proof. by move=> f; apply/ffunP=> x; rewrite ffunE. Qed. Lemma eq_dffun (g1 g2 : forall x, rT x) : (forall x, g1 x = g2 x) -> finfun g1 = finfun g2. Proof. by move=> eq_g; apply/ffunP => x; rewrite !ffunE eq_g. Qed. Definition total_fun g x := Tagged rT (g x : rT x). Definition tfgraph f := codom_tuple (total_fun f). Lemma codom_tffun f : codom (total_fun f) = tfgraph f. Proof. by []. Qed. Local Definition tfgraph_inv (G : #|aT|.-tuple {x : aT & rT x}) : option fT := if eqfunP isn't ReflectT Dtg then None else Some [ffun x => ecast x (rT x) (Dtg x) (tagged (tnth G (enum_rank x)))]. Local Lemma tfgraphK : pcancel tfgraph tfgraph_inv. Proof. move=> f; have Dg x: tnth (tfgraph f) (enum_rank x) = total_fun f x. by rewrite tnth_map -[tnth _ _]enum_val_nth enum_rankK. rewrite /tfgraph_inv; case: eqfunP => /= [Dtg | [] x]; last by rewrite Dg. congr (Some _); apply/ffunP=> x; rewrite ffunE. by rewrite Dg in (Dx := Dtg x) *; rewrite eq_axiomK. Qed. Lemma tfgraph_inj : injective tfgraph. Proof. exact: pcan_inj tfgraphK. Qed. Definition family_mem mF := [pred f : fT | [forall x, in_mem (f x) (mF x)]]. Variables (pT : forall x, predType (rT x)) (F : forall x, pT x). (* Helper for defining notation for function families. *) Local Definition fmem F x := mem (F x : pT x). Lemma familyP f : reflect (forall x, f x \in F x) (f \in family_mem (fmem F)). Proof. exact: forallP. Qed. End DepPlainTheory. Arguments ffunK {aT rT} f : rename. Arguments ffun0 {aT rT} aT0. Arguments eq_dffun {aT rT} [g1] g2 eq_g12. Arguments total_fun {aT rT} g x. Arguments tfgraph {aT rT} f. Arguments tfgraphK {aT rT} f : rename. Arguments tfgraph_inj {aT rT} [f1 f2] : rename. Arguments fmem {aT rT pT} F x /. Arguments familyP {aT rT pT F f}. Notation family F := (family_mem (fmem F)). Section InheritedStructures. Variable aT : finType. Notation dffun_aT rT rS := {dffun forall x : aT, rT x : rS}. Local Remark eqMixin rT : Equality.mixin_of (dffun_aT rT eqType). Proof. exact: PcanEqMixin tfgraphK. Qed. Canonical finfun_eqType (rT : eqType) := EqType {ffun aT -> rT} (eqMixin (fun=> rT)). Canonical dfinfun_eqType rT := EqType (dffun_aT rT eqType) (eqMixin rT). Local Remark choiceMixin rT : Choice.mixin_of (dffun_aT rT choiceType). Proof. exact: PcanChoiceMixin tfgraphK. Qed. Canonical finfun_choiceType (rT : choiceType) := ChoiceType {ffun aT -> rT} (choiceMixin (fun=> rT)). Canonical dfinfun_choiceType rT := ChoiceType (dffun_aT rT choiceType) (choiceMixin rT). Local Remark countMixin rT : Countable.mixin_of (dffun_aT rT countType). Proof. exact: PcanCountMixin tfgraphK. Qed. Canonical finfun_countType (rT : countType) := CountType {ffun aT -> rT} (countMixin (fun => rT)). Canonical dfinfun_countType rT := CountType (dffun_aT rT countType) (countMixin rT). Local Definition finMixin rT := PcanFinMixin (tfgraphK : @pcancel _ (dffun_aT rT finType) _ _). Canonical finfun_finType (rT : finType) := FinType {ffun aT -> rT} (finMixin (fun=> rT)). Canonical dfinfun_finType rT := FinType (dffun_aT rT finType) (finMixin rT). End InheritedStructures. Section FinFunTuple. Context {T : Type} {n : nat}. Definition tuple_of_finfun (f : T ^ n) : n.-tuple T := [tuple f i | i < n]. Definition finfun_of_tuple (t : n.-tuple T) : (T ^ n) := [ffun i => tnth t i]. Lemma finfun_of_tupleK : cancel finfun_of_tuple tuple_of_finfun. Proof. by move=> t; apply: eq_from_tnth => i; rewrite tnth_map ffunE tnth_ord_tuple. Qed. Lemma tuple_of_finfunK : cancel tuple_of_finfun finfun_of_tuple. Proof. by move=> f; apply/ffunP => i; rewrite ffunE tnth_map tnth_ord_tuple. Qed. End FinFunTuple. Section FunPlainTheory. Variables (aT : finType) (rT : Type). Notation fT := {ffun aT -> rT}. Implicit Types (f : fT) (R : pred rT). Definition fgraph f := codom_tuple f. Definition Finfun (G : #|aT|.-tuple rT) := [ffun x => tnth G (enum_rank x)]. Lemma tnth_fgraph f i : tnth (fgraph f) i = f (enum_val i). Proof. by rewrite tnth_map /tnth -enum_val_nth. Qed. Lemma FinfunK : cancel Finfun fgraph. Proof. by move=> G; apply/eq_from_tnth=> i; rewrite tnth_fgraph ffunE enum_valK. Qed. Lemma fgraphK : cancel fgraph Finfun. Proof. by move=> f; apply/ffunP=> x; rewrite ffunE tnth_fgraph enum_rankK. Qed. Lemma fgraph_ffun0 aT0 : fgraph (ffun0 aT0) = nil :> seq rT. Proof. by apply/nilP/eqP; rewrite size_tuple. Qed. Lemma codom_ffun f : codom f = fgraph f. Proof. by []. Qed. Lemma tagged_tfgraph f : @map _ rT tagged (tfgraph f) = fgraph f. Proof. by rewrite -map_comp. Qed. Lemma eq_ffun (g1 g2 : aT -> rT) : g1 =1 g2 -> finfun g1 = finfun g2. Proof. exact: eq_dffun. Qed. Lemma fgraph_codom f : fgraph f = codom_tuple f. Proof. exact/esym/val_inj/codom_ffun. Qed. Definition ffun_on_mem (mR : mem_pred rT) := family_mem (fun _ : aT => mR). Lemma ffun_onP R f : reflect (forall x, f x \in R) (f \in ffun_on_mem (mem R)). Proof. exact: forallP. Qed. End FunPlainTheory. Arguments Finfun {aT rT} G. Arguments fgraph {aT rT} f. Arguments FinfunK {aT rT} G : rename. Arguments fgraphK {aT rT} f : rename. Arguments eq_ffun {aT rT} [g1] g2 eq_g12. Arguments ffun_onP {aT rT R f}. Notation ffun_on R := (ffun_on_mem _ (mem R)). Notation "@ 'ffun_on' aT R" := (ffun_on R : simpl_pred (finfun_of (Phant (aT -> id _)))) (at level 10, aT, R at level 9). Lemma nth_fgraph_ord T n (x0 : T) (i : 'I_n) f : nth x0 (fgraph f) i = f i. Proof. by rewrite -[i in RHS]enum_rankK -tnth_fgraph (tnth_nth x0) enum_rank_ord. Qed. (*****************************************************************************) Section Support. Variables (aT : Type) (rT : eqType). Definition support_for y (f : aT -> rT) := [pred x | f x != y]. Lemma supportE x y f : (x \in support_for y f) = (f x != y). Proof. by []. Qed. End Support. Notation "y .-support" := (support_for y) (at level 2, format "y .-support") : fun_scope. Section EqTheory. Variables (aT : finType) (rT : eqType). Notation fT := {ffun aT -> rT}. Implicit Types (y : rT) (D : {pred aT}) (R : {pred rT}) (f : fT). Lemma supportP y D g : reflect (forall x, x \notin D -> g x = y) (y.-support g \subset D). Proof. by apply: (iffP subsetP) => Dg x; [apply: contraNeq | apply: contraR] => /Dg->. Qed. Definition pfamily_mem y mD (mF : aT -> mem_pred rT) := family (fun i : aT => if in_mem i mD then pred_of_simpl (mF i) else pred1 y). Lemma pfamilyP (pT : predType rT) y D (F : aT -> pT) f : reflect (y.-support f \subset D /\ {in D, forall x, f x \in F x}) (f \in pfamily_mem y (mem D) (fmem F)). Proof. apply: (iffP familyP) => [/= f_pfam | [/supportP f_supp f_fam] x]. split=> [|x Ax]; last by have:= f_pfam x; rewrite Ax. by apply/subsetP=> x; case: ifP (f_pfam x) => //= _ fx0 /negP[]. by case: ifPn => Ax /=; rewrite inE /= (f_fam, f_supp). Qed. Definition pffun_on_mem y mD mR := pfamily_mem y mD (fun _ => mR). Lemma pffun_onP y D R f : reflect (y.-support f \subset D /\ {subset image f D <= R}) (f \in pffun_on_mem y (mem D) (mem R)). Proof. apply: (iffP (pfamilyP y D (fun _ => R) f)) => [] [-> f_fam]; split=> //. by move=> _ /imageP[x Ax ->]; apply: f_fam. by move=> x Ax; apply: f_fam; apply/imageP; exists x. Qed. End EqTheory. Arguments supportP {aT rT y D g}. Arguments pfamilyP {aT rT pT y D F f}. Arguments pffun_onP {aT rT y D R f}. Notation pfamily y D F := (pfamily_mem y (mem D) (fmem F)). Notation pffun_on y D R := (pffun_on_mem y (mem D) (mem R)). (*****************************************************************************) Section FinDepTheory. Variables (aT : finType) (rT : aT -> finType). Notation fT := {dffun forall x : aT, rT x}. Lemma card_family (F : forall x, pred (rT x)) : #|(family F : simpl_pred fT)| = foldr muln 1 [seq #|F x| | x : aT]. Proof. rewrite /image_mem; set E := enum aT in (uniqE := enum_uniq aT) *. have trivF x: x \notin E -> #|F x| = 1 by rewrite mem_enum. elim: E uniqE => /= [_ | x0 E IH_E /andP[E'x0 uniqE]] in F trivF *. have /fin_all_exists[f0 Ff0] x: exists y0, F x =i pred1 y0. have /pred0Pn[y Fy]: #|F x| != 0 by rewrite trivF. by exists y; apply/fsym/subset_cardP; rewrite ?subset_pred1 // card1 trivF. apply: eq_card1 (finfun f0 : fT) _ _ => f; apply/familyP/eqP=> [Ff | {f}-> x]. by apply/ffunP=> x; have:= Ff x; rewrite Ff0 ffunE => /eqP. by rewrite ffunE Ff0 inE /=. have [y0 Fxy0 | Fx00] := pickP (F x0); last first. by rewrite !eq_card0 // => f; apply: contraFF (Fx00 (f x0))=> /familyP; apply. pose F1 x := if eqP is ReflectT Dx then xpred1 (ecast x (rT x) Dx y0) else F x. transitivity (#|[predX F x0 & family F1 : pred fT]|); last first. rewrite cardX {}IH_E {uniqE}// => [|x E'x]; last first. rewrite /F1; case: eqP => [Dx | /nesym/eqP-x0'x]; first exact: card1. by rewrite trivF // negb_or x0'x. congr (_ * foldr _ _ _); apply/eq_in_map=> x Ex. by rewrite /F1; case: eqP => // Dx0; rewrite Dx0 Ex in E'x0. pose g yf : fT := let: (y, f) := yf : rT x0 * fT in [ffun x => if eqP is ReflectT Dx then ecast x (rT x) Dx y else f x]. have gK: cancel (fun f : fT => (f x0, g (y0, f))) g. by move=> f; apply/ffunP=> x; rewrite !ffunE; case: eqP => //; case: x /. rewrite -(card_image (can_inj gK)); apply: eq_card => [] [y f] /=. apply/imageP/andP=> [[f1 /familyP/=Ff1] [-> ->]| [/=Fx0y /familyP/=Ff]]. split=> //; apply/familyP=> x; rewrite ffunE /F1 /=. by case: eqP => // Dx; apply: eqxx. exists (g (y, f)). by apply/familyP=> x; have:= Ff x; rewrite ffunE /F1; case: eqP; [case: x /|]. congr (_, _); first by rewrite /= ffunE; case: eqP => // Dx; rewrite eq_axiomK. by apply/ffunP=> x; have:= Ff x; rewrite !ffunE /F1; case: eqP => // Dx /eqP. Qed. Lemma card_dep_ffun : #|fT| = foldr muln 1 [seq #|rT x| | x : aT]. Proof. by rewrite -card_family; apply/esym/eq_card=> f; apply/familyP. Qed. End FinDepTheory. Section FinFunTheory. Variables aT rT : finType. Notation fT := {ffun aT -> rT}. Implicit Types (D : {pred aT}) (R : {pred rT}) (F : aT -> pred rT). Lemma card_pfamily y0 D F : #|pfamily y0 D F| = foldr muln 1 [seq #|F x| | x in D]. Proof. rewrite card_family !/(image _ _) /(enum D) -enumT /=. by elim: (enum aT) => //= x E ->; have [// | D'x] := ifP; rewrite card1 mul1n. Qed. Lemma card_pffun_on y0 D R : #|pffun_on y0 D R| = #|R| ^ #|D|. Proof. rewrite (cardE D) card_pfamily /image_mem. by elim: (enum D) => //= _ e ->; rewrite expnS. Qed. Lemma card_ffun_on R : #|@ffun_on aT R| = #|R| ^ #|aT|. Proof. rewrite card_family /image_mem cardT. by elim: (enum aT) => //= _ e ->; rewrite expnS. Qed. Lemma card_ffun : #|fT| = #|rT| ^ #|aT|. Proof. by rewrite -card_ffun_on; apply/esym/eq_card=> f; apply/forallP. Qed. End FinFunTheory. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/fingraph.v000066400000000000000000001113451375767750300231060ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat. From mathcomp Require Import seq path fintype. (******************************************************************************) (* This file develops the theory of finite graphs represented by an "edge" *) (* relation over a finType T; this mainly amounts to the theory of the *) (* transitive closure of such relations. *) (* For g : T -> seq T, e : rel T and f : T -> T we define: *) (* grel g == the adjacency relation y \in g x of the graph g. *) (* rgraph e == the graph (x |-> enum (e x)) of the relation e. *) (* dfs g n v x == the list of points traversed by a depth-first search of *) (* the g, at depth n, starting from x, and avoiding v. *) (* dfs_path g v x y <-> there is a path from x to y in g \ v. *) (* connect e == the reflexive transitive closure of e (computed by dfs). *) (* connect_sym e <-> connect e is symmetric, hence an equivalence relation. *) (* root e x == a representative of connect e x, which is the component *) (* of x in the transitive closure of e. *) (* roots e == the codomain predicate of root e. *) (* n_comp e a == the number of e-connected components of a, when a is *) (* e-closed and connect e is symmetric. *) (* equivalence classes of connect e if connect_sym e holds. *) (* closed e a == the collective predicate a is e-invariant. *) (* closure e a == the e-closure of a (the image of a under connect e). *) (* rel_adjunction h e e' a <-> in the e-closed domain a, h is the left part *) (* of an adjunction from e to another relation e'. *) (* fconnect f == connect (frel f), i.e., "connected under f iteration". *) (* froot f x == root (frel f) x, the root of the orbit of x under f. *) (* froots f == roots (frel f) == orbit representatives for f. *) (* orbit f x == lists the f-orbit of x. *) (* findex f x y == index of y in the f-orbit of x. *) (* order f x == size (cardinal) of the f-orbit of x. *) (* order_set f n == elements of f-order n. *) (* finv f == the inverse of f, if f is injective. *) (* := finv f x := iter (order x).-1 f x. *) (* fcard f a == number of orbits of f in a, provided a is f-invariant *) (* f is one-to-one. *) (* fclosed f a == the collective predicate a is f-invariant. *) (* fclosure f a == the closure of a under f iteration. *) (* fun_adjunction == rel_adjunction (frel f). *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Definition grel (T : eqType) (g : T -> seq T) := [rel x y | y \in g x]. (* Decidable connectivity in finite types. *) Section Connect. Variable T : finType. Section Dfs. Variable g : T -> seq T. Implicit Type v w a : seq T. Fixpoint dfs n v x := if x \in v then v else if n is n'.+1 then foldl (dfs n') (x :: v) (g x) else v. Lemma subset_dfs n v a : v \subset foldl (dfs n) v a. Proof. elim: n a v => [|n IHn]; first by elim=> //= *; rewrite if_same. elim=> //= x a IHa v; apply: subset_trans {IHa}(IHa _); case: ifP => // _. by apply: subset_trans (IHn _ _); apply/subsetP=> y; apply: predU1r. Qed. Inductive dfs_path v x y : Prop := DfsPath p of path (grel g) x p & y = last x p & [disjoint x :: p & v]. Lemma dfs_pathP n x y v : #|T| <= #|v| + n -> y \notin v -> reflect (dfs_path v x y) (y \in dfs n v x). Proof. have dfs_id w z: z \notin w -> dfs_path w z z. by exists [::]; rewrite ?disjoint_has //= orbF. elim: n => [|n IHn] /= in x y v * => le_v'_n not_vy. rewrite addn0 (geq_leqif (subset_leqif_card (subset_predT _))) in le_v'_n. by rewrite predT_subset in not_vy. have [v_x | not_vx] := ifPn. by rewrite (negPf not_vy); right=> [] [p _ _]; rewrite disjoint_has /= v_x. set v1 := x :: v; set a := g x; have sub_dfs := subsetP (subset_dfs n _ _). have [-> | neq_yx] := eqVneq y x. by rewrite sub_dfs ?mem_head //; left; apply: dfs_id. apply: (@equivP (exists2 x1, x1 \in a & dfs_path v1 x1 y)); last first. split=> {IHn} [[x1 a_x1 [p g_p p_y]] | [p /shortenP[]]]. rewrite disjoint_has has_sym /= has_sym /= => /norP[_ not_pv]. by exists (x1 :: p); rewrite /= ?a_x1 // disjoint_has negb_or not_vx. case=> [_ _ _ eq_yx | x1 p1 /=]; first by case/eqP: neq_yx. case/andP=> a_x1 g_p1 /andP[not_p1x _] /subsetP p_p1 p1y not_pv. exists x1 => //; exists p1 => //. rewrite disjoint_sym disjoint_cons not_p1x disjoint_sym. by move: not_pv; rewrite disjoint_cons => /andP[_ /disjointWl->]. have{neq_yx not_vy}: y \notin v1 by apply/norP. have{le_v'_n not_vx}: #|T| <= #|v1| + n by rewrite cardU1 not_vx addSnnS. elim: {x v}a v1 => [|x a IHa] v /= le_v'_n not_vy. by rewrite (negPf not_vy); right=> [] []. set v2 := dfs n v x; have v2v: v \subset v2 := subset_dfs n v [:: x]. have [v2y | not_v2y] := boolP (y \in v2). by rewrite sub_dfs //; left; exists x; [apply: mem_head | apply: IHn]. apply: {IHa}(equivP (IHa _ _ not_v2y)). by rewrite (leq_trans le_v'_n) // leq_add2r subset_leq_card. split=> [] [x1 a_x1 [p g_p p_y not_pv]]. exists x1; [exact: predU1r | exists p => //]. by rewrite disjoint_sym (disjointWl v2v) // disjoint_sym. suffices not_p1v2: [disjoint x1 :: p & v2]. case/predU1P: a_x1 => [def_x1 | ]; last by exists x1; last exists p. case/pred0Pn: not_p1v2; exists x; rewrite /= def_x1 mem_head /=. suffices not_vx: x \notin v by apply/IHn; last apply: dfs_id. by move: not_pv; rewrite disjoint_cons def_x1 => /andP[]. apply: contraR not_v2y => /pred0Pn[x2 /andP[/= p_x2 v2x2]]. case/splitPl: p_x2 p_y g_p not_pv => p0 p2 p0x2. rewrite last_cat cat_path -cat_cons lastI cat_rcons {}p0x2 => p2y /andP[_ g_p2]. rewrite disjoint_cat disjoint_cons => /and3P[{p0}_ not_vx2 not_p2v]. have{not_vx2 v2x2} [p1 g_p1 p1_x2 not_p1v] := IHn _ _ v le_v'_n not_vx2 v2x2. apply/IHn=> //; exists (p1 ++ p2); rewrite ?cat_path ?last_cat -?p1_x2 ?g_p1 //. by rewrite -cat_cons disjoint_cat not_p1v. Qed. Lemma dfsP x y : reflect (exists2 p, path (grel g) x p & y = last x p) (y \in dfs #|T| [::] x). Proof. apply: (iffP (dfs_pathP _ _ _)); rewrite ?card0 // => [] [p]; exists p => //. by rewrite disjoint_sym disjoint0. Qed. End Dfs. Variable e : rel T. Definition rgraph x := enum (e x). Lemma rgraphK : grel rgraph =2 e. Proof. by move=> x y; rewrite /= mem_enum. Qed. Definition connect : rel T := fun x y => y \in dfs rgraph #|T| [::] x. Canonical connect_app_pred x := ApplicativePred (connect x). Lemma connectP x y : reflect (exists2 p, path e x p & y = last x p) (connect x y). Proof. apply: (equivP (dfsP _ x y)). by split=> [] [p e_p ->]; exists p => //; rewrite (eq_path rgraphK) in e_p *. Qed. Lemma connect_trans : transitive connect. Proof. move=> x y z /connectP[p e_p ->] /connectP[q e_q ->]; apply/connectP. by exists (p ++ q); rewrite ?cat_path ?e_p ?last_cat. Qed. Lemma connect0 x : connect x x. Proof. by apply/connectP; exists [::]. Qed. Lemma eq_connect0 x y : x = y -> connect x y. Proof. by move->; apply: connect0. Qed. Lemma connect1 x y : e x y -> connect x y. Proof. by move=> e_xy; apply/connectP; exists [:: y]; rewrite /= ?e_xy. Qed. Lemma path_connect x p : path e x p -> subpred (mem (x :: p)) (connect x). Proof. move=> e_p y p_y; case/splitPl: p / p_y e_p => p q <-. by rewrite cat_path => /andP[e_p _]; apply/connectP; exists p. Qed. Lemma connect_cycle p : cycle e p -> {in p &, forall x y, connect x y}. Proof. move=> e_p x y /rot_to[i q rip]; rewrite -(mem_rot i) rip => yqx. have /= : cycle e (x :: q) by rewrite -rip rot_cycle. case/splitPl: yqx => r s lxr; rewrite rcons_cat cat_path => /andP[xr _]. by apply/connectP; exists r. Qed. Definition root x := odflt x (pick (connect x)). Definition roots : pred T := fun x => root x == x. Canonical roots_pred := ApplicativePred roots. Definition n_comp_mem (m_a : mem_pred T) := #|predI roots m_a|. Lemma connect_root x : connect x (root x). Proof. by rewrite /root; case: pickP; rewrite ?connect0. Qed. Definition connect_sym := symmetric connect. Hypothesis sym_e : connect_sym. Lemma same_connect : left_transitive connect. Proof. exact: sym_left_transitive connect_trans. Qed. Lemma same_connect_r : right_transitive connect. Proof. exact: sym_right_transitive connect_trans. Qed. Lemma same_connect1 x y : e x y -> connect x =1 connect y. Proof. by move/connect1; apply: same_connect. Qed. Lemma same_connect1r x y : e x y -> connect^~ x =1 connect^~ y. Proof. by move/connect1; apply: same_connect_r. Qed. Lemma rootP x y : reflect (root x = root y) (connect x y). Proof. apply: (iffP idP) => e_xy. by rewrite /root -(eq_pick (same_connect e_xy)); case: pickP e_xy => // ->. by apply: (connect_trans (connect_root x)); rewrite e_xy sym_e connect_root. Qed. Lemma root_root x : root (root x) = root x. Proof. exact/esym/rootP/connect_root. Qed. Lemma roots_root x : roots (root x). Proof. exact/eqP/root_root. Qed. Lemma root_connect x y : (root x == root y) = connect x y. Proof. exact: sameP eqP (rootP x y). Qed. Definition closed_mem m_a := forall x y, e x y -> in_mem x m_a = in_mem y m_a. Definition closure_mem m_a : pred T := fun x => ~~ disjoint (mem (connect x)) m_a. End Connect. Hint Resolve connect0 : core. Notation n_comp e a := (n_comp_mem e (mem a)). Notation closed e a := (closed_mem e (mem a)). Notation closure e a := (closure_mem e (mem a)). Prenex Implicits connect root roots. Arguments dfsP {T g x y}. Arguments connectP {T e x y}. Arguments rootP [T e] _ {x y}. Notation fconnect f := (connect (coerced_frel f)). Notation froot f := (root (coerced_frel f)). Notation froots f := (roots (coerced_frel f)). Notation fcard_mem f := (n_comp_mem (coerced_frel f)). Notation fcard f a := (fcard_mem f (mem a)). Notation fclosed f a := (closed (coerced_frel f) a). Notation fclosure f a := (closure (coerced_frel f) a). Section EqConnect. Variable T : finType. Implicit Types (e : rel T) (a : {pred T}). Lemma connect_sub e e' : subrel e (connect e') -> subrel (connect e) (connect e'). Proof. move=> e'e x _ /connectP[p e_p ->]; elim: p x e_p => //= y p IHp x /andP[exy]. by move/IHp; apply: connect_trans; apply: e'e. Qed. Lemma relU_sym e e' : connect_sym e -> connect_sym e' -> connect_sym (relU e e'). Proof. move=> sym_e sym_e'; apply: symmetric_from_pre => x _ /connectP[p e_p ->]. elim: p x e_p => //= y p IHp x /andP[e_xy /IHp{IHp}/connect_trans]; apply. case/orP: e_xy => /connect1; rewrite (sym_e, sym_e'); by apply: connect_sub y x => x y e_xy; rewrite connect1 //= e_xy ?orbT. Qed. Lemma eq_connect e e' : e =2 e' -> connect e =2 connect e'. Proof. move=> eq_e x y; apply/connectP/connectP=> [] [p e_p ->]; by exists p; rewrite // (eq_path eq_e) in e_p *. Qed. Lemma eq_n_comp e e' : connect e =2 connect e' -> n_comp_mem e =1 n_comp_mem e'. Proof. move=> eq_e [a]; apply: eq_card => x /=. by rewrite !inE /= /roots /root /= (eq_pick (eq_e x)). Qed. Lemma eq_n_comp_r {e} a a' : a =i a' -> n_comp e a = n_comp e a'. Proof. by move=> eq_a; apply: eq_card => x; rewrite inE /= eq_a. Qed. Lemma n_compC a e : n_comp e T = n_comp e a + n_comp e [predC a]. Proof. rewrite /n_comp_mem (eq_card (fun _ => andbT _)) -(cardID a); congr (_ + _). by apply: eq_card => x; rewrite !inE andbC. Qed. Lemma eq_root e e' : e =2 e' -> root e =1 root e'. Proof. by move=> eq_e x; rewrite /root (eq_pick (eq_connect eq_e x)). Qed. Lemma eq_roots e e' : e =2 e' -> roots e =1 roots e'. Proof. by move=> eq_e x; rewrite /roots (eq_root eq_e). Qed. End EqConnect. Section Closure. Variables (T : finType) (e : rel T). Hypothesis sym_e : connect_sym e. Implicit Type a : {pred T}. Lemma same_connect_rev : connect e =2 connect (fun x y => e y x). Proof. suff crev e': subrel (connect (fun x : T => e'^~ x)) (fun x => (connect e')^~x). by move=> x y; rewrite sym_e; apply/idP/idP; apply: crev. move=> x y /connectP[p e_p p_y]; apply/connectP. exists (rev (belast x p)); first by rewrite p_y rev_path. by rewrite -(last_cons x) -rev_rcons p_y -lastI rev_cons last_rcons. Qed. Lemma intro_closed a : (forall x y, e x y -> x \in a -> y \in a) -> closed e a. Proof. move=> cl_a x y e_xy; apply/idP/idP=> [|a_y]; first exact: cl_a. have{x e_xy} /connectP[p e_p ->]: connect e y x by rewrite sym_e connect1. by elim: p y a_y e_p => //= y p IHp x a_x /andP[/cl_a/(_ a_x)]; apply: IHp. Qed. Lemma closed_connect a : closed e a -> forall x y, connect e x y -> (x \in a) = (y \in a). Proof. move=> cl_a x _ /connectP[p e_p ->]. by elim: p x e_p => //= y p IHp x /andP[/cl_a->]; apply: IHp. Qed. Lemma connect_closed x : closed e (connect e x). Proof. by move=> y z /connect1/same_connect_r; apply. Qed. Lemma predC_closed a : closed e a -> closed e [predC a]. Proof. by move=> cl_a x y /cl_a; rewrite !inE => ->. Qed. Lemma closure_closed a : closed e (closure e a). Proof. apply: intro_closed => x y /connect1 e_xy; congr (~~ _). by apply: eq_disjoint; apply: same_connect. Qed. Lemma mem_closure a : {subset a <= closure e a}. Proof. by move=> x a_x; apply/existsP; exists x; rewrite !inE connect0. Qed. Lemma subset_closure a : a \subset closure e a. Proof. by apply/subsetP; apply: mem_closure. Qed. Lemma n_comp_closure2 x y : n_comp e (closure e (pred2 x y)) = (~~ connect e x y).+1. Proof. rewrite -(root_connect sym_e) -card2; apply: eq_card => z. apply/idP/idP=> [/andP[/eqP {2}<- /pred0Pn[t /andP[/= ezt exyt]]] |]. by case/pred2P: exyt => <-; rewrite (rootP sym_e ezt) !inE eqxx ?orbT. by case/pred2P=> ->; rewrite !inE roots_root //; apply/existsP; [exists x | exists y]; rewrite !inE eqxx ?orbT sym_e connect_root. Qed. Lemma n_comp_connect x : n_comp e (connect e x) = 1. Proof. rewrite -(card1 (root e x)); apply: eq_card => y. apply/andP/eqP => [[/eqP r_y /rootP-> //] | ->] /=. by rewrite inE connect_root roots_root. Qed. End Closure. Section Orbit. Variables (T : finType) (f : T -> T). Definition order x := #|fconnect f x|. Definition orbit x := traject f x (order x). Definition findex x y := index y (orbit x). Definition finv x := iter (order x).-1 f x. Lemma fconnect_iter n x : fconnect f x (iter n f x). Proof. apply/connectP. by exists (traject f (f x) n); [apply: fpath_traject | rewrite last_traject]. Qed. Lemma fconnect1 x : fconnect f x (f x). Proof. exact: (fconnect_iter 1). Qed. Lemma fconnect_finv x : fconnect f x (finv x). Proof. exact: fconnect_iter. Qed. Lemma orderSpred x : (order x).-1.+1 = order x. Proof. by rewrite /order (cardD1 x) [_ x _]connect0. Qed. Lemma size_orbit x : size (orbit x) = order x. Proof. exact: size_traject. Qed. Lemma looping_order x : looping f x (order x). Proof. apply: contraFT (ltnn (order x)); rewrite -looping_uniq => /card_uniqP. rewrite size_traject => <-; apply: subset_leq_card. by apply/subsetP=> _ /trajectP[i _ ->]; apply: fconnect_iter. Qed. Lemma fconnect_orbit x y : fconnect f x y = (y \in orbit x). Proof. apply/idP/idP=> [/connectP[_ /fpathP[m ->] ->] | /trajectP[i _ ->]]. by rewrite last_traject; apply/loopingP/looping_order. exact: fconnect_iter. Qed. Lemma in_orbit x : x \in orbit x. Proof. by rewrite -fconnect_orbit. Qed. Hint Resolve in_orbit : core. Lemma order_gt0 x : order x > 0. Proof. by rewrite -orderSpred. Qed. Hint Resolve order_gt0 : core. Lemma orbit_uniq x : uniq (orbit x). Proof. rewrite /orbit -orderSpred looping_uniq; set n := (order x).-1. apply: contraFN (ltnn n) => /trajectP[i lt_i_n eq_fnx_fix]. rewrite orderSpred -(size_traject f x n). apply: (leq_trans (subset_leq_card _) (card_size _)); apply/subsetP=> z. rewrite inE fconnect_orbit => /trajectP[j le_jn ->{z}]. rewrite -orderSpred -/n ltnS leq_eqVlt in le_jn. by apply/trajectP; case/predU1P: le_jn => [->|]; [exists i | exists j]. Qed. Lemma findex_max x y : fconnect f x y -> findex x y < order x. Proof. by rewrite [_ y]fconnect_orbit -index_mem size_orbit. Qed. Lemma findex_iter x i : i < order x -> findex x (iter i f x) = i. Proof. move=> lt_ix; rewrite -(nth_traject f lt_ix) /findex index_uniq ?orbit_uniq //. by rewrite size_orbit. Qed. Lemma iter_findex x y : fconnect f x y -> iter (findex x y) f x = y. Proof. rewrite [_ y]fconnect_orbit => fxy; pose i := index y (orbit x). have lt_ix: i < order x by rewrite -size_orbit index_mem. by rewrite -(nth_traject f lt_ix) nth_index. Qed. Lemma findex0 x : findex x x = 0. Proof. by rewrite /findex /orbit -orderSpred /= eqxx. Qed. Lemma findex_eq0 x y : (findex x y == 0) = (x == y). Proof. by rewrite /findex /orbit -orderSpred /=; case: (x == y). Qed. Lemma fconnect_invariant (T' : eqType) (k : T -> T') : invariant f k =1 xpredT -> forall x y, fconnect f x y -> k x = k y. Proof. move=> eq_k_f x y /iter_findex <-; elim: {y}(findex x y) => //= n ->. by rewrite (eqP (eq_k_f _)). Qed. Lemma mem_orbit x : {homo f : y / y \in orbit x}. Proof. by move=> y; rewrite -!fconnect_orbit => /connect_trans->//; apply: fconnect1. Qed. Lemma image_orbit x : {subset image f (orbit x) <= orbit x}. Proof. by move=> _ /mapP[y yin ->]; apply: mem_orbit; rewrite ?mem_enum in yin. Qed. Section orbit_in. Variable S : {pred T}. Hypothesis f_in : {homo f : x / x \in S}. Hypothesis injf : {in S &, injective f}. Lemma finv_in : {homo finv : x / x \in S}. Proof. by move=> x xS; rewrite iter_in. Qed. Lemma f_finv_in : {in S, cancel finv f}. Proof. move=> x xS; move: (looping_order x) (orbit_uniq x). rewrite /looping /orbit -orderSpred looping_uniq /= /looping; set n := _.-1. case/predU1P=> // /trajectP[i lt_i_n]; rewrite -iterSr. by move=> /injf ->; rewrite ?(iter_in _ f_in) //; case/trajectP; exists i. Qed. Lemma finv_f_in : {in S, cancel f finv}. Proof. by move=> x xS; apply/injf; rewrite ?iter_in ?f_finv_in ?f_in. Qed. Lemma finv_inj_in : {in S &, injective finv}. Proof. by move=> x y xS yS q; rewrite -(f_finv_in xS) q f_finv_in. Qed. Lemma fconnect_sym_in : {in S &, forall x y, fconnect f x y = fconnect f y x}. Proof. suff Sf : {in S &, forall x y, fconnect f x y -> fconnect f y x}. by move=> *; apply/idP/idP=> /Sf->. move=> x _ xS _ /connectP [p f_p ->]; elim: p => //= y p IHp in x xS f_p *. case/andP: f_p => /eqP <- /(IHp _ (f_in xS)) /connect_trans -> //. by apply: (connect_trans (fconnect_finv _)); rewrite finv_f_in. Qed. Lemma iter_order_in : {in S, forall x, iter (order x) f x = x}. Proof. by move=> x xS; rewrite -orderSpred iterS; apply: f_finv_in. Qed. Lemma iter_finv_in n : {in S, forall x, n <= order x -> iter n finv x = iter (order x - n) f x}. Proof. move=> x xS; rewrite -[x in LHS]iter_order_in => // /subnKC {1}<-. move: (_ - n) => m; rewrite iterD; elim: n => // n {2}<-. by rewrite iterSr /= finv_f_in // -iterD iter_in. Qed. Lemma cycle_orbit_in : {in S, forall x, (fcycle f) (orbit x)}. Proof. move=> x xS; rewrite /orbit -orderSpred (cycle_path x) /= last_traject. by rewrite -/(finv x) fpath_traject f_finv_in ?eqxx. Qed. Lemma fpath_finv_in p x : (x \in S) && (fpath finv x p) = (last x p \in S) && (fpath f (last x p) (rev (belast x p))). Proof. elim: p x => //= y p IHp x; rewrite rev_cons rcons_path. transitivity [&& y \in S, f y == x & fpath finv y p]. apply/and3P/and3P => -[xS /eqP<- fxp]; split; by rewrite ?f_finv_in ?finv_f_in ?finv_in ?f_in. rewrite andbCA {}IHp !andbA [RHS]andbC -andbA; congr [&& _, _ & _]. by case: p => //= z p; rewrite rev_cons last_rcons. Qed. Lemma fpath_finv_f_in p : {in S, forall x, fpath finv x p -> fpath f (last x p) (rev (belast x p))}. Proof. by move=> x xS /(conj xS)/andP; rewrite fpath_finv_in => /andP[]. Qed. Lemma fpath_f_finv_in p x : last x p \in S -> fpath f (last x p) (rev (belast x p)) -> fpath finv x p. Proof. by move=> lS /(conj lS)/andP; rewrite -fpath_finv_in => /andP[]. Qed. End orbit_in. Lemma injectivePcycle x : reflect {in orbit x &, injective f} (fcycle f (orbit x)). Proof. apply: (iffP idP) => [/inj_cycle//|/cycle_orbit_in]. by apply; [apply: mem_orbit|apply: in_orbit]. Qed. Section orbit_inj. Hypothesis injf : injective f. Lemma f_finv : cancel finv f. Proof. exact: (in1T (f_finv_in _ (in2W _))). Qed. Lemma finv_f : cancel f finv. Proof. exact: (in1T (finv_f_in _ (in2W _))). Qed. Lemma finv_bij : bijective finv. Proof. by exists f; [apply: f_finv|apply: finv_f]. Qed. Lemma finv_inj : injective finv. Proof. exact: (can_inj f_finv). Qed. Lemma fconnect_sym x y : fconnect f x y = fconnect f y x. Proof. exact: (in2T (fconnect_sym_in _ (in2W _))). Qed. Let symf := fconnect_sym. Lemma iter_order x : iter (order x) f x = x. Proof. exact: (in1T (iter_order_in _ (in2W _))). Qed. Lemma iter_finv n x : n <= order x -> iter n finv x = iter (order x - n) f x. Proof. exact: (in1T (@iter_finv_in _ _ (in2W _) _)). Qed. Lemma cycle_orbit x : fcycle f (orbit x). Proof. exact: (in1T (cycle_orbit_in _ (in2W _))). Qed. Lemma fpath_finv x p : fpath finv x p = fpath f (last x p) (rev (belast x p)). Proof. exact: (@fpath_finv_in T _ (in2W _)). Qed. Lemma same_fconnect_finv : fconnect finv =2 fconnect f. Proof. move=> x y; rewrite (same_connect_rev symf); apply: {x y}eq_connect => x y /=. by rewrite (canF_eq finv_f) eq_sym. Qed. Lemma fcard_finv : fcard_mem finv =1 fcard_mem f. Proof. exact: eq_n_comp same_fconnect_finv. Qed. Definition order_set n : pred T := [pred x | order x == n]. Lemma fcard_order_set n (a : {pred T}) : a \subset order_set n -> fclosed f a -> fcard f a * n = #|a|. Proof. move=> a_n cl_a; rewrite /n_comp_mem; set b := [predI froots f & a]. suff <-: #|preim (froot f) b| = #|b| * n. apply: eq_card => x; rewrite !inE (roots_root fconnect_sym). exact/esym/(closed_connect cl_a)/connect_root. have{cl_a a_n} (x): b x -> froot f x = x /\ order x = n. by case/andP=> /eqP-> /(subsetP a_n)/eqnP->. elim: {a b}#|b| {1 3 4}b (eqxx #|b|) => [|m IHm] b def_m f_b. by rewrite eq_card0 // => x; apply: (pred0P def_m). have [x b_x | b0] := pickP b; last by rewrite (eq_card0 b0) in def_m. have [r_x ox_n] := f_b x b_x; rewrite (cardD1 x) [x \in b]b_x eqSS in def_m. rewrite mulSn -{1}ox_n -(IHm _ def_m) => [|_ /andP[_ /f_b //]]. rewrite -(cardID (fconnect f x)); congr (_ + _); apply: eq_card => y. by apply: andb_idl => /= fxy; rewrite !inE -(rootP symf fxy) r_x. by congr (~~ _ && _); rewrite /= /in_mem /= symf -(root_connect symf) r_x. Qed. Lemma fclosed1 (a : {pred T}) : fclosed f a -> forall x, (x \in a) = (f x \in a). Proof. by move=> cl_a x; apply: cl_a (eqxx _). Qed. Lemma same_fconnect1 x : fconnect f x =1 fconnect f (f x). Proof. by apply: same_connect1 => /=. Qed. Lemma same_fconnect1_r x y : fconnect f x y = fconnect f x (f y). Proof. by apply: same_connect1r x => /=. Qed. Lemma fcard_gt0P (a : {pred T}) : fclosed f a -> reflect (exists x, x \in a) (0 < fcard f a). Proof. move=> clfA; apply: (iffP card_gt0P) => [[x /andP[]]|[x xA]]; first by exists x. exists (froot f x); rewrite inE roots_root /=; last exact: fconnect_sym. by rewrite -(closed_connect clfA (connect_root _ x)). Qed. Lemma fcard_gt1P (A : {pred T}) : fclosed f A -> reflect (exists2 x, x \in A & exists2 y, y \in A & ~~ fconnect f x y) (1 < fcard f A). Proof. move=> clAf; apply: (iffP card_gt1P) => [|[x xA [y yA not_xfy]]]. move=> [x [y [/andP [/= rfx xA] /andP[/= rfy yA] xDy]]]. by exists x; try exists y; rewrite // -root_connect // (eqP rfx) (eqP rfy). exists (froot f x), (froot f y); rewrite !inE !roots_root ?root_connect //=. by split => //; rewrite -(closed_connect clAf (connect_root _ _)). Qed. End orbit_inj. Hint Resolve orbit_uniq : core. Section fcycle_p. Variables (p : seq T) (f_p : fcycle f p). Section mem_cycle. Variable (Up : uniq p) (x : T) (p_x : x \in p). (* fconnect_cycle does not dependent on Up *) Lemma fconnect_cycle y : fconnect f x y = (y \in p). Proof. have [i q def_p] := rot_to p_x; rewrite -(mem_rot i p) def_p. have{i def_p} /andP[/eqP q_x f_q]: (f (last x q) == x) && fpath f x q. by have:= f_p; rewrite -(rot_cycle i) def_p (cycle_path x). apply/idP/idP=> [/connectP[_ /fpathP[j ->] ->] | ]; last exact: path_connect. case/fpathP: f_q q_x => n ->; rewrite !last_traject -iterS => def_x. by apply: (@loopingP _ f x n.+1); rewrite /looping def_x /= mem_head. Qed. (* order_le_cycle does not dependent on Up *) Lemma order_le_cycle : order x <= size p. Proof. apply: leq_trans (card_size _); apply/subset_leq_card/subsetP=> y. by rewrite !(fconnect_cycle, inE) ?eqxx. Qed. Lemma order_cycle : order x = size p. Proof. by rewrite -(card_uniqP Up); apply: (eq_card fconnect_cycle). Qed. Lemma orbitE : orbit x = rot (index x p) p. Proof. set i := index _ _; rewrite /orbit order_cycle -(size_rot i) rot_index// -/i. set q := _ ++ _; suffices /fpathP[j ->]: fpath f x q by rewrite /= size_traject. by move: f_p; rewrite -(rot_cycle i) rot_index// (cycle_path x); case/andP. Qed. Lemma orbit_rot_cycle : {i : nat | orbit x = rot i p}. Proof. by rewrite orbitE; exists (index x p). Qed. End mem_cycle. Let f_inj := inj_cycle f_p. Let homo_f := mem_fcycle f_p. Lemma finv_cycle : {homo finv : x / x \in p}. Proof. exact: finv_in. Qed. Lemma f_finv_cycle : {in p, cancel finv f}. Proof. exact: f_finv_in. Qed. Lemma finv_f_cycle : {in p, cancel f finv}. Proof. exact: finv_f_in. Qed. Lemma finv_inj_cycle : {in p &, injective finv}. Proof. exact: finv_inj_in. Qed. Lemma iter_finv_cycle n : {in p, forall x, n <= order x -> iter n finv x = iter (order x - n) f x}. Proof. exact: iter_finv_in. Qed. Lemma cycle_orbit_cycle : {in p, forall x, fcycle f (orbit x)}. Proof. exact: cycle_orbit_in. Qed. Lemma fpath_finv_cycle q x : (x \in p) && (fpath finv x q) = (last x q \in p) && fpath f (last x q) (rev (belast x q)). Proof. exact: fpath_finv_in. Qed. Lemma fpath_finv_f_cycle q : {in p, forall x, fpath finv x q -> fpath f (last x q) (rev (belast x q))}. Proof. exact: fpath_finv_f_in. Qed. Lemma fpath_f_finv_cycle q x : last x q \in p -> fpath f (last x q) (rev (belast x q)) -> fpath finv x q. Proof. exact: fpath_f_finv_in. Qed. Lemma prevE x : x \in p -> prev p x = finv x. Proof. move=> x_p; have /eqP/(congr1 finv) := prev_cycle f_p x_p. by rewrite finv_f_cycle// mem_prev. Qed. End fcycle_p. Section fcycle_cons. Variables (x : T) (p : seq T) (f_p : fcycle f (x :: p)). Lemma fcycle_rconsE : rcons (x :: p) x = traject f x (size p).+2. Proof. by rewrite rcons_cons; have /fpathE-> := f_p; rewrite size_rcons. Qed. Lemma fcycle_consE : x :: p = traject f x (size p).+1. Proof. by have := fcycle_rconsE; rewrite trajectSr => /rcons_inj[/= <-]. Qed. Lemma fcycle_consEflatten : exists k, x :: p = flatten (nseq k.+1 (orbit x)). Proof. move: f_p; rewrite fcycle_consE; elim/ltn_ind: (size p) => n IHn t_cycle. have := order_le_cycle t_cycle (mem_head _ _); rewrite size_traject. case: ltngtP => [||<-] //; last by exists 0; rewrite /= cats0. rewrite ltnS => n_ge _; have := t_cycle. rewrite -(subnKC n_ge) -addnS trajectD. rewrite (iter_order_in (mem_fcycle f_p) (inj_cycle f_p)) ?mem_head//. set m := (_ - _) => cycle_cat. have [||k->] := IHn m; last by exists k.+1. by rewrite ltn_subrL (leq_trans _ n_ge) ?order_gt0. move: cycle_cat; rewrite -orderSpred/= rcons_cat rcons_cons -cat_rcons. by rewrite cat_path last_rcons => /andP[]. Qed. Lemma undup_cycle_cons : undup (x :: p) = orbit x. Proof. by have [n {1}->] := fcycle_consEflatten; rewrite undup_flatten_nseq ?undup_id. Qed. End fcycle_cons. Section fcycle_undup. Variable (p : seq T) (f_p : fcycle f p). Lemma fcycleEflatten : exists k, p = flatten (nseq k (undup p)). Proof. case: p f_p => [//|x q] f_q; first by exists 0. have [k {1}->] := @fcycle_consEflatten x q f_q. by exists k.+1; rewrite undup_cycle_cons. Qed. Lemma fcycle_undup : fcycle f (undup p). Proof. case: p f_p => [//|x q] f_q; rewrite undup_cycle_cons//. by rewrite (cycle_orbit_in (mem_fcycle f_q) (inj_cycle f_q)) ?mem_head. Qed. Let p_undup_uniq := undup_uniq p. Let f_inj := inj_cycle f_p. Let homo_f := mem_fcycle f_p. Lemma in_orbit_cycle : {in p &, forall x, orbit x =i p}. Proof. by move=> x y xp yp; rewrite (orbitE fcycle_undup)// ?mem_rot ?mem_undup. Qed. Lemma eq_order_cycle : {in p &, forall x y, order y = order x}. Proof. by move=> x y xp yp; rewrite !(order_cycle fcycle_undup) ?mem_undup. Qed. Lemma iter_order_cycle : {in p &, forall x y, iter (order x) f y = y}. Proof. by move=> x y xp yp; rewrite (eq_order_cycle yp) ?(iter_order_in homo_f f_inj). Qed. End fcycle_undup. Section fconnect. Lemma fconnect_eqVf x y : fconnect f x y = (x == y) || fconnect f (f x) y. Proof. apply/idP/idP => [/iter_findex <-|/predU1P [<-|] //]; last first. exact/connect_trans/fconnect1. by case: findex => [|i]; rewrite ?eqxx// iterSr fconnect_iter orbT. Qed. (*****************************************************************************) (* Lemma orbitPcycle is of type "The Following Are Equivalent", which means *) (* all four statements are equivalent to each other. In order to use it, one *) (* has to apply it to the natural numbers corresponding to the line, e.g. *) (* `orbitPcycle 0 2 : fcycle f (orbit x) <-> exists k, iter k.+1 f x = x`. *) (* examples of this are in order_id_cycle and fconnnect_f. *) (* One may also use lemma all_iffLR to get a one sided implication, as in *) (* orderPcycle. *) (*****************************************************************************) Lemma orbitPcycle {x} : [<-> (* 0 *) fcycle f (orbit x); (* 1 *) order (f x) = order x; (* 2 *) x \in fconnect f (f x); (* 3 *) exists k, iter k.+1 f x = x; (* 4 *) iter (order x) f x = x; (* 5 *) {in orbit x &, injective f}]. Proof. tfae=> [xorbit_cycle|||[k fkx]|fx y z|/injectivePcycle//]. - by apply: eq_order_cycle xorbit_cycle _ _ _ _; rewrite ?mem_orbit. - move=> /subset_cardP/(_ _)->; rewrite ?inE//; apply/subsetP=> y. by apply: connect_trans; apply: fconnect1. - by exists (findex (f x) x); rewrite // iterSr iter_findex. - apply: (@iter_order_cycle (traject f x k.+1)); rewrite /= ?mem_head//. by apply/fpathP; exists k.+1; rewrite trajectSr -iterSr fkx. - rewrite -!fconnect_orbit => /iter_findex <- /iter_findex <-. move/(congr1 (iter (order x).-1 f)). by rewrite -!iterSr !orderSpred -!iterD ![order _ + _]addnC !iterD fx. Qed. Lemma order_id_cycle x : fcycle f (orbit x) -> order (f x) = order x. Proof. by move/(orbitPcycle 0 1). Qed. Inductive order_spec_cycle x : bool -> Type := | OrderStepCycle of fcycle f (orbit x) & order x = order (f x) : order_spec_cycle x true | OrderStepNoCycle of ~~ fcycle f (orbit x) & order x = (order (f x)).+1 : order_spec_cycle x false. Lemma orderPcycle x : order_spec_cycle x (fcycle f (orbit x)). Proof. have [xcycle|Ncycle] := boolP (fcycle f (orbit x)); constructor => //. by rewrite order_id_cycle. rewrite /order (eq_card (_ : _ =1 [predU1 x & fconnect f (f x)])). by rewrite cardU1 inE (contraNN (all_iffLR orbitPcycle 2 0)). by move=> y; rewrite !inE fconnect_eqVf eq_sym. Qed. Lemma fconnect_f x : fconnect f (f x) x = fcycle f (orbit x). Proof. by apply/idP/idP => /(orbitPcycle 0 2). Qed. Lemma fconnect_findex x y : fconnect f x y -> y != x -> findex x y = (findex (f x) y).+1. Proof. rewrite /findex fconnect_orbit /orbit -orderSpred /= inE => /orP [-> //|]. rewrite eq_sym; move=> yin /negPf->; have [_ eq_o|_ ->//] := orderPcycle x. by rewrite -(orderSpred (f x)) trajectSr -cats1 index_cat -eq_o yin. Qed. End fconnect. End Orbit. Hint Resolve in_orbit mem_orbit order_gt0 orbit_uniq : core. Prenex Implicits order orbit findex finv order_set. Arguments orbitPcycle {T f x}. Section FconnectId. Variable T : finType. Lemma fconnect_id (x : T) : fconnect id x =1 xpred1 x. Proof. by move=> y; rewrite (@fconnect_cycle _ _ [:: x]) //= ?inE ?eqxx. Qed. Lemma order_id (x : T) : order id x = 1. Proof. by rewrite /order (eq_card (fconnect_id x)) card1. Qed. Lemma orbit_id (x : T) : orbit id x = [:: x]. Proof. by rewrite /orbit order_id. Qed. Lemma froots_id (x : T) : froots id x. Proof. by rewrite /roots -fconnect_id connect_root. Qed. Lemma froot_id (x : T) : froot id x = x. Proof. by apply/eqP; apply: froots_id. Qed. Lemma fcard_id (a : {pred T}) : fcard id a = #|a|. Proof. by apply: eq_card => x; rewrite inE froots_id. Qed. End FconnectId. Section FconnectEq. Variables (T : finType) (f f' : T -> T). Lemma finv_eq_can : cancel f f' -> finv f =1 f'. Proof. move=> fK; have inj_f := can_inj fK. by apply: bij_can_eq fK; [apply: injF_bij | apply: finv_f]. Qed. Hypothesis eq_f : f =1 f'. Let eq_rf := eq_frel eq_f. Lemma eq_fconnect : fconnect f =2 fconnect f'. Proof. exact: eq_connect eq_rf. Qed. Lemma eq_fcard : fcard_mem f =1 fcard_mem f'. Proof. exact: eq_n_comp eq_fconnect. Qed. Lemma eq_finv : finv f =1 finv f'. Proof. by move=> x; rewrite /finv /order (eq_card (eq_fconnect x)) (eq_iter eq_f). Qed. Lemma eq_froot : froot f =1 froot f'. Proof. exact: eq_root eq_rf. Qed. Lemma eq_froots : froots f =1 froots f'. Proof. exact: eq_roots eq_rf. Qed. End FconnectEq. Section FinvEq. Variables (T : finType) (f : T -> T). Hypothesis injf : injective f. Lemma finv_inv : finv (finv f) =1 f. Proof. exact: (finv_eq_can (f_finv injf)). Qed. Lemma order_finv : order (finv f) =1 order f. Proof. by move=> x; apply: eq_card (same_fconnect_finv injf x). Qed. Lemma order_set_finv n : order_set (finv f) n =i order_set f n. Proof. by move=> x; rewrite !inE order_finv. Qed. End FinvEq. Section RelAdjunction. Variables (T T' : finType) (h : T' -> T) (e : rel T) (e' : rel T'). Hypotheses (sym_e : connect_sym e) (sym_e' : connect_sym e'). Record rel_adjunction_mem m_a := RelAdjunction { rel_unit x : in_mem x m_a -> {x' : T' | connect e x (h x')}; rel_functor x' y' : in_mem (h x') m_a -> connect e' x' y' = connect e (h x') (h y') }. Variable a : {pred T}. Hypothesis cl_a : closed e a. Local Notation rel_adjunction := (rel_adjunction_mem (mem a)). Lemma intro_adjunction (h' : forall x, x \in a -> T') : (forall x a_x, [/\ connect e x (h (h' x a_x)) & forall y a_y, e x y -> connect e' (h' x a_x) (h' y a_y)]) -> (forall x' a_x, [/\ connect e' x' (h' (h x') a_x) & forall y', e' x' y' -> connect e (h x') (h y')]) -> rel_adjunction. Proof. move=> Aee' Ae'e; split=> [y a_y | x' z' a_x]. by exists (h' y a_y); case/Aee': (a_y). apply/idP/idP=> [/connectP[p e'p ->{z'}] | /connectP[p e_p p_z']]. elim: p x' a_x e'p => //= y' p IHp x' a_x. case: (Ae'e x' a_x) => _ Ae'x /andP[/Ae'x e_xy /IHp e_yz] {Ae'x}. by apply: connect_trans (e_yz _); rewrite // -(closed_connect cl_a e_xy). case: (Ae'e x' a_x) => /connect_trans-> //. elim: p {x'}(h x') p_z' a_x e_p => /= [|y p IHp] x p_z' a_x. by rewrite -p_z' in a_x *; case: (Ae'e _ a_x); rewrite sym_e'. case/andP=> e_xy /(IHp _ p_z') e'yz; have a_y: y \in a by rewrite -(cl_a e_xy). by apply: connect_trans (e'yz a_y); case: (Aee' _ a_x) => _ ->. Qed. Lemma strict_adjunction : injective h -> a \subset codom h -> rel_base h e e' [predC a] -> rel_adjunction. Proof. move=> /= injh h_a a_ee'; pose h' x Hx := iinv (subsetP h_a x Hx). apply: (@intro_adjunction h') => [x a_x | x' a_x]. rewrite f_iinv connect0; split=> // y a_y e_xy. by rewrite connect1 // -a_ee' !f_iinv ?negbK. rewrite [h' _ _]iinv_f //; split=> // y' e'xy. by rewrite connect1 // a_ee' ?negbK. Qed. Let ccl_a := closed_connect cl_a. Lemma adjunction_closed : rel_adjunction -> closed e' [preim h of a]. Proof. case=> _ Ae'e; apply: intro_closed => // x' y' /connect1 e'xy a_x. by rewrite Ae'e // in e'xy; rewrite !inE -(ccl_a e'xy). Qed. Lemma adjunction_n_comp : rel_adjunction -> n_comp e a = n_comp e' [preim h of a]. Proof. case=> Aee' Ae'e. have inj_h: {in predI (roots e') [preim h of a] &, injective (root e \o h)}. move=> x' y' /andP[/eqP r_x' /= a_x'] /andP[/eqP r_y' _] /(rootP sym_e). by rewrite -Ae'e // => /(rootP sym_e'); rewrite r_x' r_y'. rewrite /n_comp_mem -(card_in_image inj_h); apply: eq_card => x. apply/andP/imageP=> [[/eqP rx a_x] | [x' /andP[/eqP r_x' a_x'] ->]]; last first. by rewrite /= -(ccl_a (connect_root _ _)) roots_root. have [y' e_xy]:= Aee' x a_x; pose x' := root e' y'. have ay': h y' \in a by rewrite -(ccl_a e_xy). have e_yx: connect e (h y') (h x') by rewrite -Ae'e ?connect_root. exists x'; first by rewrite inE /= -(ccl_a e_yx) ?roots_root. by rewrite /= -(rootP sym_e e_yx) -(rootP sym_e e_xy). Qed. End RelAdjunction. Notation rel_adjunction h e e' a := (rel_adjunction_mem h e e' (mem a)). Notation "@ 'rel_adjunction' T T' h e e' a" := (@rel_adjunction_mem T T' h e e' (mem a)) (at level 10, T, T', h, e, e', a at level 8, only parsing) : type_scope. Notation fun_adjunction h f f' a := (rel_adjunction h (frel f) (frel f') a). Notation "@ 'fun_adjunction' T T' h f f' a" := (@rel_adjunction T T' h (frel f) (frel f') a) (at level 10, T, T', h, f, f', a at level 8, only parsing) : type_scope. Arguments intro_adjunction [T T' h e e'] _ [a]. Arguments adjunction_n_comp [T T'] h [e e'] _ _ [a]. Unset Implicit Arguments. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/finset.v000066400000000000000000002571171375767750300226100ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat div seq. From mathcomp Require Import choice fintype finfun bigop. (******************************************************************************) (* This file defines a type for sets over a finite Type, similar to the type *) (* of functions over a finite Type defined in finfun.v (indeed, based in it): *) (* {set T} where T must have a finType structure *) (* We equip {set T} itself with a finType structure, hence Leibnitz and *) (* extensional equalities coincide on {set T}, and we can form {set {set T}} *) (* If A, B : {set T} and P : {set {set T}}, we define: *) (* x \in A == x belongs to A (i.e., {set T} implements predType, *) (* by coercion to pred_sort). *) (* mem A == the predicate corresponding to A. *) (* finset p == the set corresponding to a predicate p. *) (* [set x | P] == the set containing the x such that P is true (x may *) (* appear in P). *) (* [set x | P & Q] := [set x | P && Q]. *) (* [set x in A] == the set containing the x in a collective predicate A. *) (* [set x in A | P] == the set containing the x in A such that P is true. *) (* [set x in A | P & Q] := [set x in A | P && Q]. *) (* All these have typed variants [set x : T | P], [set x : T in A], etc. *) (* set0 == the empty set. *) (* [set: T] or setT == the full set (the A containing all x : T). *) (* A :|: B == the union of A and B. *) (* x |: A == A with the element x added (:= [set x] :| A). *) (* A :&: B == the intersection of A and B. *) (* ~: A == the complement of A. *) (* A :\: B == the difference A minus B. *) (* A :\ x == A with the element x removed (:= A :\: [set x]). *) (* \bigcup_ A == the union of all A, for i in (i is bound in *) (* A, see bigop.v). *) (* \bigcap_ A == the intersection of all A, for i in . *) (* cover P == the union of the set of sets P. *) (* trivIset P <=> the elements of P are pairwise disjoint. *) (* partition P A <=> P is a partition of A. *) (* pblock P x == a block of P containing x, or else set0. *) (* equivalence_partition R D == the partition induced on D by the relation R *) (* (provided R is an equivalence relation in D). *) (* preim_partition f D == the partition induced on D by the equivalence *) (* [rel x y | f x == f y]. *) (* is_transversal X P D <=> X is a transversal of the partition P of D. *) (* transversal P D == a transversal of P, provided P is a partition of D. *) (* transversal_repr x0 X B == a representative of B \in P selected by the *) (* transversal X of P, or else x0. *) (* powerset A == the set of all subset of the set A. *) (* P ::&: A == those sets in P that are subsets of the set A. *) (* f @^-1: A == the preimage of the collective predicate A under f. *) (* f @: A == the image set of the collective predicate A by f. *) (* f @2:(A, B) == the image set of A x B by the binary function f. *) (* [set E | x in A] == the set of all the values of the expression E, for x *) (* drawn from the collective predicate A. *) (* [set E | x in A & P] == the set of values of E for x drawn from A, such *) (* that P is true. *) (* [set E | x in A, y in B] == the set of values of E for x drawn from A and *) (* and y drawn from B; B may depend on x. *) (* [set E | x <- A, y <- B & P] == the set of values of E for x drawn from A *) (* y drawn from B, such that P is true. *) (* [set E | x : T] == the set of all values of E, with x in type T. *) (* [set E | x : T & P] == the set of values of E for x : T s.t. P is true. *) (* [set E | x : T, y : U in B], [set E | x : T, y : U in B & P], *) (* [set E | x : T in A, y : U], [set E | x : T in A, y : U & P], *) (* [set E | x : T, y : U], [set E | x : T, y : U & P] *) (* == type-ranging versions of the binary comprehensions. *) (* [set E | x : T in A], [set E | x in A, y], [set E | x, y & P], etc. *) (* == typed and untyped variants of the comprehensions above. *) (* The types may be required as type inference processes E *) (* before considering A or B. Note that type casts in the *) (* binary comprehension must either be both present or absent *) (* and that there are no untyped variants for single-type *) (* comprehension as Coq parsing confuses [x | P] and [E | x]. *) (* minset p A == A is a minimal set satisfying p. *) (* maxset p A == A is a maximal set satisfying p. *) (* Provided a monotonous function F : {set T} -> {set T}, we get fixpoints *) (* fixset F := iter #|T| F set0 *) (* == the least fixpoint of F *) (* == the minimal set such that F X == X *) (* fix_order F x == the minimum number of iterations so that *) (* x is in iter (fix_order F x) F set0 *) (* funsetC F := fun X => ~: F (~: X) *) (* cofixset F == the greatest fixpoint of F *) (* == the maximal set such that F X == X *) (* := ~: fixset (funsetC F) *) (* We also provide notations A :=: B, A :<>: B, A :==: B, A :!=: B, A :=P: B *) (* that specialize A = B, A <> B, A == B, etc., to {set _}. This is useful *) (* for subtypes of {set T}, such as {group T}, that coerce to {set T}. *) (* We give many lemmas on these operations, on card, and on set inclusion. *) (* In addition to the standard suffixes described in ssrbool.v, we associate *) (* the following suffixes to set operations: *) (* 0 -- the empty set, as in in_set0 : (x \in set0) = false. *) (* T -- the full set, as in in_setT : x \in [set: T]. *) (* 1 -- a singleton set, as in in_set1 : (x \in [set a]) = (x == a). *) (* 2 -- an unordered pair, as in *) (* in_set2 : (x \in [set a; b]) = (x == a) || (x == b). *) (* C -- complement, as in setCK : ~: ~: A = A. *) (* I -- intersection, as in setIid : A :&: A = A. *) (* U -- union, as in setUid : A :|: A = A. *) (* D -- difference, as in setDv : A :\: A = set0. *) (* S -- a subset argument, as in *) (* setIS: B \subset C -> A :&: B \subset A :&: C *) (* These suffixes are sometimes preceded with an `s' to distinguish them from *) (* their basic ssrbool interpretation, e.g., *) (* card1 : #|pred1 x| = 1 and cards1 : #|[set x]| = 1 *) (* We also use a trailing `r' to distinguish a right-hand complement from *) (* commutativity, e.g., *) (* setIC : A :&: B = B :&: A and setICr : A :&: ~: A = set0. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope set_scope. Section SetType. Variable T : finType. Inductive set_type : predArgType := FinSet of {ffun pred T}. Definition finfun_of_set A := let: FinSet f := A in f. Definition set_of of phant T := set_type. Identity Coercion type_of_set_of : set_of >-> set_type. Canonical set_subType := Eval hnf in [newType for finfun_of_set]. Definition set_eqMixin := Eval hnf in [eqMixin of set_type by <:]. Canonical set_eqType := Eval hnf in EqType set_type set_eqMixin. Definition set_choiceMixin := [choiceMixin of set_type by <:]. Canonical set_choiceType := Eval hnf in ChoiceType set_type set_choiceMixin. Definition set_countMixin := [countMixin of set_type by <:]. Canonical set_countType := Eval hnf in CountType set_type set_countMixin. Canonical set_subCountType := Eval hnf in [subCountType of set_type]. Definition set_finMixin := [finMixin of set_type by <:]. Canonical set_finType := Eval hnf in FinType set_type set_finMixin. Canonical set_subFinType := Eval hnf in [subFinType of set_type]. End SetType. Delimit Scope set_scope with SET. Bind Scope set_scope with set_type. Bind Scope set_scope with set_of. Open Scope set_scope. Arguments finfun_of_set {T} A%SET. Notation "{ 'set' T }" := (set_of (Phant T)) (at level 0, format "{ 'set' T }") : type_scope. (* We later define several subtypes that coerce to set; for these it is *) (* preferable to state equalities at the {set _} level, even when comparing *) (* subtype values, because the primitive "injection" tactic tends to diverge *) (* on complex types (e.g., quotient groups). We provide some parse-only *) (* notation to make this technicality less obstructive. *) Notation "A :=: B" := (A = B :> {set _}) (at level 70, no associativity, only parsing) : set_scope. Notation "A :<>: B" := (A <> B :> {set _}) (at level 70, no associativity, only parsing) : set_scope. Notation "A :==: B" := (A == B :> {set _}) (at level 70, no associativity, only parsing) : set_scope. Notation "A :!=: B" := (A != B :> {set _}) (at level 70, no associativity, only parsing) : set_scope. Notation "A :=P: B" := (A =P B :> {set _}) (at level 70, no associativity, only parsing) : set_scope. Local Notation finset_def := (fun T P => @FinSet T (finfun P)). Local Notation pred_of_set_def := (fun T (A : set_type T) => val A : _ -> _). Module Type SetDefSig. Parameter finset : forall T : finType, pred T -> {set T}. Parameter pred_of_set : forall T, set_type T -> fin_pred_sort (predPredType T). (* The weird type of pred_of_set is imposed by the syntactic restrictions on *) (* coercion declarations; it is unfortunately not possible to use a functor *) (* to retype the declaration, because this triggers an ugly bug in the Coq *) (* coercion chaining code. *) Axiom finsetE : finset = finset_def. Axiom pred_of_setE : pred_of_set = pred_of_set_def. End SetDefSig. Module SetDef : SetDefSig. Definition finset := finset_def. Definition pred_of_set := pred_of_set_def. Lemma finsetE : finset = finset_def. Proof. by []. Qed. Lemma pred_of_setE : pred_of_set = pred_of_set_def. Proof. by []. Qed. End SetDef. Notation finset := SetDef.finset. Notation pred_of_set := SetDef.pred_of_set. Canonical finset_unlock := Unlockable SetDef.finsetE. Canonical pred_of_set_unlock := Unlockable SetDef.pred_of_setE. Notation "[ 'set' x : T | P ]" := (finset (fun x : T => P%B)) (at level 0, x at level 99, only parsing) : set_scope. Notation "[ 'set' x | P ]" := [set x : _ | P] (at level 0, x, P at level 99, format "[ 'set' x | P ]") : set_scope. Notation "[ 'set' x 'in' A ]" := [set x | x \in A] (at level 0, x at level 99, format "[ 'set' x 'in' A ]") : set_scope. Notation "[ 'set' x : T 'in' A ]" := [set x : T | x \in A] (at level 0, x at level 99, only parsing) : set_scope. Notation "[ 'set' x : T | P & Q ]" := [set x : T | P && Q] (at level 0, x at level 99, only parsing) : set_scope. Notation "[ 'set' x | P & Q ]" := [set x | P && Q ] (at level 0, x, P at level 99, format "[ 'set' x | P & Q ]") : set_scope. Notation "[ 'set' x : T 'in' A | P ]" := [set x : T | x \in A & P] (at level 0, x at level 99, only parsing) : set_scope. Notation "[ 'set' x 'in' A | P ]" := [set x | x \in A & P] (at level 0, x at level 99, format "[ 'set' x 'in' A | P ]") : set_scope. Notation "[ 'set' x 'in' A | P & Q ]" := [set x in A | P && Q] (at level 0, x at level 99, format "[ 'set' x 'in' A | P & Q ]") : set_scope. Notation "[ 'set' x : T 'in' A | P & Q ]" := [set x : T in A | P && Q] (at level 0, x at level 99, only parsing) : set_scope. (* This lets us use set and subtypes of set, like group or coset_of, both as *) (* collective predicates and as arguments of the \pi(_) notation. *) Coercion pred_of_set: set_type >-> fin_pred_sort. (* Declare pred_of_set as a canonical instance of topred, but use the *) (* coercion to resolve mem A to @mem (predPredType T) (pred_of_set A). *) Canonical set_predType T := @PredType _ (unkeyed (set_type T)) (@pred_of_set T). Section BasicSetTheory. Variable T : finType. Implicit Types (x : T) (A B : {set T}) (pA : pred T). Canonical set_of_subType := Eval hnf in [subType of {set T}]. Canonical set_of_eqType := Eval hnf in [eqType of {set T}]. Canonical set_of_choiceType := Eval hnf in [choiceType of {set T}]. Canonical set_of_countType := Eval hnf in [countType of {set T}]. Canonical set_of_subCountType := Eval hnf in [subCountType of {set T}]. Canonical set_of_finType := Eval hnf in [finType of {set T}]. Canonical set_of_subFinType := Eval hnf in [subFinType of {set T}]. Lemma in_set pA x : x \in finset pA = pA x. Proof. by rewrite [@finset]unlock unlock [x \in _]ffunE. Qed. Lemma setP A B : A =i B <-> A = B. Proof. by split=> [eqAB|-> //]; apply/val_inj/ffunP=> x; have:= eqAB x; rewrite unlock. Qed. Definition set0 := [set x : T | false]. Definition setTfor (phT : phant T) := [set x : T | true]. Lemma in_setT x : x \in setTfor (Phant T). Proof. by rewrite in_set. Qed. Lemma eqsVneq A B : eq_xor_neq A B (B == A) (A == B). Proof. exact: eqVneq. Qed. Lemma eq_finset (pA pB : pred T) : pA =1 pB -> finset pA = finset pB. Proof. by move=> eq_p; apply/setP => x; rewrite !(in_set, inE) eq_p. Qed. End BasicSetTheory. Arguments eqsVneq {T} A B, {T A B}. Definition inE := (in_set, inE). Arguments set0 {T}. Arguments eq_finset {T} [pA] pB eq_pAB. Hint Resolve in_setT : core. Notation "[ 'set' : T ]" := (setTfor (Phant T)) (at level 0, format "[ 'set' : T ]") : set_scope. Notation setT := [set: _] (only parsing). Section setOpsDefs. Variable T : finType. Implicit Types (a x : T) (A B D : {set T}) (P : {set {set T}}). Definition set1 a := [set x | x == a]. Definition setU A B := [set x | (x \in A) || (x \in B)]. Definition setI A B := [set x in A | x \in B]. Definition setC A := [set x | x \notin A]. Definition setD A B := [set x | x \notin B & x \in A]. Definition ssetI P D := [set A in P | A \subset D]. Definition powerset D := [set A : {set T} | A \subset D]. End setOpsDefs. Notation "[ 'set' a ]" := (set1 a) (at level 0, a at level 99, format "[ 'set' a ]") : set_scope. Notation "[ 'set' a : T ]" := [set (a : T)] (at level 0, a at level 99, format "[ 'set' a : T ]") : set_scope. Notation "A :|: B" := (setU A B) : set_scope. Notation "a |: A" := ([set a] :|: A) : set_scope. (* This is left-associative due to historical limitations of the .. Notation. *) Notation "[ 'set' a1 ; a2 ; .. ; an ]" := (setU .. (a1 |: [set a2]) .. [set an]) (at level 0, a1 at level 99, format "[ 'set' a1 ; a2 ; .. ; an ]") : set_scope. Notation "A :&: B" := (setI A B) : set_scope. Notation "~: A" := (setC A) (at level 35, right associativity) : set_scope. Notation "[ 'set' ~ a ]" := (~: [set a]) (at level 0, format "[ 'set' ~ a ]") : set_scope. Notation "A :\: B" := (setD A B) : set_scope. Notation "A :\ a" := (A :\: [set a]) : set_scope. Notation "P ::&: D" := (ssetI P D) (at level 48) : set_scope. Section setOps. Variable T : finType. Implicit Types (a x : T) (A B C D : {set T}) (pA pB pC : pred T). Lemma eqEsubset A B : (A == B) = (A \subset B) && (B \subset A). Proof. by apply/eqP/subset_eqP=> /setP. Qed. Lemma subEproper A B : A \subset B = (A == B) || (A \proper B). Proof. by rewrite eqEsubset -andb_orr orbN andbT. Qed. Lemma eqVproper A B : A \subset B -> A = B \/ A \proper B. Proof. by rewrite subEproper => /predU1P. Qed. Lemma properEneq A B : A \proper B = (A != B) && (A \subset B). Proof. by rewrite andbC eqEsubset negb_and andb_orr andbN. Qed. Lemma proper_neq A B : A \proper B -> A != B. Proof. by rewrite properEneq; case/andP. Qed. Lemma eqEproper A B : (A == B) = (A \subset B) && ~~ (A \proper B). Proof. by rewrite negb_and negbK andb_orr andbN eqEsubset. Qed. Lemma eqEcard A B : (A == B) = (A \subset B) && (#|B| <= #|A|). Proof. rewrite eqEsubset; apply: andb_id2l => sAB. by rewrite (geq_leqif (subset_leqif_card sAB)). Qed. Lemma properEcard A B : (A \proper B) = (A \subset B) && (#|A| < #|B|). Proof. by rewrite properEneq ltnNge andbC eqEcard; case: (A \subset B). Qed. Lemma subset_leqif_cards A B : A \subset B -> (#|A| <= #|B| ?= iff (A == B)). Proof. by move=> sAB; rewrite eqEsubset sAB; apply: subset_leqif_card. Qed. Lemma in_set0 x : x \in set0 = false. Proof. by rewrite inE. Qed. Lemma sub0set A : set0 \subset A. Proof. by apply/subsetP=> x; rewrite inE. Qed. Lemma subset0 A : (A \subset set0) = (A == set0). Proof. by rewrite eqEsubset sub0set andbT. Qed. Lemma proper0 A : (set0 \proper A) = (A != set0). Proof. by rewrite properE sub0set subset0. Qed. Lemma subset_neq0 A B : A \subset B -> A != set0 -> B != set0. Proof. by rewrite -!proper0 => sAB /proper_sub_trans->. Qed. Lemma set_0Vmem A : (A = set0) + {x : T | x \in A}. Proof. case: (pickP (mem A)) => [x Ax | A0]; [by right; exists x | left]. by apply/setP=> x; rewrite inE; apply: A0. Qed. Lemma set_enum A : [set x | x \in enum A] = A. Proof. by apply/setP => x; rewrite inE mem_enum. Qed. Lemma enum_set0 : enum set0 = [::] :> seq T. Proof. by rewrite (eq_enum (in_set _)) enum0. Qed. Lemma subsetT A : A \subset setT. Proof. by apply/subsetP=> x; rewrite inE. Qed. Lemma subsetT_hint mA : subset mA (mem [set: T]). Proof. by rewrite unlock; apply/pred0P=> x; rewrite !inE. Qed. Hint Resolve subsetT_hint : core. Lemma subTset A : (setT \subset A) = (A == setT). Proof. by rewrite eqEsubset subsetT. Qed. Lemma properT A : (A \proper setT) = (A != setT). Proof. by rewrite properEneq subsetT andbT. Qed. Lemma set1P x a : reflect (x = a) (x \in [set a]). Proof. by rewrite inE; apply: eqP. Qed. Lemma enum_setT : enum [set: T] = Finite.enum T. Proof. by rewrite (eq_enum (in_set _)) enumT. Qed. Lemma in_set1 x a : (x \in [set a]) = (x == a). Proof. exact: in_set. Qed. Lemma set11 x : x \in [set x]. Proof. by rewrite inE. Qed. Lemma set1_inj : injective (@set1 T). Proof. by move=> a b eqsab; apply/set1P; rewrite -eqsab set11. Qed. Lemma enum_set1 a : enum [set a] = [:: a]. Proof. by rewrite (eq_enum (in_set _)) enum1. Qed. Lemma setU1P x a B : reflect (x = a \/ x \in B) (x \in a |: B). Proof. by rewrite !inE; apply: predU1P. Qed. Lemma in_setU1 x a B : (x \in a |: B) = (x == a) || (x \in B). Proof. by rewrite !inE. Qed. Lemma set_cons a s : [set x in a :: s] = a |: [set x in s]. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma setU11 x B : x \in x |: B. Proof. by rewrite !inE eqxx. Qed. Lemma setU1r x a B : x \in B -> x \in a |: B. Proof. by move=> Bx; rewrite !inE predU1r. Qed. (* We need separate lemmas for the explicit enumerations since they *) (* associate on the left. *) Lemma set1Ul x A b : x \in A -> x \in A :|: [set b]. Proof. by move=> Ax; rewrite !inE Ax. Qed. Lemma set1Ur A b : b \in A :|: [set b]. Proof. by rewrite !inE eqxx orbT. Qed. Lemma in_setC1 x a : (x \in [set~ a]) = (x != a). Proof. by rewrite !inE. Qed. Lemma setC11 x : (x \in [set~ x]) = false. Proof. by rewrite !inE eqxx. Qed. Lemma setD1P x A b : reflect (x != b /\ x \in A) (x \in A :\ b). Proof. by rewrite !inE; apply: andP. Qed. Lemma in_setD1 x A b : (x \in A :\ b) = (x != b) && (x \in A) . Proof. by rewrite !inE. Qed. Lemma setD11 b A : (b \in A :\ b) = false. Proof. by rewrite !inE eqxx. Qed. Lemma setD1K a A : a \in A -> a |: (A :\ a) = A. Proof. by move=> Aa; apply/setP=> x; rewrite !inE; case: eqP => // ->. Qed. Lemma setU1K a B : a \notin B -> (a |: B) :\ a = B. Proof. by move/negPf=> nBa; apply/setP=> x; rewrite !inE; case: eqP => // ->. Qed. Lemma set2P x a b : reflect (x = a \/ x = b) (x \in [set a; b]). Proof. by rewrite !inE; apply: pred2P. Qed. Lemma in_set2 x a b : (x \in [set a; b]) = (x == a) || (x == b). Proof. by rewrite !inE. Qed. Lemma set21 a b : a \in [set a; b]. Proof. by rewrite !inE eqxx. Qed. Lemma set22 a b : b \in [set a; b]. Proof. by rewrite !inE eqxx orbT. Qed. Lemma setUP x A B : reflect (x \in A \/ x \in B) (x \in A :|: B). Proof. by rewrite !inE; apply: orP. Qed. Lemma in_setU x A B : (x \in A :|: B) = (x \in A) || (x \in B). Proof. exact: in_set. Qed. Lemma setUC A B : A :|: B = B :|: A. Proof. by apply/setP => x; rewrite !inE orbC. Qed. Lemma setUS A B C : A \subset B -> C :|: A \subset C :|: B. Proof. move=> sAB; apply/subsetP=> x; rewrite !inE. by case: (x \in C) => //; apply: (subsetP sAB). Qed. Lemma setSU A B C : A \subset B -> A :|: C \subset B :|: C. Proof. by move=> sAB; rewrite -!(setUC C) setUS. Qed. Lemma setUSS A B C D : A \subset C -> B \subset D -> A :|: B \subset C :|: D. Proof. by move=> /(setSU B) /subset_trans sAC /(setUS C)/sAC. Qed. Lemma set0U A : set0 :|: A = A. Proof. by apply/setP => x; rewrite !inE orFb. Qed. Lemma setU0 A : A :|: set0 = A. Proof. by rewrite setUC set0U. Qed. Lemma setUA A B C : A :|: (B :|: C) = A :|: B :|: C. Proof. by apply/setP => x; rewrite !inE orbA. Qed. Lemma setUCA A B C : A :|: (B :|: C) = B :|: (A :|: C). Proof. by rewrite !setUA (setUC B). Qed. Lemma setUAC A B C : A :|: B :|: C = A :|: C :|: B. Proof. by rewrite -!setUA (setUC B). Qed. Lemma setUACA A B C D : (A :|: B) :|: (C :|: D) = (A :|: C) :|: (B :|: D). Proof. by rewrite -!setUA (setUCA B). Qed. Lemma setTU A : setT :|: A = setT. Proof. by apply/setP => x; rewrite !inE orTb. Qed. Lemma setUT A : A :|: setT = setT. Proof. by rewrite setUC setTU. Qed. Lemma setUid A : A :|: A = A. Proof. by apply/setP=> x; rewrite inE orbb. Qed. Lemma setUUl A B C : A :|: B :|: C = (A :|: C) :|: (B :|: C). Proof. by rewrite setUA !(setUAC _ C) -(setUA _ C) setUid. Qed. Lemma setUUr A B C : A :|: (B :|: C) = (A :|: B) :|: (A :|: C). Proof. by rewrite !(setUC A) setUUl. Qed. (* intersection *) (* setIdP is a generalisation of setIP that applies to comprehensions. *) Lemma setIdP x pA pB : reflect (pA x /\ pB x) (x \in [set y | pA y & pB y]). Proof. by rewrite !inE; apply: andP. Qed. Lemma setId2P x pA pB pC : reflect [/\ pA x, pB x & pC x] (x \in [set y | pA y & pB y && pC y]). Proof. by rewrite !inE; apply: and3P. Qed. Lemma setIdE A pB : [set x in A | pB x] = A :&: [set x | pB x]. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma setIP x A B : reflect (x \in A /\ x \in B) (x \in A :&: B). Proof. exact: (iffP (@setIdP _ _ _)). Qed. Lemma in_setI x A B : (x \in A :&: B) = (x \in A) && (x \in B). Proof. exact: in_set. Qed. Lemma setIC A B : A :&: B = B :&: A. Proof. by apply/setP => x; rewrite !inE andbC. Qed. Lemma setIS A B C : A \subset B -> C :&: A \subset C :&: B. Proof. move=> sAB; apply/subsetP=> x; rewrite !inE. by case: (x \in C) => //; apply: (subsetP sAB). Qed. Lemma setSI A B C : A \subset B -> A :&: C \subset B :&: C. Proof. by move=> sAB; rewrite -!(setIC C) setIS. Qed. Lemma setISS A B C D : A \subset C -> B \subset D -> A :&: B \subset C :&: D. Proof. by move=> /(setSI B) /subset_trans sAC /(setIS C) /sAC. Qed. Lemma setTI A : setT :&: A = A. Proof. by apply/setP => x; rewrite !inE andTb. Qed. Lemma setIT A : A :&: setT = A. Proof. by rewrite setIC setTI. Qed. Lemma set0I A : set0 :&: A = set0. Proof. by apply/setP => x; rewrite !inE andFb. Qed. Lemma setI0 A : A :&: set0 = set0. Proof. by rewrite setIC set0I. Qed. Lemma setIA A B C : A :&: (B :&: C) = A :&: B :&: C. Proof. by apply/setP=> x; rewrite !inE andbA. Qed. Lemma setICA A B C : A :&: (B :&: C) = B :&: (A :&: C). Proof. by rewrite !setIA (setIC A). Qed. Lemma setIAC A B C : A :&: B :&: C = A :&: C :&: B. Proof. by rewrite -!setIA (setIC B). Qed. Lemma setIACA A B C D : (A :&: B) :&: (C :&: D) = (A :&: C) :&: (B :&: D). Proof. by rewrite -!setIA (setICA B). Qed. Lemma setIid A : A :&: A = A. Proof. by apply/setP=> x; rewrite inE andbb. Qed. Lemma setIIl A B C : A :&: B :&: C = (A :&: C) :&: (B :&: C). Proof. by rewrite setIA !(setIAC _ C) -(setIA _ C) setIid. Qed. Lemma setIIr A B C : A :&: (B :&: C) = (A :&: B) :&: (A :&: C). Proof. by rewrite !(setIC A) setIIl. Qed. (* distribute /cancel *) Lemma setIUr A B C : A :&: (B :|: C) = (A :&: B) :|: (A :&: C). Proof. by apply/setP=> x; rewrite !inE andb_orr. Qed. Lemma setIUl A B C : (A :|: B) :&: C = (A :&: C) :|: (B :&: C). Proof. by apply/setP=> x; rewrite !inE andb_orl. Qed. Lemma setUIr A B C : A :|: (B :&: C) = (A :|: B) :&: (A :|: C). Proof. by apply/setP=> x; rewrite !inE orb_andr. Qed. Lemma setUIl A B C : (A :&: B) :|: C = (A :|: C) :&: (B :|: C). Proof. by apply/setP=> x; rewrite !inE orb_andl. Qed. Lemma setUK A B : (A :|: B) :&: A = A. Proof. by apply/setP=> x; rewrite !inE orbK. Qed. Lemma setKU A B : A :&: (B :|: A) = A. Proof. by apply/setP=> x; rewrite !inE orKb. Qed. Lemma setIK A B : (A :&: B) :|: A = A. Proof. by apply/setP=> x; rewrite !inE andbK. Qed. Lemma setKI A B : A :|: (B :&: A) = A. Proof. by apply/setP=> x; rewrite !inE andKb. Qed. (* complement *) Lemma setCP x A : reflect (~ x \in A) (x \in ~: A). Proof. by rewrite !inE; apply: negP. Qed. Lemma in_setC x A : (x \in ~: A) = (x \notin A). Proof. exact: in_set. Qed. Lemma setCK : involutive (@setC T). Proof. by move=> A; apply/setP=> x; rewrite !inE negbK. Qed. Lemma setC_inj : injective (@setC T). Proof. exact: can_inj setCK. Qed. Lemma subsets_disjoint A B : (A \subset B) = [disjoint A & ~: B]. Proof. by rewrite subset_disjoint; apply: eq_disjoint_r => x; rewrite !inE. Qed. Lemma disjoints_subset A B : [disjoint A & B] = (A \subset ~: B). Proof. by rewrite subsets_disjoint setCK. Qed. Lemma powersetCE A B : (A \in powerset (~: B)) = [disjoint A & B]. Proof. by rewrite inE disjoints_subset. Qed. Lemma setCS A B : (~: A \subset ~: B) = (B \subset A). Proof. by rewrite !subsets_disjoint setCK disjoint_sym. Qed. Lemma setCU A B : ~: (A :|: B) = ~: A :&: ~: B. Proof. by apply/setP=> x; rewrite !inE negb_or. Qed. Lemma setCI A B : ~: (A :&: B) = ~: A :|: ~: B. Proof. by apply/setP=> x; rewrite !inE negb_and. Qed. Lemma setUCr A : A :|: ~: A = setT. Proof. by apply/setP=> x; rewrite !inE orbN. Qed. Lemma setICr A : A :&: ~: A = set0. Proof. by apply/setP=> x; rewrite !inE andbN. Qed. Lemma setC0 : ~: set0 = [set: T]. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma setCT : ~: [set: T] = set0. Proof. by rewrite -setC0 setCK. Qed. Lemma properC A B : (~: B \proper ~: A) = (A \proper B). Proof. by rewrite !properE !setCS. Qed. (* difference *) Lemma setDP A B x : reflect (x \in A /\ x \notin B) (x \in A :\: B). Proof. by rewrite inE andbC; apply: andP. Qed. Lemma in_setD A B x : (x \in A :\: B) = (x \notin B) && (x \in A). Proof. exact: in_set. Qed. Lemma setDE A B : A :\: B = A :&: ~: B. Proof. by apply/setP => x; rewrite !inE andbC. Qed. Lemma setSD A B C : A \subset B -> A :\: C \subset B :\: C. Proof. by rewrite !setDE; apply: setSI. Qed. Lemma setDS A B C : A \subset B -> C :\: B \subset C :\: A. Proof. by rewrite !setDE -setCS; apply: setIS. Qed. Lemma setDSS A B C D : A \subset C -> D \subset B -> A :\: B \subset C :\: D. Proof. by move=> /(setSD B) /subset_trans sAC /(setDS C) /sAC. Qed. Lemma setD0 A : A :\: set0 = A. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma set0D A : set0 :\: A = set0. Proof. by apply/setP=> x; rewrite !inE andbF. Qed. Lemma setDT A : A :\: setT = set0. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma setTD A : setT :\: A = ~: A. Proof. by apply/setP=> x; rewrite !inE andbT. Qed. Lemma setDv A : A :\: A = set0. Proof. by apply/setP=> x; rewrite !inE andNb. Qed. Lemma setCD A B : ~: (A :\: B) = ~: A :|: B. Proof. by rewrite !setDE setCI setCK. Qed. Lemma setID A B : A :&: B :|: A :\: B = A. Proof. by rewrite setDE -setIUr setUCr setIT. Qed. Lemma setDUl A B C : (A :|: B) :\: C = (A :\: C) :|: (B :\: C). Proof. by rewrite !setDE setIUl. Qed. Lemma setDUr A B C : A :\: (B :|: C) = (A :\: B) :&: (A :\: C). Proof. by rewrite !setDE setCU setIIr. Qed. Lemma setDIl A B C : (A :&: B) :\: C = (A :\: C) :&: (B :\: C). Proof. by rewrite !setDE setIIl. Qed. Lemma setIDA A B C : A :&: (B :\: C) = (A :&: B) :\: C. Proof. by rewrite !setDE setIA. Qed. Lemma setIDAC A B C : (A :\: B) :&: C = (A :&: C) :\: B. Proof. by rewrite !setDE setIAC. Qed. Lemma setDIr A B C : A :\: (B :&: C) = (A :\: B) :|: (A :\: C). Proof. by rewrite !setDE setCI setIUr. Qed. Lemma setDDl A B C : (A :\: B) :\: C = A :\: (B :|: C). Proof. by rewrite !setDE setCU setIA. Qed. Lemma setDDr A B C : A :\: (B :\: C) = (A :\: B) :|: (A :&: C). Proof. by rewrite !setDE setCI setIUr setCK. Qed. (* powerset *) Lemma powersetE A B : (A \in powerset B) = (A \subset B). Proof. by rewrite inE. Qed. Lemma powersetS A B : (powerset A \subset powerset B) = (A \subset B). Proof. apply/subsetP/idP=> [sAB | sAB C]; last by rewrite !inE => /subset_trans ->. by rewrite -powersetE sAB // inE. Qed. Lemma powerset0 : powerset set0 = [set set0] :> {set {set T}}. Proof. by apply/setP=> A; rewrite !inE subset0. Qed. Lemma powersetT : powerset [set: T] = [set: {set T}]. Proof. by apply/setP=> A; rewrite !inE subsetT. Qed. Lemma setI_powerset P A : P :&: powerset A = P ::&: A. Proof. by apply/setP=> B; rewrite !inE. Qed. (* cardinal lemmas for sets *) Lemma cardsE pA : #|[set x in pA]| = #|pA|. Proof. exact/eq_card/in_set. Qed. Lemma sum1dep_card pA : \sum_(x | pA x) 1 = #|[set x | pA x]|. Proof. by rewrite sum1_card cardsE. Qed. Lemma sum_nat_cond_const pA n : \sum_(x | pA x) n = #|[set x | pA x]| * n. Proof. by rewrite sum_nat_const cardsE. Qed. Lemma cards0 : #|@set0 T| = 0. Proof. by rewrite cardsE card0. Qed. Lemma cards_eq0 A : (#|A| == 0) = (A == set0). Proof. by rewrite (eq_sym A) eqEcard sub0set cards0 leqn0. Qed. Lemma set0Pn A : reflect (exists x, x \in A) (A != set0). Proof. by rewrite -cards_eq0; apply: existsP. Qed. Lemma card_gt0 A : (0 < #|A|) = (A != set0). Proof. by rewrite lt0n cards_eq0. Qed. Lemma cards0_eq A : #|A| = 0 -> A = set0. Proof. by move=> A_0; apply/setP=> x; rewrite inE (card0_eq A_0). Qed. Lemma cards1 x : #|[set x]| = 1. Proof. by rewrite cardsE card1. Qed. Lemma cardsUI A B : #|A :|: B| + #|A :&: B| = #|A| + #|B|. Proof. by rewrite !cardsE cardUI. Qed. Lemma cardsU A B : #|A :|: B| = (#|A| + #|B| - #|A :&: B|)%N. Proof. by rewrite -cardsUI addnK. Qed. Lemma cardsI A B : #|A :&: B| = (#|A| + #|B| - #|A :|: B|)%N. Proof. by rewrite -cardsUI addKn. Qed. Lemma cardsT : #|[set: T]| = #|T|. Proof. by rewrite cardsE. Qed. Lemma cardsID B A : #|A :&: B| + #|A :\: B| = #|A|. Proof. by rewrite !cardsE cardID. Qed. Lemma cardsD A B : #|A :\: B| = (#|A| - #|A :&: B|)%N. Proof. by rewrite -(cardsID B A) addKn. Qed. Lemma cardsC A : #|A| + #|~: A| = #|T|. Proof. by rewrite cardsE cardC. Qed. Lemma cardsCs A : #|A| = #|T| - #|~: A|. Proof. by rewrite -(cardsC A) addnK. Qed. Lemma cardsU1 a A : #|a |: A| = (a \notin A) + #|A|. Proof. by rewrite -cardU1; apply: eq_card=> x; rewrite !inE. Qed. Lemma cards2 a b : #|[set a; b]| = (a != b).+1. Proof. by rewrite -card2; apply: eq_card=> x; rewrite !inE. Qed. Lemma cardsC1 a : #|[set~ a]| = #|T|.-1. Proof. by rewrite -(cardC1 a); apply: eq_card=> x; rewrite !inE. Qed. Lemma cardsD1 a A : #|A| = (a \in A) + #|A :\ a|. Proof. by rewrite (cardD1 a); congr (_ + _); apply: eq_card => x; rewrite !inE. Qed. (* other inclusions *) Lemma subsetIl A B : A :&: B \subset A. Proof. by apply/subsetP=> x; rewrite inE; case/andP. Qed. Lemma subsetIr A B : A :&: B \subset B. Proof. by apply/subsetP=> x; rewrite inE; case/andP. Qed. Lemma subsetUl A B : A \subset A :|: B. Proof. by apply/subsetP=> x; rewrite inE => ->. Qed. Lemma subsetUr A B : B \subset A :|: B. Proof. by apply/subsetP=> x; rewrite inE orbC => ->. Qed. Lemma subsetU1 x A : A \subset x |: A. Proof. exact: subsetUr. Qed. Lemma subsetDl A B : A :\: B \subset A. Proof. by rewrite setDE subsetIl. Qed. Lemma subD1set A x : A :\ x \subset A. Proof. by rewrite subsetDl. Qed. Lemma subsetDr A B : A :\: B \subset ~: B. Proof. by rewrite setDE subsetIr. Qed. Lemma sub1set A x : ([set x] \subset A) = (x \in A). Proof. by rewrite -subset_pred1; apply: eq_subset=> y; rewrite !inE. Qed. Variant cards_eq_spec A : seq T -> {set T} -> nat -> Type := | CardEq (s : seq T) & uniq s : cards_eq_spec A s [set x | x \in s] (size s). Lemma cards_eqP A : cards_eq_spec A (enum A) A #|A|. Proof. by move: (enum A) (cardE A) (set_enum A) (enum_uniq A) => s -> <-; constructor. Qed. Lemma cards1P A : reflect (exists x, A = [set x]) (#|A| == 1). Proof. apply: (iffP idP) => [|[x ->]]; last by rewrite cards1. by have [[|x []]// _] := cards_eqP; exists x; apply/setP => y; rewrite !inE. Qed. Lemma cards2P A : reflect (exists x y : T, x != y /\ A = [set x; y]) (#|A| == 2). Proof. apply: (iffP idP) => [|[x] [y] [xy ->]]; last by rewrite cards2 xy. have [[|x [|y []]]//=] := cards_eqP; rewrite !inE andbT => neq_xy. by exists x, y; split=> //; apply/setP => z; rewrite !inE. Qed. Lemma subset1 A x : (A \subset [set x]) = (A == [set x]) || (A == set0). Proof. rewrite eqEcard cards1 -cards_eq0 orbC andbC. by case: posnP => // A0; rewrite (cards0_eq A0) sub0set. Qed. Lemma powerset1 x : powerset [set x] = [set set0; [set x]]. Proof. by apply/setP=> A; rewrite !inE subset1 orbC. Qed. Lemma setIidPl A B : reflect (A :&: B = A) (A \subset B). Proof. apply: (iffP subsetP) => [sAB | <- x /setIP[] //]. by apply/setP=> x; rewrite inE; apply/andb_idr/sAB. Qed. Arguments setIidPl {A B}. Lemma setIidPr A B : reflect (A :&: B = B) (B \subset A). Proof. by rewrite setIC; apply: setIidPl. Qed. Lemma cardsDS A B : B \subset A -> #|A :\: B| = (#|A| - #|B|)%N. Proof. by rewrite cardsD => /setIidPr->. Qed. Lemma setUidPl A B : reflect (A :|: B = A) (B \subset A). Proof. by rewrite -setCS (sameP setIidPl eqP) -setCU (inj_eq setC_inj); apply: eqP. Qed. Lemma setUidPr A B : reflect (A :|: B = B) (A \subset B). Proof. by rewrite setUC; apply: setUidPl. Qed. Lemma setDidPl A B : reflect (A :\: B = A) [disjoint A & B]. Proof. by rewrite setDE disjoints_subset; apply: setIidPl. Qed. Lemma subIset A B C : (B \subset A) || (C \subset A) -> (B :&: C \subset A). Proof. by case/orP; apply: subset_trans; rewrite (subsetIl, subsetIr). Qed. Lemma subsetI A B C : (A \subset B :&: C) = (A \subset B) && (A \subset C). Proof. rewrite !(sameP setIidPl eqP) setIA; have [-> //|] := eqVneq (A :&: B) A. by apply: contraNF => /eqP <-; rewrite -setIA -setIIl setIAC. Qed. Lemma subsetIP A B C : reflect (A \subset B /\ A \subset C) (A \subset B :&: C). Proof. by rewrite subsetI; apply: andP. Qed. Lemma subsetIidl A B : (A \subset A :&: B) = (A \subset B). Proof. by rewrite subsetI subxx. Qed. Lemma subsetIidr A B : (B \subset A :&: B) = (B \subset A). Proof. by rewrite setIC subsetIidl. Qed. Lemma powersetI A B : powerset (A :&: B) = powerset A :&: powerset B. Proof. by apply/setP=> C; rewrite !inE subsetI. Qed. Lemma subUset A B C : (B :|: C \subset A) = (B \subset A) && (C \subset A). Proof. by rewrite -setCS setCU subsetI !setCS. Qed. Lemma subsetU A B C : (A \subset B) || (A \subset C) -> A \subset B :|: C. Proof. by rewrite -!(setCS _ A) setCU; apply: subIset. Qed. Lemma subUsetP A B C : reflect (A \subset C /\ B \subset C) (A :|: B \subset C). Proof. by rewrite subUset; apply: andP. Qed. Lemma subsetC A B : (A \subset ~: B) = (B \subset ~: A). Proof. by rewrite -setCS setCK. Qed. Lemma subCset A B : (~: A \subset B) = (~: B \subset A). Proof. by rewrite -setCS setCK. Qed. Lemma subsetD A B C : (A \subset B :\: C) = (A \subset B) && [disjoint A & C]. Proof. by rewrite setDE subsetI -disjoints_subset. Qed. Lemma subDset A B C : (A :\: B \subset C) = (A \subset B :|: C). Proof. apply/subsetP/subsetP=> sABC x; rewrite !inE. by case Bx: (x \in B) => // Ax; rewrite sABC ?inE ?Bx. by case Bx: (x \in B) => // /sABC; rewrite inE Bx. Qed. Lemma subsetDP A B C : reflect (A \subset B /\ [disjoint A & C]) (A \subset B :\: C). Proof. by rewrite subsetD; apply: andP. Qed. Lemma setU_eq0 A B : (A :|: B == set0) = (A == set0) && (B == set0). Proof. by rewrite -!subset0 subUset. Qed. Lemma setD_eq0 A B : (A :\: B == set0) = (A \subset B). Proof. by rewrite -subset0 subDset setU0. Qed. Lemma setI_eq0 A B : (A :&: B == set0) = [disjoint A & B]. Proof. by rewrite disjoints_subset -setD_eq0 setDE setCK. Qed. Lemma disjoint_setI0 A B : [disjoint A & B] -> A :&: B = set0. Proof. by rewrite -setI_eq0; move/eqP. Qed. Lemma disjoints1 A x : [disjoint [set x] & A] = (x \notin A). Proof. by rewrite (@eq_disjoint1 _ x) // => y; rewrite !inE. Qed. Lemma subsetD1 A B x : (A \subset B :\ x) = (A \subset B) && (x \notin A). Proof. by rewrite setDE subsetI subsetC sub1set inE. Qed. Lemma subsetD1P A B x : reflect (A \subset B /\ x \notin A) (A \subset B :\ x). Proof. by rewrite subsetD1; apply: andP. Qed. Lemma properD1 A x : x \in A -> A :\ x \proper A. Proof. move=> Ax; rewrite properE subsetDl; apply/subsetPn; exists x=> //. by rewrite in_setD1 Ax eqxx. Qed. Lemma properIr A B : ~~ (B \subset A) -> A :&: B \proper B. Proof. by move=> nsAB; rewrite properE subsetIr subsetI negb_and nsAB. Qed. Lemma properIl A B : ~~ (A \subset B) -> A :&: B \proper A. Proof. by move=> nsBA; rewrite properE subsetIl subsetI negb_and nsBA orbT. Qed. Lemma properUr A B : ~~ (A \subset B) -> B \proper A :|: B. Proof. by rewrite properE subsetUr subUset subxx /= andbT. Qed. Lemma properUl A B : ~~ (B \subset A) -> A \proper A :|: B. Proof. by move=> not_sBA; rewrite setUC properUr. Qed. Lemma proper1set A x : ([set x] \proper A) -> (x \in A). Proof. by move/proper_sub; rewrite sub1set. Qed. Lemma properIset A B C : (B \proper A) || (C \proper A) -> (B :&: C \proper A). Proof. by case/orP; apply: sub_proper_trans; rewrite (subsetIl, subsetIr). Qed. Lemma properI A B C : (A \proper B :&: C) -> (A \proper B) && (A \proper C). Proof. move=> pAI; apply/andP. by split; apply: (proper_sub_trans pAI); rewrite (subsetIl, subsetIr). Qed. Lemma properU A B C : (B :|: C \proper A) -> (B \proper A) && (C \proper A). Proof. move=> pUA; apply/andP. by split; apply: sub_proper_trans pUA; rewrite (subsetUr, subsetUl). Qed. Lemma properD A B C : (A \proper B :\: C) -> (A \proper B) && [disjoint A & C]. Proof. by rewrite setDE disjoints_subset => /properI/andP[-> /proper_sub]. Qed. Lemma properCr A B : (A \proper ~: B) = (B \proper ~: A). Proof. by rewrite -properC setCK. Qed. Lemma properCl A B : (~: A \proper B) = (~: B \proper A). Proof. by rewrite -properC setCK. Qed. End setOps. Arguments set1P {T x a}. Arguments set1_inj {T} [x1 x2]. Arguments set2P {T x a b}. Arguments setIdP {T x pA pB}. Arguments setIP {T x A B}. Arguments setU1P {T x a B}. Arguments setD1P {T x A b}. Arguments setUP {T x A B}. Arguments setDP {T A B x}. Arguments cards1P {T A}. Arguments setCP {T x A}. Arguments setIidPl {T A B}. Arguments setIidPr {T A B}. Arguments setUidPl {T A B}. Arguments setUidPr {T A B}. Arguments setDidPl {T A B}. Arguments subsetIP {T A B C}. Arguments subUsetP {T A B C}. Arguments subsetDP {T A B C}. Arguments subsetD1P {T A B x}. Prenex Implicits set1. Hint Resolve subsetT_hint : core. Section setOpsAlgebra. Import Monoid. Variable T : finType. Canonical setI_monoid := Law (@setIA T) (@setTI T) (@setIT T). Canonical setI_comoid := ComLaw (@setIC T). Canonical setI_muloid := MulLaw (@set0I T) (@setI0 T). Canonical setU_monoid := Law (@setUA T) (@set0U T) (@setU0 T). Canonical setU_comoid := ComLaw (@setUC T). Canonical setU_muloid := MulLaw (@setTU T) (@setUT T). Canonical setI_addoid := AddLaw (@setUIl T) (@setUIr T). Canonical setU_addoid := AddLaw (@setIUl T) (@setIUr T). End setOpsAlgebra. Section CartesianProd. Variables fT1 fT2 : finType. Variables (A1 : {set fT1}) (A2 : {set fT2}). Definition setX := [set u | u.1 \in A1 & u.2 \in A2]. Lemma in_setX x1 x2 : ((x1, x2) \in setX) = (x1 \in A1) && (x2 \in A2). Proof. by rewrite inE. Qed. Lemma setXP x1 x2 : reflect (x1 \in A1 /\ x2 \in A2) ((x1, x2) \in setX). Proof. by rewrite inE; apply: andP. Qed. Lemma cardsX : #|setX| = #|A1| * #|A2|. Proof. by rewrite cardsE cardX. Qed. End CartesianProd. Arguments setXP {fT1 fT2 A1 A2 x1 x2}. Local Notation imset_def := (fun (aT rT : finType) f mD => [set y in @image_mem aT rT f mD]). Local Notation imset2_def := (fun (aT1 aT2 rT : finType) f (D1 : mem_pred aT1) (D2 : _ -> mem_pred aT2) => [set y in @image_mem _ rT (prod_curry f) (mem [pred u | D1 u.1 & D2 u.1 u.2])]). Module Type ImsetSig. Parameter imset : forall aT rT : finType, (aT -> rT) -> mem_pred aT -> {set rT}. Parameter imset2 : forall aT1 aT2 rT : finType, (aT1 -> aT2 -> rT) -> mem_pred aT1 -> (aT1 -> mem_pred aT2) -> {set rT}. Axiom imsetE : imset = imset_def. Axiom imset2E : imset2 = imset2_def. End ImsetSig. Module Imset : ImsetSig. Definition imset := imset_def. Definition imset2 := imset2_def. Lemma imsetE : imset = imset_def. Proof. by []. Qed. Lemma imset2E : imset2 = imset2_def. Proof. by []. Qed. End Imset. Notation imset := Imset.imset. Notation imset2 := Imset.imset2. Canonical imset_unlock := Unlockable Imset.imsetE. Canonical imset2_unlock := Unlockable Imset.imset2E. Definition preimset (aT : finType) rT f (R : mem_pred rT) := [set x : aT | in_mem (f x) R]. Notation "f @^-1: A" := (preimset f (mem A)) (at level 24) : set_scope. Notation "f @: A" := (imset f (mem A)) (at level 24) : set_scope. Notation "f @2: ( A , B )" := (imset2 f (mem A) (fun _ => mem B)) (at level 24, format "f @2: ( A , B )") : set_scope. (* Comprehensions *) Notation "[ 'set' E | x 'in' A ]" := ((fun x => E) @: A) (at level 0, E, x at level 99, format "[ '[hv' 'set' E '/ ' | x 'in' A ] ']'") : set_scope. Notation "[ 'set' E | x 'in' A & P ]" := [set E | x in pred_of_set [set x in A | P]] (at level 0, E, x at level 99, format "[ '[hv' 'set' E '/ ' | x 'in' A '/ ' & P ] ']'") : set_scope. Notation "[ 'set' E | x 'in' A , y 'in' B ]" := (imset2 (fun x y => E) (mem A) (fun x => mem B)) (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x 'in' A , '/ ' y 'in' B ] ']'" ) : set_scope. Notation "[ 'set' E | x 'in' A , y 'in' B & P ]" := [set E | x in A, y in pred_of_set [set y in B | P]] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x 'in' A , '/ ' y 'in' B '/ ' & P ] ']'" ) : set_scope. (* Typed variants. *) Notation "[ 'set' E | x : T 'in' A ]" := ((fun x : T => E) @: A) (at level 0, E, x at level 99, only parsing) : set_scope. Notation "[ 'set' E | x : T 'in' A & P ]" := [set E | x : T in [set x : T in A | P]] (at level 0, E, x at level 99, only parsing) : set_scope. Notation "[ 'set' E | x : T 'in' A , y : U 'in' B ]" := (imset2 (fun (x : T) (y : U) => E) (mem A) (fun (x : T) => mem B)) (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x : T 'in' A , y : U 'in' B & P ]" := [set E | x : T in A, y : U in [set y : U in B | P]] (at level 0, E, x, y at level 99, only parsing) : set_scope. (* Comprehensions over a type. *) Local Notation predOfType T := (pred_of_simpl (@pred_of_argType T)). Notation "[ 'set' E | x : T ]" := [set E | x : T in predOfType T] (at level 0, E, x at level 99, format "[ '[hv' 'set' E '/ ' | x : T ] ']'") : set_scope. Notation "[ 'set' E | x : T & P ]" := [set E | x : T in pred_of_set [set x : T | P]] (at level 0, E, x at level 99, format "[ '[hv' 'set' E '/ ' | x : T '/ ' & P ] ']'") : set_scope. Notation "[ 'set' E | x : T , y : U 'in' B ]" := [set E | x : T in predOfType T, y : U in B] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x : T , '/ ' y : U 'in' B ] ']'") : set_scope. Notation "[ 'set' E | x : T , y : U 'in' B & P ]" := [set E | x : T, y : U in pred_of_set [set y in B | P]] (at level 0, E, x, y at level 99, format "[ '[hv ' 'set' E '/' | x : T , '/ ' y : U 'in' B '/' & P ] ']'" ) : set_scope. Notation "[ 'set' E | x : T 'in' A , y : U ]" := [set E | x : T in A, y : U in predOfType U] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x : T 'in' A , '/ ' y : U ] ']'") : set_scope. Notation "[ 'set' E | x : T 'in' A , y : U & P ]" := [set E | x : T in A, y : U in pred_of_set [set y in P]] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x : T 'in' A , '/ ' y : U & P ] ']'") : set_scope. Notation "[ 'set' E | x : T , y : U ]" := [set E | x : T, y : U in predOfType U] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x : T , '/ ' y : U ] ']'") : set_scope. Notation "[ 'set' E | x : T , y : U & P ]" := [set E | x : T, y : U in pred_of_set [set y in P]] (at level 0, E, x, y at level 99, format "[ '[hv' 'set' E '/ ' | x : T , '/ ' y : U & P ] ']'") : set_scope. (* Untyped variants. *) Notation "[ 'set' E | x , y 'in' B ]" := [set E | x : _, y : _ in B] (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x , y 'in' B & P ]" := [set E | x : _, y : _ in B & P] (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x 'in' A , y ]" := [set E | x : _ in A, y : _] (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x 'in' A , y & P ]" := [set E | x : _ in A, y : _ & P] (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x , y ]" := [set E | x : _, y : _] (at level 0, E, x, y at level 99, only parsing) : set_scope. Notation "[ 'set' E | x , y & P ]" := [set E | x : _, y : _ & P ] (at level 0, E, x, y at level 99, only parsing) : set_scope. Section FunImage. Variables aT aT2 : finType. Section ImsetTheory. Variable rT : finType. Section ImsetProp. Variables (f : aT -> rT) (f2 : aT -> aT2 -> rT). Lemma imsetP D y : reflect (exists2 x, in_mem x D & y = f x) (y \in imset f D). Proof. by rewrite [@imset]unlock inE; apply: imageP. Qed. Variant imset2_spec D1 D2 y : Prop := Imset2spec x1 x2 of in_mem x1 D1 & in_mem x2 (D2 x1) & y = f2 x1 x2. Lemma imset2P D1 D2 y : reflect (imset2_spec D1 D2 y) (y \in imset2 f2 D1 D2). Proof. rewrite [@imset2]unlock inE. apply: (iffP imageP) => [[[x1 x2] Dx12] | [x1 x2 Dx1 Dx2]] -> {y}. by case/andP: Dx12; exists x1 x2. by exists (x1, x2); rewrite //= !inE Dx1. Qed. Lemma imset_f (D : {pred aT}) x : x \in D -> f x \in f @: D. Proof. by move=> Dx; apply/imsetP; exists x. Qed. Lemma mem_imset_eq (D : {pred aT}) x : injective f -> f x \in f @: D = (x \in D). Proof. by move=> f_inj; apply/imsetP/idP;[case=> [y] ? /f_inj -> | move=> ?; exists x]. Qed. Lemma imset0 : f @: set0 = set0. Proof. by apply/setP => y; rewrite inE; apply/imsetP=> [[x]]; rewrite inE. Qed. Lemma imset_eq0 (A : {set aT}) : (f @: A == set0) = (A == set0). Proof. have [-> | [x Ax]] := set_0Vmem A; first by rewrite imset0 !eqxx. by rewrite -!cards_eq0 (cardsD1 x) Ax (cardsD1 (f x)) imset_f. Qed. Lemma imset_set1 x : f @: [set x] = [set f x]. Proof. apply/setP => y. by apply/imsetP/set1P=> [[x' /set1P-> //]| ->]; exists x; rewrite ?set11. Qed. Lemma imset2_f (D : {pred aT}) (D2 : aT -> {pred aT2}) x x2 : x \in D -> x2 \in D2 x -> f2 x x2 \in imset2 f2 (mem D) (fun x1 => mem (D2 x1)). Proof. by move=> Dx Dx2; apply/imset2P; exists x x2. Qed. Lemma mem_imset2_eq (D : {pred aT}) (D2 : aT -> {pred aT2}) x x2 : injective2 f2 -> f2 x x2 \in imset2 f2 (mem D) (fun x1 => mem (D2 x1)) = ((x \in D) && (x2 \in D2 x)). Proof. move=> inj2_f; apply/imset2P/andP => [|[xD xD2]]; last by exists x x2. by move => [x' x2' xD xD2 eq_f2]; case: (inj2_f _ _ _ _ eq_f2) => -> ->. Qed. Lemma sub_imset_pre (A : {pred aT}) (B : {pred rT}) : (f @: A \subset B) = (A \subset f @^-1: B). Proof. apply/subsetP/subsetP=> [sfAB x Ax | sAf'B fx]. by rewrite inE sfAB ?imset_f. by case/imsetP=> x Ax ->; move/sAf'B: Ax; rewrite inE. Qed. Lemma preimsetS (A B : {pred rT}) : A \subset B -> (f @^-1: A) \subset (f @^-1: B). Proof. by move=> sAB; apply/subsetP=> y; rewrite !inE; apply: subsetP. Qed. Lemma preimset0 : f @^-1: set0 = set0. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma preimsetT : f @^-1: setT = setT. Proof. by apply/setP=> x; rewrite !inE. Qed. Lemma preimsetI (A B : {set rT}) : f @^-1: (A :&: B) = (f @^-1: A) :&: (f @^-1: B). Proof. by apply/setP=> y; rewrite !inE. Qed. Lemma preimsetU (A B : {set rT}) : f @^-1: (A :|: B) = (f @^-1: A) :|: (f @^-1: B). Proof. by apply/setP=> y; rewrite !inE. Qed. Lemma preimsetD (A B : {set rT}) : f @^-1: (A :\: B) = (f @^-1: A) :\: (f @^-1: B). Proof. by apply/setP=> y; rewrite !inE. Qed. Lemma preimsetC (A : {set rT}) : f @^-1: (~: A) = ~: f @^-1: A. Proof. by apply/setP=> y; rewrite !inE. Qed. Lemma imsetS (A B : {pred aT}) : A \subset B -> f @: A \subset f @: B. Proof. move=> sAB; apply/subsetP=> _ /imsetP[x Ax ->]. by apply/imsetP; exists x; rewrite ?(subsetP sAB). Qed. Lemma imset_proper (A B : {set aT}) : {in B &, injective f} -> A \proper B -> f @: A \proper f @: B. Proof. move=> injf /properP[sAB [x Bx nAx]]; rewrite properE imsetS //=. apply: contra nAx => sfBA. have: f x \in f @: A by rewrite (subsetP sfBA) ?imset_f. by case/imsetP=> y Ay /injf-> //; apply: subsetP sAB y Ay. Qed. Lemma preimset_proper (A B : {set rT}) : B \subset codom f -> A \proper B -> (f @^-1: A) \proper (f @^-1: B). Proof. move=> sBc /properP[sAB [u Bu nAu]]; rewrite properE preimsetS //=. by apply/subsetPn; exists (iinv (subsetP sBc _ Bu)); rewrite inE /= f_iinv. Qed. Lemma imsetU (A B : {set aT}) : f @: (A :|: B) = (f @: A) :|: (f @: B). Proof. apply/eqP; rewrite eqEsubset subUset. rewrite 2?imsetS (andbT, subsetUl, subsetUr) // andbT. apply/subsetP=> _ /imsetP[x ABx ->]; apply/setUP. by case/setUP: ABx => [Ax | Bx]; [left | right]; apply/imsetP; exists x. Qed. Lemma imsetU1 a (A : {set aT}) : f @: (a |: A) = f a |: (f @: A). Proof. by rewrite imsetU imset_set1. Qed. Lemma imsetI (A B : {set aT}) : {in A & B, injective f} -> f @: (A :&: B) = f @: A :&: f @: B. Proof. move=> injf; apply/eqP; rewrite eqEsubset subsetI. rewrite 2?imsetS (andTb, subsetIl, subsetIr) //=. apply/subsetP=> _ /setIP[/imsetP[x Ax ->] /imsetP[z Bz /injf eqxz]]. by rewrite imset_f // inE Ax eqxz. Qed. Lemma imset2Sl (A B : {pred aT}) (C : {pred aT2}) : A \subset B -> f2 @2: (A, C) \subset f2 @2: (B, C). Proof. move=> sAB; apply/subsetP=> _ /imset2P[x y Ax Cy ->]. by apply/imset2P; exists x y; rewrite ?(subsetP sAB). Qed. Lemma imset2Sr (A B : {pred aT2}) (C : {pred aT}) : A \subset B -> f2 @2: (C, A) \subset f2 @2: (C, B). Proof. move=> sAB; apply/subsetP=> _ /imset2P[x y Ax Cy ->]. by apply/imset2P; exists x y; rewrite ?(subsetP sAB). Qed. Lemma imset2S (A B : {pred aT}) (A2 B2 : {pred aT2}) : A \subset B -> A2 \subset B2 -> f2 @2: (A, A2) \subset f2 @2: (B, B2). Proof. by move=> /(imset2Sl B2) sBA /(imset2Sr A)/subset_trans->. Qed. End ImsetProp. Implicit Types (f g : aT -> rT) (D : {set aT}) (R : {pred rT}). Lemma eq_preimset f g R : f =1 g -> f @^-1: R = g @^-1: R. Proof. by move=> eqfg; apply/setP => y; rewrite !inE eqfg. Qed. Lemma eq_imset f g D : f =1 g -> f @: D = g @: D. Proof. move=> eqfg; apply/setP=> y. by apply/imsetP/imsetP=> [] [x Dx ->]; exists x; rewrite ?eqfg. Qed. Lemma eq_in_imset f g D : {in D, f =1 g} -> f @: D = g @: D. Proof. move=> eqfg; apply/setP => y. by apply/imsetP/imsetP=> [] [x Dx ->]; exists x; rewrite ?eqfg. Qed. Lemma eq_in_imset2 (f g : aT -> aT2 -> rT) (D : {pred aT}) (D2 : {pred aT2}) : {in D & D2, f =2 g} -> f @2: (D, D2) = g @2: (D, D2). Proof. move=> eqfg; apply/setP => y. by apply/imset2P/imset2P=> [] [x x2 Dx Dx2 ->]; exists x x2; rewrite ?eqfg. Qed. End ImsetTheory. Lemma imset2_pair (A : {set aT}) (B : {set aT2}) : [set (x, y) | x in A, y in B] = setX A B. Proof. apply/setP=> [[x y]]; rewrite !inE /=. by apply/imset2P/andP=> [[_ _ _ _ [-> ->]//]| []]; exists x y. Qed. Lemma setXS (A1 B1 : {set aT}) (A2 B2 : {set aT2}) : A1 \subset B1 -> A2 \subset B2 -> setX A1 A2 \subset setX B1 B2. Proof. by move=> sAB1 sAB2; rewrite -!imset2_pair imset2S. Qed. End FunImage. Arguments imsetP {aT rT f D y}. Arguments imset2P {aT aT2 rT f2 D1 D2 y}. Section BigOps. Variables (R : Type) (idx : R). Variables (op : Monoid.law idx) (aop : Monoid.com_law idx). Variables I J : finType. Implicit Type A B : {set I}. Implicit Type h : I -> J. Implicit Type P : pred I. Implicit Type F : I -> R. Lemma big_set0 F : \big[op/idx]_(i in set0) F i = idx. Proof. by apply: big_pred0 => i; rewrite inE. Qed. Lemma big_set1 a F : \big[op/idx]_(i in [set a]) F i = F a. Proof. by apply: big_pred1 => i; rewrite !inE. Qed. Lemma big_set (A : pred I) F : \big[op/idx]_(i in [set i | A i]) (F i) = \big[op/idx]_(i in A) (F i). Proof. by apply: eq_bigl => i; rewrite inE. Qed. Lemma big_setID A B F : \big[aop/idx]_(i in A) F i = aop (\big[aop/idx]_(i in A :&: B) F i) (\big[aop/idx]_(i in A :\: B) F i). Proof. rewrite (bigID (mem B)) setDE. by congr (aop _ _); apply: eq_bigl => i; rewrite !inE. Qed. Lemma big_setIDcond A B P F : \big[aop/idx]_(i in A | P i) F i = aop (\big[aop/idx]_(i in A :&: B | P i) F i) (\big[aop/idx]_(i in A :\: B | P i) F i). Proof. by rewrite !big_mkcondr; apply: big_setID. Qed. Lemma big_setD1 a A F : a \in A -> \big[aop/idx]_(i in A) F i = aop (F a) (\big[aop/idx]_(i in A :\ a) F i). Proof. move=> Aa; rewrite (bigD1 a Aa); congr (aop _). by apply: eq_bigl => x; rewrite !inE andbC. Qed. Lemma big_setU1 a A F : a \notin A -> \big[aop/idx]_(i in a |: A) F i = aop (F a) (\big[aop/idx]_(i in A) F i). Proof. by move=> notAa; rewrite (@big_setD1 a) ?setU11 //= setU1K. Qed. Lemma big_imset h (A : {pred I}) G : {in A &, injective h} -> \big[aop/idx]_(j in h @: A) G j = \big[aop/idx]_(i in A) G (h i). Proof. move=> injh; pose hA := mem (image h A). rewrite (eq_bigl hA) => [|j]; last exact/imsetP/imageP. pose h' := omap (fun u : {j | hA j} => iinv (svalP u)) \o insub. rewrite (reindex_omap h h') => [|j hAj]; rewrite {}/h'/= ?insubT/= ?f_iinv//. apply: eq_bigl => i; case: insubP => [u -> /= def_u | nhAhi]; last first. by apply/andP/idP => [[]//| Ai]; case/imageP: nhAhi; exists i. set i' := iinv _; have Ai' : i' \in A := mem_iinv (svalP u). by apply/eqP/idP => [[<-] // | Ai]; congr Some; apply: injh; rewrite ?f_iinv. Qed. Lemma big_imset_cond h (A : {pred I}) (P : pred J) G : {in A &, injective h} -> \big[aop/idx]_(j in h @: A | P j) G j = \big[aop/idx]_(i in A | P (h i)) G (h i). Proof. by move=> h_inj; rewrite 2!big_mkcondr big_imset. Qed. Lemma partition_big_imset h (A : {pred I}) F : \big[aop/idx]_(i in A) F i = \big[aop/idx]_(j in h @: A) \big[aop/idx]_(i in A | h i == j) F i. Proof. by apply: partition_big => i Ai; apply/imsetP; exists i. Qed. End BigOps. Arguments big_setID [R idx aop I A]. Arguments big_setD1 [R idx aop I] a [A F]. Arguments big_setU1 [R idx aop I] a [A F]. Arguments big_imset [R idx aop I J h A]. Arguments partition_big_imset [R idx aop I J]. Section Fun2Set1. Variables aT1 aT2 rT : finType. Variables (f : aT1 -> aT2 -> rT). Lemma imset2_set1l x1 (D2 : {pred aT2}) : f @2: ([set x1], D2) = f x1 @: D2. Proof. apply/setP=> y; apply/imset2P/imsetP=> [[x x2 /set1P->]| [x2 Dx2 ->]]. by exists x2. by exists x1 x2; rewrite ?set11. Qed. Lemma imset2_set1r x2 (D1 : {pred aT1}) : f @2: (D1, [set x2]) = f^~ x2 @: D1. Proof. apply/setP=> y; apply/imset2P/imsetP=> [[x1 x Dx1 /set1P->]| [x1 Dx1 ->]]. by exists x1. by exists x1 x2; rewrite ?set11. Qed. End Fun2Set1. Section CardFunImage. Variables aT aT2 rT : finType. Variables (f : aT -> rT) (g : rT -> aT) (f2 : aT -> aT2 -> rT). Variables (D : {pred aT}) (D2 : {pred aT}). Lemma imset_card : #|f @: D| = #|image f D|. Proof. by rewrite [@imset]unlock cardsE. Qed. Lemma leq_imset_card : #|f @: D| <= #|D|. Proof. by rewrite imset_card leq_image_card. Qed. Lemma card_in_imset : {in D &, injective f} -> #|f @: D| = #|D|. Proof. by move=> injf; rewrite imset_card card_in_image. Qed. Lemma card_imset : injective f -> #|f @: D| = #|D|. Proof. by move=> injf; rewrite imset_card card_image. Qed. Lemma imset_injP : reflect {in D &, injective f} (#|f @: D| == #|D|). Proof. by rewrite [@imset]unlock cardsE; apply: image_injP. Qed. Lemma can2_in_imset_pre : {in D, cancel f g} -> {on D, cancel g & f} -> f @: D = g @^-1: D. Proof. move=> fK gK; apply/setP=> y; rewrite inE. by apply/imsetP/idP=> [[x Ax ->] | Agy]; last exists (g y); rewrite ?(fK, gK). Qed. Lemma can2_imset_pre : cancel f g -> cancel g f -> f @: D = g @^-1: D. Proof. by move=> fK gK; apply: can2_in_imset_pre; apply: in1W. Qed. End CardFunImage. Arguments imset_injP {aT rT f D}. Lemma on_card_preimset (aT rT : finType) (f : aT -> rT) (R : {pred rT}) : {on R, bijective f} -> #|f @^-1: R| = #|R|. Proof. case=> g fK gK; rewrite -(can2_in_imset_pre gK) // card_in_imset //. exact: can_in_inj gK. Qed. Lemma can_imset_pre (T : finType) f g (A : {set T}) : cancel f g -> f @: A = g @^-1: A :> {set T}. Proof. move=> fK; apply: can2_imset_pre => // x. suffices fx: x \in codom f by rewrite -(f_iinv fx) fK. exact/(subset_cardP (card_codom (can_inj fK)))/subsetP. Qed. Lemma imset_id (T : finType) (A : {set T}) : [set x | x in A] = A. Proof. by apply/setP=> x; rewrite (@can_imset_pre _ _ id) ?inE. Qed. Lemma card_preimset (T : finType) (f : T -> T) (A : {set T}) : injective f -> #|f @^-1: A| = #|A|. Proof. move=> injf; apply: on_card_preimset; apply: onW_bij. have ontof: _ \in codom f by apply/(subset_cardP (card_codom injf))/subsetP. by exists (fun x => iinv (ontof x)) => x; rewrite (f_iinv, iinv_f). Qed. Lemma card_powerset (T : finType) (A : {set T}) : #|powerset A| = 2 ^ #|A|. Proof. rewrite -card_bool -(card_pffun_on false) -(card_imset _ val_inj). apply: eq_card => f; pose sf := false.-support f; pose D := finset sf. have sDA: (D \subset A) = (sf \subset A) by apply: eq_subset; apply: in_set. have eq_sf x : sf x = f x by rewrite /= negb_eqb addbF. have valD: val D = f by rewrite /D unlock; apply/ffunP=> x; rewrite ffunE eq_sf. apply/imsetP/pffun_onP=> [[B] | [sBA _]]; last by exists D; rewrite // inE ?sDA. by rewrite inE -sDA -valD => sBA /val_inj->. Qed. Section FunImageComp. Variables T T' U : finType. Lemma imset_comp (f : T' -> U) (g : T -> T') (H : {pred T}) : (f \o g) @: H = f @: (g @: H). Proof. apply/setP/subset_eqP/andP. split; apply/subsetP=> _ /imsetP[x0 Hx0 ->]; apply/imsetP. by exists (g x0); first apply: imset_f. by move/imsetP: Hx0 => [x1 Hx1 ->]; exists x1. Qed. End FunImageComp. Notation "\bigcup_ ( i <- r | P ) F" := (\big[@setU _/set0]_(i <- r | P) F%SET) : set_scope. Notation "\bigcup_ ( i <- r ) F" := (\big[@setU _/set0]_(i <- r) F%SET) : set_scope. Notation "\bigcup_ ( m <= i < n | P ) F" := (\big[@setU _/set0]_(m <= i < n | P%B) F%SET) : set_scope. Notation "\bigcup_ ( m <= i < n ) F" := (\big[@setU _/set0]_(m <= i < n) F%SET) : set_scope. Notation "\bigcup_ ( i | P ) F" := (\big[@setU _/set0]_(i | P%B) F%SET) : set_scope. Notation "\bigcup_ i F" := (\big[@setU _/set0]_i F%SET) : set_scope. Notation "\bigcup_ ( i : t | P ) F" := (\big[@setU _/set0]_(i : t | P%B) F%SET) (only parsing): set_scope. Notation "\bigcup_ ( i : t ) F" := (\big[@setU _/set0]_(i : t) F%SET) (only parsing) : set_scope. Notation "\bigcup_ ( i < n | P ) F" := (\big[@setU _/set0]_(i < n | P%B) F%SET) : set_scope. Notation "\bigcup_ ( i < n ) F" := (\big[@setU _/set0]_ (i < n) F%SET) : set_scope. Notation "\bigcup_ ( i 'in' A | P ) F" := (\big[@setU _/set0]_(i in A | P%B) F%SET) : set_scope. Notation "\bigcup_ ( i 'in' A ) F" := (\big[@setU _/set0]_(i in A) F%SET) : set_scope. Notation "\bigcap_ ( i <- r | P ) F" := (\big[@setI _/setT]_(i <- r | P%B) F%SET) : set_scope. Notation "\bigcap_ ( i <- r ) F" := (\big[@setI _/setT]_(i <- r) F%SET) : set_scope. Notation "\bigcap_ ( m <= i < n | P ) F" := (\big[@setI _/setT]_(m <= i < n | P%B) F%SET) : set_scope. Notation "\bigcap_ ( m <= i < n ) F" := (\big[@setI _/setT]_(m <= i < n) F%SET) : set_scope. Notation "\bigcap_ ( i | P ) F" := (\big[@setI _/setT]_(i | P%B) F%SET) : set_scope. Notation "\bigcap_ i F" := (\big[@setI _/setT]_i F%SET) : set_scope. Notation "\bigcap_ ( i : t | P ) F" := (\big[@setI _/setT]_(i : t | P%B) F%SET) (only parsing): set_scope. Notation "\bigcap_ ( i : t ) F" := (\big[@setI _/setT]_(i : t) F%SET) (only parsing) : set_scope. Notation "\bigcap_ ( i < n | P ) F" := (\big[@setI _/setT]_(i < n | P%B) F%SET) : set_scope. Notation "\bigcap_ ( i < n ) F" := (\big[@setI _/setT]_(i < n) F%SET) : set_scope. Notation "\bigcap_ ( i 'in' A | P ) F" := (\big[@setI _/setT]_(i in A | P%B) F%SET) : set_scope. Notation "\bigcap_ ( i 'in' A ) F" := (\big[@setI _/setT]_(i in A) F%SET) : set_scope. Section BigSetOps. Variables T I : finType. Implicit Types (U : {pred T}) (P : pred I) (A B : {set I}) (F : I -> {set T}). (* It is very hard to use this lemma, because the unification fails to *) (* defer the F j pattern (even though it's a Miller pattern!). *) Lemma bigcup_sup j P F : P j -> F j \subset \bigcup_(i | P i) F i. Proof. by move=> Pj; rewrite (bigD1 j) //= subsetUl. Qed. Lemma bigcup_max j U P F : P j -> U \subset F j -> U \subset \bigcup_(i | P i) F i. Proof. by move=> Pj sUF; apply: subset_trans (bigcup_sup _ Pj). Qed. Lemma bigcupP x P F : reflect (exists2 i, P i & x \in F i) (x \in \bigcup_(i | P i) F i). Proof. apply: (iffP idP) => [|[i Pi]]; last first. by apply: subsetP x; apply: bigcup_sup. by elim/big_rec: _ => [|i _ Pi _ /setUP[|//]]; [rewrite inE | exists i]. Qed. Lemma bigcupsP U P F : reflect (forall i, P i -> F i \subset U) (\bigcup_(i | P i) F i \subset U). Proof. apply: (iffP idP) => [sFU i Pi| sFU]. by apply: subset_trans sFU; apply: bigcup_sup. by apply/subsetP=> x /bigcupP[i Pi]; apply: (subsetP (sFU i Pi)). Qed. Lemma bigcup_disjoint U P F : (forall i, P i -> [disjoint U & F i]) -> [disjoint U & \bigcup_(i | P i) F i]. Proof. move=> dUF; rewrite disjoint_sym disjoint_subset. by apply/bigcupsP=> i /dUF; rewrite disjoint_sym disjoint_subset. Qed. Lemma bigcup_setU A B F : \bigcup_(i in A :|: B) F i = (\bigcup_(i in A) F i) :|: (\bigcup_ (i in B) F i). Proof. apply/setP=> x; apply/bigcupP/setUP=> [[i] | ]. by case/setUP; [left | right]; apply/bigcupP; exists i. by case=> /bigcupP[i Pi]; exists i; rewrite // inE Pi ?orbT. Qed. Lemma bigcup_seq r F : \bigcup_(i <- r) F i = \bigcup_(i in r) F i. Proof. elim: r => [|i r IHr]; first by rewrite big_nil big_pred0. rewrite big_cons {}IHr; case r_i: (i \in r). rewrite (setUidPr _) ?bigcup_sup //. by apply: eq_bigl => j; rewrite !inE; case: eqP => // ->. rewrite (bigD1 i (mem_head i r)) /=; congr (_ :|: _). by apply: eq_bigl => j /=; rewrite andbC; case: eqP => // ->. Qed. (* Unlike its setU counterpart, this lemma is useable. *) Lemma bigcap_inf j P F : P j -> \bigcap_(i | P i) F i \subset F j. Proof. by move=> Pj; rewrite (bigD1 j) //= subsetIl. Qed. Lemma bigcap_min j U P F : P j -> F j \subset U -> \bigcap_(i | P i) F i \subset U. Proof. by move=> Pj; apply: subset_trans (bigcap_inf _ Pj). Qed. Lemma bigcapsP U P F : reflect (forall i, P i -> U \subset F i) (U \subset \bigcap_(i | P i) F i). Proof. apply: (iffP idP) => [sUF i Pi | sUF]. by apply: subset_trans sUF _; apply: bigcap_inf. elim/big_rec: _ => [|i V Pi sUV]; apply/subsetP=> x Ux; rewrite inE //. by rewrite !(subsetP _ x Ux) ?sUF. Qed. Lemma bigcapP x P F : reflect (forall i, P i -> x \in F i) (x \in \bigcap_(i | P i) F i). Proof. rewrite -sub1set. by apply: (iffP (bigcapsP _ _ _)) => Fx i /Fx; rewrite sub1set. Qed. Lemma setC_bigcup J r (P : pred J) (F : J -> {set T}) : ~: (\bigcup_(j <- r | P j) F j) = \bigcap_(j <- r | P j) ~: F j. Proof. by apply: big_morph => [A B|]; rewrite ?setC0 ?setCU. Qed. Lemma setC_bigcap J r (P : pred J) (F : J -> {set T}) : ~: (\bigcap_(j <- r | P j) F j) = \bigcup_(j <- r | P j) ~: F j. Proof. by apply: big_morph => [A B|]; rewrite ?setCT ?setCI. Qed. Lemma bigcap_setU A B F : (\bigcap_(i in A :|: B) F i) = (\bigcap_(i in A) F i) :&: (\bigcap_(i in B) F i). Proof. by apply: setC_inj; rewrite setCI !setC_bigcap bigcup_setU. Qed. Lemma bigcap_seq r F : \bigcap_(i <- r) F i = \bigcap_(i in r) F i. Proof. by apply: setC_inj; rewrite !setC_bigcap bigcup_seq. Qed. End BigSetOps. Arguments bigcup_sup [T I] j [P F]. Arguments bigcup_max [T I] j [U P F]. Arguments bigcupP {T I x P F}. Arguments bigcupsP {T I U P F}. Arguments bigcap_inf [T I] j [P F]. Arguments bigcap_min [T I] j [U P F]. Arguments bigcapP {T I x P F}. Arguments bigcapsP {T I U P F}. Section ImsetCurry. Variables (aT1 aT2 rT : finType) (f : aT1 -> aT2 -> rT). Section Curry. Variables (A1 : {set aT1}) (A2 : {set aT2}). Variables (D1 : {pred aT1}) (D2 : {pred aT2}). Lemma curry_imset2X : f @2: (A1, A2) = prod_curry f @: (setX A1 A2). Proof. rewrite [@imset]unlock unlock; apply/setP=> x; rewrite !in_set; congr (x \in _). by apply: eq_image => u //=; rewrite !inE. Qed. Lemma curry_imset2l : f @2: (D1, D2) = \bigcup_(x1 in D1) f x1 @: D2. Proof. apply/setP=> y; apply/imset2P/bigcupP => [[x1 x2 Dx1 Dx2 ->{y}] | [x1 Dx1]]. by exists x1; rewrite // imset_f. by case/imsetP=> x2 Dx2 ->{y}; exists x1 x2. Qed. Lemma curry_imset2r : f @2: (D1, D2) = \bigcup_(x2 in D2) f^~ x2 @: D1. Proof. apply/setP=> y; apply/imset2P/bigcupP => [[x1 x2 Dx1 Dx2 ->{y}] | [x2 Dx2]]. by exists x2; rewrite // (imset_f (f^~ x2)). by case/imsetP=> x1 Dx1 ->{y}; exists x1 x2. Qed. End Curry. Lemma imset2Ul (A B : {set aT1}) (C : {set aT2}) : f @2: (A :|: B, C) = f @2: (A, C) :|: f @2: (B, C). Proof. by rewrite !curry_imset2l bigcup_setU. Qed. Lemma imset2Ur (A : {set aT1}) (B C : {set aT2}) : f @2: (A, B :|: C) = f @2: (A, B) :|: f @2: (A, C). Proof. by rewrite !curry_imset2r bigcup_setU. Qed. End ImsetCurry. Section Partitions. Variables T I : finType. Implicit Types (x y z : T) (A B D X : {set T}) (P Q : {set {set T}}). Implicit Types (J : pred I) (F : I -> {set T}). Definition cover P := \bigcup_(B in P) B. Definition pblock P x := odflt set0 (pick [pred B in P | x \in B]). Definition trivIset P := \sum_(B in P) #|B| == #|cover P|. Definition partition P D := [&& cover P == D, trivIset P & set0 \notin P]. Definition is_transversal X P D := [&& partition P D, X \subset D & [forall B in P, #|X :&: B| == 1]]. Definition transversal P D := [set odflt x [pick y in pblock P x] | x in D]. Definition transversal_repr x0 X B := odflt x0 [pick x in X :&: B]. Lemma leq_card_setU A B : #|A :|: B| <= #|A| + #|B| ?= iff [disjoint A & B]. Proof. rewrite -(addn0 #|_|) -setI_eq0 -cards_eq0 -cardsUI eq_sym. by rewrite (mono_leqif (leq_add2l _)). Qed. Lemma leq_card_cover P : #|cover P| <= \sum_(A in P) #|A| ?= iff trivIset P. Proof. split; last exact: eq_sym. rewrite /cover; elim/big_rec2: _ => [|A n U _ leUn]; first by rewrite cards0. by rewrite (leq_trans (leq_card_setU A U).1) ?leq_add2l. Qed. Lemma trivIsetP P : reflect {in P &, forall A B, A != B -> [disjoint A & B]} (trivIset P). Proof. have->: P = [set x in enum (mem P)] by apply/setP=> x; rewrite inE mem_enum. elim: {P}(enum _) (enum_uniq (mem P)) => [_ | A e IHe] /=. by rewrite /trivIset /cover !big_set0 cards0; left=> A; rewrite inE. case/andP; rewrite set_cons -(in_set (fun B => B \in e)) => PA {}/IHe. move: {e}[set x in e] PA => P PA IHP. rewrite /trivIset /cover !big_setU1 //= eq_sym. have:= leq_card_cover P; rewrite -(mono_leqif (leq_add2l #|A|)). move/(leqif_trans (leq_card_setU _ _))->; rewrite disjoints_subset setC_bigcup. case: bigcapsP => [disjA | meetA]; last first. right=> [tI]; case: meetA => B PB; rewrite -disjoints_subset. by rewrite tI ?setU11 ?setU1r //; apply: contraNneq PA => ->. apply: (iffP IHP) => [] tI B C PB PC; last by apply: tI; apply: setU1r. by case/setU1P: PC PB => [->|PC] /setU1P[->|PB]; try by [apply: tI | case/eqP]; first rewrite disjoint_sym; rewrite disjoints_subset disjA. Qed. Lemma trivIsetS P Q : P \subset Q -> trivIset Q -> trivIset P. Proof. by move/subsetP/sub_in2=> sPQ /trivIsetP/sPQ/trivIsetP. Qed. Lemma trivIsetI P D : trivIset P -> trivIset (P ::&: D). Proof. by apply: trivIsetS; rewrite -setI_powerset subsetIl. Qed. Lemma cover_setI P D : cover (P ::&: D) \subset cover P :&: D. Proof. by apply/bigcupsP=> A /setIdP[PA sAD]; rewrite subsetI sAD andbT (bigcup_max A). Qed. Lemma mem_pblock P x : (x \in pblock P x) = (x \in cover P). Proof. rewrite /pblock; apply/esym/bigcupP. case: pickP => /= [A /andP[PA Ax]| noA]; first by rewrite Ax; exists A. by rewrite inE => [[A PA Ax]]; case/andP: (noA A). Qed. Lemma pblock_mem P x : x \in cover P -> pblock P x \in P. Proof. by rewrite -mem_pblock /pblock; case: pickP => [A /andP[]| _] //=; rewrite inE. Qed. Lemma def_pblock P B x : trivIset P -> B \in P -> x \in B -> pblock P x = B. Proof. move/trivIsetP=> tiP PB Bx; have Px: x \in cover P by apply/bigcupP; exists B. apply: (contraNeq (tiP _ _ _ PB)); first by rewrite pblock_mem. by apply/pred0Pn; exists x; rewrite /= mem_pblock Px. Qed. Lemma same_pblock P x y : trivIset P -> x \in pblock P y -> pblock P x = pblock P y. Proof. rewrite {1 3}/pblock => tI; case: pickP => [A|]; last by rewrite inE. by case/andP=> PA _{y} /= Ax; apply: def_pblock. Qed. Lemma eq_pblock P x y : trivIset P -> x \in cover P -> (pblock P x == pblock P y) = (y \in pblock P x). Proof. move=> tiP Px; apply/eqP/idP=> [eq_xy | /same_pblock-> //]. move: Px; rewrite -mem_pblock eq_xy /pblock. by case: pickP => [B /andP[] // | _]; rewrite inE. Qed. Lemma trivIsetU1 A P : {in P, forall B, [disjoint A & B]} -> trivIset P -> set0 \notin P -> trivIset (A |: P) /\ A \notin P. Proof. move=> tiAP tiP notPset0; split; last first. apply: contra notPset0 => P_A. by have:= tiAP A P_A; rewrite -setI_eq0 setIid => /eqP <-. apply/trivIsetP=> B1 B2 /setU1P[->|PB1] /setU1P[->|PB2]; by [apply: (trivIsetP _ tiP) | rewrite ?eqxx // ?(tiAP, disjoint_sym)]. Qed. Lemma cover_imset J F : cover (F @: J) = \bigcup_(i in J) F i. Proof. apply/setP=> x. apply/bigcupP/bigcupP=> [[_ /imsetP[i Ji ->]] | [i]]; first by exists i. by exists (F i); first apply: imset_f. Qed. Lemma trivIimset J F (P := F @: J) : {in J &, forall i j, j != i -> [disjoint F i & F j]} -> set0 \notin P -> trivIset P /\ {in J &, injective F}. Proof. move=> tiF notPset0; split=> [|i j Ji Jj /= eqFij]. apply/trivIsetP=> _ _ /imsetP[i Ji ->] /imsetP[j Jj ->] neqFij. by rewrite tiF // (contraNneq _ neqFij) // => ->. apply: contraNeq notPset0 => neq_ij; apply/imsetP; exists i => //; apply/eqP. by rewrite eq_sym -[F i]setIid setI_eq0 {1}eqFij tiF. Qed. Lemma cover_partition P D : partition P D -> cover P = D. Proof. by case/and3P=> /eqP. Qed. Lemma card_partition P D : partition P D -> #|D| = \sum_(A in P) #|A|. Proof. by case/and3P=> /eqP <- /eqnP. Qed. Lemma card_uniform_partition n P D : {in P, forall A, #|A| = n} -> partition P D -> #|D| = #|P| * n. Proof. by move=> uniP /card_partition->; rewrite -sum_nat_const; apply: eq_bigr. Qed. Section BigOps. Variables (R : Type) (idx : R) (op : Monoid.com_law idx). Let rhs_cond P K E := \big[op/idx]_(A in P) \big[op/idx]_(x in A | K x) E x. Let rhs P E := \big[op/idx]_(A in P) \big[op/idx]_(x in A) E x. Lemma big_trivIset_cond P (K : pred T) (E : T -> R) : trivIset P -> \big[op/idx]_(x in cover P | K x) E x = rhs_cond P K E. Proof. move=> tiP; rewrite (partition_big (pblock P) (mem P)) -/op => /= [|x]. apply: eq_bigr => A PA; apply: eq_bigl => x; rewrite andbAC; congr (_ && _). rewrite -mem_pblock; apply/andP/idP=> [[Px /eqP <- //] | Ax]. by rewrite (def_pblock tiP PA Ax). by case/andP=> Px _; apply: pblock_mem. Qed. Lemma big_trivIset P (E : T -> R) : trivIset P -> \big[op/idx]_(x in cover P) E x = rhs P E. Proof. have biginT := eq_bigl _ _ (fun _ => andbT _) => tiP. by rewrite -biginT big_trivIset_cond //; apply: eq_bigr => A _; apply: biginT. Qed. Lemma set_partition_big_cond P D (K : pred T) (E : T -> R) : partition P D -> \big[op/idx]_(x in D | K x) E x = rhs_cond P K E. Proof. by case/and3P=> /eqP <- tI_P _; apply: big_trivIset_cond. Qed. Lemma set_partition_big P D (E : T -> R) : partition P D -> \big[op/idx]_(x in D) E x = rhs P E. Proof. by case/and3P=> /eqP <- tI_P _; apply: big_trivIset. Qed. Lemma partition_disjoint_bigcup (F : I -> {set T}) E : (forall i j, i != j -> [disjoint F i & F j]) -> \big[op/idx]_(x in \bigcup_i F i) E x = \big[op/idx]_i \big[op/idx]_(x in F i) E x. Proof. move=> disjF; pose P := [set F i | i in I & F i != set0]. have trivP: trivIset P. apply/trivIsetP=> _ _ /imsetP[i _ ->] /imsetP[j _ ->] neqFij. by apply: disjF; apply: contraNneq neqFij => ->. have ->: \bigcup_i F i = cover P. apply/esym; rewrite cover_imset big_mkcond; apply: eq_bigr => i _. by rewrite inE; case: eqP. rewrite big_trivIset // /rhs big_imset => [|i j _ /setIdP[_ notFj0] eqFij]. rewrite big_mkcond; apply: eq_bigr => i _; rewrite inE. by case: eqP => //= ->; rewrite big_set0. by apply: contraNeq (disjF _ _) _; rewrite -setI_eq0 eqFij setIid. Qed. End BigOps. Section Equivalence. Variables (R : rel T) (D : {set T}). Let Px x := [set y in D | R x y]. Definition equivalence_partition := [set Px x | x in D]. Local Notation P := equivalence_partition. Hypothesis eqiR : {in D & &, equivalence_rel R}. Let Pxx x : x \in D -> x \in Px x. Proof. by move=> Dx; rewrite !inE Dx (eqiR Dx Dx). Qed. Let PPx x : x \in D -> Px x \in P := fun Dx => imset_f _ Dx. Lemma equivalence_partitionP : partition P D. Proof. have defD: cover P == D. rewrite eqEsubset; apply/andP; split. by apply/bigcupsP=> _ /imsetP[x Dx ->]; rewrite /Px setIdE subsetIl. by apply/subsetP=> x Dx; apply/bigcupP; exists (Px x); rewrite (Pxx, PPx). have tiP: trivIset P. apply/trivIsetP=> _ _ /imsetP[x Dx ->] /imsetP[y Dy ->]; apply: contraR. case/pred0Pn=> z /andP[]; rewrite !inE => /andP[Dz Rxz] /andP[_ Ryz]. apply/eqP/setP=> t; rewrite !inE; apply: andb_id2l => Dt. by rewrite (eqiR Dx Dz Dt) // (eqiR Dy Dz Dt). rewrite /partition tiP defD /=. by apply/imsetP=> [[x /Pxx Px_x Px0]]; rewrite -Px0 inE in Px_x. Qed. Lemma pblock_equivalence_partition : {in D &, forall x y, (y \in pblock P x) = R x y}. Proof. have [_ tiP _] := and3P equivalence_partitionP. by move=> x y Dx Dy; rewrite /= (def_pblock tiP (PPx Dx) (Pxx Dx)) inE Dy. Qed. End Equivalence. Lemma pblock_equivalence P D : partition P D -> {in D & &, equivalence_rel (fun x y => y \in pblock P x)}. Proof. case/and3P=> /eqP <- tiP _ x y z Px Py Pz. by rewrite mem_pblock; split=> // /same_pblock->. Qed. Lemma equivalence_partition_pblock P D : partition P D -> equivalence_partition (fun x y => y \in pblock P x) D = P. Proof. case/and3P=> /eqP <-{D} tiP notP0; apply/setP=> B /=; set D := cover P. have defP x: x \in D -> [set y in D | y \in pblock P x] = pblock P x. by move=> Dx; apply/setIidPr; rewrite (bigcup_max (pblock P x)) ?pblock_mem. apply/imsetP/idP=> [[x Px ->{B}] | PB]; first by rewrite defP ?pblock_mem. have /set0Pn[x Bx]: B != set0 := memPn notP0 B PB. have Px: x \in cover P by apply/bigcupP; exists B. by exists x; rewrite // defP // (def_pblock tiP PB Bx). Qed. Section Preim. Variables (rT : eqType) (f : T -> rT). Definition preim_partition := equivalence_partition (fun x y => f x == f y). Lemma preim_partitionP D : partition (preim_partition D) D. Proof. by apply/equivalence_partitionP; split=> // /eqP->. Qed. End Preim. Lemma preim_partition_pblock P D : partition P D -> preim_partition (pblock P) D = P. Proof. move=> partP; have [/eqP defD tiP _] := and3P partP. rewrite -{2}(equivalence_partition_pblock partP); apply: eq_in_imset => x Dx. by apply/setP=> y; rewrite !inE eq_pblock ?defD. Qed. Lemma transversalP P D : partition P D -> is_transversal (transversal P D) P D. Proof. case/and3P=> /eqP <- tiP notP0; apply/and3P; split; first exact/and3P. apply/subsetP=> _ /imsetP[x Px ->]; case: pickP => //= y Pxy. by apply/bigcupP; exists (pblock P x); rewrite ?pblock_mem //. apply/forall_inP=> B PB; have /set0Pn[x Bx]: B != set0 := memPn notP0 B PB. apply/cards1P; exists (odflt x [pick y in pblock P x]); apply/esym/eqP. rewrite eqEsubset sub1set inE -andbA; apply/andP; split. by apply/imset_f/bigcupP; exists B. rewrite (def_pblock tiP PB Bx); case def_y: _ / pickP => [y By | /(_ x)/idP//]. rewrite By /=; apply/subsetP=> _ /setIP[/imsetP[z Pz ->]]. case: {1}_ / pickP => [t zPt Bt | /(_ z)/idP[]]; last by rewrite mem_pblock. by rewrite -(same_pblock tiP zPt) (def_pblock tiP PB Bt) def_y set11. Qed. Section Transversals. Variables (X : {set T}) (P : {set {set T}}) (D : {set T}). Hypothesis trPX : is_transversal X P D. Lemma transversal_sub : X \subset D. Proof. by case/and3P: trPX. Qed. Let tiP : trivIset P. Proof. by case/andP: trPX => /and3P[]. Qed. Let sXP : {subset X <= cover P}. Proof. by case/and3P: trPX => /andP[/eqP-> _] /subsetP. Qed. Let trX : {in P, forall B, #|X :&: B| == 1}. Proof. by case/and3P: trPX => _ _ /forall_inP. Qed. Lemma setI_transversal_pblock x0 B : B \in P -> X :&: B = [set transversal_repr x0 X B]. Proof. by case/trX/cards1P=> x defXB; rewrite /transversal_repr defXB /pick enum_set1. Qed. Lemma repr_mem_pblock x0 B : B \in P -> transversal_repr x0 X B \in B. Proof. by move=> PB; rewrite -sub1set -setI_transversal_pblock ?subsetIr. Qed. Lemma repr_mem_transversal x0 B : B \in P -> transversal_repr x0 X B \in X. Proof. by move=> PB; rewrite -sub1set -setI_transversal_pblock ?subsetIl. Qed. Lemma transversal_reprK x0 : {in P, cancel (transversal_repr x0 X) (pblock P)}. Proof. by move=> B PB; rewrite /= (def_pblock tiP PB) ?repr_mem_pblock. Qed. Lemma pblockK x0 : {in X, cancel (pblock P) (transversal_repr x0 X)}. Proof. move=> x Xx; have /bigcupP[B PB Bx] := sXP Xx; rewrite (def_pblock tiP PB Bx). by apply/esym/set1P; rewrite -setI_transversal_pblock // inE Xx. Qed. Lemma pblock_inj : {in X &, injective (pblock P)}. Proof. by move=> x0; apply: (can_in_inj (pblockK x0)). Qed. Lemma pblock_transversal : pblock P @: X = P. Proof. apply/setP=> B; apply/imsetP/idP=> [[x Xx ->] | PB]. by rewrite pblock_mem ?sXP. have /cards1P[x0 _] := trX PB; set x := transversal_repr x0 X B. by exists x; rewrite ?transversal_reprK ?repr_mem_transversal. Qed. Lemma card_transversal : #|X| = #|P|. Proof. by rewrite -pblock_transversal card_in_imset //; apply: pblock_inj. Qed. Lemma im_transversal_repr x0 : transversal_repr x0 X @: P = X. Proof. rewrite -{2}[X]imset_id -pblock_transversal -imset_comp. by apply: eq_in_imset; apply: pblockK. Qed. End Transversals. End Partitions. Arguments trivIsetP {T P}. Arguments big_trivIset_cond [T R idx op] P [K E]. Arguments set_partition_big_cond [T R idx op] P [D K E]. Arguments big_trivIset [T R idx op] P [E]. Arguments set_partition_big [T R idx op] P [D E]. Prenex Implicits cover trivIset partition pblock. Lemma partition_partition (T : finType) (D : {set T}) P Q : partition P D -> partition Q P -> partition (cover @: Q) D /\ {in Q &, injective cover}. Proof. move=> /and3P[/eqP defG tiP notP0] /and3P[/eqP defP tiQ notQ0]. have sQP E: E \in Q -> {subset E <= P}. by move=> Q_E; apply/subsetP; rewrite -defP (bigcup_max E). rewrite /partition cover_imset -(big_trivIset _ tiQ) defP -defG eqxx /= andbC. have{} notQ0: set0 \notin cover @: Q. apply: contra notP0 => /imsetP[E Q_E E0]. have /set0Pn[/= A E_A] := memPn notQ0 E Q_E. congr (_ \in P): (sQP E Q_E A E_A). by apply/eqP; rewrite -subset0 E0 (bigcup_max A). rewrite notQ0; apply: trivIimset => // E F Q_E Q_F. apply: contraR => /pred0Pn[x /andP[/bigcupP[A E_A Ax] /bigcupP[B F_B Bx]]]. rewrite -(def_pblock tiQ Q_E E_A) -(def_pblock tiP _ Ax) ?(sQP E) //. by rewrite -(def_pblock tiQ Q_F F_B) -(def_pblock tiP _ Bx) ?(sQP F). Qed. (**********************************************************************) (* *) (* Maximum and minimum (sub)set with respect to a given pred *) (* *) (**********************************************************************) Section MaxSetMinSet. Variable T : finType. Notation sT := {set T}. Implicit Types A B C : sT. Implicit Type P : pred sT. Definition minset P A := [forall (B : sT | B \subset A), (B == A) == P B]. Lemma minset_eq P1 P2 A : P1 =1 P2 -> minset P1 A = minset P2 A. Proof. by move=> eP12; apply: eq_forallb => B; rewrite eP12. Qed. Lemma minsetP P A : reflect ((P A) /\ (forall B, P B -> B \subset A -> B = A)) (minset P A). Proof. apply: (iffP forallP) => [minA | [PA minA] B]. split; first by have:= minA A; rewrite subxx eqxx /= => /eqP. by move=> B PB sBA; have:= minA B; rewrite PB sBA /= eqb_id => /eqP. by apply/implyP=> sBA; apply/eqP; apply/eqP/idP=> [-> // | /minA]; apply. Qed. Arguments minsetP {P A}. Lemma minsetp P A : minset P A -> P A. Proof. by case/minsetP. Qed. Lemma minsetinf P A B : minset P A -> P B -> B \subset A -> B = A. Proof. by case/minsetP=> _; apply. Qed. Lemma ex_minset P : (exists A, P A) -> {A | minset P A}. Proof. move=> exP; pose pS n := [pred B | P B & #|B| == n]. pose p n := ~~ pred0b (pS n); have{exP}: exists n, p n. by case: exP => A PA; exists #|A|; apply/existsP; exists A; rewrite /= PA /=. case/ex_minnP=> n /pred0P; case: (pickP (pS n)) => // A /andP[PA] /eqP <-{n} _. move=> minA; exists A => //; apply/minsetP; split=> // B PB sBA; apply/eqP. by rewrite eqEcard sBA minA //; apply/pred0Pn; exists B; rewrite /= PB /=. Qed. Lemma minset_exists P C : P C -> {A | minset P A & A \subset C}. Proof. move=> PC; have{PC}: exists A, P A && (A \subset C) by exists C; rewrite PC /=. case/ex_minset=> A /minsetP[/andP[PA sAC] minA]; exists A => //; apply/minsetP. by split=> // B PB sBA; rewrite (minA B) // PB (subset_trans sBA). Qed. (* The 'locked_with' allows Coq to find the value of P by unification. *) Fact maxset_key : unit. Proof. by []. Qed. Definition maxset P A := minset (fun B => locked_with maxset_key P (~: B)) (~: A). Lemma maxset_eq P1 P2 A : P1 =1 P2 -> maxset P1 A = maxset P2 A. Proof. by move=> eP12; apply: minset_eq => x /=; rewrite !unlock_with eP12. Qed. Lemma maxminset P A : maxset P A = minset [pred B | P (~: B)] (~: A). Proof. by rewrite /maxset unlock. Qed. Lemma minmaxset P A : minset P A = maxset [pred B | P (~: B)] (~: A). Proof. by rewrite /maxset unlock setCK; apply: minset_eq => B /=; rewrite setCK. Qed. Lemma maxsetP P A : reflect ((P A) /\ (forall B, P B -> A \subset B -> B = A)) (maxset P A). Proof. apply: (iffP minsetP); rewrite ?setCK unlock_with => [] [PA minA]. by split=> // B PB sAB; rewrite -[B]setCK [~: B]minA (setCK, setCS). by split=> // B PB' sBA'; rewrite -(minA _ PB') -1?setCS setCK. Qed. Lemma maxsetp P A : maxset P A -> P A. Proof. by case/maxsetP. Qed. Lemma maxsetsup P A B : maxset P A -> P B -> A \subset B -> B = A. Proof. by case/maxsetP=> _; apply. Qed. Lemma ex_maxset P : (exists A, P A) -> {A | maxset P A}. Proof. move=> exP; have{exP}: exists A, P (~: A). by case: exP => A PA; exists (~: A); rewrite setCK. by case/ex_minset=> A minA; exists (~: A); rewrite /maxset unlock setCK. Qed. Lemma maxset_exists P C : P C -> {A : sT | maxset P A & C \subset A}. Proof. move=> PC; pose P' B := P (~: B); have: P' (~: C) by rewrite /P' setCK. case/minset_exists=> B; rewrite -[B]setCK setCS. by exists (~: B); rewrite // /maxset unlock. Qed. End MaxSetMinSet. Arguments setCK {T}. Arguments minsetP {T P A}. Arguments maxsetP {T P A}. Prenex Implicits minset maxset. Section SetFixpoint. Section Least. Variables (T : finType) (F : {set T} -> {set T}). Hypothesis (F_mono : {homo F : X Y / X \subset Y}). Let n := #|T|. Let iterF i := iter i F set0. Lemma subset_iterS i : iterF i \subset iterF i.+1. Proof. by elim: i => [| i IHi]; rewrite /= ?sub0set ?F_mono. Qed. Lemma subset_iter : {homo iterF : i j / i <= j >-> i \subset j}. Proof. by apply: homo_leq => //[? ? ?|]; [apply: subset_trans|apply: subset_iterS]. Qed. Definition fixset := iterF n. Lemma fixsetK : F fixset = fixset. Proof. suff /'exists_eqP[x /= e]: [exists k : 'I_n.+1, iterF k == iterF k.+1]. by rewrite /fixset -(subnK (leq_ord x)) /iterF iterD iter_fix. apply: contraT => /existsPn /(_ (Ordinal _)) /= neq_iter. suff iter_big k : k <= n.+1 -> k <= #|iter k F set0|. by have := iter_big _ (leqnn _); rewrite ltnNge max_card. elim: k => [|k IHk] k_lt //=; apply: (leq_ltn_trans (IHk (ltnW k_lt))). by rewrite proper_card// properEneq// subset_iterS neq_iter. Qed. Hint Resolve fixsetK : core. Lemma minset_fix : minset [pred X | F X == X] fixset. Proof. apply/minsetP; rewrite inE fixsetK eqxx; split=> // X /eqP FXeqX Xsubfix. apply/eqP; rewrite eqEsubset Xsubfix/=. suff: fixset \subset iter n F X by rewrite iter_fix. by rewrite /fixset; elim: n => //= [|m IHm]; rewrite ?sub0set ?F_mono. Qed. Lemma fixsetKn k : iter k F fixset = fixset. Proof. by rewrite iter_fix. Qed. Lemma iter_sub_fix k : iterF k \subset fixset. Proof. have [/subset_iter //|/ltnW/subnK<-] := leqP k n; by rewrite /iterF iterD fixsetKn. Qed. Lemma fix_order_proof x : x \in fixset -> exists n, x \in iterF n. Proof. by move=> x_fix; exists n. Qed. Definition fix_order (x : T) := if (x \in fixset) =P true isn't ReflectT x_fix then 0 else (ex_minn (fix_order_proof x_fix)). Lemma fix_order_le_max (x : T) : fix_order x <= n. Proof. rewrite /fix_order; case: eqP => //= x_in. by case: ex_minnP => //= ? ?; apply. Qed. Lemma in_iter_fix_orderE (x : T) : (x \in iterF (fix_order x)) = (x \in fixset). Proof. rewrite /fix_order; case: eqP; last by move=>/negP/negPf->; rewrite inE. by move=> x_in; case: ex_minnP => m ->; rewrite x_in. Qed. Lemma fix_order_gt0 (x : T) : (fix_order x > 0) = (x \in fixset). Proof. rewrite /fix_order; case: eqP => [x_in|/negP/negPf->//]. by rewrite x_in; case: ex_minnP => -[|m]; rewrite ?inE//= => _; apply. Qed. Lemma fix_order_eq0 (x : T) : (fix_order x == 0) = (x \notin fixset). Proof. by rewrite -fix_order_gt0 -ltnNge ltnS leqn0. Qed. Lemma in_iter_fixE (x : T) k : (x \in iterF k) = (0 < fix_order x <= k). Proof. rewrite /fix_order; case: eqP => //= [x_in|/negP xNin]; last first. by apply: contraNF xNin; apply/subsetP/iter_sub_fix. case: ex_minnP => -[|m]; rewrite ?inE// => xm mP. by apply/idP/idP=> [/mP//|lt_mk]; apply: subsetP xm; apply: subset_iter. Qed. Lemma in_iter (x : T) k : x \in fixset -> fix_order x <= k -> x \in iterF k. Proof. by move=> x_in xk; rewrite in_iter_fixE fix_order_gt0 x_in xk. Qed. Lemma notin_iter (x : T) k : k < fix_order x -> x \notin iterF k. Proof. by move=> k_le; rewrite in_iter_fixE negb_and orbC -ltnNge k_le. Qed. Lemma fix_order_small x k : x \in iterF k -> fix_order x <= k. Proof. by rewrite in_iter_fixE => /andP[]. Qed. Lemma fix_order_big x k : x \in fixset -> x \notin iterF k -> fix_order x > k. Proof. by move=> x_in; rewrite in_iter_fixE fix_order_gt0 x_in /= -ltnNge. Qed. Lemma le_fix_order (x y : T) : y \in iterF (fix_order x) -> fix_order y <= fix_order x. Proof. exact: fix_order_small. Qed. End Least. Section Greatest. Variables (T : finType) (F : {set T} -> {set T}). Hypothesis (F_mono : {homo F : X Y / X \subset Y}). Definition funsetC X := ~: (F (~: X)). Lemma funsetC_mono : {homo funsetC : X Y / X \subset Y}. Proof. by move=> *; rewrite subCset setCK F_mono// subCset setCK. Qed. Hint Resolve funsetC_mono : core. Definition cofixset := ~: fixset funsetC. Lemma cofixsetK : F cofixset = cofixset. Proof. by rewrite /cofixset -[in RHS]fixsetK ?setCK. Qed. Lemma maxset_cofix : maxset [pred X | F X == X] cofixset. Proof. rewrite maxminset setCK. rewrite (@minset_eq _ _ [pred X | funsetC X == X]) ?minset_fix//. by move=> X /=; rewrite (can2_eq setCK setCK). Qed. End Greatest. End SetFixpoint. Notation mem_imset := ((fun aT rT D x f xD => deprecate mem_imset imset_f aT rT f D x xD) _ _ _ _) (only parsing). Notation mem_imset2 := ((fun aT aT2 rT D D2 x x2 f xD xD2 => deprecate mem_imset2 imset2_f aT aT2 rT f D D2 x x2 xD xD2) _ _ _ _ _ _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/fintype.v000066400000000000000000002560611375767750300227730ustar00rootroot00000000000000(* (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 path. (******************************************************************************) (* The Finite interface describes Types with finitely many elements, *) (* supplying a duplicate-free sequence of all the elements. It is a subclass *) (* of Countable and thus of Choice and Equality. As with Countable, the *) (* interface explicitly includes these somewhat redundant superclasses to *) (* ensure that Canonical instance inference remains consistent. Finiteness *) (* could be stated more simply by bounding the range of the pickle function *) (* supplied by the Countable interface, but this would yield a useless *) (* computational interpretation due to the wasteful Peano integer encodings. *) (* Because the Countable interface is closely tied to the Finite interface *) (* and is not much used on its own, the Countable mixin is included inside *) (* the Finite mixin; this makes it much easier to derive Finite variants of *) (* interfaces, in this file for subFinType, and in the finalg library. *) (* We define the following interfaces and structures: *) (* finType == the packed class type of the Finite interface. *) (* FinType T m == the packed finType class for type T and Finite mixin m. *) (* Finite.axiom e <-> every x : T occurs exactly once in e : seq T. *) (* FinMixin ax_e == the Finite mixin for T, encapsulating *) (* ax_e : Finite.axiom e for some e : seq T. *) (* UniqFinMixin uniq_e total_e == an alternative mixin constructor that uses *) (* uniq_e : uniq e and total_e : e =i xpredT. *) (* PcanFinMixin fK == the Finite mixin for T, given f : T -> fT and g with fT *) (* a finType and fK : pcancel f g. *) (* CanFinMixin fK == the Finite mixin for T, given f : T -> fT and g with fT *) (* a finType and fK : cancel f g. *) (* subFinType == the join interface type for subType and finType. *) (* [finType of T for fT] == clone for T of the finType fT. *) (* [finType of T] == clone for T of the finType inferred for T. *) (* [subFinType of T] == a subFinType structure for T, when T already has both *) (* finType and subType structures. *) (* [finMixin of T by <:] == a finType structure for T, when T has a subType *) (* structure over an existing finType. *) (* We define or propagate the finType structure appropriately for all basic *) (* types : unit, bool, void, option, prod, sum, sig and sigT. We also define *) (* a generic type constructor for finite subtypes based on an explicit *) (* enumeration: *) (* seq_sub s == the subType of all x \in s, where s : seq T for some *) (* eqType T; seq_sub s has a canonical finType instance *) (* when T is a choiceType. *) (* adhoc_seq_sub_choiceType s, adhoc_seq_sub_finType s == *) (* non-canonical instances for seq_sub s, s : seq T, *) (* which can be used when T is not a choiceType. *) (* Bounded integers are supported by the following type and operations: *) (* 'I_n, ordinal n == the finite subType of integers i < n, whose *) (* enumeration is {0, ..., n.-1}. 'I_n coerces to nat, *) (* so all the integer arithmetic functions can be used *) (* with 'I_n. *) (* Ordinal lt_i_n == the element of 'I_n with (nat) value i, given *) (* lt_i_n : i < n. *) (* nat_of_ord i == the nat value of i : 'I_n (this function is a *) (* coercion so it is not usually displayed). *) (* ord_enum n == the explicit increasing sequence of the i : 'I_n. *) (* cast_ord eq_n_m i == the element j : 'I_m with the same value as i : 'I_n *) (* given eq_n_m : n = m (indeed, i : nat and j : nat *) (* are convertible). *) (* widen_ord le_n_m i == a j : 'I_m with the same value as i : 'I_n, given *) (* le_n_m : n <= m. *) (* rev_ord i == the complement to n.-1 of i : 'I_n, such that *) (* i + rev_ord i = n.-1. *) (* inord k == the i : 'I_n.+1 with value k (n is inferred from the *) (* context). *) (* sub_ord k == the i : 'I_n.+1 with value n - k (n is inferred from *) (* the context). *) (* ord0 == the i : 'I_n.+1 with value 0 (n is inferred from the *) (* context). *) (* ord_max == the i : 'I_n.+1 with value n (n is inferred from the *) (* context). *) (* bump h k == k.+1 if k >= h, else k (this is a nat function). *) (* unbump h k == k.-1 if k > h, else k (this is a nat function). *) (* lift i j == the j' : 'I_n with value bump i j, where i : 'I_n *) (* and j : 'I_n.-1. *) (* unlift i j == None if i = j, else Some j', where j' : 'I_n.-1 has *) (* value unbump i j, given i, j : 'I_n. *) (* lshift n j == the i : 'I_(m + n) with value j : 'I_m. *) (* rshift m k == the i : 'I_(m + n) with value m + k, k : 'I_n. *) (* unsplit u == either lshift n j or rshift m k, depending on *) (* whether if u : 'I_m + 'I_n is inl j or inr k. *) (* split i == the u : 'I_m + 'I_n such that i = unsplit u; the *) (* type 'I_(m + n) of i determines the split. *) (* Finally, every type T with a finType structure supports the following *) (* operations: *) (* enum A == a duplicate-free list of all the x \in A, where A is a *) (* collective predicate over T. *) (* #|A| == the cardinal of A, i.e., the number of x \in A. *) (* enum_val i == the i'th item of enum A, where i : 'I_(#|A|). *) (* enum_rank x == the i : 'I_(#|T|) such that enum_val i = x. *) (* enum_rank_in Ax0 x == some i : 'I_(#|A|) such that enum_val i = x if *) (* x \in A, given Ax0 : x0 \in A. *) (* A \subset B <=> all x \in A satisfy x \in B. *) (* A \proper B <=> all x \in A satisfy x \in B but not the converse. *) (* [disjoint A & B] <=> no x \in A satisfies x \in B. *) (* image f A == the sequence of f x for all x : T such that x \in A *) (* (where a is an applicative predicate), of length #|P|. *) (* The codomain of F can be any type, but image f A can *) (* only be used as a collective predicate is it is an *) (* eqType. *) (* codom f == a sequence spanning the codomain of f (:= image f T). *) (* [seq F | x : T in A] := image (fun x : T => F) A. *) (* [seq F | x : T] := [seq F | x <- {: T}]. *) (* [seq F | x in A], [seq F | x] == variants without casts. *) (* iinv im_y == some x such that P x holds and f x = y, given *) (* im_y : y \in image f P. *) (* invF inj_f y == the x such that f x = y, for inj_j : injective f with *) (* f : T -> T. *) (* dinjectiveb A f <=> the restriction of f : T -> R to A is injective *) (* (this is a boolean predicate, R must be an eqType). *) (* injectiveb f <=> f : T -> R is injective (boolean predicate). *) (* pred0b A <=> no x : T satisfies x \in A. *) (* [forall x, P] <=> P (in which x can appear) is true for all values of x *) (* x must range over a finType. *) (* [exists x, P] <=> P is true for some value of x. *) (* [forall (x | C), P] := [forall x, C ==> P]. *) (* [forall x in A, P] := [forall (x | x \in A), P]. *) (* [exists (x | C), P] := [exists x, C && P]. *) (* [exists x in A, P] := [exists (x | x \in A), P]. *) (* and typed variants [forall x : T, P], [forall (x : T | C), P], *) (* [exists x : T, P], [exists x : T in A, P], etc. *) (* -> The outer brackets can be omitted when nesting finitary quantifiers, *) (* e.g., [forall i in I, forall j in J, exists a, f i j == a]. *) (* 'forall_pP <-> view for [forall x, p _], for pP : reflect .. (p _). *) (* 'exists_pP <-> view for [exists x, p _], for pP : reflect .. (p _). *) (* 'forall_in_pP <-> view for [forall x in .., p _], for pP as above. *) (* 'exists_in_pP <-> view for [exists x in .., p _], for pP as above. *) (* [pick x | P] == Some x, for an x such that P holds, or None if there *) (* is no such x. *) (* [pick x : T] == Some x with x : T, provided T is nonempty, else None. *) (* [pick x in A] == Some x, with x \in A, or None if A is empty. *) (* [pick x in A | P] == Some x, with x \in A such that P holds, else None. *) (* [pick x | P & Q] := [pick x | P & Q]. *) (* [pick x in A | P & Q] := [pick x | P & Q]. *) (* and (un)typed variants [pick x : T | P], [pick x : T in A], [pick x], etc. *) (* [arg min_(i < i0 | P) M] == a value i : T minimizing M : nat, subject *) (* to the condition P (i may appear in P and M), and *) (* provided P holds for i0. *) (* [arg max_(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. *) (* These are special instances of *) (* [arg[ord]_(i < i0 | P) F] == a value i : I, minimizing F wrt ord : rel T *) (* such that for all j : T, ord (F i) (F j) *) (* subject to the condition P, and provided P i0 *) (* where I : finType, T : eqType and F : I -> T *) (* [arg[ord]_(i < i0 in A) F] == an i \in A minimizing F wrt ord, if i0 \in A.*) (* [arg[ord]_(i < i0) F] == an i : T minimizing F wrt ord, given i0 : T. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope fin_quant_scope. Module Finite. Section RawMixin. Variable T : eqType. Definition axiom e := forall x : T, count_mem x e = 1. Lemma uniq_enumP e : uniq e -> e =i T -> axiom e. Proof. by move=> Ue sT x; rewrite count_uniq_mem ?sT. Qed. Record mixin_of := Mixin { mixin_base : Countable.mixin_of T; mixin_enum : seq T; _ : axiom mixin_enum }. End RawMixin. Section Mixins. Variable T : countType. Definition EnumMixin := let: Countable.Pack _ (Countable.Class _ m) as cT := T return forall e : seq cT, axiom e -> mixin_of cT in @Mixin (EqType _ _) m. Definition UniqMixin e Ue eT := @EnumMixin e (uniq_enumP Ue eT). Variable n : nat. Definition count_enum := pmap (@pickle_inv T) (iota 0 n). Hypothesis ubT : forall x : T, pickle x < n. Lemma count_enumP : axiom count_enum. Proof. apply: uniq_enumP (pmap_uniq (@pickle_invK T) (iota_uniq _ _)) _ => x. by rewrite mem_pmap -pickleK_inv map_f // mem_iota ubT. Qed. Definition CountMixin := EnumMixin count_enumP. End Mixins. Section ClassDef. Set Primitive Projections. Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of (Equality.Pack base) }. Unset Primitive Projections. Definition base2 T c := Countable.Class (@base T c) (mixin_base (mixin c)). Local Coercion base : class_of >-> Choice.class_of. Structure type : 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. Definition clone c of phant_id class c := @Pack T c. Definition pack b0 (m0 : mixin_of (EqType T b0)) := fun bT b & phant_id (Choice.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT (base2 class). End ClassDef. Module Import Exports. Coercion mixin_base : mixin_of >-> Countable.mixin_of. Coercion base : class_of >-> Choice.class_of. Coercion mixin : class_of >-> mixin_of. Coercion base2 : class_of >-> Countable.class_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Notation finType := type. Notation FinType T m := (@pack T _ m _ _ id _ id). Notation FinMixin := EnumMixin. Notation UniqFinMixin := UniqMixin. Notation "[ 'finType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'finType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'finType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'finType' 'of' T ]") : form_scope. End Exports. Module Type EnumSig. Parameter enum : forall cT : type, seq cT. Axiom enumDef : enum = fun cT => mixin_enum (class cT). End EnumSig. Module EnumDef : EnumSig. Definition enum cT := mixin_enum (class cT). Definition enumDef := erefl enum. End EnumDef. Notation enum := EnumDef.enum. End Finite. Export Finite.Exports. Canonical finEnum_unlock := Unlockable Finite.EnumDef.enumDef. (* Workaround for the silly syntactic uniformity restriction on coercions; *) (* this avoids a cross-dependency between finset.v and prime.v for the *) (* definition of the \pi(A) notation. *) Definition fin_pred_sort (T : finType) (pT : predType T) := pred_sort pT. Identity Coercion pred_sort_of_fin : fin_pred_sort >-> pred_sort. Definition enum_mem T (mA : mem_pred _) := filter mA (Finite.enum T). Notation enum A := (enum_mem (mem A)). Definition pick (T : finType) (P : pred T) := ohead (enum P). Notation "[ 'pick' x | P ]" := (pick (fun x => P%B)) (at level 0, x ident, format "[ 'pick' x | P ]") : form_scope. Notation "[ 'pick' x : T | P ]" := (pick (fun x : T => P%B)) (at level 0, x ident, only parsing) : form_scope. Definition pick_true T (x : T) := true. Reserved Notation "[ 'pick' x : T ]" (at level 0, x ident, format "[ 'pick' x : T ]"). Notation "[ 'pick' x : T ]" := [pick x : T | pick_true x] (only parsing) : form_scope. Notation "[ 'pick' x : T ]" := [pick x : T | pick_true _] (only printing) : form_scope. Notation "[ 'pick' x ]" := [pick x : _] (at level 0, x ident, only parsing) : form_scope. Notation "[ 'pick' x | P & Q ]" := [pick x | P && Q ] (at level 0, x ident, format "[ '[hv ' 'pick' x | P '/ ' & Q ] ']'") : form_scope. Notation "[ 'pick' x : T | P & Q ]" := [pick x : T | P && Q ] (at level 0, x ident, only parsing) : form_scope. Notation "[ 'pick' x 'in' A ]" := [pick x | x \in A] (at level 0, x ident, format "[ 'pick' x 'in' A ]") : form_scope. Notation "[ 'pick' x : T 'in' A ]" := [pick x : T | x \in A] (at level 0, x ident, only parsing) : form_scope. Notation "[ 'pick' x 'in' A | P ]" := [pick x | x \in A & P ] (at level 0, x ident, format "[ '[hv ' 'pick' x 'in' A '/ ' | P ] ']'") : form_scope. Notation "[ 'pick' x : T 'in' A | P ]" := [pick x : T | x \in A & P ] (at level 0, x ident, only parsing) : form_scope. Notation "[ 'pick' x 'in' A | P & Q ]" := [pick x in A | P && Q] (at level 0, x ident, format "[ '[hv ' 'pick' x 'in' A '/ ' | P '/ ' & Q ] ']'") : form_scope. Notation "[ 'pick' x : T 'in' A | P & Q ]" := [pick x : T in A | P && Q] (at level 0, x ident, only parsing) : form_scope. (* We lock the definitions of card and subset to mitigate divergence of the *) (* Coq term comparison algorithm. *) Local Notation card_type := (forall T : finType, mem_pred T -> nat). Local Notation card_def := (fun T mA => size (enum_mem mA)). Module Type CardDefSig. Parameter card : card_type. Axiom cardEdef : card = card_def. End CardDefSig. Module CardDef : CardDefSig. Definition card : card_type := card_def. Definition cardEdef := erefl card. End CardDef. (* Should be Include, but for a silly restriction: can't Include at toplevel! *) Export CardDef. Canonical card_unlock := Unlockable cardEdef. (* A is at level 99 to allow the notation #|G : H| in groups. *) Notation "#| A |" := (card (mem A)) (at level 0, A at level 99, format "#| A |") : nat_scope. Definition pred0b (T : finType) (P : pred T) := #|P| == 0. Prenex Implicits pred0b. Module FiniteQuant. Variant quantified := Quantified of bool. Delimit Scope fin_quant_scope with Q. (* Bogus, only used to declare scope. *) Bind Scope fin_quant_scope with quantified. Notation "F ^*" := (Quantified F) (at level 2). Notation "F ^~" := (~~ F) (at level 2). Section Definitions. Variable T : finType. Implicit Types (B : quantified) (x y : T). Definition quant0b Bp := pred0b [pred x : T | let: F^* := Bp x x in F]. (* The first redundant argument protects the notation from Coq's K-term *) (* display kludge; the second protects it from simpl and /=. *) Definition ex B x y := B. (* Binding the predicate value rather than projecting it prevents spurious *) (* unfolding of the boolean connectives by unification. *) Definition all B x y := let: F^* := B in F^~^*. Definition all_in C B x y := let: F^* := B in (C ==> F)^~^*. Definition ex_in C B x y := let: F^* := B in (C && F)^*. End Definitions. Notation "[ x | B ]" := (quant0b (fun x => B x)) (at level 0, x ident). Notation "[ x : T | B ]" := (quant0b (fun x : T => B x)) (at level 0, x ident). Module Exports. Notation ", F" := F^* (at level 200, format ", '/ ' F") : fin_quant_scope. Notation "[ 'forall' x B ]" := [x | all B] (at level 0, x at level 99, B at level 200, format "[ '[hv' 'forall' x B ] ']'") : bool_scope. Notation "[ 'forall' x : T B ]" := [x : T | all B] (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation "[ 'forall' ( x | C ) B ]" := [x | all_in C B] (at level 0, x at level 99, B at level 200, format "[ '[hv' '[' 'forall' ( x '/ ' | C ) ']' B ] ']'") : bool_scope. Notation "[ 'forall' ( x : T | C ) B ]" := [x : T | all_in C B] (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation "[ 'forall' x 'in' A B ]" := [x | all_in (x \in A) B] (at level 0, x at level 99, B at level 200, format "[ '[hv' '[' 'forall' x '/ ' 'in' A ']' B ] ']'") : bool_scope. Notation "[ 'forall' x : T 'in' A B ]" := [x : T | all_in (x \in A) B] (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation ", 'forall' x B" := [x | all B]^* (at level 200, x at level 99, B at level 200, format ", '/ ' 'forall' x B") : fin_quant_scope. Notation ", 'forall' x : T B" := [x : T | all B]^* (at level 200, x at level 99, B at level 200, only parsing) : fin_quant_scope. Notation ", 'forall' ( x | C ) B" := [x | all_in C B]^* (at level 200, x at level 99, B at level 200, format ", '/ ' '[' 'forall' ( x '/ ' | C ) ']' B") : fin_quant_scope. Notation ", 'forall' ( x : T | C ) B" := [x : T | all_in C B]^* (at level 200, x at level 99, B at level 200, only parsing) : fin_quant_scope. Notation ", 'forall' x 'in' A B" := [x | all_in (x \in A) B]^* (at level 200, x at level 99, B at level 200, format ", '/ ' '[' 'forall' x '/ ' 'in' A ']' B") : bool_scope. Notation ", 'forall' x : T 'in' A B" := [x : T | all_in (x \in A) B]^* (at level 200, x at level 99, B at level 200, only parsing) : bool_scope. Notation "[ 'exists' x B ]" := [x | ex B]^~ (at level 0, x at level 99, B at level 200, format "[ '[hv' 'exists' x B ] ']'") : bool_scope. Notation "[ 'exists' x : T B ]" := [x : T | ex B]^~ (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation "[ 'exists' ( x | C ) B ]" := [x | ex_in C B]^~ (at level 0, x at level 99, B at level 200, format "[ '[hv' '[' 'exists' ( x '/ ' | C ) ']' B ] ']'") : bool_scope. Notation "[ 'exists' ( x : T | C ) B ]" := [x : T | ex_in C B]^~ (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation "[ 'exists' x 'in' A B ]" := [x | ex_in (x \in A) B]^~ (at level 0, x at level 99, B at level 200, format "[ '[hv' '[' 'exists' x '/ ' 'in' A ']' B ] ']'") : bool_scope. Notation "[ 'exists' x : T 'in' A B ]" := [x : T | ex_in (x \in A) B]^~ (at level 0, x at level 99, B at level 200, only parsing) : bool_scope. Notation ", 'exists' x B" := [x | ex B]^~^* (at level 200, x at level 99, B at level 200, format ", '/ ' 'exists' x B") : fin_quant_scope. Notation ", 'exists' x : T B" := [x : T | ex B]^~^* (at level 200, x at level 99, B at level 200, only parsing) : fin_quant_scope. Notation ", 'exists' ( x | C ) B" := [x | ex_in C B]^~^* (at level 200, x at level 99, B at level 200, format ", '/ ' '[' 'exists' ( x '/ ' | C ) ']' B") : fin_quant_scope. Notation ", 'exists' ( x : T | C ) B" := [x : T | ex_in C B]^~^* (at level 200, x at level 99, B at level 200, only parsing) : fin_quant_scope. Notation ", 'exists' x 'in' A B" := [x | ex_in (x \in A) B]^~^* (at level 200, x at level 99, B at level 200, format ", '/ ' '[' 'exists' x '/ ' 'in' A ']' B") : bool_scope. Notation ", 'exists' x : T 'in' A B" := [x : T | ex_in (x \in A) B]^~^* (at level 200, x at level 99, B at level 200, only parsing) : bool_scope. End Exports. End FiniteQuant. Export FiniteQuant.Exports. Definition disjoint T (A B : mem_pred _) := @pred0b T (predI A B). Notation "[ 'disjoint' A & B ]" := (disjoint (mem A) (mem B)) (at level 0, format "'[hv' [ 'disjoint' '/ ' A '/' & B ] ']'") : bool_scope. Local Notation subset_type := (forall (T : finType) (A B : mem_pred T), bool). Local Notation subset_def := (fun T A B => pred0b (predD A B)). Module Type SubsetDefSig. Parameter subset : subset_type. Axiom subsetEdef : subset = subset_def. End SubsetDefSig. Module Export SubsetDef : SubsetDefSig. Definition subset : subset_type := subset_def. Definition subsetEdef := erefl subset. End SubsetDef. Canonical subset_unlock := Unlockable subsetEdef. Notation "A \subset B" := (subset (mem A) (mem B)) (at level 70, no associativity) : bool_scope. Definition proper T A B := @subset T A B && ~~ subset B A. Notation "A \proper B" := (proper (mem A) (mem B)) (at level 70, no associativity) : bool_scope. (* image, xinv, inv, and ordinal operations will be defined later. *) Section OpsTheory. Variable T : finType. Implicit Types (A B C D: {pred T}) (P Q : pred T) (x y : T) (s : seq T). Lemma enumP : Finite.axiom (Finite.enum T). Proof. by rewrite unlock; case T => ? [? []]. Qed. Section EnumPick. Variable P : pred T. Lemma enumT : enum T = Finite.enum T. Proof. exact: filter_predT. Qed. Lemma mem_enum A : enum A =i A. Proof. by move=> x; rewrite mem_filter andbC -has_pred1 has_count enumP. Qed. Lemma enum_uniq A : uniq (enum A). Proof. by apply/filter_uniq/count_mem_uniq => x; rewrite enumP -enumT mem_enum. Qed. Lemma enum0 : enum pred0 = Nil T. Proof. exact: filter_pred0. Qed. Lemma enum1 x : enum (pred1 x) = [:: x]. Proof. rewrite [enum _](all_pred1P x _ _); first by rewrite size_filter enumP. by apply/allP=> y; rewrite mem_enum. Qed. Variant pick_spec : option T -> Type := | Pick x of P x : pick_spec (Some x) | Nopick of P =1 xpred0 : pick_spec None. Lemma pickP : pick_spec (pick P). Proof. rewrite /pick; case: (enum _) (mem_enum P) => [|x s] Pxs /=. by right; apply: fsym. by left; rewrite -[P _]Pxs mem_head. Qed. End EnumPick. Lemma eq_enum A B : A =i B -> enum A = enum B. Proof. by move=> eqAB; apply: eq_filter. Qed. Lemma eq_pick P Q : P =1 Q -> pick P = pick Q. Proof. by move=> eqPQ; rewrite /pick (eq_enum eqPQ). Qed. Lemma cardE A : #|A| = size (enum A). Proof. by rewrite unlock. Qed. Lemma eq_card A B : A =i B -> #|A| = #|B|. Proof. by move=> eqAB; rewrite !cardE (eq_enum eqAB). Qed. Lemma eq_card_trans A B n : #|A| = n -> B =i A -> #|B| = n. Proof. by move <-; apply: eq_card. Qed. Lemma card0 : #|@pred0 T| = 0. Proof. by rewrite cardE enum0. Qed. Lemma cardT : #|T| = size (enum T). Proof. by rewrite cardE. Qed. Lemma card1 x : #|pred1 x| = 1. Proof. by rewrite cardE enum1. Qed. Lemma eq_card0 A : A =i pred0 -> #|A| = 0. Proof. exact: eq_card_trans card0. Qed. Lemma eq_cardT A : A =i predT -> #|A| = size (enum T). Proof. exact: eq_card_trans cardT. Qed. Lemma eq_card1 x A : A =i pred1 x -> #|A| = 1. Proof. exact: eq_card_trans (card1 x). Qed. Lemma cardUI A B : #|[predU A & B]| + #|[predI A & B]| = #|A| + #|B|. Proof. by rewrite !cardE !size_filter count_predUI. Qed. Lemma cardID B A : #|[predI A & B]| + #|[predD A & B]| = #|A|. Proof. rewrite -cardUI addnC [#|predI _ _|]eq_card0 => [|x] /=. by apply: eq_card => x; rewrite !inE andbC -andb_orl orbN. by rewrite !inE -!andbA andbC andbA andbN. Qed. Lemma cardC A : #|A| + #|[predC A]| = #|T|. Proof. by rewrite !cardE !size_filter count_predC. Qed. Lemma cardU1 x A : #|[predU1 x & A]| = (x \notin A) + #|A|. Proof. case Ax: (x \in A). by apply: eq_card => y; rewrite inE /=; case: eqP => // ->. rewrite /= -(card1 x) -cardUI addnC. rewrite [#|predI _ _|]eq_card0 => [|y /=]; first exact: eq_card. by rewrite !inE; case: eqP => // ->. Qed. Lemma card2 x y : #|pred2 x y| = (x != y).+1. Proof. by rewrite cardU1 card1 addn1. Qed. Lemma cardC1 x : #|predC1 x| = #|T|.-1. Proof. by rewrite -(cardC (pred1 x)) card1. Qed. Lemma cardD1 x A : #|A| = (x \in A) + #|[predD1 A & x]|. Proof. case Ax: (x \in A); last first. by apply: eq_card => y; rewrite !inE /=; case: eqP => // ->. rewrite /= -(card1 x) -cardUI addnC /=. rewrite [#|predI _ _|]eq_card0 => [|y]; last by rewrite !inE; case: eqP. by apply: eq_card => y; rewrite !inE; case: eqP => // ->. Qed. Lemma max_card A : #|A| <= #|T|. Proof. by rewrite -(cardC A) leq_addr. Qed. Lemma card_size s : #|s| <= size s. Proof. elim: s => [|x s IHs] /=; first by rewrite card0. by rewrite cardU1 /=; case: (~~ _) => //; apply: leqW. Qed. Lemma card_uniqP s : reflect (#|s| = size s) (uniq s). Proof. elim: s => [|x s IHs]; first by left; apply: card0. rewrite cardU1 /= /addn; case: {+}(x \in s) => /=. by right=> card_Ssz; have:= card_size s; rewrite card_Ssz ltnn. by apply: (iffP IHs) => [<-| [<-]]. Qed. Lemma card0_eq A : #|A| = 0 -> A =i pred0. Proof. by move=> A0 x; apply/idP => Ax; rewrite (cardD1 x) Ax in A0. Qed. Lemma fintype0 : T -> #|T| <> 0. Proof. by move=> x /card0_eq/(_ x). Qed. Lemma pred0P P : reflect (P =1 pred0) (pred0b P). Proof. by apply: (iffP eqP); [apply: card0_eq | apply: eq_card0]. Qed. Lemma pred0Pn P : reflect (exists x, P x) (~~ pred0b P). Proof. case: (pickP P) => [x Px | P0]. by rewrite (introN (pred0P P)) => [|P0]; [left; exists x | rewrite P0 in Px]. by rewrite -lt0n eq_card0 //; right=> [[x]]; rewrite P0. Qed. Lemma card_gt0P A : reflect (exists i, i \in A) (#|A| > 0). Proof. by rewrite lt0n; apply: pred0Pn. Qed. Lemma card_le1P {A} : reflect {in A, forall x, A =i pred1 x} (#|A| <= 1). Proof. apply: (iffP idP) => [A1 x xA y|]; last first. by have [/= x xA /(_ _ xA)/eq_card1->|/eq_card0->//] := pickP (mem A). move: A1; rewrite (cardD1 x) xA ltnS leqn0 => /eqP/card0_eq/(_ y). by rewrite !inE; have [->|]:= eqP. Qed. Lemma mem_card1 A : #|A| = 1 -> {x | A =i pred1 x}. Proof. move=> A1; have /card_gt0P/sigW[x xA]: #|A| > 0 by rewrite A1. by exists x; apply/card_le1P; rewrite ?A1. Qed. Lemma card1P A : reflect (exists x, A =i pred1 x) (#|A| == 1). Proof. by apply: (iffP idP) => [/eqP/mem_card1[x inA]|[x /eq_card1/eqP//]]; exists x. Qed. Lemma card_le1_eqP A : reflect {in A &, forall x, all_equal_to x} (#|A| <= 1). Proof. apply: (iffP card_le1P) => [Ale1 x y xA yA /=|all_eq x xA y]. by apply/eqP; rewrite -[_ == _]/(y \in pred1 x) -Ale1. by rewrite inE; case: (altP (y =P x)) => [->//|]; exact/contra_neqF/all_eq. Qed. Lemma fintype_le1P : reflect (forall x : T, all_equal_to x) (#|T| <= 1). Proof. apply: (iffP (card_le1_eqP {:T})); [exact: in2T | exact: in2W]. Qed. Lemma fintype1 : #|T| = 1 -> {x : T | all_equal_to x}. Proof. by move=> /mem_card1[x ex]; exists x => y; suff: y \in T by rewrite ex => /eqP. Qed. Lemma fintype1P : reflect (exists x, all_equal_to x) (#|T| == 1). Proof. apply: (iffP idP) => [/eqP/fintype1|] [x eqx]; first by exists x. by apply/card1P; exists x => y; rewrite eqx !inE eqxx. Qed. Lemma subsetE A B : (A \subset B) = pred0b [predD A & B]. Proof. by rewrite unlock. Qed. Lemma subsetP A B : reflect {subset A <= B} (A \subset B). Proof. rewrite unlock; apply: (iffP (pred0P _)) => [AB0 x | sAB x /=]. by apply/implyP; apply/idPn; rewrite negb_imply andbC [_ && _]AB0. by rewrite andbC -negb_imply; apply/negbF/implyP; apply: sAB. Qed. Lemma subsetPn A B : reflect (exists2 x, x \in A & x \notin B) (~~ (A \subset B)). Proof. rewrite unlock; apply: (iffP (pred0Pn _)) => [[x] | [x Ax nBx]]. by case/andP; exists x. by exists x; rewrite /= nBx. Qed. Lemma subset_leq_card A B : A \subset B -> #|A| <= #|B|. Proof. move=> sAB. rewrite -(cardID A B) [#|predI _ _|](@eq_card _ A) ?leq_addr //= => x. by rewrite !inE andbC; case Ax: (x \in A) => //; apply: subsetP Ax. Qed. Lemma subxx_hint (mA : mem_pred T) : subset mA mA. Proof. by case: mA => A; have:= introT (subsetP A A); rewrite !unlock => ->. Qed. Hint Resolve subxx_hint : core. (* The parametrization by predType makes it easier to apply subxx. *) Lemma subxx (pT : predType T) (pA : pT) : pA \subset pA. Proof. by []. Qed. Lemma eq_subset A B : A =i B -> subset (mem A) =1 subset (mem B). Proof. move=> eqAB [C]; rewrite !unlock; congr (_ == 0). by apply: eq_card => x; rewrite inE /= eqAB. Qed. Lemma eq_subset_r A B : A =i B -> (@subset T)^~ (mem A) =1 (@subset T)^~ (mem B). Proof. move=> eqAB [C]; rewrite !unlock; congr (_ == 0). by apply: eq_card => x; rewrite !inE /= eqAB. Qed. Lemma eq_subxx A B : A =i B -> A \subset B. Proof. by move/eq_subset->. Qed. Lemma subset_predT A : A \subset T. Proof. exact/subsetP. Qed. Lemma predT_subset A : T \subset A -> forall x, x \in A. Proof. by move/subsetP=> allA x; apply: allA. Qed. Lemma subset_pred1 A x : (pred1 x \subset A) = (x \in A). Proof. by apply/subsetP/idP=> [-> // | Ax y /eqP-> //]; apply: eqxx. Qed. Lemma subset_eqP A B : reflect (A =i B) ((A \subset B) && (B \subset A)). Proof. apply: (iffP andP) => [[sAB sBA] x| eqAB]; last by rewrite !eq_subxx. by apply/idP/idP; apply: subsetP. Qed. Lemma subset_cardP A B : #|A| = #|B| -> reflect (A =i B) (A \subset B). Proof. move=> eqcAB; case: (subsetP A B) (subset_eqP A B) => //= sAB. case: (subsetP B A) => [//|[]] x Bx; apply/idPn => Ax. case/idP: (ltnn #|A|); rewrite {2}eqcAB (cardD1 x B) Bx /=. apply: subset_leq_card; apply/subsetP=> y Ay; rewrite inE /= andbC. by rewrite sAB //; apply/eqP => eqyx; rewrite -eqyx Ay in Ax. Qed. Lemma subset_leqif_card A B : A \subset B -> #|A| <= #|B| ?= iff (B \subset A). Proof. move=> sAB; split; [exact: subset_leq_card | apply/eqP/idP]. by move/subset_cardP=> sABP; rewrite (eq_subset_r (sABP sAB)). by move=> sBA; apply: eq_card; apply/subset_eqP; rewrite sAB. Qed. Lemma subset_trans A B C : A \subset B -> B \subset C -> A \subset C. Proof. by move/subsetP=> sAB /subsetP=> sBC; apply/subsetP=> x /sAB; apply: sBC. Qed. Lemma subset_all s A : (s \subset A) = all (mem A) s. Proof. exact: (sameP (subsetP _ _) allP). Qed. Lemma properE A B : A \proper B = (A \subset B) && ~~(B \subset A). Proof. by []. Qed. Lemma properP A B : reflect (A \subset B /\ (exists2 x, x \in B & x \notin A)) (A \proper B). Proof. by rewrite properE; apply: (iffP andP) => [] [-> /subsetPn]. Qed. Lemma proper_sub A B : A \proper B -> A \subset B. Proof. by case/andP. Qed. Lemma proper_subn A B : A \proper B -> ~~ (B \subset A). Proof. by case/andP. Qed. Lemma proper_trans A B C : A \proper B -> B \proper C -> A \proper C. Proof. case/properP=> sAB [x Bx nAx] /properP[sBC [y Cy nBy]]. rewrite properE (subset_trans sAB) //=; apply/subsetPn; exists y => //. by apply: contra nBy; apply: subsetP. Qed. Lemma proper_sub_trans A B C : A \proper B -> B \subset C -> A \proper C. Proof. case/properP=> sAB [x Bx nAx] sBC; rewrite properE (subset_trans sAB) //. by apply/subsetPn; exists x; rewrite ?(subsetP _ _ sBC). Qed. Lemma sub_proper_trans A B C : A \subset B -> B \proper C -> A \proper C. Proof. move=> sAB /properP[sBC [x Cx nBx]]; rewrite properE (subset_trans sAB) //. by apply/subsetPn; exists x => //; apply: contra nBx; apply: subsetP. Qed. Lemma proper_card A B : A \proper B -> #|A| < #|B|. Proof. by case/andP=> sAB nsBA; rewrite ltn_neqAle !(subset_leqif_card sAB) andbT. Qed. Lemma proper_irrefl A : ~~ (A \proper A). Proof. by rewrite properE subxx. Qed. Lemma properxx A : (A \proper A) = false. Proof. by rewrite properE subxx. Qed. Lemma eq_proper A B : A =i B -> proper (mem A) =1 proper (mem B). Proof. move=> eAB [C]; congr (_ && _); first exact: (eq_subset eAB). by rewrite (eq_subset_r eAB). Qed. Lemma eq_proper_r A B : A =i B -> (@proper T)^~ (mem A) =1 (@proper T)^~ (mem B). Proof. move=> eAB [C]; congr (_ && _); first exact: (eq_subset_r eAB). by rewrite (eq_subset eAB). Qed. Lemma card_geqP {A n} : reflect (exists s, [/\ uniq s, size s = n & {subset s <= A}]) (n <= #|A|). Proof. apply: (iffP idP) => [n_le_A|[s] [uniq_s size_s /subsetP subA]]; last first. by rewrite -size_s -(card_uniqP _ uniq_s); exact: subset_leq_card. exists (take n (enum A)); rewrite take_uniq ?enum_uniq // size_take. split => //; last by move => x /mem_take; rewrite mem_enum. case: (ltnP n (size (enum A))) => // size_A. by apply/eqP; rewrite eqn_leq size_A -cardE n_le_A. Qed. Lemma card_gt1P A : reflect (exists x y, [/\ x \in A, y \in A & x != y]) (1 < #|A|). Proof. apply: (iffP card_geqP) => [[s] []|[x] [y] [xA yA xDy]]. case: s => [|a [|b []]]//=; rewrite inE andbT => aDb _ subD. by exists a, b; rewrite aDb !subD ?inE ?eqxx ?orbT. exists [:: x; y]; rewrite /= !inE xDy. by split=> // z; rewrite !inE => /pred2P[]->. Qed. Lemma card_gt2P A : reflect (exists x y z, [/\ x \in A, y \in A & z \in A] /\ [/\ x != y, y != z & z != x]) (2 < #|A|). Proof. apply: (iffP card_geqP) => [[s] []|[x] [y] [z] [[xD yD zD] [xDy xDz yDz]]]. case: s => [|x [|y [|z []]]]//=; rewrite !inE !andbT negb_or -andbA. case/and3P => xDy xDz yDz _ subA. by exists x, y, z; rewrite xDy yDz eq_sym xDz !subA ?inE ?eqxx ?orbT. exists [:: x; y; z]; rewrite /= !inE negb_or xDy xDz eq_sym yDz; split=> // u. by rewrite !inE => /or3P [] /eqP->. Qed. Lemma disjoint_sym A B : [disjoint A & B] = [disjoint B & A]. Proof. by congr (_ == 0); apply: eq_card => x; apply: andbC. Qed. Lemma eq_disjoint A B : A =i B -> disjoint (mem A) =1 disjoint (mem B). Proof. by move=> eqAB [C]; congr (_ == 0); apply: eq_card => x; rewrite !inE eqAB. Qed. Lemma eq_disjoint_r A B : A =i B -> (@disjoint T)^~ (mem A) =1 (@disjoint T)^~ (mem B). Proof. by move=> eqAB [C]; congr (_ == 0); apply: eq_card => x; rewrite !inE eqAB. Qed. Lemma subset_disjoint A B : (A \subset B) = [disjoint A & [predC B]]. Proof. by rewrite disjoint_sym unlock. Qed. Lemma disjoint_subset A B : [disjoint A & B] = (A \subset [predC B]). Proof. by rewrite subset_disjoint; apply: eq_disjoint_r => x; rewrite !inE /= negbK. Qed. Lemma disjointFr A B x : [disjoint A & B] -> x \in A -> x \in B = false. Proof. by move/pred0P/(_ x) => /=; case: (x \in A). Qed. Lemma disjointFl A B x : [disjoint A & B] -> x \in B -> x \in A = false. Proof. rewrite disjoint_sym; exact: disjointFr. Qed. Lemma disjointWl A B C : A \subset B -> [disjoint B & C] -> [disjoint A & C]. Proof. by rewrite 2!disjoint_subset; apply: subset_trans. Qed. Lemma disjointWr A B C : A \subset B -> [disjoint C & B] -> [disjoint C & A]. Proof. rewrite ![[disjoint C & _]]disjoint_sym. exact:disjointWl. Qed. Lemma disjointW A B C D : A \subset B -> C \subset D -> [disjoint B & D] -> [disjoint A & C]. Proof. by move=> subAB subCD BD; apply/(disjointWl subAB)/(disjointWr subCD). Qed. Lemma disjoint0 A : [disjoint pred0 & A]. Proof. exact/pred0P. Qed. Lemma eq_disjoint0 A B : A =i pred0 -> [disjoint A & B]. Proof. by move/eq_disjoint->; apply: disjoint0. Qed. Lemma disjoint1 x A : [disjoint pred1 x & A] = (x \notin A). Proof. apply/negbRL/(sameP (pred0Pn _))=> /=. apply: introP => [Ax | notAx [_ /andP[/eqP->]]]; last exact: negP. by exists x; rewrite inE eqxx. Qed. Lemma eq_disjoint1 x A B : A =i pred1 x -> [disjoint A & B] = (x \notin B). Proof. by move/eq_disjoint->; apply: disjoint1. Qed. Lemma disjointU A B C : [disjoint predU A B & C] = [disjoint A & C] && [disjoint B & C]. Proof. case: [disjoint A & C] / (pred0P (xpredI A C)) => [A0 | nA0] /=. by congr (_ == 0); apply: eq_card => x; rewrite [x \in _]andb_orl A0. apply/pred0P=> nABC; case: nA0 => x; apply/idPn=> /=; move/(_ x): nABC. by rewrite [_ x]andb_orl; case/norP. Qed. Lemma disjointU1 x A B : [disjoint predU1 x A & B] = (x \notin B) && [disjoint A & B]. Proof. by rewrite disjointU disjoint1. Qed. Lemma disjoint_cons x s B : [disjoint x :: s & B] = (x \notin B) && [disjoint s & B]. Proof. exact: disjointU1. Qed. Lemma disjoint_has s A : [disjoint s & A] = ~~ has (mem A) s. Proof. apply/negbRL; apply/pred0Pn/hasP => [[x /andP[]]|[x]]; exists x => //. exact/andP. Qed. Lemma disjoint_cat s1 s2 A : [disjoint s1 ++ s2 & A] = [disjoint s1 & A] && [disjoint s2 & A]. Proof. by rewrite !disjoint_has has_cat negb_or. Qed. End OpsTheory. Notation disjoint_trans := (deprecate disjoint_trans disjointWl _ _ _ _) (only parsing). Hint Resolve subxx_hint : core. Arguments pred0P {T P}. Arguments pred0Pn {T P}. Arguments card_le1P {T A}. Arguments card_le1_eqP {T A}. Arguments card1P {T A}. Arguments fintype_le1P {T}. Arguments fintype1P {T}. Arguments subsetP {T A B}. Arguments subsetPn {T A B}. Arguments subset_eqP {T A B}. Arguments card_uniqP {T s}. Arguments card_geqP {T A n}. Arguments card_gt0P {T A}. Arguments card_gt1P {T A}. Arguments card_gt2P {T A}. Arguments properP {T A B}. (**********************************************************************) (* *) (* Boolean quantifiers for finType *) (* *) (**********************************************************************) Section QuantifierCombinators. Variables (T : finType) (P : pred T) (PP : T -> Prop). Hypothesis viewP : forall x, reflect (PP x) (P x). Lemma existsPP : reflect (exists x, PP x) [exists x, P x]. Proof. by apply: (iffP pred0Pn) => -[x /viewP]; exists x. Qed. Lemma forallPP : reflect (forall x, PP x) [forall x, P x]. Proof. by apply: (iffP pred0P) => /= allP x; have /viewP//=-> := allP x. Qed. End QuantifierCombinators. Notation "'exists_ view" := (existsPP (fun _ => view)) (at level 4, right associativity, format "''exists_' view"). Notation "'forall_ view" := (forallPP (fun _ => view)) (at level 4, right associativity, format "''forall_' view"). Section Quantifiers. Variables (T : finType) (rT : T -> eqType). Implicit Types (D P : pred T) (f : forall x, rT x). Lemma forallP P : reflect (forall x, P x) [forall x, P x]. Proof. exact: 'forall_idP. Qed. Lemma eqfunP f1 f2 : reflect (forall x, f1 x = f2 x) [forall x, f1 x == f2 x]. Proof. exact: 'forall_eqP. Qed. Lemma forall_inP D P : reflect (forall x, D x -> P x) [forall (x | D x), P x]. Proof. exact: 'forall_implyP. Qed. Lemma forall_inPP D P PP : (forall x, reflect (PP x) (P x)) -> reflect (forall x, D x -> PP x) [forall (x | D x), P x]. Proof. by move=> vP; apply: (iffP (forall_inP _ _)) => /(_ _ _) /vP. Qed. Lemma eqfun_inP D f1 f2 : reflect {in D, forall x, f1 x = f2 x} [forall (x | x \in D), f1 x == f2 x]. Proof. exact: (forall_inPP _ (fun=> eqP)). Qed. Lemma existsP P : reflect (exists x, P x) [exists x, P x]. Proof. exact: 'exists_idP. Qed. Lemma exists_eqP f1 f2 : reflect (exists x, f1 x = f2 x) [exists x, f1 x == f2 x]. Proof. exact: 'exists_eqP. Qed. Lemma exists_inP D P : reflect (exists2 x, D x & P x) [exists (x | D x), P x]. Proof. by apply: (iffP 'exists_andP) => [[x []] | [x]]; exists x. Qed. Lemma exists_inPP D P PP : (forall x, reflect (PP x) (P x)) -> reflect (exists2 x, D x & PP x) [exists (x | D x), P x]. Proof. by move=> vP; apply: (iffP (exists_inP _ _)) => -[x?/vP]; exists x. Qed. Lemma exists_eq_inP D f1 f2 : reflect (exists2 x, D x & f1 x = f2 x) [exists (x | D x), f1 x == f2 x]. Proof. exact: (exists_inPP _ (fun=> eqP)). Qed. Lemma eq_existsb P1 P2 : P1 =1 P2 -> [exists x, P1 x] = [exists x, P2 x]. Proof. by move=> eqP12; congr (_ != 0); apply: eq_card. Qed. Lemma eq_existsb_in D P1 P2 : (forall x, D x -> P1 x = P2 x) -> [exists (x | D x), P1 x] = [exists (x | D x), P2 x]. Proof. by move=> eqP12; apply: eq_existsb => x; apply: andb_id2l => /eqP12. Qed. Lemma eq_forallb P1 P2 : P1 =1 P2 -> [forall x, P1 x] = [forall x, P2 x]. Proof. by move=> eqP12; apply/negb_inj/eq_existsb=> /= x; rewrite eqP12. Qed. Lemma eq_forallb_in D P1 P2 : (forall x, D x -> P1 x = P2 x) -> [forall (x | D x), P1 x] = [forall (x | D x), P2 x]. Proof. by move=> eqP12; apply: eq_forallb => i; case Di: (D i); rewrite // eqP12. Qed. Lemma negb_forall P : ~~ [forall x, P x] = [exists x, ~~ P x]. Proof. by []. Qed. Lemma negb_forall_in D P : ~~ [forall (x | D x), P x] = [exists (x | D x), ~~ P x]. Proof. by apply: eq_existsb => x; rewrite negb_imply. Qed. Lemma negb_exists P : ~~ [exists x, P x] = [forall x, ~~ P x]. Proof. by apply/negbLR/esym/eq_existsb=> x; apply: negbK. Qed. Lemma negb_exists_in D P : ~~ [exists (x | D x), P x] = [forall (x | D x), ~~ P x]. Proof. by rewrite negb_exists; apply/eq_forallb => x; rewrite [~~ _]fun_if. Qed. Lemma existsPn P : reflect (forall x, ~~ P x) (~~ [exists x, P x]). Proof. rewrite negb_exists. exact: forallP. Qed. Lemma forallPn P : reflect (exists x, ~~ P x) (~~ [forall x, P x]). Proof. rewrite negb_forall. exact: existsP. Qed. Lemma exists_inPn D P : reflect (forall x, x \in D -> ~~ P x) (~~ [exists x in D, P x]). Proof. rewrite negb_exists_in. exact: forall_inP. Qed. Lemma forall_inPn D P : reflect (exists2 x, x \in D & ~~ P x) (~~ [forall x in D, P x]). Proof. rewrite negb_forall_in. exact: exists_inP. Qed. End Quantifiers. Arguments forallP {T P}. Arguments eqfunP {T rT f1 f2}. Arguments forall_inP {T D P}. Arguments eqfun_inP {T rT D f1 f2}. Arguments existsP {T P}. Arguments exists_eqP {T rT f1 f2}. Arguments exists_inP {T D P}. Arguments exists_eq_inP {T rT D f1 f2}. Arguments existsPn {T P}. Arguments exists_inPn {T D P}. Arguments forallPn {T P}. Arguments forall_inPn {T D P}. Notation "'exists_in_ view" := (exists_inPP _ (fun _ => view)) (at level 4, right associativity, format "''exists_in_' view"). Notation "'forall_in_ view" := (forall_inPP _ (fun _ => view)) (at level 4, right associativity, format "''forall_in_' view"). (**********************************************************************) (* *) (* Boolean injectivity test for functions with a finType domain *) (* *) (**********************************************************************) Section Injectiveb. Variables (aT : finType) (rT : eqType) (f : aT -> rT). Implicit Type D : {pred aT}. Definition dinjectiveb D := uniq (map f (enum D)). Definition injectiveb := dinjectiveb aT. Lemma dinjectivePn D : reflect (exists2 x, x \in D & exists2 y, y \in [predD1 D & x] & f x = f y) (~~ dinjectiveb D). Proof. apply: (iffP idP) => [injf | [x Dx [y Dxy eqfxy]]]; last first. move: Dx; rewrite -(mem_enum D) => /rot_to[i E defE]. rewrite /dinjectiveb -(rot_uniq i) -map_rot defE /=; apply/nandP; left. rewrite inE /= -(mem_enum D) -(mem_rot i) defE inE in Dxy. rewrite andb_orr andbC andbN in Dxy. by rewrite eqfxy map_f //; case/andP: Dxy. pose p := [pred x in D | [exists (y | y \in [predD1 D & x]), f x == f y]]. case: (pickP p) => [x /= /andP[Dx /exists_inP[y Dxy /eqP eqfxy]] | no_p]. by exists x; last exists y. rewrite /dinjectiveb map_inj_in_uniq ?enum_uniq // in injf => x y Dx Dy eqfxy. apply: contraNeq (negbT (no_p x)) => ne_xy /=; rewrite -mem_enum Dx. by apply/existsP; exists y; rewrite /= !inE eq_sym ne_xy -mem_enum Dy eqfxy /=. Qed. Lemma dinjectiveP D : reflect {in D &, injective f} (dinjectiveb D). Proof. rewrite -[dinjectiveb D]negbK. case: dinjectivePn=> [noinjf | injf]; constructor. case: noinjf => x Dx [y /andP[neqxy /= Dy] eqfxy] injf. by case/eqP: neqxy; apply: injf. move=> x y Dx Dy /= eqfxy; apply/eqP; apply/idPn=> nxy; case: injf. by exists x => //; exists y => //=; rewrite inE /= eq_sym nxy. Qed. Lemma injectivePn : reflect (exists x, exists2 y, x != y & f x = f y) (~~ injectiveb). Proof. apply: (iffP (dinjectivePn _)) => [[x _ [y nxy eqfxy]] | [x [y nxy eqfxy]]]; by exists x => //; exists y => //; rewrite inE /= andbT eq_sym in nxy *. Qed. Lemma injectiveP : reflect (injective f) injectiveb. Proof. by apply: (iffP (dinjectiveP _)) => injf x y => [|_ _]; apply: injf. Qed. End Injectiveb. Definition image_mem T T' f mA : seq T' := map f (@enum_mem T mA). Notation image f A := (image_mem f (mem A)). Notation "[ 'seq' F | x 'in' A ]" := (image (fun x => F) A) (at level 0, F at level 99, x ident, format "'[hv' [ 'seq' F '/ ' | x 'in' A ] ']'") : seq_scope. Notation "[ 'seq' F | x : T 'in' A ]" := (image (fun x : T => F) A) (at level 0, F at level 99, x ident, only parsing) : seq_scope. Notation "[ 'seq' F | x : T ]" := [seq F | x : T in pred_of_simpl (@pred_of_argType T)] (at level 0, F at level 99, x ident, format "'[hv' [ 'seq' F '/ ' | x : T ] ']'") : seq_scope. Notation "[ 'seq' F , x ]" := [seq F | x : _ ] (at level 0, F at level 99, x ident, only parsing) : seq_scope. Definition codom T T' f := @image_mem T T' f (mem T). Section Image. Variable T : finType. Implicit Type A : {pred T}. Section SizeImage. Variables (T' : Type) (f : T -> T'). Lemma size_image A : size (image f A) = #|A|. Proof. by rewrite size_map -cardE. Qed. Lemma size_codom : size (codom f) = #|T|. Proof. exact: size_image. Qed. Lemma codomE : codom f = map f (enum T). Proof. by []. Qed. End SizeImage. Variables (T' : eqType) (f : T -> T'). Lemma imageP A y : reflect (exists2 x, x \in A & y = f x) (y \in image f A). Proof. by apply: (iffP mapP) => [] [x Ax y_fx]; exists x; rewrite // mem_enum in Ax *. Qed. Lemma codomP y : reflect (exists x, y = f x) (y \in codom f). Proof. by apply: (iffP (imageP _ y)) => [][x]; exists x. Qed. Remark iinv_proof A y : y \in image f A -> {x | x \in A & f x = y}. Proof. move=> fy; pose b x := A x && (f x == y). case: (pickP b) => [x /andP[Ax /eqP] | nfy]; first by exists x. by case/negP: fy => /imageP[x Ax fx_y]; case/andP: (nfy x); rewrite fx_y. Qed. Definition iinv A y fAy := s2val (@iinv_proof A y fAy). Lemma f_iinv A y fAy : f (@iinv A y fAy) = y. Proof. exact: s2valP' (iinv_proof fAy). Qed. Lemma mem_iinv A y fAy : @iinv A y fAy \in A. Proof. exact: s2valP (iinv_proof fAy). Qed. Lemma in_iinv_f A : {in A &, injective f} -> forall x fAfx, x \in A -> @iinv A (f x) fAfx = x. Proof. by move=> injf x fAfx Ax; apply: injf => //; [apply: mem_iinv | apply: f_iinv]. Qed. Lemma preim_iinv A B y fAy : preim f B (@iinv A y fAy) = B y. Proof. by rewrite /= f_iinv. Qed. Lemma image_f A x : x \in A -> f x \in image f A. Proof. by move=> Ax; apply/imageP; exists x. Qed. Lemma codom_f x : f x \in codom f. Proof. exact: image_f. Qed. Lemma image_codom A : {subset image f A <= codom f}. Proof. by move=> _ /imageP[x _ ->]; apply: codom_f. Qed. Lemma image_pred0 : image f pred0 =i pred0. Proof. by move=> x; rewrite /image_mem /= enum0. Qed. Section Injective. Hypothesis injf : injective f. Lemma mem_image A x : (f x \in image f A) = (x \in A). Proof. by rewrite mem_map ?mem_enum. Qed. Lemma pre_image A : [preim f of image f A] =i A. Proof. by move=> x; rewrite inE /= mem_image. Qed. Lemma image_iinv A y (fTy : y \in codom f) : (y \in image f A) = (iinv fTy \in A). Proof. by rewrite -mem_image ?f_iinv. Qed. Lemma iinv_f x fTfx : @iinv T (f x) fTfx = x. Proof. by apply: in_iinv_f; first apply: in2W. Qed. Lemma image_pre (B : pred T') : image f [preim f of B] =i [predI B & codom f]. Proof. by move=> y; rewrite /image_mem -filter_map /= mem_filter -enumT. Qed. Lemma bij_on_codom (x0 : T) : {on [pred y in codom f], bijective f}. Proof. pose g y := iinv (valP (insigd (codom_f x0) y)). by exists g => [x fAfx | y fAy]; first apply: injf; rewrite f_iinv insubdK. Qed. Lemma bij_on_image A (x0 : T) : {on [pred y in image f A], bijective f}. Proof. exact: subon_bij (@image_codom A) (bij_on_codom x0). Qed. End Injective. Fixpoint preim_seq s := if s is y :: s' then (if pick (preim f (pred1 y)) is Some x then cons x else id) (preim_seq s') else [::]. Lemma map_preim (s : seq T') : {subset s <= codom f} -> map f (preim_seq s) = s. Proof. elim: s => //= y s IHs; case: pickP => [x /eqP fx_y | nfTy] fTs. by rewrite /= fx_y IHs // => z s_z; apply: fTs; apply: predU1r. by case/imageP: (fTs y (mem_head y s)) => x _ fx_y; case/eqP: (nfTy x). Qed. End Image. Prenex Implicits codom iinv. Arguments imageP {T T' f A y}. Arguments codomP {T T' f y}. Lemma flatten_imageP (aT : finType) (rT : eqType) (A : aT -> seq rT) (P : {pred aT}) (y : rT) : reflect (exists2 x, x \in P & y \in A x) (y \in flatten [seq A x | x in P]). Proof. by apply: (iffP flatten_mapP) => [][x Px]; exists x; rewrite ?mem_enum in Px *. Qed. Arguments flatten_imageP {aT rT A P y}. Section CardFunImage. Variables (T T' : finType) (f : T -> T'). Implicit Type A : {pred T}. Lemma leq_image_card A : #|image f A| <= #|A|. Proof. by rewrite (cardE A) -(size_map f) card_size. Qed. Lemma card_in_image A : {in A &, injective f} -> #|image f A| = #|A|. Proof. move=> injf; rewrite (cardE A) -(size_map f); apply/card_uniqP. by rewrite map_inj_in_uniq ?enum_uniq // => x y; rewrite !mem_enum; apply: injf. Qed. Lemma image_injP A : reflect {in A &, injective f} (#|image f A| == #|A|). Proof. apply: (iffP eqP) => [eqfA |]; last exact: card_in_image. by apply/dinjectiveP; apply/card_uniqP; rewrite size_map -cardE. Qed. Lemma leq_card_in A : {in A &, injective f} -> #|A| <= #|T'|. Proof. by move=> /card_in_image <-; rewrite max_card. Qed. Hypothesis injf : injective f. Lemma card_image A : #|image f A| = #|A|. Proof. by apply: card_in_image; apply: in2W. Qed. Lemma card_codom : #|codom f| = #|T|. Proof. exact: card_image. Qed. Lemma card_preim (B : {pred T'}) : #|[preim f of B]| = #|[predI codom f & B]|. Proof. rewrite -card_image /=; apply: eq_card => y. by rewrite [y \in _]image_pre !inE andbC. Qed. Lemma leq_card : #|T| <= #|T'|. Proof. exact: (leq_card_in (in2W _)). Qed. Hypothesis card_range : #|T| >= #|T'|. Let eq_card : #|T| = #|T'|. Proof. by apply/eqP; rewrite eqn_leq leq_card. Qed. Lemma inj_card_onto y : y \in codom f. Proof. by move: y; apply/subset_cardP; rewrite ?card_codom ?subset_predT. Qed. Lemma inj_card_bij : bijective f. Proof. by exists (fun y => iinv (inj_card_onto y)) => y; rewrite ?iinv_f ?f_iinv. Qed. End CardFunImage. Arguments image_injP {T T' f A}. Arguments leq_card_in [T T'] f. Arguments leq_card [T T'] f. Section FinCancel. Variables (T : finType) (f g : T -> T). Section Inv. Hypothesis injf : injective f. Lemma injF_onto y : y \in codom f. Proof. exact: inj_card_onto. Qed. Definition invF y := iinv (injF_onto y). Lemma invF_f : cancel f invF. Proof. by move=> x; apply: iinv_f. Qed. Lemma f_invF : cancel invF f. Proof. by move=> y; apply: f_iinv. Qed. Lemma injF_bij : bijective f. Proof. exact: inj_card_bij. Qed. End Inv. Hypothesis fK : cancel f g. Lemma canF_sym : cancel g f. Proof. exact/(bij_can_sym (injF_bij (can_inj fK))). Qed. Lemma canF_LR x y : x = g y -> f x = y. Proof. exact: canLR canF_sym. Qed. Lemma canF_RL x y : g x = y -> x = f y. Proof. exact: canRL canF_sym. Qed. Lemma canF_eq x y : (f x == y) = (x == g y). Proof. exact: (can2_eq fK canF_sym). Qed. Lemma canF_invF : g =1 invF (can_inj fK). Proof. by move=> y; apply: (canLR fK); rewrite f_invF. Qed. End FinCancel. Section EqImage. Variables (T : finType) (T' : Type). Lemma eq_image (A B : {pred T}) (f g : T -> T') : A =i B -> f =1 g -> image f A = image g B. Proof. by move=> eqAB eqfg; rewrite /image_mem (eq_enum eqAB) (eq_map eqfg). Qed. Lemma eq_codom (f g : T -> T') : f =1 g -> codom f = codom g. Proof. exact: eq_image. Qed. Lemma eq_invF f g injf injg : f =1 g -> @invF T f injf =1 @invF T g injg. Proof. by move=> eq_fg x; apply: (canLR (invF_f injf)); rewrite eq_fg f_invF. Qed. End EqImage. (* Standard finTypes *) Lemma unit_enumP : Finite.axiom [::tt]. Proof. by case. Qed. Definition unit_finMixin := Eval hnf in FinMixin unit_enumP. Canonical unit_finType := Eval hnf in FinType unit unit_finMixin. Lemma card_unit : #|{: unit}| = 1. Proof. by rewrite cardT enumT unlock. Qed. Lemma bool_enumP : Finite.axiom [:: true; false]. Proof. by case. Qed. Definition bool_finMixin := Eval hnf in FinMixin bool_enumP. Canonical bool_finType := Eval hnf in FinType bool bool_finMixin. Lemma card_bool : #|{: bool}| = 2. Proof. by rewrite cardT enumT unlock. Qed. Lemma void_enumP : Finite.axiom (Nil void). Proof. by case. Qed. Definition void_finMixin := Eval hnf in FinMixin void_enumP. Canonical void_finType := Eval hnf in FinType void void_finMixin. Lemma card_void : #|{: void}| = 0. Proof. by rewrite cardT enumT unlock. Qed. Local Notation enumF T := (Finite.enum T). Section OptionFinType. Variable T : finType. Definition option_enum := None :: map some (enumF T). Lemma option_enumP : Finite.axiom option_enum. Proof. by case=> [x|]; rewrite /= count_map (count_pred0, enumP). Qed. Definition option_finMixin := Eval hnf in FinMixin option_enumP. Canonical option_finType := Eval hnf in FinType (option T) option_finMixin. Lemma card_option : #|{: option T}| = #|T|.+1. Proof. by rewrite !cardT !enumT [in LHS]unlock /= !size_map. Qed. End OptionFinType. Section TransferFinType. Variables (eT : countType) (fT : finType) (f : eT -> fT). Lemma pcan_enumP g : pcancel f g -> Finite.axiom (undup (pmap g (enumF fT))). Proof. move=> fK x; rewrite count_uniq_mem ?undup_uniq // mem_undup. by rewrite mem_pmap -fK map_f // -enumT mem_enum. Qed. Definition PcanFinMixin g fK := FinMixin (@pcan_enumP g fK). Definition CanFinMixin g (fK : cancel f g) := PcanFinMixin (can_pcan fK). End TransferFinType. Section SubFinType. Variables (T : choiceType) (P : pred T). Import Finite. Structure subFinType := SubFinType { subFin_sort :> subType P; _ : mixin_of (sub_eqType subFin_sort) }. Definition pack_subFinType U := fun cT b m & phant_id (class cT) (@Class U b m) => fun sT m' & phant_id m' m => @SubFinType sT m'. Implicit Type sT : subFinType. Definition subFin_mixin sT := let: SubFinType _ m := sT return mixin_of (sub_eqType sT) in m. Coercion subFinType_subCountType sT := @SubCountType _ _ sT (subFin_mixin sT). Canonical subFinType_subCountType. Coercion subFinType_finType sT := Pack (@Class sT (sub_choiceClass sT) (subFin_mixin sT)). Canonical subFinType_finType. Lemma codom_val sT x : (x \in codom (val : sT -> T)) = P x. Proof. by apply/codomP/idP=> [[u ->]|Px]; last exists (Sub x Px); rewrite ?valP ?SubK. Qed. End SubFinType. (* This assumes that T has both finType and subCountType structures. *) Notation "[ 'subFinType' 'of' T ]" := (@pack_subFinType _ _ T _ _ _ id _ _ id) (at level 0, format "[ 'subFinType' 'of' T ]") : form_scope. Section FinTypeForSub. Variables (T : finType) (P : pred T) (sT : subCountType P). Definition sub_enum : seq sT := pmap insub (enumF T). Lemma mem_sub_enum u : u \in sub_enum. Proof. by rewrite mem_pmap_sub -enumT mem_enum. Qed. Lemma sub_enum_uniq : uniq sub_enum. Proof. by rewrite pmap_sub_uniq // -enumT enum_uniq. Qed. Lemma val_sub_enum : map val sub_enum = enum P. Proof. rewrite pmap_filter; last exact: insubK. by apply: eq_filter => x; apply: isSome_insub. Qed. (* We can't declare a canonical structure here because we've already *) (* stated that subType_sort and FinType.sort unify via to the *) (* subType_finType structure. *) Definition SubFinMixin := UniqFinMixin sub_enum_uniq mem_sub_enum. Definition SubFinMixin_for (eT : eqType) of phant eT := eq_rect _ Finite.mixin_of SubFinMixin eT. Variable sfT : subFinType P. Lemma card_sub : #|sfT| = #|[pred x | P x]|. Proof. by rewrite -(eq_card (codom_val sfT)) (card_image val_inj). Qed. Lemma eq_card_sub (A : {pred sfT}) : A =i predT -> #|A| = #|[pred x | P x]|. Proof. exact: eq_card_trans card_sub. Qed. End FinTypeForSub. (* This assumes that T has a subCountType structure over a type that *) (* has a finType structure. *) Notation "[ 'finMixin' 'of' T 'by' <: ]" := (SubFinMixin_for (Phant T) (erefl _)) (at level 0, format "[ 'finMixin' 'of' T 'by' <: ]") : form_scope. (* Regression for the subFinType stack Record myb : Type := MyB {myv : bool; _ : ~~ myv}. Canonical myb_sub := Eval hnf in [subType for myv]. Definition myb_eqm := Eval hnf in [eqMixin of myb by <:]. Canonical myb_eq := Eval hnf in EqType myb myb_eqm. Definition myb_chm := [choiceMixin of myb by <:]. Canonical myb_ch := Eval hnf in ChoiceType myb myb_chm. Definition myb_cntm := [countMixin of myb by <:]. Canonical myb_cnt := Eval hnf in CountType myb myb_cntm. Canonical myb_scnt := Eval hnf in [subCountType of myb]. Definition myb_finm := [finMixin of myb by <:]. Canonical myb_fin := Eval hnf in FinType myb myb_finm. Canonical myb_sfin := Eval hnf in [subFinType of myb]. Print Canonical Projections. Print myb_finm. Print myb_cntm. *) Section CardSig. Variables (T : finType) (P : pred T). Definition sig_finMixin := [finMixin of {x | P x} by <:]. Canonical sig_finType := Eval hnf in FinType {x | P x} sig_finMixin. Canonical sig_subFinType := Eval hnf in [subFinType of {x | P x}]. Lemma card_sig : #|{: {x | P x}}| = #|[pred x | P x]|. Proof. exact: card_sub. Qed. End CardSig. (* Subtype for an explicit enumeration. *) Section SeqSubType. Variables (T : eqType) (s : seq T). Record seq_sub : Type := SeqSub {ssval : T; ssvalP : in_mem ssval (@mem T _ s)}. Canonical seq_sub_subType := Eval hnf in [subType for ssval]. Definition seq_sub_eqMixin := Eval hnf in [eqMixin of seq_sub by <:]. Canonical seq_sub_eqType := Eval hnf in EqType seq_sub seq_sub_eqMixin. Definition seq_sub_enum : seq seq_sub := undup (pmap insub s). Lemma mem_seq_sub_enum x : x \in seq_sub_enum. Proof. by rewrite mem_undup mem_pmap -valK map_f ?ssvalP. Qed. Lemma val_seq_sub_enum : uniq s -> map val seq_sub_enum = s. Proof. move=> Us; rewrite /seq_sub_enum undup_id ?pmap_sub_uniq //. rewrite (pmap_filter (insubK _)); apply/all_filterP. by apply/allP => x; rewrite isSome_insub. Qed. Definition seq_sub_pickle x := index x seq_sub_enum. Definition seq_sub_unpickle n := nth None (map some seq_sub_enum) n. Lemma seq_sub_pickleK : pcancel seq_sub_pickle seq_sub_unpickle. Proof. rewrite /seq_sub_unpickle => x. by rewrite (nth_map x) ?nth_index ?index_mem ?mem_seq_sub_enum. Qed. Definition seq_sub_countMixin := CountMixin seq_sub_pickleK. Fact seq_sub_axiom : Finite.axiom seq_sub_enum. Proof. exact: Finite.uniq_enumP (undup_uniq _) mem_seq_sub_enum. Qed. Definition seq_sub_finMixin := Finite.Mixin seq_sub_countMixin seq_sub_axiom. (* Beware: these are not the canonical instances, as they are not consistent *) (* with the generic sub_choiceType canonical instance. *) Definition adhoc_seq_sub_choiceMixin := PcanChoiceMixin seq_sub_pickleK. Definition adhoc_seq_sub_choiceType := Eval hnf in ChoiceType seq_sub adhoc_seq_sub_choiceMixin. Definition adhoc_seq_sub_finType := [finType of seq_sub for FinType adhoc_seq_sub_choiceType seq_sub_finMixin]. End SeqSubType. Section SeqReplace. Variables (T : eqType). Implicit Types (s : seq T). Lemma seq_sub_default s : size s > 0 -> seq_sub s. Proof. by case: s => // x s _; exists x; rewrite mem_head. Qed. Lemma seq_subE s (s_gt0 : size s > 0) : s = map val (map (insubd (seq_sub_default s_gt0)) s : seq (seq_sub s)). Proof. by rewrite -map_comp map_id_in// => x x_in_s /=; rewrite insubdK. Qed. End SeqReplace. Notation in_sub_seq s_gt0 := (insubd (seq_sub_default s_gt0)). Section SeqFinType. Variables (T : choiceType) (s : seq T). Local Notation sT := (seq_sub s). Definition seq_sub_choiceMixin := [choiceMixin of sT by <:]. Canonical seq_sub_choiceType := Eval hnf in ChoiceType sT seq_sub_choiceMixin. Canonical seq_sub_countType := Eval hnf in CountType sT (seq_sub_countMixin s). Canonical seq_sub_subCountType := Eval hnf in [subCountType of sT]. Canonical seq_sub_finType := Eval hnf in FinType sT (seq_sub_finMixin s). Canonical seq_sub_subFinType := Eval hnf in [subFinType of sT]. Lemma card_seq_sub : uniq s -> #|{:sT}| = size s. Proof. by move=> Us; rewrite cardE enumT -(size_map val) unlock val_seq_sub_enum. Qed. End SeqFinType. Section Extrema. Variant extremum_spec {T : eqType} (ord : rel T) {I : finType} (P : pred I) (F : I -> T) : I -> Type := ExtremumSpec (i : I) of P i & (forall j : I, P j -> ord (F i) (F j)) : extremum_spec ord P F i. Let arg_pred {T : eqType} ord {I : finType} (P : pred I) (F : I -> T) := [pred i | P i & [forall (j | P j), ord (F i) (F j)]]. Section Extremum. Context {T : eqType} {I : finType} (ord : rel T). Context (i0 : I) (P : pred I) (F : I -> T). Definition extremum := odflt i0 (pick (arg_pred ord P F)). Hypothesis ord_refl : reflexive ord. Hypothesis ord_trans : transitive ord. Hypothesis ord_total : total ord. Hypothesis Pi0 : P i0. Lemma extremumP : extremum_spec ord P F extremum. Proof. rewrite /extremum; case: pickP => [i /andP[Pi /'forall_implyP/= min_i] | no_i]. by split=> // j; apply/implyP. have := sort_sorted ord_total [seq F i | i <- enum P]. set s := sort _ _ => ss; have s_gt0 : size s > 0 by rewrite size_sort size_map -cardE; apply/card_gt0P; exists i0. pose t0 := nth (F i0) s 0; have: t0 \in s by rewrite mem_nth. rewrite mem_sort => /mapP/sig2_eqW[it0]; rewrite mem_enum => it0P def_t0. have /negP[/=] := no_i it0; rewrite [P _]it0P/=; apply/'forall_implyP=> j Pj. have /(nthP (F i0))[k g_lt <-] : F j \in s by rewrite mem_sort map_f ?mem_enum. by rewrite -def_t0 sorted_leq_nth. Qed. End Extremum. Section ExtremumIn. Context {T : eqType} {I : finType} (ord : rel T). Context (i0 : I) (P : pred I) (F : I -> T). Hypothesis ord_refl : {in P, reflexive (relpre F ord)}. Hypothesis ord_trans : {in P & P & P, transitive (relpre F ord)}. Hypothesis ord_total : {in P &, total (relpre F ord)}. Hypothesis Pi0 : P i0. Lemma extremum_inP : extremum_spec ord P F (extremum ord i0 P F). Proof. rewrite /extremum; case: pickP => [i /andP[Pi /'forall_implyP/= min_i] | no_i]. by split=> // j; apply/implyP. pose TP := seq_sub [seq F i | i <- enum P]. have FPP (iP : {i | P i}) : F (proj1_sig iP) \in [seq F i | i <- enum P]. by rewrite map_f// mem_enum; apply: valP. pose FP := SeqSub (FPP _). have []//= := @extremumP _ _ (relpre val ord) (exist P i0 Pi0) xpredT FP. - by move=> [/= _/mapP[i iP ->]]; apply: ord_refl; rewrite mem_enum in iP. - move=> [/= _/mapP[j jP ->]] [/= _/mapP[i iP ->]] [/= _/mapP[k kP ->]]. by apply: ord_trans; rewrite !mem_enum in iP jP kP. - move=> [/= _/mapP[i iP ->]] [/= _/mapP[j jP ->]]. by apply: ord_total; rewrite !mem_enum in iP jP. - rewrite /FP => -[/= i Pi] _ /(_ (exist _ _ _))/= ordF. have /negP/negP/= := no_i i; rewrite Pi/= negb_forall => /existsP/sigW[j]. by rewrite negb_imply => /andP[Pj]; rewrite ordF. Qed. End ExtremumIn. 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 ]") : 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 ]") : 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 ]") : nat_scope. Section ArgMinMax. Variables (I : finType) (i0 : I) (P : pred I) (F : I -> nat) (Pi0 : P i0). Definition arg_min := extremum leq i0 P F. Definition arg_max := extremum geq i0 P F. Lemma arg_minnP : extremum_spec leq P F arg_min. Proof. by apply: extremumP => //; [apply: leq_trans|apply: leq_total]. Qed. Lemma arg_maxnP : extremum_spec geq P F arg_max. Proof. apply: extremumP => //; first exact: leqnn. by move=> n m p mn np; apply: leq_trans mn. by move=> ??; apply: leq_total. Qed. End ArgMinMax. End Extrema. Notation "@ 'arg_minP'" := (deprecate arg_minP arg_minnP) (at level 10, only parsing) : fun_scope. Notation arg_minP := (@arg_minP _ _ _) (only parsing). Notation "@ 'arg_maxP'" := (deprecate arg_maxP arg_maxnP) (at level 10, only parsing) : fun_scope. Notation arg_maxP := (@arg_maxP _ _ _) (only parsing). 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 ]") : 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 ]") : 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 ]") : 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 ]") : 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 ]") : 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 ]") : nat_scope. (**********************************************************************) (* *) (* Ordinal finType : {0, ... , n-1} *) (* *) (**********************************************************************) Section OrdinalSub. Variable n : nat. Inductive ordinal : predArgType := Ordinal m of m < n. Coercion nat_of_ord i := let: Ordinal m _ := i in m. Canonical ordinal_subType := [subType for nat_of_ord]. Definition ordinal_eqMixin := Eval hnf in [eqMixin of ordinal by <:]. Canonical ordinal_eqType := Eval hnf in EqType ordinal ordinal_eqMixin. Definition ordinal_choiceMixin := [choiceMixin of ordinal by <:]. Canonical ordinal_choiceType := Eval hnf in ChoiceType ordinal ordinal_choiceMixin. Definition ordinal_countMixin := [countMixin of ordinal by <:]. Canonical ordinal_countType := Eval hnf in CountType ordinal ordinal_countMixin. Canonical ordinal_subCountType := [subCountType of ordinal]. Lemma ltn_ord (i : ordinal) : i < n. Proof. exact: valP i. Qed. Lemma ord_inj : injective nat_of_ord. Proof. exact: val_inj. Qed. Definition ord_enum : seq ordinal := pmap insub (iota 0 n). Lemma val_ord_enum : map val ord_enum = iota 0 n. Proof. rewrite pmap_filter; last exact: insubK. by apply/all_filterP; apply/allP=> i; rewrite mem_iota isSome_insub. Qed. Lemma ord_enum_uniq : uniq ord_enum. Proof. by rewrite pmap_sub_uniq ?iota_uniq. Qed. Lemma mem_ord_enum i : i \in ord_enum. Proof. by rewrite -(mem_map ord_inj) val_ord_enum mem_iota ltn_ord. Qed. Definition ordinal_finMixin := Eval hnf in UniqFinMixin ord_enum_uniq mem_ord_enum. Canonical ordinal_finType := Eval hnf in FinType ordinal ordinal_finMixin. Canonical ordinal_subFinType := Eval hnf in [subFinType of ordinal]. End OrdinalSub. Notation "''I_' n" := (ordinal n) (at level 8, n at level 2, format "''I_' n"). Hint Resolve ltn_ord : core. Section OrdinalEnum. Variable n : nat. Lemma val_enum_ord : map val (enum 'I_n) = iota 0 n. Proof. by rewrite enumT unlock val_ord_enum. Qed. Lemma size_enum_ord : size (enum 'I_n) = n. Proof. by rewrite -(size_map val) val_enum_ord size_iota. Qed. Lemma card_ord : #|'I_n| = n. Proof. by rewrite cardE size_enum_ord. Qed. Lemma nth_enum_ord i0 m : m < n -> nth i0 (enum 'I_n) m = m :> nat. Proof. by move=> ?; rewrite -(nth_map _ 0) (size_enum_ord, val_enum_ord) // nth_iota. Qed. Lemma nth_ord_enum (i0 i : 'I_n) : nth i0 (enum 'I_n) i = i. Proof. by apply: val_inj; apply: nth_enum_ord. Qed. Lemma index_enum_ord (i : 'I_n) : index i (enum 'I_n) = i. Proof. by rewrite -[in LHS](nth_ord_enum i i) index_uniq ?(enum_uniq, size_enum_ord). Qed. Lemma mask_enum_ord m : mask m (enum 'I_n) = [seq i <- enum 'I_n | nth false m (val i)]. Proof. rewrite mask_filter ?enum_uniq//; apply: eq_filter => i. by rewrite in_mask ?enum_uniq ?mem_enum// index_enum_ord. Qed. End OrdinalEnum. Lemma widen_ord_proof n m (i : 'I_n) : n <= m -> i < m. Proof. exact: leq_trans. Qed. Definition widen_ord n m le_n_m i := Ordinal (@widen_ord_proof n m i le_n_m). Lemma cast_ord_proof n m (i : 'I_n) : n = m -> i < m. Proof. by move <-. Qed. Definition cast_ord n m eq_n_m i := Ordinal (@cast_ord_proof n m i eq_n_m). Lemma cast_ord_id n eq_n i : cast_ord eq_n i = i :> 'I_n. Proof. exact: val_inj. Qed. Lemma cast_ord_comp n1 n2 n3 eq_n2 eq_n3 i : @cast_ord n2 n3 eq_n3 (@cast_ord n1 n2 eq_n2 i) = cast_ord (etrans eq_n2 eq_n3) i. Proof. exact: val_inj. Qed. Lemma cast_ordK n1 n2 eq_n : cancel (@cast_ord n1 n2 eq_n) (cast_ord (esym eq_n)). Proof. by move=> i; apply: val_inj. Qed. Lemma cast_ordKV n1 n2 eq_n : cancel (cast_ord (esym eq_n)) (@cast_ord n1 n2 eq_n). Proof. by move=> i; apply: val_inj. Qed. Lemma cast_ord_inj n1 n2 eq_n : injective (@cast_ord n1 n2 eq_n). Proof. exact: can_inj (cast_ordK eq_n). Qed. Lemma rev_ord_proof n (i : 'I_n) : n - i.+1 < n. Proof. by case: n i => [|n] [i lt_i_n] //; rewrite ltnS subSS leq_subr. Qed. Definition rev_ord n i := Ordinal (@rev_ord_proof n i). Lemma rev_ordK {n} : involutive (@rev_ord n). Proof. by case: n => [|n] [i lti] //; apply: val_inj; rewrite /= !subSS subKn. Qed. Lemma rev_ord_inj {n} : injective (@rev_ord n). Proof. exact: inv_inj rev_ordK. Qed. Lemma inj_leq m n (f : 'I_m -> 'I_n) : injective f -> m <= n. Proof. by move=> /leq_card; rewrite !card_ord. Qed. Arguments inj_leq [m n] f _. (* bijection between any finType T and the Ordinal finType of its cardinal *) Section EnumRank. Variable T : finType. Implicit Type A : {pred T}. Lemma enum_rank_subproof x0 A : x0 \in A -> 0 < #|A|. Proof. by move=> Ax0; rewrite (cardD1 x0) Ax0. Qed. Definition enum_rank_in x0 A (Ax0 : x0 \in A) x := insubd (Ordinal (@enum_rank_subproof x0 [eta A] Ax0)) (index x (enum A)). Definition enum_rank x := @enum_rank_in x T (erefl true) x. Lemma enum_default A : 'I_(#|A|) -> T. Proof. by rewrite cardE; case: (enum A) => [|//] []. Qed. Definition enum_val A i := nth (@enum_default [eta A] i) (enum A) i. Prenex Implicits enum_val. Lemma enum_valP A i : @enum_val A i \in A. Proof. by rewrite -mem_enum mem_nth -?cardE. Qed. Lemma enum_val_nth A x i : @enum_val A i = nth x (enum A) i. Proof. by apply: set_nth_default; rewrite cardE in i *; apply: ltn_ord. Qed. Lemma nth_image T' y0 (f : T -> T') A (i : 'I_#|A|) : nth y0 (image f A) i = f (enum_val i). Proof. by rewrite -(nth_map _ y0) // -cardE. Qed. Lemma nth_codom T' y0 (f : T -> T') (i : 'I_#|T|) : nth y0 (codom f) i = f (enum_val i). Proof. exact: nth_image. Qed. Lemma nth_enum_rank_in x00 x0 A Ax0 : {in A, cancel (@enum_rank_in x0 A Ax0) (nth x00 (enum A))}. Proof. move=> x Ax; rewrite /= insubdK ?nth_index ?mem_enum //. by rewrite cardE [_ \in _]index_mem mem_enum. Qed. Lemma nth_enum_rank x0 : cancel enum_rank (nth x0 (enum T)). Proof. by move=> x; apply: nth_enum_rank_in. Qed. Lemma enum_rankK_in x0 A Ax0 : {in A, cancel (@enum_rank_in x0 A Ax0) enum_val}. Proof. by move=> x; apply: nth_enum_rank_in. Qed. Lemma enum_rankK : cancel enum_rank enum_val. Proof. by move=> x; apply: enum_rankK_in. Qed. Lemma enum_valK_in x0 A Ax0 : cancel enum_val (@enum_rank_in x0 A Ax0). Proof. move=> x; apply: ord_inj; rewrite insubdK; last first. by rewrite cardE [_ \in _]index_mem mem_nth // -cardE. by rewrite index_uniq ?enum_uniq // -cardE. Qed. Lemma enum_valK : cancel enum_val enum_rank. Proof. by move=> x; apply: enum_valK_in. Qed. Lemma enum_rank_inj : injective enum_rank. Proof. exact: can_inj enum_rankK. Qed. Lemma enum_val_inj A : injective (@enum_val A). Proof. by move=> i; apply: can_inj (enum_valK_in (enum_valP i)) (i). Qed. Lemma enum_val_bij_in x0 A : x0 \in A -> {on A, bijective (@enum_val A)}. Proof. move=> Ax0; exists (enum_rank_in Ax0) => [i _|]; last exact: enum_rankK_in. exact: enum_valK_in. Qed. Lemma eq_enum_rank_in (x0 y0 : T) A (Ax0 : x0 \in A) (Ay0 : y0 \in A) : {in A, enum_rank_in Ax0 =1 enum_rank_in Ay0}. Proof. by move=> x xA; apply: enum_val_inj; rewrite !enum_rankK_in. Qed. Lemma enum_rank_in_inj (x0 y0 : T) A (Ax0 : x0 \in A) (Ay0 : y0 \in A) : {in A &, forall x y, enum_rank_in Ax0 x = enum_rank_in Ay0 y -> x = y}. Proof. by move=> x y xA yA /(congr1 enum_val); rewrite !enum_rankK_in. Qed. Lemma enum_rank_bij : bijective enum_rank. Proof. by move: enum_rankK enum_valK; exists (@enum_val T). Qed. Lemma enum_val_bij : bijective (@enum_val T). Proof. by move: enum_rankK enum_valK; exists enum_rank. Qed. (* Due to the limitations of the Coq unification patterns, P can only be *) (* inferred from the premise of this lemma, not its conclusion. As a result *) (* this lemma will only be usable in forward chaining style. *) Lemma fin_all_exists U (P : forall x : T, U x -> Prop) : (forall x, exists u, P x u) -> (exists u, forall x, P x (u x)). Proof. move=> ex_u; pose Q m x := enum_rank x < m -> {ux | P x ux}. suffices: forall m, m <= #|T| -> exists w : forall x, Q m x, True. case/(_ #|T|)=> // w _; pose u x := sval (w x (ltn_ord _)). by exists u => x; rewrite {}/u; case: (w x _). elim=> [|m IHm] ltmX; first by have w x: Q 0 x by []; exists w. have{IHm} [w _] := IHm (ltnW ltmX); pose i := Ordinal ltmX. have [u Pu] := ex_u (enum_val i); suffices w' x: Q m.+1 x by exists w'. rewrite /Q ltnS leq_eqVlt (val_eqE _ i); case: eqP => [def_i _ | _ /w //]. by rewrite -def_i enum_rankK in u Pu; exists u. Qed. Lemma fin_all_exists2 U (P Q : forall x : T, U x -> Prop) : (forall x, exists2 u, P x u & Q x u) -> (exists2 u, forall x, P x (u x) & forall x, Q x (u x)). Proof. move=> ex_u; have (x): exists u, P x u /\ Q x u by have [u] := ex_u x; exists u. by case/fin_all_exists=> u /all_and2[]; exists u. Qed. End EnumRank. Arguments enum_val_inj {T A} [i1 i2] : rename. Arguments enum_rank_inj {T} [x1 x2]. Prenex Implicits enum_val enum_rank enum_valK enum_rankK. Lemma enum_rank_ord n i : enum_rank i = cast_ord (esym (card_ord n)) i. Proof. by apply: val_inj; rewrite insubdK ?index_enum_ord // card_ord [_ \in _]ltn_ord. Qed. Lemma enum_val_ord n i : enum_val i = cast_ord (card_ord n) i. Proof. by apply: canLR (@enum_rankK _) _; apply: val_inj; rewrite enum_rank_ord. Qed. (* The integer bump / unbump operations. *) Definition bump h i := (h <= i) + i. Definition unbump h i := i - (h < i). Lemma bumpK h : cancel (bump h) (unbump h). Proof. rewrite /bump /unbump => i. have [le_hi | lt_ih] := leqP h i; first by rewrite ltnS le_hi subn1. by rewrite ltnNge ltnW ?subn0. Qed. Lemma neq_bump h i : h != bump h i. Proof. rewrite /bump eqn_leq; have [le_hi | lt_ih] := leqP h i. by rewrite ltnNge le_hi andbF. by rewrite leqNgt lt_ih. Qed. Lemma unbumpKcond h i : bump h (unbump h i) = (i == h) + i. Proof. rewrite /bump /unbump leqNgt -subSKn. case: (ltngtP i h) => /= [-> | ltih | ->] //; last by rewrite ltnn. by rewrite subn1 /= leqNgt !(ltn_predK ltih, ltih, add1n). Qed. Lemma unbumpK {h} : {in predC1 h, cancel (unbump h) (bump h)}. Proof. by move=> i /negbTE-neq_h_i; rewrite unbumpKcond neq_h_i. Qed. Lemma bumpDl h i k : bump (k + h) (k + i) = k + bump h i. Proof. by rewrite /bump leq_add2l addnCA. Qed. Lemma bumpS h i : bump h.+1 i.+1 = (bump h i).+1. Proof. exact: addnS. Qed. Lemma unbumpDl h i k : unbump (k + h) (k + i) = k + unbump h i. Proof. apply: (can_inj (bumpK (k + h))). by rewrite bumpDl !unbumpKcond eqn_add2l addnCA. Qed. Lemma unbumpS h i : unbump h.+1 i.+1 = (unbump h i).+1. Proof. exact: unbumpDl 1. Qed. Lemma leq_bump h i j : (i <= bump h j) = (unbump h i <= j). Proof. rewrite /bump leq_subLR. case: (leqP i h) (leqP h j) => [le_i_h | lt_h_i] [le_h_j | lt_j_h] //. by rewrite leqW (leq_trans le_i_h). by rewrite !(leqNgt i) ltnW (leq_trans _ lt_h_i). Qed. Lemma leq_bump2 h i j : (bump h i <= bump h j) = (i <= j). Proof. by rewrite leq_bump bumpK. Qed. Lemma bumpC h1 h2 i : bump h1 (bump h2 i) = bump (bump h1 h2) (bump (unbump h2 h1) i). Proof. rewrite {1 5}/bump -leq_bump addnCA; congr (_ + (_ + _)). rewrite 2!leq_bump /unbump /bump; case: (leqP h1 h2) => [le_h12 | lt_h21]. by rewrite subn0 ltnS le_h12 subn1. by rewrite subn1 (ltn_predK lt_h21) (leqNgt h1) lt_h21 subn0. Qed. (* The lift operations on ordinals; to avoid a messy dependent type, *) (* unlift is a partial operation (returns an option). *) Lemma lift_subproof n h (i : 'I_n.-1) : bump h i < n. Proof. by case: n i => [[]|n] //= i; rewrite -addnS (leq_add (leq_b1 _)). Qed. Definition lift n (h : 'I_n) (i : 'I_n.-1) := Ordinal (lift_subproof h i). Lemma unlift_subproof n (h : 'I_n) (u : {j | j != h}) : unbump h (val u) < n.-1. Proof. case: n h u => [|n h] [] //= j ne_jh. rewrite -(leq_bump2 h.+1) bumpS unbumpK // /bump. case: (ltngtP n h) => [|_|eq_nh]; rewrite ?(leqNgt _ h) ?ltn_ord //. by rewrite ltn_neqAle [j <= _](valP j) {2}eq_nh andbT. Qed. Definition unlift n (h i : 'I_n) := omap (fun u : {j | j != h} => Ordinal (unlift_subproof u)) (insub i). Variant unlift_spec n h i : option 'I_n.-1 -> Type := | UnliftSome j of i = lift h j : unlift_spec h i (Some j) | UnliftNone of i = h : unlift_spec h i None. Lemma unliftP n (h i : 'I_n) : unlift_spec h i (unlift h i). Proof. rewrite /unlift; case: insubP => [u nhi | ] def_i /=; constructor. by apply: val_inj; rewrite /= def_i unbumpK. by rewrite negbK in def_i; apply/eqP. Qed. Lemma neq_lift n (h : 'I_n) i : h != lift h i. Proof. exact: neq_bump. Qed. Lemma eq_liftF n (h : 'I_n) i : (h == lift h i) = false. Proof. exact/negbTE/neq_lift. Qed. Lemma lift_eqF n (h : 'I_n) i : (lift h i == h) = false. Proof. by rewrite eq_sym eq_liftF. Qed. Lemma unlift_none n (h : 'I_n) : unlift h h = None. Proof. by case: unliftP => // j Dh; case/eqP: (neq_lift h j). Qed. Lemma unlift_some n (h i : 'I_n) : h != i -> {j | i = lift h j & unlift h i = Some j}. Proof. rewrite eq_sym => /eqP neq_ih. by case Dui: (unlift h i) / (unliftP h i) => [j Dh|//]; exists j. Qed. Lemma lift_inj n (h : 'I_n) : injective (lift h). Proof. by move=> i1 i2 [/(can_inj (bumpK h))/val_inj]. Qed. Arguments lift_inj {n h} [i1 i2] eq_i12h : rename. Lemma liftK n (h : 'I_n) : pcancel (lift h) (unlift h). Proof. by move=> i; case: (unlift_some (neq_lift h i)) => j /lift_inj->. Qed. (* Shifting and splitting indices, for cutting and pasting arrays *) Lemma lshift_subproof m n (i : 'I_m) : i < m + n. Proof. by apply: leq_trans (valP i) _; apply: leq_addr. Qed. Lemma rshift_subproof m n (i : 'I_n) : m + i < m + n. Proof. by rewrite ltn_add2l. Qed. Definition lshift m n (i : 'I_m) := Ordinal (lshift_subproof n i). Definition rshift m n (i : 'I_n) := Ordinal (rshift_subproof m i). Lemma lshift_inj m n : injective (@lshift m n). Proof. by move=> ? ? /(f_equal val) /= /val_inj. Qed. Lemma rshift_inj m n : injective (@rshift m n). Proof. by move=> ? ? /(f_equal val) /addnI /val_inj. Qed. Lemma eq_lshift m n i j : (@lshift m n i == @lshift m n j) = (i == j). Proof. by rewrite (inj_eq (@lshift_inj _ _)). Qed. Lemma eq_rshift m n i j : (@rshift m n i == @rshift m n j) = (i == j). Proof. by rewrite (inj_eq (@rshift_inj _ _)). Qed. Lemma eq_lrshift m n i j : (@lshift m n i == @rshift m n j) = false. Proof. apply/eqP=> /(congr1 val)/= def_i; have := ltn_ord i. by rewrite def_i -ltn_subRL subnn. Qed. Lemma eq_rlshift m n i j : (@rshift m n i == @lshift m n j) = false. Proof. by rewrite eq_sym eq_lrshift. Qed. Definition eq_shift := (eq_lshift, eq_rshift, eq_lrshift, eq_rlshift). Lemma split_subproof m n (i : 'I_(m + n)) : i >= m -> i - m < n. Proof. by move/subSn <-; rewrite leq_subLR. Qed. Definition split {m n} (i : 'I_(m + n)) : 'I_m + 'I_n := match ltnP (i) m with | LtnNotGeq lt_i_m => inl _ (Ordinal lt_i_m) | GeqNotLtn ge_i_m => inr _ (Ordinal (split_subproof ge_i_m)) end. Variant split_spec m n (i : 'I_(m + n)) : 'I_m + 'I_n -> bool -> Type := | SplitLo (j : 'I_m) of i = j :> nat : split_spec i (inl _ j) true | SplitHi (k : 'I_n) of i = m + k :> nat : split_spec i (inr _ k) false. Lemma splitP m n (i : 'I_(m + n)) : split_spec i (split i) (i < m). Proof. (* We need to prevent the case on ltnP from rewriting the hidden constructor *) (* argument types of the match branches exposed by unfolding split. If the *) (* match representation is changed to omit these then this proof could reduce *) (* to by rewrite /split; case: ltnP; [left | right. rewrite subnKC]. *) set lt_i_m := i < m; rewrite /split. by case: _ _ _ _ {-}_ lt_i_m / ltnP; [left | right; rewrite subnKC]. Qed. Variant split_ord_spec m n (i : 'I_(m + n)) : 'I_m + 'I_n -> bool -> Type := | SplitOrdLo (j : 'I_m) of i = lshift _ j : split_ord_spec i (inl _ j) true | SplitOrdHi (k : 'I_n) of i = rshift _ k : split_ord_spec i (inr _ k) false. Lemma split_ordP m n (i : 'I_(m + n)) : split_ord_spec i (split i) (i < m). Proof. by case: splitP; [left|right]; apply: val_inj. Qed. Definition unsplit {m n} (jk : 'I_m + 'I_n) := match jk with inl j => lshift n j | inr k => rshift m k end. Lemma ltn_unsplit m n (jk : 'I_m + 'I_n) : (unsplit jk < m) = jk. Proof. by case: jk => [j|k]; rewrite /= ?ltn_ord // ltnNge leq_addr. Qed. Lemma splitK {m n} : cancel (@split m n) unsplit. Proof. by move=> i; case: split_ordP. Qed. Lemma unsplitK {m n} : cancel (@unsplit m n) split. Proof. by move=> [j|k]; case: split_ordP => ? /eqP; rewrite eq_shift// => /eqP->. Qed. Section OrdinalPos. Variable n' : nat. Local Notation n := n'.+1. Definition ord0 := Ordinal (ltn0Sn n'). Definition ord_max := Ordinal (ltnSn n'). Lemma leq_ord (i : 'I_n) : i <= n'. Proof. exact: valP i. Qed. Lemma sub_ord_proof m : n' - m < n. Proof. by rewrite ltnS leq_subr. Qed. Definition sub_ord m := Ordinal (sub_ord_proof m). Lemma sub_ordK (i : 'I_n) : n' - (n' - i) = i. Proof. by rewrite subKn ?leq_ord. Qed. Definition inord m : 'I_n := insubd ord0 m. Lemma inordK m : m < n -> inord m = m :> nat. Proof. by move=> lt_m; rewrite val_insubd lt_m. Qed. Lemma inord_val (i : 'I_n) : inord i = i. Proof. by rewrite /inord /insubd valK. Qed. Lemma enum_ordS : enum 'I_n = ord0 :: map (lift ord0) (enum 'I_n'). Proof. apply: (inj_map val_inj); rewrite val_enum_ord /= -map_comp. by rewrite (map_comp (addn 1)) val_enum_ord -iotaDl. Qed. Lemma lift_max (i : 'I_n') : lift ord_max i = i :> nat. Proof. by rewrite /= /bump leqNgt ltn_ord. Qed. Lemma lift0 (i : 'I_n') : lift ord0 i = i.+1 :> nat. Proof. by []. Qed. End OrdinalPos. Arguments ord0 {n'}. Arguments ord_max {n'}. Arguments inord {n'}. Arguments sub_ord {n'}. Arguments sub_ordK {n'}. Arguments inord_val {n'}. Lemma ord1 : all_equal_to (ord0 : 'I_1). Proof. by case=> [[] // ?]; apply: val_inj. Qed. (* Product of two fintypes which is a fintype *) Section ProdFinType. Variable T1 T2 : finType. Definition prod_enum := [seq (x1, x2) | x1 <- enum T1, x2 <- enum T2]. Lemma predX_prod_enum (A1 : {pred T1}) (A2 : {pred T2}) : count [predX A1 & A2] prod_enum = #|A1| * #|A2|. Proof. rewrite !cardE !size_filter -!enumT /prod_enum. elim: (enum T1) => //= x1 s1 IHs; rewrite count_cat {}IHs count_map /preim /=. by case: (x1 \in A1); rewrite ?count_pred0. Qed. Lemma prod_enumP : Finite.axiom prod_enum. Proof. by case=> x1 x2; rewrite (predX_prod_enum (pred1 x1) (pred1 x2)) !card1. Qed. Definition prod_finMixin := Eval hnf in FinMixin prod_enumP. Canonical prod_finType := Eval hnf in FinType (T1 * T2) prod_finMixin. Lemma cardX (A1 : {pred T1}) (A2 : {pred T2}) : #|[predX A1 & A2]| = #|A1| * #|A2|. Proof. by rewrite -predX_prod_enum unlock size_filter unlock. Qed. Lemma card_prod : #|{: T1 * T2}| = #|T1| * #|T2|. Proof. by rewrite -cardX; apply: eq_card; case. Qed. Lemma eq_card_prod (A : {pred (T1 * T2)}) : A =i predT -> #|A| = #|T1| * #|T2|. Proof. exact: eq_card_trans card_prod. Qed. End ProdFinType. Section TagFinType. Variables (I : finType) (T_ : I -> finType). Definition tag_enum := flatten [seq [seq Tagged T_ x | x <- enumF (T_ i)] | i <- enumF I]. Lemma tag_enumP : Finite.axiom tag_enum. Proof. case=> i x; rewrite -(enumP i) /tag_enum -enumT. elim: (enum I) => //= j e IHe. rewrite count_cat count_map {}IHe; congr (_ + _). rewrite -size_filter -cardE /=; case: eqP => [-> | ne_j_i]. by apply: (@eq_card1 _ x) => y; rewrite -topredE /= tagged_asE ?eqxx. by apply: eq_card0 => y. Qed. Definition tag_finMixin := Eval hnf in FinMixin tag_enumP. Canonical tag_finType := Eval hnf in FinType {i : I & T_ i} tag_finMixin. Lemma card_tagged : #|{: {i : I & T_ i}}| = sumn (map (fun i => #|T_ i|) (enum I)). Proof. rewrite cardE !enumT [in LHS]unlock size_flatten /shape -map_comp. by congr (sumn _); apply: eq_map => i; rewrite /= size_map -enumT -cardE. Qed. End TagFinType. Section SumFinType. Variables T1 T2 : finType. Definition sum_enum := [seq inl _ x | x <- enumF T1] ++ [seq inr _ y | y <- enumF T2]. Lemma sum_enum_uniq : uniq sum_enum. Proof. rewrite cat_uniq -!enumT !(enum_uniq, map_inj_uniq); try by move=> ? ? []. by rewrite andbT; apply/hasP=> [[_ /mapP[x _ ->] /mapP[]]]. Qed. Lemma mem_sum_enum u : u \in sum_enum. Proof. by case: u => x; rewrite mem_cat -!enumT map_f ?mem_enum ?orbT. Qed. Definition sum_finMixin := Eval hnf in UniqFinMixin sum_enum_uniq mem_sum_enum. Canonical sum_finType := Eval hnf in FinType (T1 + T2) sum_finMixin. Lemma card_sum : #|{: T1 + T2}| = #|T1| + #|T2|. Proof. by rewrite !cardT !enumT [in LHS]unlock size_cat !size_map. Qed. End SumFinType. Notation bump_addl := (deprecate bump_addl bumpDl) (only parsing). Notation unbump_addl := (deprecate unbump_addl unbumpDl) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/generic_quotient.v000066400000000000000000000655521375767750300246640ustar00rootroot00000000000000(* (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. From mathcomp Require Import seq fintype. (*****************************************************************************) (* Provided a base type T, this files defines an interface for quotients Q *) (* of the type T with explicit functions for canonical surjection (\pi *) (* : T -> Q) and for choosing a representative (repr : Q -> T). It then *) (* provide a helper to quotient T by a decidable equivalence relation (e *) (* : rel T) if T is a choiceType (or encodable as a choiceType modulo e). *) (* *) (* See "Pragmatic Quotient Types in Coq", proceedings of ITP2013, *) (* by Cyril Cohen. *) (* *) (* *** Generic Quotienting *** *) (* QuotClass (reprK : cancel repr pi) == builds the quotient which *) (* canonical surjection function is pi and which *) (* representative selection function is repr. *) (* QuotType Q class == packs the quotClass class to build a quotType *) (* You may declare such elements as Canonical *) (* \pi_Q x == the class in Q of the element x of T *) (* \pi x == the class of x where Q is inferred from the context *) (* repr c == canonical representative in T of the class c *) (* [quotType of Q] == clone of the canonical quotType structure of Q on T *) (* x = y %[mod Q] := \pi_Q x = \pi_Q y *) (* <-> x and y are equal modulo Q *) (* x <> y %[mod Q] := \pi_Q x <> \pi_Q y *) (* x == y %[mod Q] := \pi_Q x == \pi_Q y *) (* x != y %[mod Q] := \pi_Q x != \pi_Q y *) (* *) (* The quotient_scope is delimited by %qT *) (* The most useful lemmas are piE and reprK *) (* *) (* *** Morphisms *** *) (* One may declare existing functions and predicates as liftings of some *) (* morphisms for a quotient. *) (* PiMorph1 pi_f == where pi_f : {morph \pi : x / f x >-> fq x} *) (* declares fq : Q -> Q as the lifting of f : T -> T *) (* PiMorph2 pi_g == idem with pi_g : {morph \pi : x y / g x y >-> gq x y} *) (* PiMono1 pi_p == idem with pi_p : {mono \pi : x / p x >-> pq x} *) (* PiMono2 pi_r == idem with pi_r : {morph \pi : x y / r x y >-> rq x y} *) (* PiMorph11 pi_f == idem with pi_f : {morph \pi : x / f x >-> fq x} *) (* where fq : Q -> Q' and f : T -> T'. *) (* PiMorph eq == Most general declaration of compatibility, *) (* /!\ use with caution /!\ *) (* One can use the following helpers to build the liftings which may or *) (* may not satisfy the above properties (but if they do not, it is *) (* probably not a good idea to define them): *) (* lift_op1 Q f := lifts f : T -> T *) (* lift_op2 Q g := lifts g : T -> T -> T *) (* lift_fun1 Q p := lifts p : T -> R *) (* lift_fun2 Q r := lifts r : T -> T -> R *) (* lift_op11 Q Q' f := lifts f : T -> T' *) (* There is also the special case of constants and embedding functions *) (* that one may define and declare as compatible with Q using: *) (* lift_cst Q x := lifts x : T to Q *) (* PiConst c := declare the result c of the previous construction as *) (* compatible with Q *) (* lift_embed Q e := lifts e : R -> T to R -> Q *) (* PiEmbed f := declare the result f of the previous construction as *) (* compatible with Q *) (* *) (* *** Quotients that have an eqType structure *** *) (* Having a canonical (eqQuotType e) structure enables piE to replace terms *) (* of the form (x == y) by terms of the form (e x' y') if x and y are *) (* canonical surjections of some x' and y'. *) (* EqQuotType e Q m == builds an (eqQuotType e) structure on Q from the *) (* morphism property m *) (* where m : {mono \pi : x y / e x y >-> x == y} *) (* [eqQuotType of Q] == clones the canonical eqQuotType structure of Q *) (* *) (* *** Equivalence and quotient by an equivalence *** *) (* EquivRel r er es et == builds an equiv_rel structure based on the *) (* reflexivity, symmetry and transitivity property *) (* of a boolean relation. *) (* {eq_quot e} == builds the quotType of T by equiv *) (* where e : rel T is an equiv_rel *) (* and T is a choiceType or a (choiceTypeMod e) *) (* it is canonically an eqType, a choiceType, *) (* a quotType and an eqQuotType. *) (* x = y %[mod_eq e] := x = y %[mod {eq_quot e}] *) (* <-> x and y are equal modulo e *) (* ... *) (*****************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope quotient_scope. Reserved Notation "\pi_ Q" (at level 0, format "\pi_ Q"). Reserved Notation "\pi" (at level 0, format "\pi"). Reserved Notation "{pi_ Q a }" (at level 0, Q at next level, format "{pi_ Q a }"). Reserved Notation "{pi a }" (at level 0, format "{pi a }"). Reserved Notation "x == y %[mod_eq e ]" (at level 70, y at next level, no associativity, format "'[hv ' x '/' == y '/' %[mod_eq e ] ']'"). Reserved Notation "x = y %[mod_eq e ]" (at level 70, y at next level, no associativity, format "'[hv ' x '/' = y '/' %[mod_eq e ] ']'"). Reserved Notation "x != y %[mod_eq e ]" (at level 70, y at next level, no associativity, format "'[hv ' x '/' != y '/' %[mod_eq e ] ']'"). Reserved Notation "x <> y %[mod_eq e ]" (at level 70, y at next level, no associativity, format "'[hv ' x '/' <> y '/' %[mod_eq e ] ']'"). Reserved Notation "{eq_quot e }" (at level 0, e at level 0, format "{eq_quot e }"). Delimit Scope quotient_scope with qT. Local Open Scope quotient_scope. (*****************************************) (* Definition of the quotient interface. *) (*****************************************) Section QuotientDef. Variable T : Type. Record quot_mixin_of qT := QuotClass { quot_repr : qT -> T; quot_pi : T -> qT; _ : cancel quot_repr quot_pi }. Notation quot_class_of := quot_mixin_of. Record quotType := QuotTypePack { quot_sort :> Type; quot_class : quot_class_of quot_sort }. Variable qT : quotType. Definition pi_phant of phant qT := quot_pi (quot_class qT). Local Notation "\pi" := (pi_phant (Phant qT)). Definition repr_of := quot_repr (quot_class qT). Lemma repr_ofK : cancel repr_of \pi. Proof. by rewrite /pi_phant /repr_of /=; case: qT=> [? []]. Qed. Definition QuotType_clone (Q : Type) qT cT of phant_id (quot_class qT) cT := @QuotTypePack Q cT. End QuotientDef. Arguments repr_ofK {T qT}. (****************************) (* Protecting some symbols. *) (****************************) Module Type PiSig. Parameter f : forall (T : Type) (qT : quotType T), phant qT -> T -> qT. Axiom E : f = pi_phant. End PiSig. Module Pi : PiSig. Definition f := pi_phant. Definition E := erefl f. End Pi. Module MPi : PiSig. Definition f := pi_phant. Definition E := erefl f. End MPi. Module Type ReprSig. Parameter f : forall (T : Type) (qT : quotType T), qT -> T. Axiom E : f = repr_of. End ReprSig. Module Repr : ReprSig. Definition f := repr_of. Definition E := erefl f. End Repr. (*******************) (* Fancy Notations *) (*******************) Notation repr := Repr.f. Notation "\pi_ Q" := (@Pi.f _ _ (Phant Q)) : quotient_scope. Notation "\pi" := (@Pi.f _ _ (Phant _)) (only parsing) : quotient_scope. Notation "x == y %[mod Q ]" := (\pi_Q x == \pi_Q y) : quotient_scope. Notation "x = y %[mod Q ]" := (\pi_Q x = \pi_Q y) : quotient_scope. Notation "x != y %[mod Q ]" := (\pi_Q x != \pi_Q y) : quotient_scope. Notation "x <> y %[mod Q ]" := (\pi_Q x <> \pi_Q y) : quotient_scope. Local Notation "\mpi" := (@MPi.f _ _ (Phant _)). Canonical mpi_unlock := Unlockable MPi.E. Canonical pi_unlock := Unlockable Pi.E. Canonical repr_unlock := Unlockable Repr.E. Notation quot_class_of := quot_mixin_of. Notation QuotType Q m := (@QuotTypePack _ Q m). Notation "[ 'quotType' 'of' Q ]" := (@QuotType_clone _ Q _ _ id) (at level 0, format "[ 'quotType' 'of' Q ]") : form_scope. Arguments repr {T qT} x. (************************) (* Exporting the theory *) (************************) Section QuotTypeTheory. Variable T : Type. Variable qT : quotType T. Lemma reprK : cancel repr \pi_qT. Proof. by move=> x; rewrite !unlock repr_ofK. Qed. Variant pi_spec (x : T) : T -> Type := PiSpec y of x = y %[mod qT] : pi_spec x y. Lemma piP (x : T) : pi_spec x (repr (\pi_qT x)). Proof. by constructor; rewrite reprK. Qed. Lemma mpiE : \mpi =1 \pi_qT. Proof. by move=> x; rewrite !unlock. Qed. Lemma quotW P : (forall y : T, P (\pi_qT y)) -> forall x : qT, P x. Proof. by move=> Py x; rewrite -[x]reprK; apply: Py. Qed. Lemma quotP P : (forall y : T, repr (\pi_qT y) = y -> P (\pi_qT y)) -> forall x : qT, P x. Proof. by move=> Py x; rewrite -[x]reprK; apply: Py; rewrite reprK. Qed. End QuotTypeTheory. Arguments reprK {T qT} x. (*******************) (* About morphisms *) (*******************) (* This was pi_morph T (x : T) := PiMorph { pi_op : T; _ : x = pi_op }. *) Structure equal_to T (x : T) := EqualTo { equal_val : T; _ : x = equal_val }. Lemma equal_toE (T : Type) (x : T) (m : equal_to x) : equal_val m = x. Proof. by case: m. Qed. Notation piE := (@equal_toE _ _). Canonical equal_to_pi T (qT : quotType T) (x : T) := @EqualTo _ (\pi_qT x) (\pi x) (erefl _). Arguments EqualTo {T x equal_val}. Section Morphism. Variables T U : Type. Variable (qT : quotType T). Variable (qU : quotType U). Variable (f : T -> T) (g : T -> T -> T) (p : T -> U) (r : T -> T -> U). Variable (fq : qT -> qT) (gq : qT -> qT -> qT) (pq : qT -> U) (rq : qT -> qT -> U). Variable (h : T -> U) (hq : qT -> qU). Hypothesis pi_f : {morph \pi : x / f x >-> fq x}. Hypothesis pi_g : {morph \pi : x y / g x y >-> gq x y}. Hypothesis pi_p : {mono \pi : x / p x >-> pq x}. Hypothesis pi_r : {mono \pi : x y / r x y >-> rq x y}. Hypothesis pi_h : forall (x : T), \pi_qU (h x) = hq (\pi_qT x). Variables (a b : T) (x : equal_to (\pi_qT a)) (y : equal_to (\pi_qT b)). (* Internal Lemmas : do not use directly *) Lemma pi_morph1 : \pi (f a) = fq (equal_val x). Proof. by rewrite !piE. Qed. Lemma pi_morph2 : \pi (g a b) = gq (equal_val x) (equal_val y). Proof. by rewrite !piE. Qed. Lemma pi_mono1 : p a = pq (equal_val x). Proof. by rewrite !piE. Qed. Lemma pi_mono2 : r a b = rq (equal_val x) (equal_val y). Proof. by rewrite !piE. Qed. Lemma pi_morph11 : \pi (h a) = hq (equal_val x). Proof. by rewrite !piE. Qed. End Morphism. Arguments pi_morph1 {T qT f fq}. Arguments pi_morph2 {T qT g gq}. Arguments pi_mono1 {T U qT p pq}. Arguments pi_mono2 {T U qT r rq}. Arguments pi_morph11 {T U qT qU h hq}. Notation "{pi_ Q a }" := (equal_to (\pi_Q a)) : quotient_scope. Notation "{pi a }" := (equal_to (\pi a)) : quotient_scope. (* Declaration of morphisms *) Notation PiMorph pi_x := (EqualTo pi_x). Notation PiMorph1 pi_f := (fun a (x : {pi a}) => EqualTo (pi_morph1 pi_f a x)). Notation PiMorph2 pi_g := (fun a b (x : {pi a}) (y : {pi b}) => EqualTo (pi_morph2 pi_g a b x y)). Notation PiMono1 pi_p := (fun a (x : {pi a}) => EqualTo (pi_mono1 pi_p a x)). Notation PiMono2 pi_r := (fun a b (x : {pi a}) (y : {pi b}) => EqualTo (pi_mono2 pi_r a b x y)). Notation PiMorph11 pi_f := (fun a (x : {pi a}) => EqualTo (pi_morph11 pi_f a x)). (* lifting helpers *) Notation lift_op1 Q f := (locked (fun x : Q => \pi_Q (f (repr x)) : Q)). Notation lift_op2 Q g := (locked (fun x y : Q => \pi_Q (g (repr x) (repr y)) : Q)). Notation lift_fun1 Q f := (locked (fun x : Q => f (repr x))). Notation lift_fun2 Q g := (locked (fun x y : Q => g (repr x) (repr y))). Notation lift_op11 Q Q' f := (locked (fun x : Q => \pi_Q' (f (repr x)) : Q')). (* constant declaration *) Notation lift_cst Q x := (locked (\pi_Q x : Q)). Notation PiConst a := (@EqualTo _ _ a (lock _)). (* embedding declaration, please don't redefine \pi *) Notation lift_embed qT e := (locked (fun x => \pi_qT (e x) : qT)). Lemma eq_lock T T' e : e =1 (@locked (T -> T') (fun x : T => e x)). Proof. by rewrite -lock. Qed. Prenex Implicits eq_lock. Notation PiEmbed e := (fun x => @EqualTo _ _ (e x) (eq_lock (fun _ => \pi _) _)). (********************) (* About eqQuotType *) (********************) Section EqQuotTypeStructure. Variable T : Type. Variable eq_quot_op : rel T. Definition eq_quot_mixin_of (Q : Type) (qc : quot_class_of T Q) (ec : Equality.class_of Q) := {mono \pi_(QuotTypePack qc) : x y / eq_quot_op x y >-> @eq_op (Equality.Pack ec) x y}. Record eq_quot_class_of (Q : Type) : Type := EqQuotClass { eq_quot_quot_class :> quot_class_of T Q; eq_quot_eq_mixin :> Equality.class_of Q; pi_eq_quot_mixin :> eq_quot_mixin_of eq_quot_quot_class eq_quot_eq_mixin }. Record eqQuotType : Type := EqQuotTypePack { eq_quot_sort :> Type; _ : eq_quot_class_of eq_quot_sort; }. Implicit Type eqT : eqQuotType. Definition eq_quot_class eqT : eq_quot_class_of eqT := let: EqQuotTypePack _ cT as qT' := eqT return eq_quot_class_of qT' in cT. Canonical eqQuotType_eqType eqT := EqType eqT (eq_quot_class eqT). Canonical eqQuotType_quotType eqT := QuotType eqT (eq_quot_class eqT). Coercion eqQuotType_eqType : eqQuotType >-> eqType. Coercion eqQuotType_quotType : eqQuotType >-> quotType. Definition EqQuotType_pack Q := fun (qT : quotType T) (eT : eqType) qc ec of phant_id (quot_class qT) qc & phant_id (Equality.class eT) ec => fun m => EqQuotTypePack (@EqQuotClass Q qc ec m). Definition EqQuotType_clone (Q : Type) eqT cT of phant_id (eq_quot_class eqT) cT := @EqQuotTypePack Q cT. Lemma pi_eq_quot eqT : {mono \pi_eqT : x y / eq_quot_op x y >-> x == y}. Proof. by case: eqT => [] ? []. Qed. Canonical pi_eq_quot_mono eqT := PiMono2 (pi_eq_quot eqT). End EqQuotTypeStructure. Notation EqQuotType e Q m := (@EqQuotType_pack _ e Q _ _ _ _ id id m). Notation "[ 'eqQuotType' e 'of' Q ]" := (@EqQuotType_clone _ e Q _ _ id) (at level 0, format "[ 'eqQuotType' e 'of' Q ]") : form_scope. (**************************************************************************) (* Even if a quotType is a natural subType, we do not make this subType *) (* canonical, to allow the user to define the subtyping he wants. However *) (* one can: *) (* - get the eqMixin and the choiceMixin by subtyping *) (* - get the subType structure and maybe declare it Canonical. *) (**************************************************************************) Module QuotSubType. Section SubTypeMixin. Variable T : eqType. Variable qT : quotType T. Definition Sub x (px : repr (\pi_qT x) == x) := \pi_qT x. Lemma qreprK x Px : repr (@Sub x Px) = x. Proof. by rewrite /Sub (eqP Px). Qed. Lemma sortPx (x : qT) : repr (\pi_qT (repr x)) == repr x. Proof. by rewrite !reprK eqxx. Qed. Lemma sort_Sub (x : qT) : x = Sub (sortPx x). Proof. by rewrite /Sub reprK. Qed. Lemma reprP K (PK : forall x Px, K (@Sub x Px)) u : K u. Proof. by rewrite (sort_Sub u); apply: PK. Qed. Canonical subType := SubType _ _ _ reprP qreprK. Definition eqMixin := Eval hnf in [eqMixin of qT by <:]. Canonical eqType := EqType qT eqMixin. End SubTypeMixin. Definition choiceMixin (T : choiceType) (qT : quotType T) := Eval hnf in [choiceMixin of qT by <:]. Canonical choiceType (T : choiceType) (qT : quotType T) := ChoiceType qT (@choiceMixin T qT). Definition countMixin (T : countType) (qT : quotType T) := Eval hnf in [countMixin of qT by <:]. Canonical countType (T : countType) (qT : quotType T) := CountType qT (@countMixin T qT). Section finType. Variables (T : finType) (qT : quotType T). Canonical subCountType := [subCountType of qT]. Definition finMixin := Eval hnf in [finMixin of qT by <:]. End finType. End QuotSubType. Notation "[ 'subType' Q 'of' T 'by' %/ ]" := (@SubType T _ Q _ _ (@QuotSubType.reprP _ _) (@QuotSubType.qreprK _ _)) (at level 0, format "[ 'subType' Q 'of' T 'by' %/ ]") : form_scope. Notation "[ 'eqMixin' 'of' Q 'by' <:%/ ]" := (@QuotSubType.eqMixin _ _: Equality.class_of Q) (at level 0, format "[ 'eqMixin' 'of' Q 'by' <:%/ ]") : form_scope. Notation "[ 'choiceMixin' 'of' Q 'by' <:%/ ]" := (@QuotSubType.choiceMixin _ _: Choice.mixin_of Q) (at level 0, format "[ 'choiceMixin' 'of' Q 'by' <:%/ ]") : form_scope. Notation "[ 'countMixin' 'of' Q 'by' <:%/ ]" := (@QuotSubType.countMixin _ _: Countable.mixin_of Q) (at level 0, format "[ 'countMixin' 'of' Q 'by' <:%/ ]") : form_scope. Notation "[ 'finMixin' 'of' Q 'by' <:%/ ]" := (@QuotSubType.finMixin _ _: Finite.mixin_of Q) (at level 0, format "[ 'finMixin' 'of' Q 'by' <:%/ ]") : form_scope. (****************************************************) (* Definition of a (decidable) equivalence relation *) (****************************************************) Section EquivRel. Variable T : Type. Lemma left_trans (e : rel T) : symmetric e -> transitive e -> left_transitive e. Proof. by move=> s t ? * ?; apply/idP/idP; apply: t; rewrite // s. Qed. Lemma right_trans (e : rel T) : symmetric e -> transitive e -> right_transitive e. Proof. by move=> s t ? * x; rewrite ![e x _]s; apply: left_trans. Qed. Variant equiv_class_of (equiv : rel T) := EquivClass of reflexive equiv & symmetric equiv & transitive equiv. Record equiv_rel := EquivRelPack { equiv :> rel T; _ : equiv_class_of equiv }. Variable e : equiv_rel. Definition equiv_class := let: EquivRelPack _ ce as e' := e return equiv_class_of e' in ce. Definition equiv_pack (r : rel T) ce of phant_id ce equiv_class := @EquivRelPack r ce. Lemma equiv_refl x : e x x. Proof. by case: e => [] ? []. Qed. Lemma equiv_sym : symmetric e. Proof. by case: e => [] ? []. Qed. Lemma equiv_trans : transitive e. Proof. by case: e => [] ? []. Qed. Lemma eq_op_trans (T' : eqType) : transitive (@eq_op T'). Proof. by move=> x y z /eqP -> /eqP ->. Qed. Lemma equiv_ltrans: left_transitive e. Proof. by apply: left_trans; [apply: equiv_sym|apply: equiv_trans]. Qed. Lemma equiv_rtrans: right_transitive e. Proof. by apply: right_trans; [apply: equiv_sym|apply: equiv_trans]. Qed. End EquivRel. Hint Resolve equiv_refl : core. Notation EquivRel r er es et := (@EquivRelPack _ r (EquivClass er es et)). Notation "[ 'equiv_rel' 'of' e ]" := (@equiv_pack _ _ e _ id) (at level 0, format "[ 'equiv_rel' 'of' e ]") : form_scope. (**************************************************) (* Encoding to another type modulo an equivalence *) (**************************************************) Section EncodingModuloRel. Variables (D E : Type) (ED : E -> D) (DE : D -> E) (e : rel D). Variant encModRel_class_of (r : rel D) := EncModRelClassPack of (forall x, r x x -> r (ED (DE x)) x) & (r =2 e). Record encModRel := EncModRelPack { enc_mod_rel :> rel D; _ : encModRel_class_of enc_mod_rel }. Variable r : encModRel. Definition encModRelClass := let: EncModRelPack _ c as r' := r return encModRel_class_of r' in c. Definition encModRelP (x : D) : r x x -> r (ED (DE x)) x. Proof. by case: r => [] ? [] /= he _ /he. Qed. Definition encModRelE : r =2 e. Proof. by case: r => [] ? []. Qed. Definition encoded_equiv : rel E := [rel x y | r (ED x) (ED y)]. End EncodingModuloRel. Notation EncModRelClass m := (EncModRelClassPack (fun x _ => m x) (fun _ _ => erefl _)). Notation EncModRel r m := (@EncModRelPack _ _ _ _ _ r (EncModRelClass m)). Section EncodingModuloEquiv. Variables (D E : Type) (ED : E -> D) (DE : D -> E) (e : equiv_rel D). Variable (r : encModRel ED DE e). Lemma enc_mod_rel_is_equiv : equiv_class_of (enc_mod_rel r). Proof. split => [x|x y|y x z]; rewrite !encModRelE //; first by rewrite equiv_sym. by move=> exy /(equiv_trans exy). Qed. Definition enc_mod_rel_equiv_rel := EquivRelPack enc_mod_rel_is_equiv. Definition encModEquivP (x : D) : r (ED (DE x)) x. Proof. by rewrite encModRelP ?encModRelE. Qed. Local Notation e' := (encoded_equiv r). Lemma encoded_equivE : e' =2 [rel x y | e (ED x) (ED y)]. Proof. by move=> x y; rewrite /encoded_equiv /= encModRelE. Qed. Local Notation e'E := encoded_equivE. Lemma encoded_equiv_is_equiv : equiv_class_of e'. Proof. split => [x|x y|y x z]; rewrite !e'E //=; first by rewrite equiv_sym. by move=> exy /(equiv_trans exy). Qed. Canonical encoded_equiv_equiv_rel := EquivRelPack encoded_equiv_is_equiv. Lemma encoded_equivP x : e' (DE (ED x)) x. Proof. by rewrite /encoded_equiv /= encModEquivP. Qed. End EncodingModuloEquiv. (**************************************) (* Quotient by a equivalence relation *) (**************************************) Module EquivQuot. Section EquivQuot. Variables (D : Type) (C : choiceType) (CD : C -> D) (DC : D -> C). Variables (eD : equiv_rel D) (encD : encModRel CD DC eD). Notation eC := (encoded_equiv encD). Definition canon x := choose (eC x) (x). Record equivQuotient := EquivQuotient { erepr : C; _ : (frel canon) erepr erepr }. Definition type_of of (phantom (rel _) encD) := equivQuotient. Lemma canon_id : forall x, (invariant canon canon) x. Proof. move=> x /=; rewrite /canon (@eq_choose _ _ (eC x)). by rewrite (@choose_id _ (eC x) _ x) ?chooseP ?equiv_refl. by move=> y; apply: equiv_ltrans; rewrite equiv_sym /= chooseP. Qed. Definition pi := locked (fun x => EquivQuotient (canon_id x)). Lemma ereprK : cancel erepr pi. Proof. by unlock pi; case=> x hx; apply/(@val_inj _ _ [subType for erepr])/eqP. Qed. Local Notation encDE := (encModRelE encD). Local Notation encDP := (encModEquivP encD). Canonical encD_equiv_rel := EquivRelPack (enc_mod_rel_is_equiv encD). Lemma pi_CD (x y : C) : reflect (pi x = pi y) (eC x y). Proof. apply: (iffP idP) => hxy. apply: (can_inj ereprK); unlock pi canon => /=. rewrite -(@eq_choose _ (eC x) (eC y)); last first. by move=> z; rewrite /eC /=; apply: equiv_ltrans. by apply: choose_id; rewrite ?equiv_refl //. rewrite (equiv_trans (chooseP (equiv_refl _ _))) //=. move: hxy => /(f_equal erepr) /=; unlock pi canon => /= ->. by rewrite equiv_sym /= chooseP. Qed. Lemma pi_DC (x y : D) : reflect (pi (DC x) = pi (DC y)) (eD x y). Proof. apply: (iffP idP)=> hxy. apply/pi_CD; rewrite /eC /=. by rewrite (equiv_ltrans (encDP _)) (equiv_rtrans (encDP _)) /= encDE. rewrite -encDE -(equiv_ltrans (encDP _)) -(equiv_rtrans (encDP _)) /=. exact/pi_CD. Qed. Lemma equivQTP : cancel (CD \o erepr) (pi \o DC). Proof. by move=> x; rewrite /= (pi_CD _ (erepr x) _) ?ereprK /eC /= ?encDP. Qed. Local Notation qT := (type_of (Phantom (rel D) encD)). Definition quotClass := QuotClass equivQTP. Canonical quotType := QuotType qT quotClass. Lemma eqmodP x y : reflect (x = y %[mod qT]) (eD x y). Proof. by apply: (iffP (pi_DC _ _)); rewrite !unlock. Qed. Fact eqMixin : Equality.mixin_of qT. Proof. exact: CanEqMixin ereprK. Qed. Canonical eqType := EqType qT eqMixin. Definition choiceMixin := CanChoiceMixin ereprK. Canonical choiceType := ChoiceType qT choiceMixin. Lemma eqmodE x y : x == y %[mod qT] = eD x y. Proof. exact: sameP eqP (@eqmodP _ _). Qed. Canonical eqQuotType := EqQuotType eD qT eqmodE. End EquivQuot. End EquivQuot. Canonical EquivQuot.quotType. Canonical EquivQuot.eqType. Canonical EquivQuot.choiceType. Canonical EquivQuot.eqQuotType. Arguments EquivQuot.ereprK {D C CD DC eD encD}. Notation "{eq_quot e }" := (@EquivQuot.type_of _ _ _ _ _ _ (Phantom (rel _) e)) : quotient_scope. Notation "x == y %[mod_eq r ]" := (x == y %[mod {eq_quot r}]) : quotient_scope. Notation "x = y %[mod_eq r ]" := (x = y %[mod {eq_quot r}]) : quotient_scope. Notation "x != y %[mod_eq r ]" := (x != y %[mod {eq_quot r}]) : quotient_scope. Notation "x <> y %[mod_eq r ]" := (x <> y %[mod {eq_quot r}]) : quotient_scope. (***********************************************************) (* If the type is directly a choiceType, no need to encode *) (***********************************************************) Section DefaultEncodingModuloRel. Variables (D : choiceType) (r : rel D). Definition defaultEncModRelClass := @EncModRelClassPack D D id id r r (fun _ rxx => rxx) (fun _ _ => erefl _). Canonical defaultEncModRel := EncModRelPack defaultEncModRelClass. End DefaultEncodingModuloRel. (***************************************************) (* Recovering a potential countable type structure *) (***************************************************) Section CountEncodingModuloRel. Variables (D : Type) (C : countType) (CD : C -> D) (DC : D -> C). Variables (eD : equiv_rel D) (encD : encModRel CD DC eD). Notation eC := (encoded_equiv encD). Fact eq_quot_countMixin : Countable.mixin_of {eq_quot encD}. Proof. exact: CanCountMixin EquivQuot.ereprK. Qed. Canonical eq_quot_countType := CountType {eq_quot encD} eq_quot_countMixin. End CountEncodingModuloRel. Section EquivQuotTheory. Variables (T : choiceType) (e : equiv_rel T) (Q : eqQuotType e). Lemma eqmodE x y : x == y %[mod_eq e] = e x y. Proof. by rewrite pi_eq_quot. Qed. Lemma eqmodP x y : reflect (x = y %[mod_eq e]) (e x y). Proof. by rewrite -eqmodE; apply/eqP. Qed. End EquivQuotTheory. Prenex Implicits eqmodE eqmodP. Section EqQuotTheory. Variables (T : Type) (e : rel T) (Q : eqQuotType e). Lemma eqquotE x y : x == y %[mod Q] = e x y. Proof. by rewrite pi_eq_quot. Qed. Lemma eqquotP x y : reflect (x = y %[mod Q]) (e x y). Proof. by rewrite -eqquotE; apply/eqP. Qed. End EqQuotTheory. Prenex Implicits eqquotE eqquotP. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/order.v000066400000000000000000010623101375767750300224210ustar00rootroot00000000000000(* (c) Copyright 2006-2019 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 path fintype tuple bigop finset div prime. (******************************************************************************) (* This files defines types equipped with order relations. *) (* *) (* Use one of the following modules implementing different theories: *) (* Order.LTheory: partially ordered types and lattices excluding complement *) (* and totality related theorems. *) (* Order.CTheory: complemented lattices including Order.LTheory. *) (* Order.TTheory: totally ordered types including Order.LTheory. *) (* Order.Theory: ordered types including all of the above theory modules *) (* *) (* To access the definitions, notations, and the theory from, say, *) (* "Order.Xyz", insert "Import Order.Xyz." at the top of your scripts. *) (* Notations are accessible by opening the scope "order_scope" bound to the *) (* delimiting key "O". *) (* *) (* We provide the following structures of ordered types *) (* porderType d == the type of partially ordered types *) (* latticeType d == the type of non-distributive lattices *) (* bLatticeType d == latticeType with a bottom element *) (* tbLatticeType d == latticeType with both a top and a bottom *) (* distrLatticeType d == the type of distributive lattices *) (* bDistrLatticeType d == distrLatticeType with a bottom element *) (* tbDistrLatticeType d == distrLatticeType with both a top and a bottom *) (* cbDistrLatticeType d == the type of sectionally complemented distributive*) (* lattices *) (* (lattices with bottom and a difference operation)*) (* ctbDistrLatticeType d == the type of complemented distributive lattices *) (* (lattices with top, bottom, difference, *) (* and complement) *) (* orderType d == the type of totally ordered types *) (* finPOrderType d == the type of partially ordered finite types *) (* finLatticeType d == the type of nonempty finite non-distributive *) (* lattices *) (* finDistrLatticeType d == the type of nonempty finite distributive lattices*) (* finCDistrLatticeType d == the type of nonempty finite complemented *) (* distributive lattices *) (* finOrderType d == the type of nonempty totally ordered finite types*) (* *) (* Each generic partial order and lattice operations symbols also has a first *) (* argument which is the display, the second which is the minimal structure *) (* they operate on and then the operands. Here is the exhaustive list of all *) (* such symbols for partial orders and lattices together with their default *) (* display (as displayed by Check). We document their meaning in the *) (* paragraph after the next. *) (* *) (* For porderType T *) (* @Order.le disp T == <=%O (in fun_scope) *) (* @Order.lt disp T == <%O (in fun_scope) *) (* @Order.comparable disp T == >=<%O (in fun_scope) *) (* @Order.ge disp T == >=%O (in fun_scope) *) (* @Order.gt disp T == >%O (in fun_scope) *) (* @Order.leif disp T == x is less than or equal to y. *) (* x < y <-> x is less than y (:= (y != x) && (x <= y)). *) (* min x y <-> if x < y then x else y *) (* max x y <-> if x < y then y else x *) (* 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 ?<= if C <-> x is smaller than y, and strictly if C is false. *) (* x >=< y <-> x and y are comparable (:= (x <= y) || (y <= x)). *) (* x >< y <-> x and y are incomparable (:= ~~ x >=< y). *) (* For x, y of type T, where T is canonically a latticeType d: *) (* x `&` y == the meet of x and y. *) (* x `|` y == the join of x and y. *) (* In a type T, where T is canonically a bLatticeType d: *) (* 0 == the bottom element. *) (* \join_ e == iterated join of a lattice with a bottom. *) (* In a type T, where T is canonically a tbLatticeType d: *) (* 1 == the top element. *) (* \meet_ e == iterated meet of a lattice with a top. *) (* For x, y of type T, where T is canonically a cbDistrLatticeType d: *) (* x `\` y == the (sectional) complement of y in [0, x]. *) (* For x of type T, where T is canonically a ctbDistrLatticeType d: *) (* ~` x == the complement of x in [0, 1]. *) (* *) (* There are three distinct uses of the symbols *) (* <, <=, >, >=, _ <= _ ?= iff _, >=<, and >< *) (* in the default display: *) (* they can be 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 conventions are compatible with Haskell's, *) (* where ((< y) x) = (x < y) = ((<) x y), *) (* except that we write <%O instead of (<). *) (* *) (* Alternative notation displays can be defined by : *) (* 1. declaring a new opaque definition of type unit. Using the idiom *) (* `Lemma my_display : unit. Proof. exact: tt. Qed.` *) (* 2. using this symbol to tag canonical porderType structures using *) (* `Canonical my_porderType := POrderType my_display my_type my_mixin`, *) (* 3. declaring notations for the main operations of this library, by *) (* setting the first argument of the definition to the display, e.g. *) (* `Notation my_syndef_le x y := @Order.le my_display _ x y.` or *) (* `Notation "x <=< y" := @Order.lt my_display _ x y (at level ...).` *) (* Non overloaded notations will default to the default display. *) (* *) (* One may use displays either for convenience or to disambiguate between *) (* different structures defined on "copies" of a type (as explained below.) *) (* We provide the following "copies" of types, *) (* the first one is a *documented example* *) (* natdvd := nat *) (* == a "copy" of nat which is canonically ordered using *) (* divisibility predicate dvdn. *) (* Notation %|, %<|, gcd, lcm are used instead of *) (* <=, <, meet and join. *) (* T^d := dual T, *) (* where dual is a new definition for (fun T => T) *) (* == a "copy" of T, such that if T is canonically ordered, *) (* then T^d is canonically ordered with the dual *) (* order, and displayed with an extra ^d in the notation *) (* i.e. <=^d, <^d, >=<^d, ><^d, `&`^d, `|`^d are *) (* used and displayed instead of *) (* <=, <, >=<, ><, `&`, `|` *) (* T *prod[d] T' := T * T' *) (* == a "copy" of the cartesian product such that, *) (* if T and T' are canonically ordered, *) (* then T *prod[d] T' is canonically ordered in product *) (* order. *) (* i.e. (x1, x2) <= (y1, y2) = *) (* (x1 <= y1) && (x2 <= y2), *) (* and displayed in display d *) (* T *p T' := T *prod[prod_display] T' *) (* where prod_display adds an extra ^p to all notations *) (* T *lexi[d] T' := T * T' *) (* == a "copy" of the cartesian product such that, *) (* if T and T' are canonically ordered, *) (* then T *lexi[d] T' is canonically ordered in *) (* lexicographic order *) (* i.e. (x1, x2) <= (y1, y2) = *) (* (x1 <= y1) && ((x1 >= y1) ==> (x2 <= y2)) *) (* and (x1, x2) < (y1, y2) = *) (* (x1 <= y1) && ((x1 >= y1) ==> (x2 < y2)) *) (* and displayed in display d *) (* T *l T' := T *lexi[lexi_display] T' *) (* where lexi_display adds an extra ^l to all notations *) (* seqprod_with d T := seq T *) (* == a "copy" of seq, such that if T is canonically *) (* ordered, then seqprod_with d T is canonically ordered *) (* in product order i.e. *) (* [:: x1, .., xn] <= [y1, .., yn] = *) (* (x1 <= y1) && ... && (xn <= yn) *) (* and displayed in display d *) (* n.-tupleprod[d] T == same with n.tuple T *) (* seqprod T := seqprod_with prod_display T *) (* n.-tupleprod T := n.-tuple[prod_display] T *) (* seqlexi_with d T := seq T *) (* == a "copy" of seq, such that if T is canonically *) (* ordered, then seqprod_with d T is canonically ordered *) (* in lexicographic order i.e. *) (* [:: x1, .., xn] <= [y1, .., yn] = *) (* (x1 <= x2) && ((x1 >= y1) ==> ((x2 <= y2) && ...)) *) (* and displayed in display d *) (* n.-tuplelexi[d] T == same with n.tuple T *) (* seqlexi T := lexiprod_with lexi_display T *) (* n.-tuplelexi T := n.-tuple[lexi_display] T *) (* *) (* Beware that canonical structure inference will not try to find the copy of *) (* the structures that fits the display one mentioned, but will rather *) (* determine which canonical structure and display to use depending on the *) (* copy of the type one provided. In this sense they are merely displays *) (* to inform the user of what the inference did, rather than additional *) (* input for the inference. *) (* *) (* Existing displays are either dual_display d (where d is a display), *) (* dvd_display (both explained above), ring_display (from algebra/ssrnum *) (* to change the scope of the usual notations to ring_scope). We also provide *) (* lexi_display and prod_display for lexicographic and product order *) (* respectively. *) (* The default display is tt and users can define their own as explained *) (* above. *) (* *) (* For porderType we provide the following operations *) (* [arg min_(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 max_(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. *) (* with head symbols Order.arg_min and Order.arg_max *) (* The user may use extremumP or extremum_inP to eliminate them. *) (* *) (* In order to build the above structures, one must provide the appropriate *) (* factory instance to the following structure constructors. The list of *) (* possible factories is indicated after each constructor. Each factory is *) (* documented in the next paragraph. *) (* NB: Since each mixim_of record of structure in this library is an internal *) (* interface that is not designed to be used by users directly, one should *) (* not build structure instances from their Mixin constructors. *) (* *) (* POrderType disp T pord_mixin *) (* == builds a porderType from a canonical choiceType *) (* instance of T where pord_mixin can be of types *) (* lePOrderMixin, ltPOrderMixin, meetJoinMixin, *) (* leOrderMixin, or ltOrderMixin *) (* or computed using PcanPOrderMixin or CanPOrderMixin. *) (* disp is a display as explained above *) (* *) (* LatticeType T lat_mixin *) (* == builds a latticeType from a porderType where lat_mixin *) (* can be of types *) (* latticeMixin, distrLatticePOrderMixin, *) (* totalPOrderMixin, meetJoinMixin, leOrderMixin, or *) (* ltOrderMixin *) (* or computed using IsoLatticeMixin. *) (* *) (* BLatticeType T bot_mixin *) (* == builds a bLatticeType from a latticeType and bottom *) (* where bot_mixin is of type bottomMixin. *) (* *) (* TBLatticeType T top_mixin *) (* == builds a tbLatticeType from a bLatticeType and top *) (* where top_mixin is of type topMixin. *) (* *) (* DistrLatticeType T lat_mixin *) (* == builds a distrLatticeType from a porderType where *) (* lat_mixin can be of types *) (* distrLatticeMixin, distrLatticePOrderMixin, *) (* totalLatticeMixin, totalPOrderMixin, meetJoinMixin, *) (* leOrderMixin, or ltOrderMixin *) (* or computed using IsoLatticeMixin. *) (* *) (* CBDistrLatticeType T sub_mixin *) (* == builds a cbDistrLatticeType from a bDistrLatticeType *) (* and a difference operation where sub_mixin is of type *) (* cbDistrLatticeMixin. *) (* *) (* CTBDistrLatticeType T compl_mixin *) (* == builds a ctbDistrLatticeType from a tbDistrLatticeType *) (* and a complement operation where compl_mixin is of *) (* type ctbDistrLatticeMixin. *) (* *) (* OrderType T ord_mixin *) (* == builds an orderType from a distrLatticeType where *) (* ord_mixin can be of types *) (* totalOrderMixin, totalPOrderMixin, totalLatticeMixin,*) (* leOrderMixin, or ltOrderMixin *) (* or computed using MonoTotalMixin. *) (* *) (* Additionally: *) (* - [porderType of _] ... notations are available to recover structures on *) (* "copies" of the types, as in eqType, choiceType, ssralg... *) (* - [finPOrderType of _] ... notations to compute joins between finite types *) (* and ordered types *) (* *) (* List of possible factories: *) (* *) (* - lePOrderMixin == on a choiceType, takes le, lt, *) (* reflexivity, antisymmetry and transitivity of le. *) (* (can build: porderType) *) (* *) (* - ltPOrderMixin == on a choiceType, takes le, lt, *) (* irreflexivity and transitivity of lt. *) (* (can build: porderType) *) (* *) (* - latticeMixin == on a porderType, takes meet, join, *) (* commutativity and associativity of meet and join, and *) (* some absorption laws. *) (* (can build: latticeType) *) (* *) (* - distrLatticeMixin == *) (* on a latticeType, takes distributivity of meet over join.*) (* (can build: distrLatticeType) *) (* *) (* - distrLatticePOrderMixin == on a porderType, takes meet, join, *) (* commutativity and associativity of meet and join, and *) (* the absorption and distributive laws. *) (* (can build: latticeType, distrLatticeType) *) (* *) (* - meetJoinMixin == on a choiceType, takes le, lt, meet, join, *) (* commutativity and associativity of meet and join, *) (* the absorption and distributive laws, and *) (* idempotence of meet. *) (* (can build: porderType, latticeType, distrLatticeType) *) (* *) (* - leOrderMixin == on a choiceType, takes le, lt, meet, join, *) (* antisymmetry, transitivity and totality of le. *) (* (can build: porderType, latticeType, distrLatticeType, *) (* orderType) *) (* *) (* - ltOrderMixin == on a choiceType, takes le, lt, meet, join, *) (* irreflexivity, transitivity and totality of lt. *) (* (can build: porderType, latticeType, distrLatticeType, *) (* orderType) *) (* *) (* - totalPOrderMixin == on a porderType T, totality of the order of T *) (* := total (<=%O : rel T) *) (* (can build: latticeType, distrLatticeType, orderType) *) (* *) (* - totalLatticeMixin == on a latticeType T, totality of the order of T *) (* := total (<=%O : rel T) *) (* (can build distrLatticeType, orderType) *) (* *) (* - totalOrderMixin == on a distrLatticeType T, totality of the order of T *) (* := total (<=%O : rel T) *) (* (can build: orderType) *) (* NB: the above three mixins are kept separate from each other (even *) (* though they are convertible), in order to avoid ambiguous coercion *) (* paths. *) (* *) (* - bottomMixin, topMixin, cbDistrLatticeMixin, ctbDistrLatticeMixin *) (* == mixins with one extra operation *) (* (respectively bottom, top, difference, and complement) *) (* *) (* Additionally: *) (* - [porderMixin of T by <:] creates a porderMixin by subtyping. *) (* - [totalOrderMixin of T by <:] creates the associated totalOrderMixin. *) (* - PCanPOrderMixin, CanPOrderMixin create porderMixin from cancellations *) (* - MonoTotalMixin creates a totalPOrderMixin from monotonicity *) (* - IsoLatticeMixin creates a distrLatticeMixin from an ordered structure *) (* isomorphism (i.e., cancel f f', cancel f' f, {mono f : x y / x <= y}) *) (* *) (* List of "big pack" notations: *) (* - DistrLatticeOfChoiceType builds a distrLatticeType from a choiceType and *) (* a meetJoinMixin. *) (* - DistrLatticeOfPOrderType builds a distrLatticeType from a porderType and *) (* a distrLatticePOrderMixin. *) (* - OrderOfChoiceType builds an orderType from a choiceType, and a *) (* leOrderMixin or a ltOrderMixin. *) (* - OrderOfPOrder builds an orderType from a porderType and a *) (* totalPOrderMixin. *) (* - OrderOfLattice builds an orderType from a latticeType and a *) (* totalLatticeMixin. *) (* NB: These big pack notations should be used only to construct instances on *) (* the fly, e.g., in the middle of a proof, and should not be used to *) (* declare canonical instances. See field/algebraics_fundamentals.v for *) (* an example usage. *) (* *) (* We provide the following canonical instances of ordered types *) (* - all possible structures on bool *) (* - porderType, latticeType, distrLatticeType, orderType and bLatticeType *) (* on nat for the leq order *) (* - porderType, latticeType, distrLatticeType, bLatticeType, tbLatticeType, *) (* on nat for the dvdn order, where meet and join are respectively gcdn and *) (* lcmn *) (* - porderType, latticeType, distrLatticeType, orderType, bLatticeType, *) (* tbLatticeType, cbDistrLatticeType, ctbDistrLatticeType *) (* on T *prod[disp] T' a "copy" of T * T' *) (* using product order (and T *p T' its specialization to prod_display) *) (* - porderType, latticeType, distrLatticeType, and orderType, on *) (* T *lexi[disp] T' another "copy" of T * T', with lexicographic ordering *) (* (and T *l T' its specialization to lexi_display) *) (* - porderType, latticeType, distrLatticeType, and orderType, on *) (* {t : T & T' x} with lexicographic ordering *) (* - porderType, latticeType, distrLatticeType, orderType, bLatticeType, *) (* tbLatticeType, cbDistrLatticeType, ctbDistrLatticeType *) (* on seqprod_with disp T a "copy" of seq T *) (* using product order (and seqprod T' its specialization to prod_display)*) (* - porderType, latticeType, distrLatticeType, and orderType, on *) (* seqlexi_with disp T another "copy" of seq T, with lexicographic *) (* ordering (and seqlexi T its specialization to lexi_display) *) (* - porderType, latticeType, distrLatticeType, orderType, bLatticeType, *) (* tbLatticeType, cbDistrLatticeType, ctbDistrLatticeType *) (* on n.-tupleprod[disp] a "copy" of n.-tuple T *) (* using product order (and n.-tupleprod T its specialization *) (* to prod_display) *) (* - porderType, latticeType, distrLatticeType, and orderType, on *) (* n.-tuplelexi[d] T another "copy" of n.-tuple T, with lexicographic *) (* ordering (and n.-tuplelexi T its specialization to lexi_display) *) (* and all possible finite type instances *) (* *) (* In order to get a canonical order on prod or seq, one may import modules *) (* DefaultProdOrder or DefaultProdLexiOrder, DefaultSeqProdOrder or *) (* DefaultSeqLexiOrder, and DefaultTupleProdOrder or DefaultTupleLexiOrder. *) (* *) (* On orderType, leP ltP ltgtP are the three main lemmas for case analysis. *) (* On porderType, one may use comparableP, comparable_leP, comparable_ltP, *) (* and comparable_ltgtP, which are the four main lemmas for case analysis. *) (* *) (* We also provide specialized versions of some theorems from path.v. *) (* *) (* This file is based on prior work by *) (* D. Dreyer, G. Gonthier, A. Nanevski, P-Y Strub, B. Ziliani *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope order_scope. Delimit Scope order_scope with O. Local Open Scope order_scope. Reserved Notation "<= y" (at level 35). Reserved Notation ">= y" (at level 35). Reserved Notation "< y" (at level 35). Reserved Notation "> y" (at level 35). 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). Reserved Notation "> y :> T" (at level 35, y at next level). Reserved Notation "x >=< y" (at level 70, no associativity). Reserved Notation ">=< y" (at level 35). Reserved Notation ">=< y :> T" (at level 35, y at next level). 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 < y ?<= 'if' c" (at level 70, y, c at next level, format "x '[hv' < y '/' ?<= 'if' c ']'"). Reserved Notation "x < y ?<= 'if' c :> T" (at level 70, y, c at next level, format "x '[hv' < y '/' ?<= 'if' c :> T ']'"). (* Reserved notation for lattice operations. *) Reserved Notation "A `&` B" (at level 48, left associativity). 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). (* Notations for dual partial and total order *) Reserved Notation "x <=^d y" (at level 70, y at next level). Reserved Notation "x >=^d y" (at level 70, y at next level). Reserved Notation "x <^d y" (at level 70, y at next level). Reserved Notation "x >^d y" (at level 70, y at next level). Reserved Notation "x <=^d y :> T" (at level 70, y at next level). Reserved Notation "x >=^d y :> T" (at level 70, y at next level). Reserved Notation "x <^d y :> T" (at level 70, y at next level). Reserved Notation "x >^d y :> T" (at level 70, y at next level). Reserved Notation "<=^d y" (at level 35). Reserved Notation ">=^d y" (at level 35). Reserved Notation "<^d y" (at level 35). Reserved Notation ">^d y" (at level 35). Reserved Notation "<=^d y :> T" (at level 35, y at next level). Reserved Notation ">=^d y :> T" (at level 35, y at next level). Reserved Notation "<^d y :> T" (at level 35, y at next level). Reserved Notation ">^d y :> T" (at level 35, y at next level). Reserved Notation "x >=<^d y" (at level 70, no associativity). Reserved Notation ">=<^d y" (at level 35). Reserved Notation ">=<^d y :> T" (at level 35, y at next level). Reserved Notation "x ><^d y" (at level 70, no associativity). Reserved Notation "><^d x" (at level 35). Reserved Notation "><^d y :> T" (at level 35, y at next level). Reserved Notation "x <=^d y <=^d z" (at level 70, y, z at next level). Reserved Notation "x <^d y <=^d z" (at level 70, y, z at next level). Reserved Notation "x <=^d y <^d z" (at level 70, y, z at next level). Reserved Notation "x <^d y <^d z" (at level 70, y, z at next level). Reserved Notation "x <=^d y ?= 'iff' c" (at level 70, y, c at next level, format "x '[hv' <=^d y '/' ?= 'iff' c ']'"). Reserved Notation "x <=^d y ?= 'iff' c :> T" (at level 70, y, c at next level, format "x '[hv' <=^d y '/' ?= 'iff' c :> T ']'"). Reserved Notation "x <^d y ?<= 'if' c" (at level 70, y, c at next level, format "x '[hv' <^d y '/' ?<= 'if' c ']'"). Reserved Notation "x <^d y ?<= 'if' c :> T" (at level 70, y, c at next level, format "x '[hv' <^d y '/' ?<= 'if' c :> T ']'"). (* Reserved notation for dual lattice operations. *) Reserved Notation "A `&^d` B" (at level 48, left associativity). Reserved Notation "A `|^d` B" (at level 52, left associativity). Reserved Notation "A `\^d` B" (at level 50, left associativity). Reserved Notation "~^d` A" (at level 35, right associativity). Reserved Notation "0^d" (at level 0). Reserved Notation "1^d" (at level 0). (* Reserved notations for product ordering of prod or seq *) Reserved Notation "x <=^p y" (at level 70, y at next level). Reserved Notation "x >=^p y" (at level 70, y at next level). Reserved Notation "x <^p y" (at level 70, y at next level). Reserved Notation "x >^p y" (at level 70, y at next level). Reserved Notation "x <=^p y :> T" (at level 70, y at next level). Reserved Notation "x >=^p y :> T" (at level 70, y at next level). Reserved Notation "x <^p y :> T" (at level 70, y at next level). Reserved Notation "x >^p y :> T" (at level 70, y at next level). Reserved Notation "<=^p y" (at level 35). Reserved Notation ">=^p y" (at level 35). Reserved Notation "<^p y" (at level 35). Reserved Notation ">^p y" (at level 35). Reserved Notation "<=^p y :> T" (at level 35, y at next level). Reserved Notation ">=^p y :> T" (at level 35, y at next level). Reserved Notation "<^p y :> T" (at level 35, y at next level). Reserved Notation ">^p y :> T" (at level 35, y at next level). Reserved Notation "x >=<^p y" (at level 70, no associativity). Reserved Notation ">=<^p x" (at level 35). Reserved Notation ">=<^p y :> T" (at level 35, y at next level). Reserved Notation "x ><^p y" (at level 70, no associativity). Reserved Notation "><^p x" (at level 35). Reserved Notation "><^p y :> T" (at level 35, y at next level). Reserved Notation "x <=^p y <=^p z" (at level 70, y, z at next level). Reserved Notation "x <^p y <=^p z" (at level 70, y, z at next level). Reserved Notation "x <=^p y <^p z" (at level 70, y, z at next level). Reserved Notation "x <^p y <^p z" (at level 70, y, z at next level). Reserved Notation "x <=^p y ?= 'iff' c" (at level 70, y, c at next level, format "x '[hv' <=^p y '/' ?= 'iff' c ']'"). Reserved Notation "x <=^p y ?= 'iff' c :> T" (at level 70, y, c at next level, format "x '[hv' <=^p y '/' ?= 'iff' c :> T ']'"). (* Reserved notation for dual lattice operations. *) Reserved Notation "A `&^p` B" (at level 48, left associativity). Reserved Notation "A `|^p` B" (at level 52, left associativity). Reserved Notation "A `\^p` B" (at level 50, left associativity). Reserved Notation "~^p` A" (at level 35, right associativity). (* Reserved notations for lexicographic ordering of prod or seq *) Reserved Notation "x <=^l y" (at level 70, y at next level). Reserved Notation "x >=^l y" (at level 70, y at next level). Reserved Notation "x <^l y" (at level 70, y at next level). Reserved Notation "x >^l y" (at level 70, y at next level). Reserved Notation "x <=^l y :> T" (at level 70, y at next level). Reserved Notation "x >=^l y :> T" (at level 70, y at next level). Reserved Notation "x <^l y :> T" (at level 70, y at next level). Reserved Notation "x >^l y :> T" (at level 70, y at next level). Reserved Notation "<=^l y" (at level 35). Reserved Notation ">=^l y" (at level 35). Reserved Notation "<^l y" (at level 35). Reserved Notation ">^l y" (at level 35). Reserved Notation "<=^l y :> T" (at level 35, y at next level). Reserved Notation ">=^l y :> T" (at level 35, y at next level). Reserved Notation "<^l y :> T" (at level 35, y at next level). Reserved Notation ">^l y :> T" (at level 35, y at next level). Reserved Notation "x >=<^l y" (at level 70, no associativity). Reserved Notation ">=<^l x" (at level 35). Reserved Notation ">=<^l y :> T" (at level 35, y at next level). Reserved Notation "x ><^l y" (at level 70, no associativity). Reserved Notation "><^l x" (at level 35). Reserved Notation "><^l y :> T" (at level 35, y at next level). Reserved Notation "x <=^l y <=^l z" (at level 70, y, z at next level). Reserved Notation "x <^l y <=^l z" (at level 70, y, z at next level). Reserved Notation "x <=^l y <^l z" (at level 70, y, z at next level). Reserved Notation "x <^l y <^l z" (at level 70, y, z at next level). Reserved Notation "x <=^l y ?= 'iff' c" (at level 70, y, c at next level, format "x '[hv' <=^l y '/' ?= 'iff' c ']'"). Reserved Notation "x <=^l y ?= 'iff' c :> T" (at level 70, y, c at next level, format "x '[hv' <=^l y '/' ?= 'iff' c :> T ']'"). (* Reserved notations for divisibility *) Reserved Notation "x %<| y" (at level 70, no associativity). Reserved Notation "\gcd_ i F" (at level 41, F at level 41, i at level 0, format "'[' \gcd_ i '/ ' F ']'"). Reserved Notation "\gcd_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \gcd_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\gcd_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \gcd_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\gcd_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \gcd_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\gcd_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \gcd_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\gcd_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \gcd_ ( i | P ) '/ ' F ']'"). Reserved Notation "\gcd_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\gcd_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\gcd_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \gcd_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\gcd_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \gcd_ ( i < n ) F ']'"). Reserved Notation "\gcd_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \gcd_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\gcd_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \gcd_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\lcm_ i F" (at level 41, F at level 41, i at level 0, format "'[' \lcm_ i '/ ' F ']'"). Reserved Notation "\lcm_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \lcm_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\lcm_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \lcm_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\lcm_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \lcm_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\lcm_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \lcm_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\lcm_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \lcm_ ( i | P ) '/ ' F ']'"). Reserved Notation "\lcm_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\lcm_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\lcm_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \lcm_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\lcm_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \lcm_ ( i < n ) F ']'"). Reserved Notation "\lcm_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \lcm_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\lcm_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \lcm_ ( i 'in' A ) '/ ' F ']'"). (* Reserved notation for dual lattice operations. *) Reserved Notation "A `&^l` B" (at level 48, left associativity). Reserved Notation "A `|^l` B" (at level 52, left associativity). Reserved Notation "A `\^l` B" (at level 50, left associativity). Reserved Notation "~^l` A" (at level 35, right associativity). Reserved Notation "\meet_ i F" (at level 41, F at level 41, i at level 0, format "'[' \meet_ i '/ ' F ']'"). Reserved Notation "\meet_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\meet_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\meet_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\meet_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\meet_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \meet_ ( i | P ) '/ ' F ']'"). Reserved Notation "\meet_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\meet_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet_ ( i < n ) F ']'"). Reserved Notation "\meet_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\meet_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\join_ i F" (at level 41, F at level 41, i at level 0, format "'[' \join_ i '/ ' F ']'"). Reserved Notation "\join_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\join_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\join_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\join_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\join_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \join_ ( i | P ) '/ ' F ']'"). Reserved Notation "\join_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\join_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join_ ( i < n ) F ']'"). Reserved Notation "\join_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join_ ( i 'in' A | P ) '/ ' F ']'"). 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 "\min_ i F" (at level 41, F at level 41, i at level 0, format "'[' \min_ i '/ ' F ']'"). Reserved Notation "\min_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \min_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\min_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \min_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\min_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \min_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\min_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \min_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\min_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \min_ ( i | P ) '/ ' F ']'"). Reserved Notation "\min_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\min_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\min_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \min_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\min_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \min_ ( i < n ) F ']'"). Reserved Notation "\min_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \min_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\min_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \min_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\max_ i F" (at level 41, F at level 41, i at level 0, format "'[' \max_ i '/ ' F ']'"). Reserved Notation "\max_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\max_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\max_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\max_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \max_ ( i | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\max_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\max_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max_ ( i < n ) F ']'"). Reserved Notation "\max_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\max_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\meet^d_ i F" (at level 41, F at level 41, i at level 0, format "'[' \meet^d_ i '/ ' F ']'"). Reserved Notation "\meet^d_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet^d_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet^d_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet^d_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet^d_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \meet^d_ ( i | P ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet^d_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet^d_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet^d_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet^d_ ( i < n ) F ']'"). Reserved Notation "\meet^d_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet^d_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\meet^d_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet^d_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\join^d_ i F" (at level 41, F at level 41, i at level 0, format "'[' \join^d_ i '/ ' F ']'"). Reserved Notation "\join^d_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join^d_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\join^d_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join^d_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\join^d_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join^d_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\join^d_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join^d_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\join^d_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \join^d_ ( i | P ) '/ ' F ']'"). Reserved Notation "\join^d_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join^d_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join^d_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join^d_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\join^d_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join^d_ ( i < n ) F ']'"). Reserved Notation "\join^d_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join^d_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\join^d_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join^d_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\min^d_ i F" (at level 41, F at level 41, i at level 0, format "'[' \min^d_ i '/ ' F ']'"). Reserved Notation "\min^d_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \min^d_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\min^d_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \min^d_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\min^d_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \min^d_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\min^d_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \min^d_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\min^d_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \min^d_ ( i | P ) '/ ' F ']'"). Reserved Notation "\min^d_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\min^d_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\min^d_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \min^d_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\min^d_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \min^d_ ( i < n ) F ']'"). Reserved Notation "\min^d_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \min^d_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\min^d_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \min^d_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\max^d_ i F" (at level 41, F at level 41, i at level 0, format "'[' \max^d_ i '/ ' F ']'"). Reserved Notation "\max^d_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max^d_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\max^d_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \max^d_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\max^d_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max^d_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\max^d_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \max^d_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\max^d_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \max^d_ ( i | P ) '/ ' F ']'"). Reserved Notation "\max^d_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\max^d_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\max^d_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max^d_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\max^d_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \max^d_ ( i < n ) F ']'"). Reserved Notation "\max^d_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max^d_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\max^d_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \max^d_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\meet^p_ i F" (at level 41, F at level 41, i at level 0, format "'[' \meet^p_ i '/ ' F ']'"). Reserved Notation "\meet^p_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet^p_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \meet^p_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet^p_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \meet^p_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \meet^p_ ( i | P ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet^p_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\meet^p_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet^p_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \meet^p_ ( i < n ) F ']'"). Reserved Notation "\meet^p_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet^p_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\meet^p_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \meet^p_ ( i 'in' A ) '/ ' F ']'"). Reserved Notation "\join^p_ i F" (at level 41, F at level 41, i at level 0, format "'[' \join^p_ i '/ ' F ']'"). Reserved Notation "\join^p_ ( i <- r | P ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join^p_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\join^p_ ( i <- r ) F" (at level 41, F at level 41, i, r at level 50, format "'[' \join^p_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\join^p_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join^p_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\join^p_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \join^p_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\join^p_ ( i | P ) F" (at level 41, F at level 41, i at level 50, format "'[' \join^p_ ( i | P ) '/ ' F ']'"). Reserved Notation "\join^p_ ( i : t | P ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join^p_ ( i : t ) F" (at level 41, F at level 41, i at level 50). Reserved Notation "\join^p_ ( i < n | P ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join^p_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\join^p_ ( i < n ) F" (at level 41, F at level 41, i, n at level 50, format "'[' \join^p_ ( i < n ) F ']'"). Reserved Notation "\join^p_ ( i 'in' A | P ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join^p_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\join^p_ ( i 'in' A ) F" (at level 41, F at level 41, i, A at level 50, format "'[' \join^p_ ( i 'in' A ) '/ ' F ']'"). Module Order. (**************) (* STRUCTURES *) (**************) Module POrder. Section ClassDef. Record mixin_of (T0 : Type) (b : Equality.class_of T0) (T := Equality.Pack b) := Mixin { le : rel T; lt : rel T; _ : forall x y, lt x y = (y != x) && (le x y); _ : reflexive le; _ : antisymmetric le; _ : transitive le; }. Set Primitive Projections. Record class_of (T : Type) := Class { base : Choice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> Choice.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (Choice.class bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. End ClassDef. 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 POrderType disp T m := (@pack T disp _ _ id m). 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_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] (at level 0, format "[ 'porderType' 'of' T 'with' disp ]") : form_scope. End Exports. End POrder. Import POrder.Exports. Section POrderDef. Variable (disp : unit) (T : porderType disp). Definition le : rel T := POrder.le (POrder.class T). Local Notation "x <= y" := (le x y) : order_scope. Definition lt : rel T := POrder.lt (POrder.class T). Local Notation "x < y" := (lt x y) : order_scope. Definition comparable : rel T := fun (x y : T) => (x <= y) || (y <= x). Local Notation "x >=< y" := (comparable x y) : order_scope. Local Notation "x >< y" := (~~ (x >=< y)) : order_scope. Definition ge : simpl_rel T := [rel x y | y <= x]. Definition gt : simpl_rel T := [rel x y | y < x]. 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. Definition lteif x y C := if C then x <= y else x < y. Variant le_xor_gt (x y : T) : T -> T -> T -> T -> bool -> bool -> Set := | LeNotGt of x <= y : le_xor_gt x y x x y y true false | GtNotLe of y < x : le_xor_gt x y y y x x false true. Variant lt_xor_ge (x y : T) : T -> T -> T -> T -> bool -> bool -> Set := | LtNotGe of x < y : lt_xor_ge x y x x y y false true | GeNotLt of y <= x : lt_xor_ge x y y y x x true false. Definition min x y := if x < y then x else y. Definition max x y := if x < y then y else x. Variant compare (x y : T) : T -> T -> T -> T -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | CompareLt of x < y : compare x y x x y y false false false true false true | CompareGt of y < x : compare x y y y x x false false true false true false | CompareEq of x = y : compare x y x x x x true true true true false false. Variant incompare (x y : T) : T -> T -> T -> T -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | InCompareLt of x < y : incompare x y x x y y false false false true false true true true | InCompareGt of y < x : incompare x y y y x x false false true false true false true true | InCompare of x >< y : incompare x y x y y x false false false false false false false false | InCompareEq of x = y : incompare x y x x x x true true true true false false true true. Definition arg_min {I : finType} := @extremum T I le. Definition arg_max {I : finType} := @extremum T I ge. End POrderDef. Prenex Implicits lt le leif lteif. Arguments ge {_ _}. Arguments gt {_ _}. Arguments min {_ _}. Arguments max {_ _}. Arguments comparable {_ _}. Module Import POSyntax. Notation "<=%O" := le : fun_scope. Notation ">=%O" := ge : fun_scope. Notation "<%O" := lt : fun_scope. Notation ">%O" := gt : fun_scope. Notation "=<%O" := comparable : fun_scope. Notation "><%O" := (fun x y => ~~ (comparable x y)) : fun_scope. Notation "<= y" := (ge y) : order_scope. Notation "<= y :> T" := (<= (y : T)) (only parsing) : order_scope. Notation ">= y" := (le y) : order_scope. Notation ">= y :> T" := (>= (y : T)) (only parsing) : order_scope. Notation "< y" := (gt y) : order_scope. Notation "< y :> T" := (< (y : T)) (only parsing) : order_scope. Notation "> y" := (lt y) : order_scope. Notation "> y :> T" := (> (y : T)) (only parsing) : order_scope. Notation "x <= y" := (le x y) : order_scope. Notation "x <= y :> T" := ((x : T) <= (y : T)) (only parsing) : order_scope. Notation "x >= y" := (y <= x) (only parsing) : order_scope. Notation "x >= y :> T" := ((x : T) >= (y : T)) (only parsing) : order_scope. Notation "x < y" := (lt x y) : order_scope. Notation "x < y :> T" := ((x : T) < (y : T)) (only parsing) : order_scope. Notation "x > y" := (y < x) (only parsing) : order_scope. Notation "x > y :> T" := ((x : T) > (y : T)) (only parsing) : order_scope. Notation "x <= y <= z" := ((x <= y) && (y <= z)) : order_scope. Notation "x < y <= z" := ((x < y) && (y <= z)) : order_scope. 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 :> T" := ((x : T) <= (y : T) ?= iff C) (only parsing) : order_scope. Notation "x < y ?<= 'if' C" := (lteif x y C) : order_scope. Notation "x < y ?<= 'if' C :> T" := ((x : T) < (y : T) ?<= if C) (only parsing) : order_scope. Notation ">=< y" := [pred x | comparable x y] : order_scope. Notation ">=< y :> T" := (>=< (y : T)) (only parsing) : order_scope. Notation "x >=< y" := (comparable x y) : order_scope. Notation ">< y" := [pred x | ~~ comparable x y] : order_scope. Notation ">< y :> T" := (>< (y : T)) (only parsing) : order_scope. Notation "x >< y" := (~~ (comparable x y)) : 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 POSyntax. Module POCoercions. Coercion le_of_leif : leif >-> is_true. End POCoercions. Module Lattice. Section ClassDef. Record mixin_of (T0 : Type) (b : POrder.class_of T0) (T := POrder.Pack tt b) := Mixin { meet : T -> T -> T; join : T -> T -> T; _ : commutative meet; _ : commutative join; _ : associative meet; _ : associative join; _ : forall y x, meet x (join x y) = x; _ : forall y x, join x (meet x y) = x; _ : forall x y, (x <= y) = (meet x y == x); }. Set Primitive Projections. Record class_of (T : Type) := Class { base : POrder.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> POrder.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@POrder.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. End ClassDef. 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 LatticeType T m := (@pack T _ _ _ id m). 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_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] (at level 0, format "[ 'latticeType' 'of' T 'with' disp ]") : form_scope. End Exports. End Lattice. Export Lattice.Exports. Section LatticeDef. Context {disp : unit} {T : latticeType disp}. Definition meet : T -> T -> T := Lattice.meet (Lattice.class T). Definition join : T -> T -> T := Lattice.join (Lattice.class T). Variant lel_xor_gt (x y : T) : T -> T -> T -> T -> T -> T -> T -> T -> bool -> bool -> Set := | LelNotGt of x <= y : lel_xor_gt x y x x y y x x y y true false | GtlNotLe of y < x : lel_xor_gt x y y y x x y y x x false true. Variant ltl_xor_ge (x y : T) : T -> T -> T -> T -> T -> T -> T -> T -> bool -> bool -> Set := | LtlNotGe of x < y : ltl_xor_ge x y x x y y x x y y false true | GelNotLt of y <= x : ltl_xor_ge x y y y x x y y x x true false. Variant comparel (x y : T) : T -> T -> T -> T -> T -> T -> T -> T -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | ComparelLt of x < y : comparel x y x x y y x x y y false false false true false true | ComparelGt of y < x : comparel x y y y x x y y x x false false true false true false | ComparelEq of x = y : comparel x y x x x x x x x x true true true true false false. Variant incomparel (x y : T) : T -> T -> T -> T -> T -> T -> T -> T -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | InComparelLt of x < y : incomparel x y x x y y x x y y false false false true false true true true | InComparelGt of y < x : incomparel x y y y x x y y x x false false true false true false true true | InComparel of x >< y : incomparel x y x y y x (meet y x) (meet x y) (join y x) (join x y) false false false false false false false false | InComparelEq of x = y : incomparel x y x x x x x x x x true true true true false false true true. End LatticeDef. Module Import LatticeSyntax. Notation "x `&` y" := (meet x y) : order_scope. Notation "x `|` y" := (join x y) : order_scope. End LatticeSyntax. Module BLattice. Section ClassDef. Record mixin_of (T : Type) (b : POrder.class_of T) (T := POrder.Pack tt b) := Mixin { bottom : T; _ : forall x, bottom <= x; }. Set Primitive Projections. Record class_of (T : Type) := Class { base : Lattice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> Lattice.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@Lattice.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. End ClassDef. 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 BLatticeType T m := (@pack T _ _ _ id m). 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_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] (at level 0, format "[ 'bLatticeType' 'of' T 'with' disp ]") : form_scope. End Exports. End BLattice. Export BLattice.Exports. Definition bottom {disp : unit} {T : bLatticeType disp} : T := BLattice.bottom (BLattice.class T). Module Import BLatticeSyntax. Notation "0" := bottom : order_scope. Notation "\join_ ( i <- r | P ) F" := (\big[@join _ _/0%O]_(i <- r | P%B) F%O) : order_scope. Notation "\join_ ( i <- r ) F" := (\big[@join _ _/0%O]_(i <- r) F%O) : order_scope. Notation "\join_ ( i | P ) F" := (\big[@join _ _/0%O]_(i | P%B) F%O) : order_scope. Notation "\join_ i F" := (\big[@join _ _/0%O]_i F%O) : order_scope. Notation "\join_ ( i : I | P ) F" := (\big[@join _ _/0%O]_(i : I | P%B) F%O) (only parsing) : order_scope. 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. Notation "\join_ ( m <= i < n ) F" := (\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. Notation "\join_ ( i < n ) F" := (\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. Notation "\join_ ( i 'in' A ) F" := (\big[@join _ _/0%O]_(i in A) F%O) : order_scope. End BLatticeSyntax. Module TBLattice. Section ClassDef. Record mixin_of (T0 : Type) (b : POrder.class_of T0) (T := POrder.Pack tt b) := Mixin { top : T; _ : forall x, x <= top; }. Set Primitive Projections. Record class_of (T : Type) := Class { base : BLattice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> BLattice.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@BLattice.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. End ClassDef. 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 tbLatticeType := type. Notation TBLatticeType T m := (@pack T _ _ _ id m). 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_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] (at level 0, format "[ 'tbLatticeType' 'of' T 'with' disp ]") : form_scope. End Exports. End TBLattice. Export TBLattice.Exports. Definition top disp {T : tbLatticeType disp} : T := TBLattice.top (TBLattice.class T). Module Import TBLatticeSyntax. Notation "1" := top : order_scope. Notation "\meet_ ( i <- r | P ) F" := (\big[meet/1]_(i <- r | P%B) F%O) : order_scope. Notation "\meet_ ( i <- r ) F" := (\big[meet/1]_(i <- r) F%O) : order_scope. Notation "\meet_ ( i | P ) F" := (\big[meet/1]_(i | P%B) F%O) : order_scope. Notation "\meet_ i F" := (\big[meet/1]_i F%O) : order_scope. Notation "\meet_ ( i : I | P ) F" := (\big[meet/1]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\meet_ ( i : I ) F" := (\big[meet/1]_(i : I) F%O) (only parsing) : order_scope. Notation "\meet_ ( m <= i < n | P ) F" := (\big[meet/1]_(m <= i < n | P%B) F%O) : order_scope. Notation "\meet_ ( m <= i < n ) F" := (\big[meet/1]_(m <= i < n) F%O) : order_scope. Notation "\meet_ ( i < n | P ) F" := (\big[meet/1]_(i < n | P%B) F%O) : order_scope. Notation "\meet_ ( i < n ) F" := (\big[meet/1]_(i < n) F%O) : order_scope. Notation "\meet_ ( i 'in' A | P ) F" := (\big[meet/1]_(i in A | P%B) F%O) : order_scope. Notation "\meet_ ( i 'in' A ) F" := (\big[meet/1]_(i in A) F%O) : order_scope. End TBLatticeSyntax. Module DistrLattice. Section ClassDef. Record mixin_of (T0 : Type) (b : Lattice.class_of T0) (T := Lattice.Pack tt b) := Mixin { _ : @left_distributive T T meet join; }. Set Primitive Projections. Record class_of (T : Type) := Class { base : Lattice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> Lattice.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@Lattice.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. End ClassDef. 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 distrLatticeType := type. Notation DistrLatticeType T m := (@pack T _ _ _ id m). Notation "[ 'distrLatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'distrLatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'distrLatticeType' 'of' T 'for' cT 'with' disp ]" := (@clone_with T _ cT disp _ id) (at level 0, format "[ 'distrLatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. Notation "[ 'distrLatticeType' 'of' T ]" := [distrLatticeType of T for _] (at level 0, format "[ 'distrLatticeType' 'of' T ]") : form_scope. Notation "[ 'distrLatticeType' 'of' T 'with' disp ]" := [latticeType of T for _ with disp] (at level 0, format "[ 'distrLatticeType' 'of' T 'with' disp ]") : form_scope. End Exports. End DistrLattice. Export DistrLattice.Exports. Module BDistrLattice. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : DistrLattice.class_of T; mixin : BLattice.mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> DistrLattice.class_of. Local Coercion base2 T (c : class_of T) : BLattice.class_of T := BLattice.Class (mixin c). 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 pack := fun bT b & phant_id (@DistrLattice.class disp bT) b => fun mT m & phant_id (@BLattice.class disp mT) (BLattice.Class m) => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition nb_distrLatticeType := @DistrLattice.Pack disp bLatticeType class. End ClassDef. Module Exports. Coercion base : class_of >-> DistrLattice.class_of. Coercion base2 : class_of >-> BLattice.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. Coercion bLatticeType : type >-> BLattice.type. Coercion distrLatticeType : type >-> DistrLattice.type. Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical distrLatticeType. Canonical nb_distrLatticeType. Notation bDistrLatticeType := type. Notation "[ 'bDistrLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'bDistrLatticeType' 'of' T ]") : form_scope. End Exports. End BDistrLattice. Export BDistrLattice.Exports. Module TBDistrLattice. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : BDistrLattice.class_of T; mixin : TBLattice.mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> BDistrLattice.class_of. Local Coercion base2 T (c : class_of T) : TBLattice.class_of T := @TBLattice.Class T c (mixin c). 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 pack := fun bT (b : BDistrLattice.class_of T) & phant_id (@BDistrLattice.class disp bT) b => fun mT m & phant_id (@TBLattice.class disp mT) (@TBLattice.Class _ b m) => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. Definition ntb_distrLatticeType := @DistrLattice.Pack disp tbLatticeType class. Definition ntb_bDistrLatticeType := @BDistrLattice.Pack disp tbLatticeType class. End ClassDef. Module Exports. Coercion base : class_of >-> BDistrLattice.class_of. Coercion base2 : class_of >-> TBLattice.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. Coercion bLatticeType : type >-> BLattice.type. Coercion tbLatticeType : type >-> TBLattice.type. Coercion distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical ntb_distrLatticeType. Canonical ntb_bDistrLatticeType. Notation tbDistrLatticeType := type. Notation "[ 'tbDistrLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'tbDistrLatticeType' 'of' T ]") : form_scope. End Exports. End TBDistrLattice. Export TBDistrLattice.Exports. Module CBDistrLattice. Section ClassDef. Record mixin_of (T0 : Type) (b : BDistrLattice.class_of T0) (T := BDistrLattice.Pack tt b) := Mixin { sub : T -> T -> T; _ : forall x y, y `&` sub x y = bottom; _ : forall x y, (x `&` y) `|` sub x y = x }. Set Primitive Projections. Record class_of (T : Type) := Class { base : BDistrLattice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> BDistrLattice.class_of. 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@BDistrLattice.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. End ClassDef. Module Exports. Coercion base : class_of >-> BDistrLattice.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. Coercion distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Notation cbDistrLatticeType := type. Notation CBDistrLatticeType T m := (@pack T _ _ _ id m). Notation "[ 'cbDistrLatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'cbDistrLatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'cbDistrLatticeType' 'of' T 'for' cT 'with' disp ]" := (@clone_with T _ cT disp _ id) (at level 0, format "[ 'cbDistrLatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. Notation "[ 'cbDistrLatticeType' 'of' T ]" := [cbDistrLatticeType of T for _] (at level 0, format "[ 'cbDistrLatticeType' 'of' T ]") : form_scope. Notation "[ 'cbDistrLatticeType' 'of' T 'with' disp ]" := [cbDistrLatticeType of T for _ with disp] (at level 0, format "[ 'cbDistrLatticeType' 'of' T 'with' disp ]") : form_scope. End Exports. End CBDistrLattice. Export CBDistrLattice.Exports. Definition sub {disp : unit} {T : cbDistrLatticeType disp} : T -> T -> T := CBDistrLattice.sub (CBDistrLattice.class T). Module Import CBDistrLatticeSyntax. Notation "x `\` y" := (sub x y) : order_scope. End CBDistrLatticeSyntax. Module CTBDistrLattice. Section ClassDef. Record mixin_of (T0 : Type) (b : TBDistrLattice.class_of T0) (T := TBDistrLattice.Pack tt b) (sub : T -> T -> T) := Mixin { compl : T -> T; _ : forall x, compl x = sub top x }. Set Primitive Projections. Record class_of (T : Type) := Class { base : TBDistrLattice.class_of T; mixin1 : CBDistrLattice.mixin_of base; mixin2 : @mixin_of _ base (CBDistrLattice.sub mixin1); }. Unset Primitive Projections. Local Coercion base : class_of >-> TBDistrLattice.class_of. Local Coercion base2 T (c : class_of T) : CBDistrLattice.class_of T := CBDistrLattice.Class (mixin1 c). 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 c of phant_id class c := @Pack disp T c. Definition clone_with disp' c of phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@TBDistrLattice.class disp bT) b => fun mT m0 & phant_id (@CBDistrLattice.class disp mT) (CBDistrLattice.Class m0) => fun m1 => Pack disp (@Class T b m0 m1). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. Definition tbDistrLatticeType := @TBDistrLattice.Pack disp cT class. Definition cbDistrLatticeType := @CBDistrLattice.Pack disp cT class. Definition cb_tbLatticeType := @TBLattice.Pack disp cbDistrLatticeType class. Definition cb_tbDistrLatticeType := @TBDistrLattice.Pack disp cbDistrLatticeType class. End ClassDef. Module Exports. Coercion base : class_of >-> TBDistrLattice.class_of. Coercion base2 : class_of >-> CBDistrLattice.class_of. Coercion mixin1 : class_of >-> CBDistrLattice.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 distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Coercion tbDistrLatticeType : type >-> TBDistrLattice.type. Coercion cbDistrLatticeType : type >-> CBDistrLattice.type. Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical cbDistrLatticeType. Canonical cb_tbLatticeType. Canonical cb_tbDistrLatticeType. Notation ctbDistrLatticeType := type. Notation CTBDistrLatticeType T m := (@pack T _ _ _ id _ _ id m). Notation "[ 'ctbDistrLatticeType' 'of' T 'for' cT ]" := (@clone T _ cT _ id) (at level 0, format "[ 'ctbDistrLatticeType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'ctbDistrLatticeType' 'of' T 'for' cT 'with' disp ]" := (@clone_with T _ cT disp _ id) (at level 0, format "[ 'ctbDistrLatticeType' 'of' T 'for' cT 'with' disp ]") : form_scope. Notation "[ 'ctbDistrLatticeType' 'of' T ]" := [ctbDistrLatticeType of T for _] (at level 0, format "[ 'ctbDistrLatticeType' 'of' T ]") : form_scope. Notation "[ 'ctbDistrLatticeType' 'of' T 'with' disp ]" := [ctbDistrLatticeType of T for _ with disp] (at level 0, format "[ 'ctbDistrLatticeType' 'of' T 'with' disp ]") : form_scope. Notation "[ 'default_ctbDistrLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id (Mixin (fun=> erefl))) (at level 0, format "[ 'default_ctbDistrLatticeType' 'of' T ]") : form_scope. End Exports. End CTBDistrLattice. Export CTBDistrLattice.Exports. Definition compl {disp : unit} {T : ctbDistrLatticeType disp} : T -> T := CTBDistrLattice.compl (CTBDistrLattice.class T). Module Import CTBDistrLatticeSyntax. Notation "~` A" := (compl A) : order_scope. End CTBDistrLatticeSyntax. Module Total. Section ClassDef. Definition mixin_of T0 (b : POrder.class_of T0) (T := POrder.Pack tt b) := total (<=%O : rel T). Set Primitive Projections. Record class_of (T : Type) := Class { base : DistrLattice.class_of T; mixin : mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> DistrLattice.class_of. 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 c & phant_id class c := @Pack disp T c. Definition clone_with disp' c & phant_id class c := @Pack disp' T c. Definition pack := fun bT b & phant_id (@DistrLattice.class disp bT) b => fun m => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. End ClassDef. Module Exports. Coercion base : class_of >-> DistrLattice.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. Coercion distrLatticeType : type >-> DistrLattice.type. Canonical eqType. Canonical choiceType. Canonical porderType. Canonical latticeType. Canonical distrLatticeType. Notation orderType := type. Notation OrderType T m := (@pack T _ _ _ id m). 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_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] (at level 0, format "[ 'orderType' 'of' T 'with' disp ]") : form_scope. End Exports. End Total. Import Total.Exports. (**********) (* FINITE *) (**********) Module FinPOrder. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : POrder.class_of T; mixin : Finite.mixin_of (Equality.Pack base) }. Unset Primitive Projections. 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 }. 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 pack := 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 class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT class. Definition finType := @Finite.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition count_porderType := @POrder.Pack disp countType class. Definition fin_porderType := @POrder.Pack disp finType class. End ClassDef. 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 choiceType : type >-> Choice.type. Coercion countType : type >-> Countable.type. Coercion finType : type >-> Finite.type. Coercion porderType : type >-> POrder.type. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical count_porderType. Canonical fin_porderType. Notation finPOrderType := type. Notation "[ 'finPOrderType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finPOrderType' 'of' T ]") : form_scope. End Exports. End FinPOrder. Import FinPOrder.Exports. Module FinLattice. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : TBLattice.class_of T; mixin : Finite.mixin_of (Equality.Pack base); }. Unset Primitive Projections. Local Coercion base : class_of >-> TBLattice.class_of. Local Coercion base2 T (c : class_of T) : FinPOrder.class_of T := @FinPOrder.Class T c (mixin c). 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 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 class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT class. Definition finType := @Finite.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition finPOrderType := @FinPOrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition count_latticeType := @Lattice.Pack disp countType class. Definition count_bLatticeType := @BLattice.Pack disp countType class. Definition count_tbLatticeType := @TBLattice.Pack disp countType class. Definition fin_latticeType := @Lattice.Pack disp finType class. Definition fin_bLatticeType := @BLattice.Pack disp finType class. Definition fin_tbLatticeType := @TBLattice.Pack disp finType class. Definition finPOrder_latticeType := @Lattice.Pack disp finPOrderType class. Definition finPOrder_bLatticeType := @BLattice.Pack disp finPOrderType class. Definition finPOrder_tbLatticeType := @TBLattice.Pack disp finPOrderType class. End ClassDef. Module Exports. Coercion base : class_of >-> TBLattice.class_of. Coercion base2 : 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 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 _ _ _ id _ _ id) (at level 0, format "[ 'finLatticeType' 'of' T ]") : form_scope. End Exports. End FinLattice. Export FinLattice.Exports. Module FinDistrLattice. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : TBDistrLattice.class_of T; mixin : Finite.mixin_of (Equality.Pack base); }. Unset Primitive Projections. Local Coercion base : class_of >-> TBDistrLattice.class_of. Local Coercion base2 T (c : class_of T) : FinLattice.class_of T := @FinLattice.Class T c (mixin c). 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 pack := fun bT b & phant_id (@TBDistrLattice.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 class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT class. Definition finType := @Finite.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition finPOrderType := @FinPOrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition finLatticeType := @FinLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. Definition tbDistrLatticeType := @TBDistrLattice.Pack disp cT class. Definition count_distrLatticeType := @DistrLattice.Pack disp countType class. Definition count_bDistrLatticeType := @BDistrLattice.Pack disp countType class. Definition count_tbDistrLatticeType := @TBDistrLattice.Pack disp countType class. Definition fin_distrLatticeType := @DistrLattice.Pack disp finType class. Definition fin_bDistrLatticeType := @BDistrLattice.Pack disp finType class. Definition fin_tbDistrLatticeType := @TBDistrLattice.Pack disp finType class. Definition finPOrder_distrLatticeType := @DistrLattice.Pack disp finPOrderType class. Definition finPOrder_bDistrLatticeType := @BDistrLattice.Pack disp finPOrderType class. Definition finPOrder_tbDistrLatticeType := @TBDistrLattice.Pack disp finPOrderType class. Definition finLattice_distrLatticeType := @DistrLattice.Pack disp finLatticeType class. Definition finLattice_bDistrLatticeType := @BDistrLattice.Pack disp finLatticeType class. Definition finLattice_tbDistrLatticeType := @TBDistrLattice.Pack disp finLatticeType class. End ClassDef. Module Exports. Coercion base : class_of >-> TBDistrLattice.class_of. Coercion base2 : 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 distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Coercion tbDistrLatticeType : type >-> TBDistrLattice.type. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical finLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical count_distrLatticeType. Canonical count_bDistrLatticeType. Canonical count_tbDistrLatticeType. Canonical fin_distrLatticeType. Canonical fin_bDistrLatticeType. Canonical fin_tbDistrLatticeType. Canonical finPOrder_distrLatticeType. Canonical finPOrder_bDistrLatticeType. Canonical finPOrder_tbDistrLatticeType. Canonical finLattice_distrLatticeType. Canonical finLattice_bDistrLatticeType. Canonical finLattice_tbDistrLatticeType. Notation finDistrLatticeType := type. Notation "[ 'finDistrLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finDistrLatticeType' 'of' T ]") : form_scope. End Exports. End FinDistrLattice. Export FinDistrLattice.Exports. Module FinCDistrLattice. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : CTBDistrLattice.class_of T; mixin : Finite.mixin_of (Equality.Pack base); }. Unset Primitive Projections. Local Coercion base : class_of >-> CTBDistrLattice.class_of. Local Coercion base2 T (c : class_of T) : FinDistrLattice.class_of T := @FinDistrLattice.Class T c (mixin c). 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 pack := fun bT b & phant_id (@CTBDistrLattice.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 class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT class. Definition finType := @Finite.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition finPOrderType := @FinPOrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition finLatticeType := @FinLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. Definition tbDistrLatticeType := @TBDistrLattice.Pack disp cT class. Definition finDistrLatticeType := @FinDistrLattice.Pack disp cT class. Definition cbDistrLatticeType := @CBDistrLattice.Pack disp cT class. Definition ctbDistrLatticeType := @CTBDistrLattice.Pack disp cT class. Definition count_cbDistrLatticeType := @CBDistrLattice.Pack disp countType class. Definition count_ctbDistrLatticeType := @CTBDistrLattice.Pack disp countType class. Definition fin_cbDistrLatticeType := @CBDistrLattice.Pack disp finType class. Definition fin_ctbDistrLatticeType := @CTBDistrLattice.Pack disp finType class. Definition finPOrder_cbDistrLatticeType := @CBDistrLattice.Pack disp finPOrderType class. Definition finPOrder_ctbDistrLatticeType := @CTBDistrLattice.Pack disp finPOrderType class. Definition finLattice_cbDistrLatticeType := @CBDistrLattice.Pack disp finLatticeType class. Definition finLattice_ctbDistrLatticeType := @CTBDistrLattice.Pack disp finLatticeType class. Definition finDistrLattice_cbDistrLatticeType := @CBDistrLattice.Pack disp finDistrLatticeType class. Definition finDistrLattice_ctbDistrLatticeType := @CTBDistrLattice.Pack disp finDistrLatticeType class. End ClassDef. Module Exports. Coercion base : class_of >-> CTBDistrLattice.class_of. Coercion base2 : class_of >-> FinDistrLattice.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 distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Coercion tbDistrLatticeType : type >-> TBDistrLattice.type. Coercion finDistrLatticeType : type >-> FinDistrLattice.type. Coercion cbDistrLatticeType : type >-> CBDistrLattice.type. Coercion ctbDistrLatticeType : type >-> CTBDistrLattice.type. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical finLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical finDistrLatticeType. Canonical cbDistrLatticeType. Canonical ctbDistrLatticeType. Canonical count_cbDistrLatticeType. Canonical count_ctbDistrLatticeType. Canonical fin_cbDistrLatticeType. Canonical fin_ctbDistrLatticeType. Canonical finPOrder_cbDistrLatticeType. Canonical finPOrder_ctbDistrLatticeType. Canonical finLattice_cbDistrLatticeType. Canonical finLattice_ctbDistrLatticeType. Canonical finDistrLattice_cbDistrLatticeType. Canonical finDistrLattice_ctbDistrLatticeType. Notation finCDistrLatticeType := type. Notation "[ 'finCDistrLatticeType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finCDistrLatticeType' 'of' T ]") : form_scope. End Exports. End FinCDistrLattice. Export FinCDistrLattice.Exports. Module FinTotal. Section ClassDef. Set Primitive Projections. Record class_of (T : Type) := Class { base : FinDistrLattice.class_of T; mixin : Total.mixin_of base; }. Unset Primitive Projections. Local Coercion base : class_of >-> FinDistrLattice.class_of. Local Coercion base2 T (c : class_of T) : Total.class_of T := @Total.Class _ c (mixin (c := c)). 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 pack := fun bT b & phant_id (@FinDistrLattice.class disp bT) b => fun mT m & phant_id (@Total.class disp mT) (Total.Class m) => Pack disp (@Class T b m). Definition eqType := @Equality.Pack cT class. Definition choiceType := @Choice.Pack cT class. Definition countType := @Countable.Pack cT class. Definition finType := @Finite.Pack cT class. Definition porderType := @POrder.Pack disp cT class. Definition finPOrderType := @FinPOrder.Pack disp cT class. Definition latticeType := @Lattice.Pack disp cT class. Definition bLatticeType := @BLattice.Pack disp cT class. Definition tbLatticeType := @TBLattice.Pack disp cT class. Definition finLatticeType := @FinLattice.Pack disp cT class. Definition distrLatticeType := @DistrLattice.Pack disp cT class. Definition bDistrLatticeType := @BDistrLattice.Pack disp cT class. Definition tbDistrLatticeType := @TBDistrLattice.Pack disp cT class. Definition finDistrLatticeType := @FinDistrLattice.Pack disp cT class. Definition orderType := @Total.Pack disp cT class. Definition order_countType := @Countable.Pack orderType class. Definition order_finType := @Finite.Pack orderType class. Definition order_finPOrderType := @FinPOrder.Pack disp orderType class. Definition order_bLatticeType := @BLattice.Pack disp orderType class. Definition order_tbLatticeType := @TBLattice.Pack disp orderType class. Definition order_finLatticeType := @FinLattice.Pack disp orderType class. Definition order_bDistrLatticeType := @BDistrLattice.Pack disp orderType class. Definition order_tbDistrLatticeType := @TBDistrLattice.Pack disp orderType class. Definition order_finDistrLatticeType := @FinDistrLattice.Pack disp orderType class. End ClassDef. Module Exports. Coercion base : class_of >-> FinDistrLattice.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 bLatticeType : type >-> BLattice.type. Coercion tbLatticeType : type >-> TBLattice.type. Coercion finLatticeType : type >-> FinLattice.type. Coercion distrLatticeType : type >-> DistrLattice.type. Coercion bDistrLatticeType : type >-> BDistrLattice.type. Coercion tbDistrLatticeType : type >-> TBDistrLattice.type. Coercion finDistrLatticeType : type >-> FinDistrLattice.type. Coercion orderType : type >-> Total.type. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical finPOrderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical finLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical finDistrLatticeType. Canonical orderType. Canonical order_countType. Canonical order_finType. Canonical order_finPOrderType. Canonical order_bLatticeType. Canonical order_tbLatticeType. Canonical order_finLatticeType. Canonical order_bDistrLatticeType. Canonical order_tbDistrLatticeType. Canonical order_finDistrLatticeType. Notation finOrderType := type. Notation "[ 'finOrderType' 'of' T ]" := (@pack T _ _ _ id _ _ id) (at level 0, format "[ 'finOrderType' 'of' T ]") : form_scope. End Exports. End FinTotal. Export FinTotal.Exports. (********) (* DUAL *) (********) Definition dual T : Type := T. Definition dual_display : unit -> unit. Proof. exact. Qed. Notation dual_le := (@le (dual_display _) _). Notation dual_lt := (@lt (dual_display _) _). Notation dual_comparable := (@comparable (dual_display _) _). Notation dual_ge := (@ge (dual_display _) _). Notation dual_gt := (@gt (dual_display _) _). Notation dual_leif := (@leif (dual_display _) _). Notation dual_lteif := (@lteif (dual_display _) _). Notation dual_max := (@max (dual_display _) _). Notation dual_min := (@min (dual_display _) _). Notation dual_meet := (@meet (dual_display _) _). Notation dual_join := (@join (dual_display _) _). Notation dual_bottom := (@bottom (dual_display _) _). Notation dual_top := (@top (dual_display _) _). Module Import DualSyntax. Notation "T ^d" := (dual T) (at level 2, format "T ^d") : type_scope. Notation "<=^d%O" := dual_le : fun_scope. Notation ">=^d%O" := dual_ge : fun_scope. Notation "<^d%O" := dual_lt : fun_scope. Notation ">^d%O" := dual_gt : fun_scope. Notation "=<^d%O" := dual_comparable : fun_scope. Notation "><^d%O" := (fun x y => ~~ dual_comparable x y) : fun_scope. Notation "<=^d y" := (>=^d%O y) : order_scope. Notation "<=^d y :> T" := (<=^d (y : T)) (only parsing) : order_scope. Notation ">=^d y" := (<=^d%O y) : order_scope. Notation ">=^d y :> T" := (>=^d (y : T)) (only parsing) : order_scope. Notation "<^d y" := (>^d%O y) : order_scope. Notation "<^d y :> T" := (<^d (y : T)) (only parsing) : order_scope. Notation ">^d y" := (<^d%O y) : order_scope. Notation ">^d y :> T" := (>^d (y : T)) (only parsing) : order_scope. Notation "x <=^d y" := (<=^d%O x y) : order_scope. Notation "x <=^d y :> T" := ((x : T) <=^d (y : T)) (only parsing) : order_scope. Notation "x >=^d y" := (y <=^d x) (only parsing) : order_scope. Notation "x >=^d y :> T" := ((x : T) >=^d (y : T)) (only parsing) : order_scope. Notation "x <^d y" := (<^d%O x y) : order_scope. Notation "x <^d y :> T" := ((x : T) <^d (y : T)) (only parsing) : order_scope. Notation "x >^d y" := (y <^d x) (only parsing) : order_scope. Notation "x >^d y :> T" := ((x : T) >^d (y : T)) (only parsing) : order_scope. Notation "x <=^d y <=^d z" := ((x <=^d y) && (y <=^d z)) : order_scope. Notation "x <^d y <=^d z" := ((x <^d y) && (y <=^d z)) : order_scope. Notation "x <=^d y <^d z" := ((x <=^d y) && (y <^d z)) : order_scope. Notation "x <^d y <^d z" := ((x <^d y) && (y <^d z)) : order_scope. Notation "x <=^d y ?= 'iff' C" := ( T" := ((x : T) <=^d (y : T) ?= iff C) (only parsing) : order_scope. Notation "x <^d y ?<= 'if' C" := ( T" := ((x : T) <^d (y : T) ?<= if C) (only parsing) : order_scope. Notation ">=<^d x" := (>=<^d%O x) : order_scope. Notation ">=<^d y :> T" := (>=<^d (y : T)) (only parsing) : order_scope. Notation "x >=<^d y" := (>=<^d%O x y) : order_scope. Notation "><^d y" := [pred x | ~~ dual_comparable x y] : order_scope. Notation "><^d y :> T" := (><^d (y : T)) (only parsing) : order_scope. Notation "x ><^d y" := (~~ (><^d%O x y)) : order_scope. Notation "x `&^d` y" := (dual_meet x y) : order_scope. Notation "x `|^d` y" := (dual_join x y) : order_scope. Notation "0^d" := dual_bottom : order_scope. Notation "1^d" := dual_top : order_scope. (* The following Local Notations are here to define the \join^d_ and \meet^d_ *) (* notations later. Do not remove them. *) Local Notation "0" := dual_bottom. Local Notation "1" := dual_top. Local Notation join := dual_join. Local Notation meet := dual_meet. Notation "\join^d_ ( i <- r | P ) F" := (\big[join/0]_(i <- r | P%B) F%O) : order_scope. Notation "\join^d_ ( i <- r ) F" := (\big[join/0]_(i <- r) F%O) : order_scope. Notation "\join^d_ ( i | P ) F" := (\big[join/0]_(i | P%B) F%O) : order_scope. Notation "\join^d_ i F" := (\big[join/0]_i F%O) : order_scope. Notation "\join^d_ ( i : I | P ) F" := (\big[join/0]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\join^d_ ( i : I ) F" := (\big[join/0]_(i : I) F%O) (only parsing) : order_scope. Notation "\join^d_ ( m <= i < n | P ) F" := (\big[join/0]_(m <= i < n | P%B) F%O) : order_scope. Notation "\join^d_ ( m <= i < n ) F" := (\big[join/0]_(m <= i < n) F%O) : order_scope. Notation "\join^d_ ( i < n | P ) F" := (\big[join/0]_(i < n | P%B) F%O) : order_scope. Notation "\join^d_ ( i < n ) F" := (\big[join/0]_(i < n) F%O) : order_scope. Notation "\join^d_ ( i 'in' A | P ) F" := (\big[join/0]_(i in A | P%B) F%O) : order_scope. Notation "\join^d_ ( i 'in' A ) F" := (\big[join/0]_(i in A) F%O) : order_scope. Notation "\meet^d_ ( i <- r | P ) F" := (\big[meet/1]_(i <- r | P%B) F%O) : order_scope. Notation "\meet^d_ ( i <- r ) F" := (\big[meet/1]_(i <- r) F%O) : order_scope. Notation "\meet^d_ ( i | P ) F" := (\big[meet/1]_(i | P%B) F%O) : order_scope. Notation "\meet^d_ i F" := (\big[meet/1]_i F%O) : order_scope. Notation "\meet^d_ ( i : I | P ) F" := (\big[meet/1]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\meet^d_ ( i : I ) F" := (\big[meet/1]_(i : I) F%O) (only parsing) : order_scope. Notation "\meet^d_ ( m <= i < n | P ) F" := (\big[meet/1]_(m <= i < n | P%B) F%O) : order_scope. Notation "\meet^d_ ( m <= i < n ) F" := (\big[meet/1]_(m <= i < n) F%O) : order_scope. Notation "\meet^d_ ( i < n | P ) F" := (\big[meet/1]_(i < n | P%B) F%O) : order_scope. Notation "\meet^d_ ( i < n ) F" := (\big[meet/1]_(i < n) F%O) : order_scope. Notation "\meet^d_ ( i 'in' A | P ) F" := (\big[meet/1]_(i in A | P%B) F%O) : order_scope. Notation "\meet^d_ ( i 'in' A ) F" := (\big[meet/1]_(i in A) F%O) : order_scope. End DualSyntax. (**********) (* THEORY *) (**********) Module Import POrderTheory. Section POrderTheory. Context {disp : unit} {T : porderType disp}. Implicit Types (x y : T) (s : seq 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 : core. Definition le_refl : reflexive le := lexx. 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 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_def eqxx. Qed. Definition lt_irreflexive : irreflexive lt := ltxx. 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. Lemma lt_eqF x y: x < y -> x == y = false. Proof. by rewrite lt_neqAle => /andP [/negbTE->]. Qed. Lemma gt_eqF x y : y < x -> x == y = false. Proof. by apply: contraTF => /eqP ->; rewrite ltxx. Qed. Lemma eq_le x y: (x == y) = (x <= y <= x). Proof. by apply/eqP/idP => [->|/le_anti]; rewrite ?lexx. Qed. Lemma ltW x y: x < y -> x <= y. Proof. by rewrite le_eqVlt orbC => ->. Qed. Lemma lt_le_trans y x z: x < y -> y <= z -> x < z. Proof. rewrite !lt_neqAle => /andP [nexy lexy leyz]; rewrite (le_trans lexy) // andbT. by apply: contraNneq nexy => eqxz; rewrite eqxz eq_le leyz andbT in lexy *. Qed. Lemma lt_trans: transitive (<%O : rel T). Proof. by move=> y x z le1 /ltW le2; apply/(@lt_le_trans y). Qed. Lemma le_lt_trans y x z: x <= y -> y < z -> x < z. 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. Qed. Lemma lt_geF x y : (x < y) -> y <= x = false. Proof. by move=> le_xy; apply/negP => /le_lt_trans /(_ le_xy); rewrite ltxx. Qed. Definition lt_gtF x y hxy := le_gtF (@ltW x y hxy). Lemma lt_leAnge x y : (x < y) = (x <= y) && ~~ (y <= x). Proof. apply/idP/idP => [ltxy|/andP[lexy Nleyx]]; first by rewrite ltW // lt_geF. 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 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 : sorted <%O s = uniq s && sorted <=%O s. Proof. case: s => //= n s; elim: s n => //= m s IHs n. rewrite inE lt_neqAle negb_or IHs -!andbA. case sn: (n \in s); last do !bool_congr. rewrite andbF; apply/and5P=> [[ne_nm lenm _ _ le_ms]]; case/negP: ne_nm. by rewrite eq_le lenm /=; apply: (allP (order_path_min le_trans le_ms)). Qed. Lemma lt_sorted_eq s1 s2 : sorted <%O s1 -> sorted <%O s2 -> s1 =i s2 -> s1 = s2. Proof. by apply: irr_sorted_eq => //; apply: lt_trans. Qed. Lemma le_sorted_eq s1 s2 : sorted <=%O s1 -> sorted <=%O s2 -> perm_eq s1 s2 -> s1 = s2. Proof. exact/sorted_eq/le_anti/le_trans. Qed. Lemma sort_le_id s : sorted <=%O s -> sort <=%O s = s. Proof. exact/sorted_sort/le_trans. Qed. Lemma comparable_leNgt x y : x >=< y -> (x <= y) = ~~ (y < x). Proof. move=> c_xy; apply/idP/idP => [/le_gtF/negP/negP//|]; rewrite lt_neqAle. by move: c_xy => /orP [] -> //; rewrite andbT negbK => /eqP ->. Qed. Lemma comparable_ltNge x y : x >=< y -> (x < y) = ~~ (y <= x). Proof. move=> c_xy; apply/idP/idP => [/lt_geF/negP/negP//|]. by rewrite lt_neqAle eq_le; move: c_xy => /orP [] -> //; rewrite andbT. Qed. Lemma comparable_ltgtP x y : x >=< y -> compare x y (min y x) (min x y) (max y x) (max x y) (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y). Proof. rewrite /min /max />=<%O !le_eqVlt [y == x]eq_sym. have := (eqVneq x y, (boolP (x < y), boolP (y < x))). move=> [[->//|neq_xy /=] [[] xy [] //=]] ; do ?by rewrite ?ltxx; constructor. by rewrite ltxx in xy. by rewrite le_gtF // ltW. Qed. Lemma comparable_leP x y : x >=< y -> le_xor_gt x y (min y x) (min x y) (max y x) (max x y) (x <= y) (y < x). Proof. by move=> /comparable_ltgtP [?|?|->]; constructor; rewrite // ltW. Qed. Lemma comparable_ltP x y : x >=< y -> lt_xor_ge x y (min y x) (min x y) (max y x) (max x y) (y <= x) (x < y). Proof. by move=> /comparable_ltgtP [?|?|->]; constructor; rewrite // ltW. Qed. Lemma comparable_sym x y : (y >=< x) = (x >=< y). Proof. by rewrite /comparable orbC. Qed. Lemma comparablexx x : x >=< x. Proof. by rewrite /comparable lexx. Qed. Lemma incomparable_eqF x y : (x >< y) -> (x == y) = false. Proof. by apply: contraNF => /eqP ->; rewrite comparablexx. Qed. Lemma incomparable_leF x y : (x >< y) -> (x <= y) = false. Proof. by apply: contraNF; rewrite /comparable => ->. Qed. Lemma incomparable_ltF x y : (x >< y) -> (x < y) = false. Proof. by rewrite lt_neqAle => /incomparable_leF ->; rewrite andbF. Qed. Lemma comparableP x y : incompare x y (min y x) (min x y) (max y x) (max x y) (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y) (y >=< x) (x >=< y). Proof. rewrite ![y >=< _]comparable_sym; have [c_xy|i_xy] := boolP (x >=< y). by case: (comparable_ltgtP c_xy) => ?; constructor. by rewrite /min /max ?incomparable_eqF ?incomparable_leF; rewrite ?incomparable_ltF// 1?comparable_sym //; constructor. Qed. Lemma le_comparable (x y : T) : x <= y -> x >=< y. Proof. by case: comparableP. Qed. Lemma lt_comparable (x y : T) : x < y -> x >=< y. Proof. by case: comparableP. Qed. Lemma ge_comparable (x y : T) : y <= x -> x >=< y. Proof. by case: comparableP. Qed. Lemma gt_comparable (x y : T) : y < x -> x >=< y. Proof. by case: comparableP. Qed. (* leif *) Lemma leifP x y C : reflect (x <= y ?= iff C) (if C then x == y else x < y). Proof. rewrite /leif le_eqVlt; apply: (iffP idP)=> [|[]]. by case: C => [/eqP->|lxy]; rewrite ?eqxx // lxy lt_eqF. 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 ltNleif x y C : x <= y ?= iff ~~ C -> (x < y) = C. Proof. by move=> /lt_leif; rewrite negbK. Qed. Lemma eq_leif x y C : x <= y ?= iff C -> (x == y) = C. Proof. by move=> /leifP; case: C comparableP => [] []. Qed. Lemma eqTleif x y C : x <= y ?= iff C -> C -> x = y. Proof. by move=> /eq_leif<-/eqP. Qed. (* lteif *) Lemma lteif_trans x y z C1 C2 : x < y ?<= if C1 -> y < z ?<= if C2 -> x < z ?<= if C1 && C2. Proof. case: C1 C2 => [][]; [exact: le_trans | exact: le_lt_trans | exact: lt_le_trans | exact: lt_trans]. Qed. Lemma lteif_anti C1 C2 x y : (x < y ?<= if C1) && (y < x ?<= if C2) = C1 && C2 && (x == y). Proof. by case: C1 C2 => [][]; rewrite lte_anti. Qed. Lemma lteifxx x C : (x < x ?<= if C) = C. Proof. by case: C; rewrite /= ltexx. Qed. Lemma lteifNF x y C : y < x ?<= if ~~ C -> x < y ?<= if C = false. Proof. by case: C => [/lt_geF|/le_gtF]. Qed. Lemma lteifS x y C : x < y -> x < y ?<= if C. Proof. by case: C => //= /ltW. Qed. Lemma lteifT x y : x < y ?<= if true = (x <= y). Proof. by []. Qed. Lemma lteifF x y : x < y ?<= if false = (x < y). Proof. by []. Qed. Lemma lteif_orb x y : {morph lteif x y : p q / p || q}. Proof. by case=> [][] /=; case: comparableP. Qed. Lemma lteif_andb x y : {morph lteif x y : p q / p && q}. Proof. by case=> [][] /=; case: comparableP. Qed. Lemma lteif_imply C1 C2 x y : C1 ==> C2 -> x < y ?<= if C1 -> x < y ?<= if C2. Proof. by case: C1 C2 => [][] //= _ /ltW. Qed. Lemma lteifW C x y : x < y ?<= if C -> x <= y. Proof. by case: C => // /ltW. Qed. Lemma ltrW_lteif C x y : x < y -> x < y ?<= if C. Proof. by case: C => // /ltW. Qed. Lemma lteifN C x y : x < y ?<= if ~~ C -> ~~ (y < x ?<= if C). Proof. by case: C => /=; case: comparableP. Qed. (* min and max *) Lemma minElt x y : min x y = if x < y then x else y. Proof. by []. Qed. Lemma maxElt x y : max x y = if x < y then y else x. Proof. by []. Qed. Lemma minEle x y : min x y = if x <= y then x else y. Proof. by case: comparableP. Qed. Lemma maxEle x y : max x y = if x <= y then y else x. Proof. by case: comparableP. Qed. Lemma comparable_minEgt x y : x >=< y -> min x y = if x > y then y else x. Proof. by case: comparableP. Qed. Lemma comparable_maxEgt x y : x >=< y -> max x y = if x > y then x else y. Proof. by case: comparableP. Qed. Lemma comparable_minEge x y : x >=< y -> min x y = if x >= y then y else x. Proof. by case: comparableP. Qed. Lemma comparable_maxEge x y : x >=< y -> max x y = if x >= y then x else y. Proof. by case: comparableP. Qed. Lemma min_l x y : x <= y -> min x y = x. Proof. by case: comparableP. Qed. Lemma min_r x y : y <= x -> min x y = y. Proof. by case: comparableP. Qed. Lemma max_l x y : y <= x -> max x y = x. Proof. by case: comparableP. Qed. Lemma max_r x y : x <= y -> max x y = y. Proof. by case: comparableP. Qed. Lemma minxx : idempotent (min : T -> T -> T). Proof. by rewrite /min => x; rewrite ltxx. Qed. Lemma maxxx : idempotent (max : T -> T -> T). Proof. by rewrite /max => x; rewrite ltxx. Qed. Lemma eq_minl x y : (min x y == x) = (x <= y). Proof. by rewrite !(fun_if, if_arg) eqxx; case: comparableP. Qed. Lemma eq_maxr x y : (max x y == y) = (x <= y). Proof. by rewrite !(fun_if, if_arg) eqxx; case: comparableP. Qed. Lemma min_idPl x y : reflect (min x y = x) (x <= y). Proof. by apply: (iffP idP); rewrite (rwP eqP) eq_minl. Qed. Lemma max_idPr x y : reflect (max x y = y) (x <= y). Proof. by apply: (iffP idP); rewrite (rwP eqP) eq_maxr. Qed. Lemma min_minKx x y : min (min x y) y = min x y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP. Qed. Lemma min_minxK x y : min x (min x y) = min x y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP. Qed. Lemma max_maxKx x y : max (max x y) y = max x y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP. Qed. Lemma max_maxxK x y : max x (max x y) = max x y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP. Qed. Lemma comparable_minl z : {in >=< z &, forall x y, min x y >=< z}. Proof. by move=> x y cmp_xz cmp_yz; rewrite /min; case: ifP. Qed. Lemma comparable_minr z : {in >=<%O z &, forall x y, z >=< min x y}. Proof. by move=> x y cmp_xz cmp_yz; rewrite /min; case: ifP. Qed. Lemma comparable_maxl z : {in >=< z &, forall x y, max x y >=< z}. Proof. by move=> x y cmp_xz cmp_yz; rewrite /max; case: ifP. Qed. Lemma comparable_maxr z : {in >=<%O z &, forall x y, z >=< max x y}. Proof. by move=> x y cmp_xz cmp_yz; rewrite /max; case: ifP. Qed. Section Comparable2. Variables (z x y : T) (cmp_xy : x >=< y). Lemma comparable_minC : min x y = min y x. Proof. by case: comparableP cmp_xy. Qed. Lemma comparable_maxC : max x y = max y x. Proof. by case: comparableP cmp_xy. Qed. Lemma comparable_eq_minr : (min x y == y) = (y <= x). Proof. by rewrite !(fun_if, if_arg) eqxx; case: comparableP cmp_xy. Qed. Lemma comparable_eq_maxl : (max x y == x) = (y <= x). Proof. by rewrite !(fun_if, if_arg) eqxx; case: comparableP cmp_xy. Qed. Lemma comparable_min_idPr : reflect (min x y = y) (y <= x). Proof. by apply: (iffP idP); rewrite (rwP eqP) comparable_eq_minr. Qed. Lemma comparable_max_idPl : reflect (max x y = x) (y <= x). Proof. by apply: (iffP idP); rewrite (rwP eqP) comparable_eq_maxl. Qed. Lemma comparable_le_minr : (z <= min x y) = (z <= x) && (z <= y). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?andbb//; last rewrite andbC; by case: (comparableP z) => // [/lt_trans xlt/xlt|->] /ltW. Qed. Lemma comparable_le_minl : (min x y <= z) = (x <= z) || (y <= z). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?orbb//; last rewrite orbC; by move=> xy _; apply/idP/idP => [->|/orP[]]//; apply/le_trans/ltW. Qed. Lemma comparable_lt_minr : (z < min x y) = (z < x) && (z < y). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?andbb//; last rewrite andbC; by case: (comparableP z) => // /lt_trans xlt/xlt. Qed. Lemma comparable_lt_minl : (min x y < z) = (x < z) || (y < z). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?orbb//; last rewrite orbC; by move=> xy _; apply/idP/idP => [->|/orP[]]//; apply/lt_trans. Qed. Lemma comparable_le_maxr : (z <= max x y) = (z <= x) || (z <= y). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?orbb//; first rewrite orbC; by move=> xy _; apply/idP/idP => [->|/orP[]]// /le_trans->//; apply/ltW. Qed. Lemma comparable_le_maxl : (max x y <= z) = (x <= z) && (y <= z). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?andbb//; first rewrite andbC; by case: (comparableP z) => // [ylt /lt_trans /(_ _)/ltW|->/ltW]->. Qed. Lemma comparable_lt_maxr : (z < max x y) = (z < x) || (z < y). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?orbb//; first rewrite orbC; by move=> xy _; apply/idP/idP => [->|/orP[]]// /lt_trans->. Qed. Lemma comparable_lt_maxl : (max x y < z) = (x < z) && (y < z). Proof. case: comparableP cmp_xy => // [||<-//]; rewrite ?andbb//; first rewrite andbC; by case: (comparableP z) => // ylt /lt_trans->. Qed. Lemma comparable_minxK : max (min x y) y = y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP cmp_xy. Qed. Lemma comparable_minKx : max x (min x y) = x. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP cmp_xy. Qed. Lemma comparable_maxxK : min (max x y) y = y. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP cmp_xy. Qed. Lemma comparable_maxKx : min x (max x y) = x. Proof. by rewrite !(fun_if, if_arg) ltxx/=; case: comparableP cmp_xy. Qed. Lemma comparable_lteifNE C : x >=< y -> x < y ?<= if ~~ C = ~~ (y < x ?<= if C). Proof. by case: C => /=; case: comparableP. Qed. Lemma comparable_lteif_minr C : (z < Order.min x y ?<= if C) = (z < x ?<= if C) && (z < y ?<= if C). Proof. by case: C; rewrite /= (comparable_le_minr, comparable_lt_minr). Qed. Lemma comparable_lteif_minl C : (Order.min x y < z ?<= if C) = (x < z ?<= if C) || (y < z ?<= if C). Proof. by case: C; rewrite /= (comparable_le_minl, comparable_lt_minl). Qed. Lemma comparable_lteif_maxr C : (z < Order.max x y ?<= if C) = (z < x ?<= if C) || (z < y ?<= if C). Proof. by case: C; rewrite /= (comparable_le_maxr, comparable_lt_maxr). Qed. Lemma comparable_lteif_maxl C : (Order.max x y < z ?<= if C) = (x < z ?<= if C) && (y < z ?<= if C). Proof. by case: C; rewrite /= (comparable_le_maxl, comparable_lt_maxl). Qed. End Comparable2. Section Comparable3. Variables (x y z : T) (cmp_xy : x >=< y) (cmp_xz : x >=< z) (cmp_yz : y >=< z). Let P := comparableP. Lemma comparable_minA : min x (min y z) = min (min x y) z. Proof. move: cmp_xy cmp_xz cmp_yz; rewrite !(fun_if, if_arg)/=. move: (P x y) (P x z) (P y z) => [xy|xy|xy|<-] [xz|xz|xz|<-]// []//= yz. - by have := lt_trans xy (lt_trans yz xz); rewrite ltxx. - by have := lt_trans xy (lt_trans xz yz); rewrite ltxx. - by have := lt_trans xy xz; rewrite yz ltxx. Qed. Lemma comparable_maxA : max x (max y z) = max (max x y) z. Proof. move: cmp_xy cmp_xz cmp_yz; rewrite !(fun_if, if_arg)/=. move: (P x y) (P x z) (P y z) => [xy|xy|xy|<-] [xz|xz|xz|<-]// []//= yz. - by have := lt_trans xy (lt_trans yz xz); rewrite ltxx. - by have := lt_trans xy (lt_trans xz yz); rewrite ltxx. - by have := lt_trans xy xz; rewrite yz ltxx. Qed. Lemma comparable_max_minl : max (min x y) z = min (max x z) (max y z). Proof. move: cmp_xy cmp_xz cmp_yz; rewrite !(fun_if, if_arg)/=. move: (P x y) (P x z) (P y z). move=> [xy|xy|xy|<-] [xz|xz|xz|<-] [yz|yz|yz|//->]//= _; rewrite ?ltxx//. - by have := lt_trans xy (lt_trans yz xz); rewrite ltxx. - by have := lt_trans xy (lt_trans xz yz); rewrite ltxx. Qed. Lemma comparable_min_maxl : min (max x y) z = max (min x z) (min y z). Proof. move: cmp_xy cmp_xz cmp_yz; rewrite !(fun_if, if_arg)/=. move: (P x y) (P x z) (P y z). move=> [xy|xy|xy|<-] [xz|xz|xz|<-] []yz//= _; rewrite ?ltxx//. - by have := lt_trans xy (lt_trans yz xz); rewrite ltxx. - by have := lt_trans xy yz; rewrite ltxx. - by have := lt_trans xy (lt_trans xz yz); rewrite ltxx. - by have := lt_trans xy xz; rewrite yz ltxx. Qed. End Comparable3. Lemma comparable_minAC x y z : x >=< y -> x >=< z -> y >=< z -> min (min x y) z = min (min x z) y. Proof. move=> xy xz yz; rewrite -comparable_minA// [min y z]comparable_minC//. by rewrite comparable_minA// 1?comparable_sym. Qed. Lemma comparable_maxAC x y z : x >=< y -> x >=< z -> y >=< z -> max (max x y) z = max (max x z) y. Proof. move=> xy xz yz; rewrite -comparable_maxA// [max y z]comparable_maxC//. by rewrite comparable_maxA// 1?comparable_sym. Qed. Lemma comparable_minCA x y z : x >=< y -> x >=< z -> y >=< z -> min x (min y z) = min y (min x z). Proof. move=> xy xz yz; rewrite comparable_minA// [min x y]comparable_minC//. by rewrite -comparable_minA// 1?comparable_sym. Qed. Lemma comparable_maxCA x y z : x >=< y -> x >=< z -> y >=< z -> max x (max y z) = max y (max x z). Proof. move=> xy xz yz; rewrite comparable_maxA// [max x y]comparable_maxC//. by rewrite -comparable_maxA// 1?comparable_sym. Qed. Lemma comparable_minACA x y z t : x >=< y -> x >=< z -> x >=< t -> y >=< z -> y >=< t -> z >=< t -> min (min x y) (min z t) = min (min x z) (min y t). Proof. move=> xy xz xt yz yt zt; rewrite comparable_minA// ?comparable_minl//. rewrite [min _ z]comparable_minAC// -comparable_minA// ?comparable_minl//. by rewrite inE comparable_sym. Qed. Lemma comparable_maxACA x y z t : x >=< y -> x >=< z -> x >=< t -> y >=< z -> y >=< t -> z >=< t -> max (max x y) (max z t) = max (max x z) (max y t). Proof. move=> xy xz xt yz yt zt; rewrite comparable_maxA// ?comparable_maxl//. rewrite [max _ z]comparable_maxAC// -comparable_maxA// ?comparable_maxl//. by rewrite inE comparable_sym. Qed. Lemma comparable_max_minr x y z : x >=< y -> x >=< z -> y >=< z -> max x (min y z) = min (max x y) (max x z). Proof. move=> xy xz yz; rewrite ![max x _]comparable_maxC// ?comparable_minr//. by rewrite comparable_max_minl// 1?comparable_sym. Qed. Lemma comparable_min_maxr x y z : x >=< y -> x >=< z -> y >=< z -> min x (max y z) = max (min x y) (min x z). Proof. move=> xy xz yz; rewrite ![min x _]comparable_minC// ?comparable_maxr//. by rewrite comparable_min_maxl// 1?comparable_sym. Qed. Section ArgExtremum. Context (I : finType) (i0 : I) (P : {pred I}) (F : I -> T) (Pi0 : P i0). Hypothesis F_comparable : {in P &, forall i j, F i >=< F j}. Lemma comparable_arg_minP: extremum_spec <=%O P F (arg_min i0 P F). Proof. by apply: extremum_inP => // [x _|y x z _ _ _]; [apply: lexx|apply: le_trans]. Qed. Lemma comparable_arg_maxP: extremum_spec >=%O P F (arg_max i0 P F). Proof. apply: extremum_inP => // [x _|y x z _ _ _|]; [exact: lexx|exact: ge_trans|]. by move=> x y xP yP; rewrite orbC [_ || _]F_comparable. Qed. End ArgExtremum. (* monotonicity *) 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. Lemma comparable_bigl x x0 op I (P : pred I) F (s : seq I) : {in >=< x &, forall y z, op y z >=< x} -> x0 >=< x -> {in P, forall i, F i >=< x} -> \big[op/x0]_(i <- s | P i) F i >=< x. Proof. by move=> *; elim/big_ind : _. Qed. Lemma comparable_bigr x x0 op I (P : pred I) F (s : seq I) : {in >=<%O x &, forall y z, x >=< op y z} -> x >=< x0 -> {in P, forall i, x >=< F i} -> x >=< \big[op/x0]_(i <- s | P i) F i. Proof. by move=> *; elim/big_ind : _. Qed. End POrderTheory. Hint Resolve comparable_minr comparable_minl : core. Hint Resolve comparable_maxr comparable_maxl : core. Section ContraTheory. Context {disp1 disp2 : unit} {T1 : porderType disp1} {T2 : porderType disp2}. Implicit Types (x y : T1) (z t : T2) (b : bool) (m n : nat) (P : Prop). Lemma comparable_contraTle b x y : x >=< y -> (y < x -> ~~ b) -> (b -> x <= y). Proof. by case: comparableP; case: b. Qed. Lemma comparable_contraTlt b x y : x >=< y -> (y <= x -> ~~ b) -> (b -> x < y). Proof. by case: comparableP; case: b. Qed. Lemma comparable_contraPle P x y : x >=< y -> (y < x -> ~ P) -> (P -> x <= y). Proof. by case: comparableP => // _ _ /(_ isT). Qed. Lemma comparable_contraPlt P x y : x >=< y -> (y <= x -> ~ P) -> (P -> x < y). Proof. by case: comparableP => // _ _ /(_ isT). Qed. Lemma comparable_contraNle b x y : x >=< y -> (y < x -> b) -> (~~ b -> x <= y). Proof. by case: comparableP; case: b. Qed. Lemma comparable_contraNlt b x y : x >=< y -> (y <= x -> b) -> (~~ b -> x < y). Proof. by case: comparableP; case: b. Qed. Lemma comparable_contra_not_le P x y : x >=< y -> (y < x -> P) -> (~ P -> x <= y). Proof. by case: comparableP => // _ _ /(_ isT). Qed. Lemma comparable_contra_not_lt P x y : x >=< y -> (y <= x -> P) -> (~ P -> x < y). Proof. by case: comparableP => // _ _ /(_ isT). Qed. Lemma comparable_contraFle b x y : x >=< y -> (y < x -> b) -> (b = false -> x <= y). Proof. by case: comparableP; case: b => // _ _ /implyP. Qed. Lemma comparable_contraFlt b x y : x >=< y -> (y <= x -> b) -> (b = false -> x < y). Proof. by case: comparableP; case: b => // _ _ /implyP. Qed. Lemma contra_leT b x y : (~~ b -> x < y) -> (y <= x -> b). Proof. by case: comparableP; case: b. Qed. Lemma contra_ltT b x y : (~~ b -> x <= y) -> (y < x -> b). Proof. by case: comparableP; case: b. Qed. Lemma contra_leN b x y : (b -> x < y) -> (y <= x -> ~~ b). Proof. by case: comparableP; case: b. Qed. Lemma contra_ltN b x y : (b -> x <= y) -> (y < x -> ~~ b). Proof. by case: comparableP; case: b. Qed. Lemma contra_le_not P x y : (P -> x < y) -> (y <= x -> ~ P). Proof. by case: comparableP => // _ PF _ /PF. Qed. Lemma contra_lt_not P x y : (P -> x <= y) -> (y < x -> ~ P). Proof. by case: comparableP => // _ PF _ /PF. Qed. Lemma contra_leF b x y : (b -> x < y) -> (y <= x -> b = false). Proof. by case: comparableP; case: b => // _ /implyP. Qed. Lemma contra_ltF b x y : (b -> x <= y) -> (y < x -> b = false). Proof. by case: comparableP; case: b => // _ /implyP. Qed. Lemma comparable_contra_leq_le m n x y : x >=< y -> (y < x -> (n < m)%N) -> ((m <= n)%N -> x <= y). Proof. by case: comparableP; case: ltngtP. Qed. Lemma comparable_contra_leq_lt m n x y : x >=< y -> (y <= x -> (n < m)%N) -> ((m <= n)%N -> x < y). Proof. by case: comparableP; case: ltngtP. Qed. Lemma comparable_contra_ltn_le m n x y : x >=< y -> (y < x -> (n <= m)%N) -> ((m < n)%N -> x <= y). Proof. by case: comparableP; case: ltngtP. Qed. Lemma comparable_contra_ltn_lt m n x y : x >=< y -> (y <= x -> (n <= m)%N) -> ((m < n)%N -> x < y). Proof. by case: comparableP; case: ltngtP. Qed. Lemma contra_le_leq x y m n : ((n < m)%N -> y < x) -> (x <= y -> (m <= n)%N). Proof. by case: comparableP; case: ltngtP. Qed. Lemma contra_le_ltn x y m n : ((n <= m)%N -> y < x) -> (x <= y -> (m < n)%N). Proof. by case: comparableP; case: ltngtP. Qed. Lemma contra_lt_leq x y m n : ((n < m)%N -> y <= x) -> (x < y -> (m <= n)%N). Proof. by case: comparableP; case: ltngtP. Qed. Lemma contra_lt_ltn x y m n : ((n <= m)%N -> y <= x) -> (x < y -> (m < n)%N). Proof. by case: comparableP; case: ltngtP. Qed. Lemma comparable_contra_le x y z t : z >=< t -> (t < z -> y < x) -> (x <= y -> z <= t). Proof. by do 2![case: comparableP => //= ?]. Qed. Lemma comparable_contra_le_lt x y z t : z >=< t -> (t <= z -> y < x) -> (x <= y -> z < t). Proof. by do 2![case: comparableP => //= ?]. Qed. Lemma comparable_contra_lt_le x y z t : z >=< t -> (t < z -> y <= x) -> (x < y -> z <= t). Proof. by do 2![case: comparableP => //= ?]. Qed. Lemma comparable_contra_lt x y z t : z >=< t -> (t <= z -> y <= x) -> (x < y -> z < t). Proof. by do 2![case: comparableP => //= ?]. Qed. End ContraTheory. 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'). Let leT_anti := @le_anti _ T. Let leT'_anti := @le_anti _ T'. Hint Resolve lexx lt_neqAle 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. Notation "@ 'eq_sorted_lt'" := (deprecate eq_sorted_lt lt_sorted_eq) (at level 10, only parsing) : fun_scope. Notation "@ 'eq_sorted_le'" := (deprecate eq_sorted_le le_sorted_eq) (at level 10, only parsing) : fun_scope. Notation eq_sorted_lt := (@eq_sorted_lt _ _ _ _) (only parsing). Notation eq_sorted_le := (@eq_sorted_le _ _ _ _) (only parsing). End POrderTheory. 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]. Arguments min_idPl {disp T x y}. Arguments max_idPr {disp T x y}. Arguments comparable_min_idPr {disp T x y _}. Arguments comparable_max_idPl {disp T x y _}. Module Import DualPOrder. Section DualPOrder. Canonical dual_eqType (T : eqType) := EqType T [eqMixin of T^d]. Canonical dual_choiceType (T : choiceType) := [choiceType of T^d]. Canonical dual_countType (T : countType) := [countType of T^d]. Canonical dual_finType (T : finType) := [finType of T^d]. Context {disp : unit}. Variable T : porderType disp. Lemma dual_lt_def (x y : T) : gt x y = (y != x) && ge x y. Proof. by apply: lt_neqAle. Qed. Fact dual_le_anti : antisymmetric (@ge _ T). Proof. by move=> x y /andP [xy yx]; apply/le_anti/andP; split. Qed. Definition dual_porderMixin := @POrder.Mixin _ _ ge gt dual_lt_def (lexx : reflexive ge) dual_le_anti (fun y z x zy yx => @le_trans _ _ y x z yx zy). Canonical dual_porderType := POrderType (dual_display disp) T^d dual_porderMixin. Lemma leEdual (x y : T) : (x <=^d y :> T^d) = (y <= x). Proof. by []. Qed. Lemma ltEdual (x y : T) : (x <^d y :> T^d) = (y < x). Proof. by []. Qed. End DualPOrder. Canonical dual_finPOrderType d (T : finPOrderType d) := [finPOrderType of T^d]. End DualPOrder. Module Import DualLattice. Section DualLattice. Context {disp : unit}. Variable L : latticeType disp. 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 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 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. Lemma meetUK x y : (x `&` y) `|` y = y. Proof. by rewrite joinC meetC meetKU. Qed. Lemma joinIK x y : (x `|` y) `&` y = y. Proof. by rewrite joinC meetC joinKI. Qed. 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. Lemma leEjoin x y : (x <= y) = (x `|` y == y). Proof. by rewrite leEmeet; apply/eqP/eqP => <-; rewrite (joinKI, meetUK). Qed. Fact dual_leEmeet (x y : L^d) : (x <= y) = (x `|` y == x). Proof. by rewrite [LHS]leEjoin joinC. Qed. Definition dual_latticeMixin := @Lattice.Mixin _ (POrder.class [porderType of L^d]) _ _ joinC meetC joinA meetA meetKU joinKI dual_leEmeet. Canonical dual_latticeType := LatticeType L^d dual_latticeMixin. Lemma meetEdual x y : ((x : L^d) `&^d` y) = (x `|` y). Proof. by []. Qed. Lemma joinEdual x y : ((x : L^d) `|^d` y) = (x `&` y). Proof. by []. Qed. End DualLattice. End DualLattice. Module Import LatticeTheoryMeet. Section LatticeTheoryMeet. Context {disp : unit} {L : latticeType disp}. Implicit Types (x y : L). (* lattice theory *) Lemma meetAC : right_commutative (@meet _ L). Proof. by move=> x y z; rewrite -!meetA [X in _ `&` X]meetC. Qed. Lemma meetCA : left_commutative (@meet _ L). Proof. by move=> x y z; rewrite !meetA [X in X `&` _]meetC. Qed. Lemma meetACA : interchange (@meet _ L) (@meet _ L). Proof. by move=> x y z t; rewrite !meetA [X in X `&` _]meetAC. Qed. Lemma meetxx x : x `&` x = x. Proof. by rewrite -[X in _ `&` X](meetKU x) joinKI. Qed. Lemma meetKI y x : x `&` (x `&` y) = x `&` y. Proof. by rewrite meetA meetxx. Qed. Lemma meetIK y x : (x `&` y) `&` y = x `&` y. Proof. by rewrite -meetA meetxx. Qed. Lemma meetKIC y x : x `&` (y `&` x) = x `&` y. Proof. by rewrite meetC meetIK meetC. Qed. Lemma meetIKC y x : y `&` x `&` y = x `&` y. Proof. by rewrite meetAC meetC meetxx. Qed. (* interaction with order *) Lemma lexI x y z : (x <= y `&` z) = (x <= y) && (x <= z). Proof. rewrite !leEmeet; apply/eqP/andP => [<-|[/eqP<- /eqP<-]]. by rewrite meetA meetIK eqxx -meetA meetACA meetxx meetAC eqxx. by rewrite -[X in X `&` _]meetA meetIK meetA. 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 leIx2 ?lexx ?orbT. Qed. Lemma leIl x y : x `&` y <= x. 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 meet_l x y : x <= y -> x `&` y = x. Proof. exact/meet_idPl. Qed. Lemma meet_r x y : y <= x -> x `&` y = y. Proof. exact/meet_idPr. 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 !leIx2 ?xz ?yt ?orbT //. Qed. End LatticeTheoryMeet. End LatticeTheoryMeet. Module Import LatticeTheoryJoin. Section LatticeTheoryJoin. Context {disp : unit} {L : latticeType disp}. Implicit Types (x y : L). (* lattice theory *) Lemma joinAC : right_commutative (@join _ L). Proof. exact: (@meetAC _ [latticeType of L^d]). Qed. Lemma joinCA : left_commutative (@join _ L). Proof. exact: (@meetCA _ [latticeType of L^d]). Qed. Lemma joinACA : interchange (@join _ L) (@join _ L). Proof. exact: (@meetACA _ [latticeType of L^d]). Qed. Lemma joinxx x : x `|` x = x. Proof. exact: (@meetxx _ [latticeType of L^d]). Qed. Lemma joinKU y x : x `|` (x `|` y) = x `|` y. Proof. exact: (@meetKI _ [latticeType of L^d]). Qed. Lemma joinUK y x : (x `|` y) `|` y = x `|` y. Proof. exact: (@meetIK _ [latticeType of L^d]). Qed. Lemma joinKUC y x : x `|` (y `|` x) = x `|` y. Proof. exact: (@meetKIC _ [latticeType of L^d]). Qed. Lemma joinUKC y x : y `|` x `|` y = x `|` y. Proof. exact: (@meetIKC _ [latticeType of L^d]). Qed. (* interaction with order *) Lemma leUx x y z : (x `|` y <= z) = (x <= z) && (y <= z). Proof. exact: (@lexI _ [latticeType of L^d]). Qed. Lemma lexUl x y z : x <= y -> x <= y `|` z. Proof. exact: (@leIxl _ [latticeType of L^d]). Qed. Lemma lexUr x y z : x <= z -> x <= y `|` z. Proof. exact: (@leIxr _ [latticeType of L^d]). Qed. Lemma lexU2 x y z : (x <= y) || (x <= z) -> x <= y `|` z. Proof. exact: (@leIx2 _ [latticeType of L^d]). Qed. Lemma leUr x y : x <= y `|` x. Proof. exact: (@leIr _ [latticeType of L^d]). Qed. Lemma leUl x y : x <= x `|` y. Proof. exact: (@leIl _ [latticeType of L^d]). Qed. Lemma join_idPr {x y} : reflect (x `|` y = y) (x <= y). Proof. exact: (@meet_idPr _ [latticeType of L^d]). Qed. Lemma join_idPl {x y} : reflect (y `|` x = y) (x <= y). Proof. exact: (@meet_idPl _ [latticeType of L^d]). Qed. Lemma join_l x y : y <= x -> x `|` y = x. Proof. exact/join_idPl. Qed. Lemma join_r x y : x <= y -> x `|` y = y. Proof. exact/join_idPr. Qed. Lemma leUidl x y : (x `|` y <= y) = (x <= y). Proof. exact: (@leIidr _ [latticeType of L^d]). Qed. Lemma leUidr x y : (y `|` x <= y) = (x <= y). Proof. exact: (@leIidl _ [latticeType of L^d]). Qed. Lemma eq_joinl x y : (x `|` y == x) = (y <= x). Proof. exact: (@eq_meetl _ [latticeType of L^d]). Qed. Lemma eq_joinr x y : (x `|` y == y) = (x <= y). Proof. exact: (@eq_meetr _ [latticeType of L^d]). Qed. Lemma leU2 x y z t : x <= z -> y <= t -> x `|` y <= z `|` t. Proof. exact: (@leI2 _ [latticeType of L^d]). Qed. Lemma lcomparableP x y : incomparel x y (min y x) (min x y) (max y x) (max x y) (y `&` x) (x `&` y) (y `|` x) (x `|` y) (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y) (y >=< x) (x >=< y). Proof. by case: (comparableP x) => [hxy|hxy|hxy|->]; do 1?have hxy' := ltW hxy; rewrite ?(meetxx, joinxx); rewrite ?(meet_l hxy', meet_r hxy', join_l hxy', join_r hxy'); constructor. Qed. Lemma lcomparable_ltgtP x y : x >=< y -> comparel x y (min y x) (min x y) (max y x) (max x y) (y `&` x) (x `&` y) (y `|` x) (x `|` y) (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y). Proof. by case: (lcomparableP x) => // *; constructor. Qed. Lemma lcomparable_leP x y : x >=< y -> lel_xor_gt x y (min y x) (min x y) (max y x) (max x y) (y `&` x) (x `&` y) (y `|` x) (x `|` y) (x <= y) (y < x). Proof. by move/lcomparable_ltgtP => [/ltW xy|xy|->]; constructor. Qed. Lemma lcomparable_ltP x y : x >=< y -> ltl_xor_ge x y (min y x) (min x y) (max y x) (max 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. Arguments meet_idPl {disp L x y}. Arguments join_idPl {disp L x y}. Module Import DistrLatticeTheory. Section DistrLatticeTheory. Context {disp : unit}. Variable L : distrLatticeType disp. Implicit Types (x y : L). Lemma meetUl : left_distributive (@meet _ L) (@join _ L). 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. Lemma joinIl : left_distributive (@join _ L) (@meet _ L). Proof. by move=> x y z; rewrite meetUr joinIK meetUl -joinA meetUKC. Qed. Lemma joinIr : right_distributive (@join _ L) (@meet _ L). Proof. by move=> x y z; rewrite !(joinC x) -joinIl. Qed. Definition dual_distrLatticeMixin := @DistrLattice.Mixin _ (Lattice.class [latticeType of L^d]) joinIl. Canonical dual_distrLatticeType := DistrLatticeType L^d dual_distrLatticeMixin. End DistrLatticeTheory. End DistrLatticeTheory. Module Import TotalTheory. Section TotalTheory. Context {disp : unit} {T : orderType disp}. Implicit Types (x y z t : T) (s : seq T). Lemma le_total : total (<=%O : rel T). Proof. by case: T => [? [?]]. Qed. Hint Resolve le_total : core. Lemma ge_total : total (>=%O : rel T). Proof. by move=> ? ?; apply: le_total. Qed. Hint Resolve ge_total : core. Lemma comparableT x y : x >=< y. Proof. exact: le_total. Qed. Hint Resolve comparableT : core. Lemma sort_le_sorted s : sorted <=%O (sort <=%O s). Proof. exact: sort_sorted. Qed. Hint Resolve sort_le_sorted : core. Lemma sort_lt_sorted s : sorted <%O (sort <=%O s) = uniq s. Proof. by rewrite lt_sorted_uniq_le sort_uniq sort_le_sorted andbT. Qed. Lemma leNgt x y : (x <= y) = ~~ (y < x). Proof. exact: comparable_leNgt. Qed. Lemma ltNge x y : (x < y) = ~~ (y <= x). Proof. exact: comparable_ltNge. 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). 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. by move=> sP hP x y; case: (leP x y) => [| /ltW] /hP // /sP. Qed. 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. by move=> rP sP hP x y; case: (ltgtP x y) => [||->] // /hP // /sP. Qed. Lemma neq_lt x y : (x != y) = (x < y) || (y < x). Proof. by case: ltgtP. Qed. Lemma lt_total x y : x != y -> (x < y) || (y < x). Proof. by case: ltgtP. Qed. Lemma eq_leLR x y z t : (x <= y -> z <= t) -> (y < x -> t < z) -> (x <= y) = (z <= t). Proof. by rewrite !ltNge => ? /contraTT ?; apply/idP/idP. 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 rewrite !leNgt => ? /contraTT ?; apply/idP/idP. 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. (* max and min is join and meet *) Lemma meetEtotal x y : x `&` y = min x y. Proof. by case: leP. Qed. Lemma joinEtotal x y : x `|` y = max x y. Proof. by case: leP. Qed. (* max and min theory *) Lemma minEgt x y : min x y = if x > y then y else x. Proof. by case: ltP. Qed. Lemma maxEgt x y : max x y = if x > y then x else y. Proof. by case: ltP. Qed. Lemma minEge x y : min x y = if x >= y then y else x. Proof. by case: leP. Qed. Lemma maxEge x y : max x y = if x >= y then x else y. Proof. by case: leP. Qed. Lemma minC : commutative (min : T -> T -> T). Proof. by move=> x y; apply: comparable_minC. Qed. Lemma maxC : commutative (max : T -> T -> T). Proof. by move=> x y; apply: comparable_maxC. Qed. Lemma minA : associative (min : T -> T -> T). Proof. by move=> x y z; apply: comparable_minA. Qed. Lemma maxA : associative (max : T -> T -> T). Proof. by move=> x y z; apply: comparable_maxA. Qed. Lemma minAC : right_commutative (min : T -> T -> T). Proof. by move=> x y z; apply: comparable_minAC. Qed. Lemma maxAC : right_commutative (max : T -> T -> T). Proof. by move=> x y z; apply: comparable_maxAC. Qed. Lemma minCA : left_commutative (min : T -> T -> T). Proof. by move=> x y z; apply: comparable_minCA. Qed. Lemma maxCA : left_commutative (max : T -> T -> T). Proof. by move=> x y z; apply: comparable_maxCA. Qed. Lemma minACA : interchange (min : T -> T -> T) min. Proof. by move=> x y z t; apply: comparable_minACA. Qed. Lemma maxACA : interchange (max : T -> T -> T) max. Proof. by move=> x y z t; apply: comparable_maxACA. Qed. Lemma eq_minr x y : (min x y == y) = (y <= x). Proof. exact: comparable_eq_minr. Qed. Lemma eq_maxl x y : (max x y == x) = (y <= x). Proof. exact: comparable_eq_maxl. Qed. Lemma min_idPr x y : reflect (min x y = y) (y <= x). Proof. exact: comparable_min_idPr. Qed. Lemma max_idPl x y : reflect (max x y = x) (y <= x). Proof. exact: comparable_max_idPl. Qed. Lemma le_minr z x y : (z <= min x y) = (z <= x) && (z <= y). Proof. exact: comparable_le_minr. Qed. Lemma le_minl z x y : (min x y <= z) = (x <= z) || (y <= z). Proof. exact: comparable_le_minl. Qed. Lemma lt_minr z x y : (z < min x y) = (z < x) && (z < y). Proof. exact: comparable_lt_minr. Qed. Lemma lt_minl z x y : (min x y < z) = (x < z) || (y < z). Proof. exact: comparable_lt_minl. Qed. Lemma le_maxr z x y : (z <= max x y) = (z <= x) || (z <= y). Proof. exact: comparable_le_maxr. Qed. Lemma le_maxl z x y : (max x y <= z) = (x <= z) && (y <= z). Proof. exact: comparable_le_maxl. Qed. Lemma lt_maxr z x y : (z < max x y) = (z < x) || (z < y). Proof. exact: comparable_lt_maxr. Qed. Lemma lt_maxl z x y : (max x y < z) = (x < z) && (y < z). Proof. exact: comparable_lt_maxl. Qed. Lemma minxK x y : max (min x y) y = y. Proof. exact: comparable_minxK. Qed. Lemma minKx x y : max x (min x y) = x. Proof. exact: comparable_minKx. Qed. Lemma maxxK x y : min (max x y) y = y. Proof. exact: comparable_maxxK. Qed. Lemma maxKx x y : min x (max x y) = x. Proof. exact: comparable_maxKx. Qed. Lemma max_minl : left_distributive (max : T -> T -> T) min. Proof. by move=> x y z; apply: comparable_max_minl. Qed. Lemma min_maxl : left_distributive (min : T -> T -> T) max. Proof. by move=> x y z; apply: comparable_min_maxl. Qed. Lemma max_minr : right_distributive (max : T -> T -> T) min. Proof. by move=> x y z; apply: comparable_max_minr. Qed. Lemma min_maxr : right_distributive (min : T -> T -> T) max. Proof. by move=> x y z; apply: comparable_min_maxr. Qed. Lemma leIx x y z : (meet y z <= x) = (y <= x) || (z <= x). Proof. by rewrite meetEtotal le_minl. Qed. Lemma lexU x y z : (x <= join y z) = (x <= y) || (x <= z). Proof. by rewrite joinEtotal le_maxr. Qed. Lemma ltxI x y z : (x < meet y z) = (x < y) && (x < z). Proof. by rewrite !ltNge leIx negb_or. Qed. Lemma ltIx x y z : (meet y z < x) = (y < x) || (z < x). Proof. by rewrite !ltNge lexI negb_and. Qed. Lemma ltxU x y z : (x < join y z) = (x < y) || (x < z). Proof. by rewrite !ltNge leUx negb_and. Qed. Lemma ltUx x y z : (join y z < x) = (y < x) && (z < x). Proof. by rewrite !ltNge lexU negb_or. Qed. Definition ltexI := (@lexI _ T, ltxI). Definition lteIx := (leIx, ltIx). Definition ltexU := (lexU, ltxU). Definition lteUx := (@leUx _ T, ltUx). (* lteif *) Lemma lteifNE x y C : x < y ?<= if ~~ C = ~~ (y < x ?<= if C). Proof. by case: C => /=; case: leP. Qed. Lemma lteif_minr z x y C : (z < Order.min x y ?<= if C) = (z < x ?<= if C) && (z < y ?<= if C). Proof. by case: C; rewrite /= (le_minr, lt_minr). Qed. Lemma lteif_minl z x y C : (Order.min x y < z ?<= if C) = (x < z ?<= if C) || (y < z ?<= if C). Proof. by case: C; rewrite /= (le_minl, lt_minl). Qed. Lemma lteif_maxr z x y C : (z < Order.max x y ?<= if C) = (z < x ?<= if C) || (z < y ?<= if C). Proof. by case: C; rewrite /= (le_maxr, lt_maxr). Qed. Lemma lteif_maxl z x y C : (Order.max x y < z ?<= if C) = (x < z ?<= if C) && (y < z ?<= if C). Proof. by case: C; rewrite /= (le_maxl, lt_maxl). Qed. Section ArgExtremum. 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. Hint Resolve le_total : core. Hint Resolve ge_total : core. Hint Resolve comparableT : core. Hint Resolve sort_le_sorted : core. Arguments min_idPr {disp T x y}. Arguments max_idPl {disp T x y}. (* contra lemmas *) Section ContraTheory. Context {disp1 disp2 : unit} {T1 : porderType disp1} {T2 : orderType disp2}. Implicit Types (x y : T1) (z t : T2) (b : bool) (m n : nat) (P : Prop). Lemma contraTle b z t : (t < z -> ~~ b) -> (b -> z <= t). Proof. exact: comparable_contraTle. Qed. Lemma contraTlt b z t : (t <= z -> ~~ b) -> (b -> z < t). Proof. exact: comparable_contraTlt. Qed. Lemma contraPle P z t : (t < z -> ~ P) -> (P -> z <= t). Proof. exact: comparable_contraPle. Qed. Lemma contraPlt P z t : (t <= z -> ~ P) -> (P -> z < t). Proof. exact: comparable_contraPlt. Qed. Lemma contraNle b z t : (t < z -> b) -> (~~ b -> z <= t). Proof. exact: comparable_contraNle. Qed. Lemma contraNlt b z t : (t <= z -> b) -> (~~ b -> z < t). Proof. exact: comparable_contraNlt. Qed. Lemma contra_not_le P z t : (t < z -> P) -> (~ P -> z <= t). Proof. exact: comparable_contra_not_le. Qed. Lemma contra_not_lt P z t : (t <= z -> P) -> (~ P -> z < t). Proof. exact: comparable_contra_not_lt. Qed. Lemma contraFle b z t : (t < z -> b) -> (b = false -> z <= t). Proof. exact: comparable_contraFle. Qed. Lemma contraFlt b z t : (t <= z -> b) -> (b = false -> z < t). Proof. exact: comparable_contraFlt. Qed. Lemma contra_leq_le m n z t : (t < z -> (n < m)%N) -> ((m <= n)%N -> z <= t). Proof. exact: comparable_contra_leq_le. Qed. Lemma contra_leq_lt m n z t : (t <= z -> (n < m)%N) -> ((m <= n)%N -> z < t). Proof. exact: comparable_contra_leq_lt. Qed. Lemma contra_ltn_le m n z t : (t < z -> (n <= m)%N) -> ((m < n)%N -> z <= t). Proof. exact: comparable_contra_ltn_le. Qed. Lemma contra_ltn_lt m n z t : (t <= z -> (n <= m)%N) -> ((m < n)%N -> z < t). Proof. exact: comparable_contra_ltn_lt. Qed. Lemma contra_le x y z t : (t < z -> y < x) -> (x <= y -> z <= t). Proof. exact: comparable_contra_le. Qed. Lemma contra_le_lt x y z t : (t <= z -> y < x) -> (x <= y -> z < t). Proof. exact: comparable_contra_le_lt. Qed. Lemma contra_lt_le x y z t : (t < z -> y <= x) -> (x < y -> z <= t). Proof. exact: comparable_contra_lt_le. Qed. Lemma contra_lt x y z t : (t <= z -> y <= x) -> (x < y -> z < t). Proof. exact: comparable_contra_lt. Qed. End ContraTheory. 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'). Let leT_anti := @le_anti _ T. Let leT'_anti := @le_anti _ T'. Let ltT_neqAle := @lt_neqAle _ T. Let ltT'_neqAle := @lt_neqAle _ T'. Let ltT_def := @lt_def _ T. Let leT_total := @le_total _ T. Lemma le_mono : {homo f : x y / x < y} -> {mono f : x y / x <= y}. Proof. exact: total_homo_mono. Qed. Lemma le_nmono : {homo f : x y /~ x < y} -> {mono f : x y /~ x <= y}. Proof. exact: total_homo_mono. Qed. Lemma le_mono_in : {in D &, {homo f : x y / x < y}} -> {in D &, {mono f : x y / x <= y}}. Proof. exact: total_homo_mono_in. Qed. Lemma le_nmono_in : {in D &, {homo f : x y /~ x < y}} -> {in D &, {mono f : x y /~ x <= y}}. Proof. exact: total_homo_mono_in. Qed. End TotalMonotonyTheory. End TotalTheory. Module Import BLatticeTheory. Section BLatticeTheory. Context {disp : unit} {L : bLatticeType disp}. Implicit Types (I : finType) (T : eqType) (x y z : L). Local Notation "0" := bottom. (* Non-distributive lattice theory with 0 & 1*) 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. Lemma ltx0 x : (x < 0) = false. Proof. by rewrite lt_neqAle lex0 andNb. Qed. Lemma lt0x x : (0 < x) = (x != 0). Proof. by rewrite lt_neqAle le0x andbT eq_sym. Qed. Lemma meet0x : left_zero 0 (@meet _ L). Proof. by move=> x; apply/eqP; rewrite -leEmeet. Qed. Lemma meetx0 : right_zero 0 (@meet _ L). Proof. by move=> x; rewrite meetC meet0x. Qed. Lemma join0x : left_id 0 (@join _ L). Proof. by move=> x; apply/eqP; rewrite -leEjoin. Qed. Lemma joinx0 : right_id 0 (@join _ L). Proof. by move=> x; rewrite joinC join0x. Qed. Lemma join_eq0 x y : (x `|` y == 0) = (x == 0) && (y == 0). Proof. apply/idP/idP; last by move=> /andP [/eqP-> /eqP->]; rewrite joinx0. by move=> /eqP xUy0; rewrite -!lex0 -!xUy0 ?leUl ?leUr. Qed. 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. Lemma posxP x : eq0_xor_gt0 x (x == 0) (0 < x). Proof. by rewrite lt0x; have [] := eqVneq; constructor; rewrite ?lt0x. Qed. Canonical join_monoid := Monoid.Law (@joinA _ _) join0x joinx0. Canonical join_comoid := Monoid.ComLaw (@joinC _ _). Lemma join_sup I (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) //= lexU2 ?lexx. Qed. Lemma join_min I (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 (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)). by elim/big_rec2: _ => [|i y b Pi <-]; rewrite ?le0x ?leUx. rewrite big_all_cond; apply: (iffP allP) => /= H i; have := H i _; rewrite mem_index_enum; last by move/implyP->. by move=> /(_ isT) /implyP. Qed. Lemma join_sup_seq T (r : seq T) (P : {pred T}) (F : T -> L) (x : T) : x \in r -> P x -> F x <= \join_(i <- r | P i) F i. Proof. by move=> /seq_tnthP[j->] Px; rewrite big_tnth join_sup. Qed. Lemma join_min_seq T (r : seq T) (P : {pred T}) (F : T -> L) (x : T) (l : L) : x \in r -> P x -> l <= F x -> l <= \join_(x <- r | P x) F x. Proof. by move=> /seq_tnthP[j->] Px; rewrite big_tnth; apply: join_min. Qed. Lemma joinsP_seq T (r : seq T) (P : {pred T}) (F : T -> L) (u : L) : reflect (forall x : T, x \in r -> P x -> F x <= u) (\join_(x <- r | P x) F x <= u). Proof. rewrite big_tnth; apply: (iffP (joinsP _ _ _)) => /= F_le. by move=> x /seq_tnthP[i ->]; apply: F_le. by move=> i /F_le->//; rewrite mem_tnth. Qed. Lemma le_joins I (A B : {set I}) (F : I -> L) : A \subset B -> \join_(i in A) F i <= \join_(i in B) F i. Proof. 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 lexU2 // (setIidPr _) // lexx. Qed. Lemma joins_setU I (A B : {set I}) (F : I -> L) : \join_(i in (A :|: B)) F i = \join_(i in A) F i `|` \join_(i in B) F i. Proof. apply/eqP; rewrite eq_le leUx !le_joins ?subsetUl ?subsetUr ?andbT //. apply/joinsP => i; rewrite inE; move=> /orP. by case=> ?; rewrite lexU2 //; [rewrite join_sup|rewrite orbC join_sup]. Qed. Lemma join_seq I (r : seq I) (F : I -> L) : \join_(i <- r) F i = \join_(i in r) F i. Proof. 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 ?lexU2 ?lexx //. by rewrite join_sup ?orbT ?inE. Qed. End BLatticeTheory. End BLatticeTheory. Module Import DualTBLattice. Section DualTBLattice. Context {disp : unit} {L : tbLatticeType disp}. Lemma lex1 (x : L) : x <= top. Proof. by case: L x => [?[?[]]]. Qed. Definition dual_bLatticeMixin := @BLattice.Mixin _ (Lattice.class [latticeType of L^d]) top lex1. Canonical dual_bLatticeType := BLatticeType L^d dual_bLatticeMixin. Definition dual_tbLatticeMixin := @TBLattice.Mixin _ (BLattice.class [bLatticeType of L^d]) (bottom : L) (@le0x _ L). Canonical dual_tbLatticeType := TBLatticeType L^d dual_tbLatticeMixin. Lemma botEdual : (dual_bottom : L^d) = 1 :> L. Proof. by []. Qed. Lemma topEdual : (dual_top : L^d) = 0 :> L. Proof. by []. Qed. End DualTBLattice. Canonical dual_finLatticeType d (T : finLatticeType d) := [finLatticeType of T^d]. End DualTBLattice. Module Import TBLatticeTheory. Section TBLatticeTheory. Context {disp : unit} {L : tbLatticeType disp}. Implicit Types (I : finType) (T : eqType) (x y : L). Local Notation "1" := top. Hint Resolve le0x lex1 : core. Lemma meetx1 : right_id 1 (@meet _ L). Proof. exact: (@joinx0 _ [tbLatticeType of L^d]). Qed. Lemma meet1x : left_id 1 (@meet _ L). Proof. exact: (@join0x _ [tbLatticeType of L^d]). Qed. Lemma joinx1 : right_zero 1 (@join _ L). Proof. exact: (@meetx0 _ [tbLatticeType of L^d]). Qed. Lemma join1x : left_zero 1 (@join _ L). Proof. exact: (@meet0x _ [tbLatticeType of L^d]). Qed. Lemma le1x x : (1 <= x) = (x == 1). Proof. exact: (@lex0 _ [tbLatticeType of L^d]). Qed. Lemma meet_eq1 x y : (x `&` y == 1) = (x == 1) && (y == 1). Proof. exact: (@join_eq0 _ [tbLatticeType of L^d]). Qed. Canonical meet_monoid := Monoid.Law (@meetA _ _) meet1x meetx1. Canonical meet_comoid := Monoid.ComLaw (@meetC _ _). Canonical meet_muloid := Monoid.MulLaw (@meet0x _ L) (@meetx0 _ _). Canonical join_muloid := Monoid.MulLaw join1x joinx1. Lemma meets_inf I (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^d]). Qed. Lemma meets_max I (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^d]). Qed. Lemma meetsP I (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^d]). Qed. Lemma meet_inf_seq T (r : seq T) (P : {pred T}) (F : T -> L) (x : T) : x \in r -> P x -> \meet_(i <- r | P i) F i <= F x. Proof. exact: (@join_sup_seq _ [tbLatticeType of L^d]). Qed. Lemma meet_max_seq T (r : seq T) (P : {pred T}) (F : T -> L) (x : T) (u : L) : x \in r -> P x -> F x <= u -> \meet_(x <- r | P x) F x <= u. Proof. exact: (@join_min_seq _ [tbLatticeType of L^d]). Qed. Lemma meetsP_seq T (r : seq T) (P : {pred T}) (F : T -> L) (l : L) : reflect (forall x : T, x \in r -> P x -> l <= F x) (l <= \meet_(x <- r | P x) F x). Proof. exact: (@joinsP_seq _ [tbLatticeType of L^d]). Qed. Lemma le_meets I (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^d]). Qed. Lemma meets_setU I (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^d]). Qed. Lemma meet_seq I (r : seq I) (F : I -> L) : \meet_(i <- r) F i = \meet_(i in r) F i. Proof. exact: (@join_seq _ [tbLatticeType of L^d]). Qed. End TBLatticeTheory. End TBLatticeTheory. Module Import BDistrLatticeTheory. Section BDistrLatticeTheory. Context {disp : unit} {L : bDistrLatticeType disp}. Implicit Types (I : finType) (T : eqType) (x y z : L). Local Notation "0" := bottom. (* Distributive lattice theory with 0 & 1*) Lemma leU2l_le y t x z : x `&` t = 0 -> x `|` y <= z `|` t -> x <= z. Proof. by move=> xIt0 /(leI2 (lexx x)); rewrite joinKI meetUr xIt0 joinx0 leIidl. Qed. Lemma leU2r_le y t x z : x `&` t = 0 -> y `|` x <= t `|` z -> x <= z. Proof. by rewrite joinC [_ `|` z]joinC => /leU2l_le H /H. Qed. Lemma disjoint_lexUl z x y : x `&` z = 0 -> (x <= y `|` z) = (x <= y). Proof. move=> xz0; apply/idP/idP=> xy; last by rewrite lexU2 ?xy. by apply: (@leU2l_le x z); rewrite ?joinxx. Qed. Lemma disjoint_lexUr z x y : x `&` z = 0 -> (x <= z `|` y) = (x <= y). Proof. by move=> xz0; rewrite joinC; rewrite disjoint_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. by move=> lexyzt; rewrite (leU2l_le _ lexyzt) // (leU2r_le _ lexyzt). Qed. Lemma joins_disjoint I (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). rewrite big_all_cond; apply/allP => i _ /=. by apply/implyP => /d_Fi_disj ->. elim/big_rec2: _ => [|i y]; first by rewrite meetx0. case; rewrite (andbF, andbT) // => Pi /(_ isT) dy /eqP dFi. by rewrite meetUr dy dFi joinxx. Qed. End BDistrLatticeTheory. End BDistrLatticeTheory. Module Import DualTBDistrLattice. Section DualTBDistrLattice. Context {disp : unit} {L : tbDistrLatticeType disp}. Canonical dual_bDistrLatticeType := [bDistrLatticeType of L^d]. Canonical dual_tbDistrLatticeType := [tbDistrLatticeType of L^d]. End DualTBDistrLattice. Canonical dual_finDistrLatticeType d (T : finDistrLatticeType d) := [finDistrLatticeType of T^d]. End DualTBDistrLattice. Module Import TBDistrLatticeTheory. Section TBDistrLatticeTheory. Context {disp : unit} {L : tbDistrLatticeType disp}. Implicit Types (I : finType) (T : eqType) (x y : L). Local Notation "1" := top. Lemma leI2l_le y t x z : y `|` z = 1 -> x `&` y <= z `&` t -> x <= z. Proof. rewrite joinC; exact: (@leU2l_le _ [tbDistrLatticeType of L^d]). Qed. Lemma leI2r_le y t x z : y `|` z = 1 -> y `&` x <= t `&` z -> x <= z. Proof. rewrite joinC; exact: (@leU2r_le _ [tbDistrLatticeType of L^d]). Qed. Lemma cover_leIxl z x y : z `|` y = 1 -> (x `&` z <= y) = (x <= y). Proof. rewrite joinC; exact: (@disjoint_lexUl _ [tbDistrLatticeType of L^d]). Qed. Lemma cover_leIxr z x y : z `|` y = 1 -> (z `&` x <= y) = (x <= y). Proof. rewrite joinC; exact: (@disjoint_lexUr _ [tbDistrLatticeType of L^d]). 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 _ [tbDistrLatticeType of L^d]); rewrite meetC. Qed. Canonical join_addoid := Monoid.AddLaw (@meetUl _ L) (@meetUr _ _). Canonical meet_addoid := Monoid.AddLaw (@joinIl _ L) (@joinIr _ _). Lemma meets_total I (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 _ [tbDistrLatticeType of L^d]). Qed. End TBDistrLatticeTheory. End TBDistrLatticeTheory. Module Import CBDistrLatticeTheory. Section CBDistrLatticeTheory. Context {disp : unit} {L : cbDistrLatticeType disp}. 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. Lemma subIK x y : (x `\` y) `&` y = 0. Proof. by rewrite meetC subKI. Qed. Lemma meetIB z x y : (z `&` y) `&` (x `\` y) = 0. Proof. by rewrite -meetA subKI meetx0. Qed. 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. Lemma joinBI y x : (x `\` y) `|` (x `&` y) = x. Proof. by rewrite joinC joinIB. Qed. Lemma joinIBC y x : (y `&` x) `|` (x `\` y) = x. Proof. by rewrite meetC joinIB. Qed. 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) lexU2 // lexx orbT. Qed. Hint Resolve leBx : core. Lemma subxx x : x `\` x = 0. Proof. by have := subKI x x; rewrite meet_r. Qed. Lemma leBl z x y : x <= y -> x `\` z <= y `\` z. Proof. rewrite -{1}[x](joinIB z) -{1}[y](joinIB z). by rewrite leU2E ?meetIB ?meetBI // => /andP []. Qed. Lemma subKU y x : y `|` (x `\` y) = y `|` x. Proof. apply/eqP; rewrite eq_le leU2 //= leUx leUl. by apply/meet_idPl; have := joinIB y x; rewrite joinIl join_l. Qed. Lemma subUK y x : (x `\` y) `|` y = x `|` y. Proof. by rewrite joinC subKU joinC. Qed. Lemma leBKU y x : y <= x -> y `|` (x `\` y) = x. Proof. by move=> /join_r {2}<-; rewrite subKU. Qed. Lemma leBUK y x : y <= x -> (x `\` y) `|` y = x. Proof. by move=> leyx; rewrite joinC leBKU. Qed. Lemma leBLR x y z : (x `\` y <= z) = (x <= y `|` z). Proof. apply/idP/idP; first by move=> /join_r <-; rewrite joinA subKU joinAC leUr. by rewrite -{1}[x](joinIB y) => /(leU2r_le (subIK _ _)). Qed. Lemma subUx x y z : (x `|` y) `\` z = (x `\` z) `|` (y `\` z). Proof. apply/eqP; rewrite eq_le leUx !leBl ?leUr ?leUl ?andbT //. by rewrite leBLR joinA subKU joinAC subKU joinAC -joinA leUr. Qed. Lemma sub_eq0 x y : (x `\` y == 0) = (x <= y). Proof. by rewrite -lex0 leBLR joinx0. Qed. Lemma joinxB x y z : x `|` (y `\` z) = ((x `|` y) `\` z) `|` (x `&` z). Proof. by rewrite subUx joinAC joinBI. Qed. Lemma joinBx x y z : (y `\` z) `|` x = ((y `|` x) `\` z) `|` (z `&` x). 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_r ?leBUK ?leUr ?lexUl. Qed. Lemma leB2 x y z t : x <= z -> t <= y -> x `\` y <= z `\` t. Proof. by move=> /(@leBl t) ? /(@leBr x) /le_trans ->. Qed. Lemma meet_eq0E_sub z x y : x <= z -> (x `&` y == 0) = (x <= z `\` y). Proof. move=> xz; apply/idP/idP; last by move=> /meet_r <-; rewrite -meetA meetBI. by move=> /eqP xIy_eq0; rewrite -[x](joinIB y) xIy_eq0 join0x leBl. Qed. Lemma leBRL x y z : (x <= z `\` y) = (x <= z) && (x `&` y == 0). Proof. apply/idP/idP => [xyz|]; first by rewrite (@meet_eq0E_sub z) // (le_trans xyz). by move=> /andP [?]; rewrite -meet_eq0E_sub. Qed. Lemma eq_sub x y z : (x `\` y == z) = (z <= x <= y `|` z) && (z `&` y == 0). 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 leIx2 ?leBx //= meetUr meetAC subIK -meetA subIK. by rewrite meet0x meetx0 joinx0. Qed. Lemma subx0 x : x `\` 0 = x. Proof. by apply/eqP; rewrite eq_sub join0x meetx0 lexx eqxx. Qed. Lemma sub0x x : 0 `\` x = 0. Proof. by apply/eqP; rewrite eq_sub joinx0 meet0x lexx eqxx le0x. Qed. Lemma subIx x y z : (x `&` y) `\` z = (x `\` z) `&` (y `\` z). Proof. apply/eqP; rewrite eq_sub joinIr ?leI2 ?subKU ?leUr ?leBx //=. by rewrite -meetA subIK meetx0. Qed. Lemma meetxB x y z : x `&` (y `\` z) = (x `&` y) `\` z. Proof. by rewrite subIx -{1}[x](joinBI z) meetUl meetIB joinx0. Qed. Lemma meetBx x y z : (x `\` y) `&` z = (x `&` z) `\` y. Proof. by rewrite ![_ `&` z]meetC meetxB. Qed. Lemma subxI x y z : x `\` (y `&` z) = (x `\` y) `|` (x `\` z). Proof. apply/eqP; rewrite eq_sub leUx !leBx //= joinIl joinA joinCA !subKU. rewrite joinCA -joinA [_ `|` x]joinC ![x `|` _]join_l //. by rewrite -joinIl leUr /= meetUl {1}[_ `&` z]meetC ?meetBI joinx0. Qed. Lemma subBx x y z : (x `\` y) `\` z = x `\` (y `|` z). Proof. apply/eqP; rewrite eq_sub leBr ?leUl //=. by rewrite subxU joinIr subKU -joinIr meet_l ?leUr //= -meetA subIK meetx0. Qed. Lemma subxB x y z : x `\` (y `\` z) = (x `\` y) `|` (x `&` z). Proof. rewrite -[y in RHS](joinIB z) subxU joinIl subxI -joinA joinBI join_r //. by rewrite joinBx meetKU meetA meetAC subIK meet0x joinx0 meet_r. Qed. Lemma joinBK x y : (y `|` x) `\` x = (y `\` x). Proof. by rewrite subUx subxx joinx0. Qed. Lemma joinBKC x y : (x `|` y) `\` x = (y `\` x). Proof. by rewrite subUx subxx join0x. Qed. Lemma disj_le x y : x `&` y == 0 -> x <= y = (x == 0). Proof. by rewrite [x == 0]eq_sym -eq_meetl => /eqP ->. Qed. Lemma disj_leC x y : y `&` x == 0 -> x <= y = (x == 0). Proof. by rewrite meetC => /disj_le. Qed. Lemma disj_subl x y : x `&` y == 0 -> x `\` y = x. Proof. by move=> dxy; apply/eqP; rewrite eq_sub dxy lexx leUr. Qed. Lemma disj_subr x y : x `&` y == 0 -> y `\` x = y. Proof. by rewrite meetC => /disj_subl. Qed. Lemma lt0B x y : x < y -> 0 < y `\` x. Proof. by move=> ?; rewrite lt_leAnge le0x leBLR joinx0 /= lt_geF. Qed. End CBDistrLatticeTheory. End CBDistrLatticeTheory. Module Import CTBDistrLatticeTheory. Section CTBDistrLatticeTheory. Context {disp : unit} {L : ctbDistrLatticeType disp}. Implicit Types (x y z : L). Local Notation "0" := bottom. Local Notation "1" := top. Lemma complE x : ~` x = 1 `\` x. Proof. by case: L x => [?[? ?[]]]. Qed. Lemma sub1x x : 1 `\` x = ~` x. Proof. by rewrite complE. Qed. Lemma subE x y : x `\` y = x `&` ~` y. Proof. by rewrite complE meetxB meetx1. Qed. Lemma complK : involutive (@compl _ L). Proof. by move=> x; rewrite !complE subxB subxx meet1x join0x. Qed. Lemma compl_inj : injective (@compl _ L). Proof. exact/inv_inj/complK. Qed. Lemma disj_leC x y : (x `&` y == 0) = (x <= ~` y). Proof. by rewrite -sub_eq0 subE complK. Qed. Lemma leC x y : (~` x <= ~` y) = (y <= x). Proof. gen have leC : x y / y <= x -> ~` x <= ~` y; last first. by apply/idP/idP=> /leC; rewrite ?complK. by move=> leyx; rewrite !complE leBr. Qed. Lemma complU x y : ~` (x `|` y) = ~` x `&` ~` y. Proof. by rewrite !complE subxU. Qed. Lemma complI x y : ~` (x `&` y) = ~` x `|` ~` y. Proof. by rewrite !complE subxI. Qed. Lemma joinxC x : x `|` ~` x = 1. Proof. by rewrite complE subKU joinx1. Qed. Lemma joinCx x : ~` x `|` x = 1. Proof. by rewrite joinC joinxC. Qed. Lemma meetxC x : x `&` ~` x = 0. Proof. by rewrite complE subKI. Qed. Lemma meetCx x : ~` x `&` x = 0. Proof. by rewrite meetC meetxC. Qed. Lemma compl1 : ~` 1 = 0 :> L. Proof. by rewrite complE subxx. Qed. Lemma compl0 : ~` 0 = 1 :> L. Proof. by rewrite complE subx0. Qed. Lemma complB x y : ~` (x `\` y) = ~` x `|` y. Proof. by rewrite !complE subxB meet1x. Qed. Lemma leBC x y : x `\` y <= ~` y. Proof. by rewrite leBLR joinxC lex1. Qed. Lemma leCx x y : (~` x <= y) = (~` y <= x). 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) : ~` (\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) : ~` (\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 CTBDistrLatticeTheory. End CTBDistrLatticeTheory. (*************) (* FACTORIES *) (*************) Module LePOrderMixin. Section LePOrderMixin. Variable (T : eqType). Record of_ := Build { le : rel T; lt : rel T; lt_def : forall x y, lt x y = (y != x) && (le x y); lexx : reflexive le; le_anti : antisymmetric le; le_trans : transitive le; }. Definition porderMixin (m : of_) := @POrder.Mixin _ _ (le m) (lt m) (lt_def m) (lexx m) (@le_anti m) (@le_trans m). End LePOrderMixin. Module Exports. Notation lePOrderMixin := of_. Notation LePOrderMixin := Build. Coercion porderMixin : of_ >-> POrder.mixin_of. End Exports. End LePOrderMixin. Import LePOrderMixin.Exports. Module BottomMixin. Section BottomMixin. Variable (disp : unit) (T : porderType disp). Record of_ := Build { bottom : T; le0x : forall x, bottom <= x; }. Definition bLatticeMixin (m : of_) := @BLattice.Mixin _ _ (bottom m) (le0x m). End BottomMixin. Module Exports. Notation bottomMixin := of_. Notation BottomMixin := Build. Coercion bLatticeMixin : of_ >-> BLattice.mixin_of. End Exports. End BottomMixin. Import BottomMixin.Exports. Module TopMixin. Section TopMixin. Variable (disp : unit) (T : porderType disp). Record of_ := Build { top : T; lex1 : forall x, x <= top; }. Definition tbLatticeMixin (m : of_) := @TBLattice.Mixin _ _ (top m) (lex1 m). End TopMixin. Module Exports. Notation topMixin := of_. Notation TopMixin := Build. Coercion tbLatticeMixin : of_ >-> TBLattice.mixin_of. End Exports. End TopMixin. Import TopMixin.Exports. Module LatticeMixin. Section LatticeMixin. Variable (disp : unit) (T : porderType disp). Record of_ := Build { meet : T -> T -> T; join : T -> T -> T; meetC : commutative meet; joinC : commutative join; meetA : associative meet; joinA : associative join; joinKI : forall y x, meet x (join x y) = x; meetKU : forall y x, join x (meet x y) = x; leEmeet : forall x y, (x <= y) = (meet x y == x); }. Definition latticeMixin (m : of_) := @Lattice.Mixin T _ (meet m) (join m) (meetC m) (joinC m) (meetA m) (joinA m) (joinKI m) (meetKU m) (leEmeet m). End LatticeMixin. Module Exports. Coercion latticeMixin : of_ >-> Lattice.mixin_of. Notation latticeMixin := of_. Notation LatticeMixin := Build. End Exports. End LatticeMixin. Import LatticeMixin.Exports. Module DistrLatticeMixin. Section DistrLatticeMixin. Variable (disp : unit) (T : latticeType disp). Record of_ := Build { meetUl : @left_distributive T T meet join; }. Definition distrLatticeMixin (m : of_) := @DistrLattice.Mixin _ _ (meetUl m). End DistrLatticeMixin. Module Exports. Coercion distrLatticeMixin : of_ >-> DistrLattice.mixin_of. Notation distrLatticeMixin := of_. Notation DistrLatticeMixin := Build. End Exports. End DistrLatticeMixin. Import DistrLatticeMixin.Exports. Module CBDistrLatticeMixin. Section CBDistrLatticeMixin. Variable (disp : unit) (T : bDistrLatticeType disp). Record of_ := Build { sub : T -> T -> T; subKI : forall x y, y `&` sub x y = bottom; joinIB : forall x y, (x `&` y) `|` sub x y = x; }. Definition cbDistrLatticeMixin (m : of_) := @CBDistrLattice.Mixin _ _ (sub m) (subKI m) (joinIB m). End CBDistrLatticeMixin. Module Exports. Coercion cbDistrLatticeMixin : of_ >-> CBDistrLattice.mixin_of. Notation cbDistrLatticeMixin := of_. Notation CBDistrLatticeMixin := Build. End Exports. End CBDistrLatticeMixin. Import CBDistrLatticeMixin.Exports. Module CTBDistrLatticeMixin. Section CTBDistrLatticeMixin. Variable (disp : unit) (T : tbDistrLatticeType disp) (sub : T -> T -> T). Record of_ := Build { compl : T -> T; complE : forall x, compl x = sub top x }. Definition ctbDistrLatticeMixin (m : of_) := @CTBDistrLattice.Mixin _ _ sub (compl m) (complE m). End CTBDistrLatticeMixin. Module Exports. Coercion ctbDistrLatticeMixin : of_ >-> CTBDistrLattice.mixin_of. Notation ctbDistrLatticeMixin := of_. Notation CTBDistrLatticeMixin := Build. End Exports. End CTBDistrLatticeMixin. Import CTBDistrLatticeMixin.Exports. Module TotalOrderMixin. Section TotalOrderMixin. Variable (disp : unit) (T : distrLatticeType disp). Definition of_ := total (<=%O : rel T). Definition totalOrderMixin (m : of_) : Total.mixin_of (DistrLattice.class T) := m. End TotalOrderMixin. Module Exports. Coercion totalOrderMixin : of_ >-> Total.mixin_of. Notation totalOrderMixin := of_. End Exports. End TotalOrderMixin. Import TotalOrderMixin.Exports. Module DistrLatticePOrderMixin. Section DistrLatticePOrderMixin. Variable (disp : unit) (T : porderType disp). Record of_ := Build { meet : T -> T -> T; join : T -> T -> T; meetC : commutative meet; joinC : commutative join; meetA : associative meet; joinA : associative join; joinKI : forall y x, meet x (join x y) = x; meetKU : forall y x, join x (meet x y) = x; leEmeet : forall x y, (x <= y) = (meet x y == x); meetUl : left_distributive meet join; }. Variable (m : of_). Definition latticeMixin := @LatticeMixin _ _ (meet m) (join m) (meetC m) (joinC m) (meetA m) (joinA m) (joinKI m) (meetKU m) (leEmeet m). Definition distrLatticeMixin := @DistrLatticeMixin _ (LatticeType T latticeMixin) (meetUl m). End DistrLatticePOrderMixin. Module Exports. Notation distrLatticePOrderMixin := of_. Notation DistrLatticePOrderMixin := Build. Coercion latticeMixin : of_ >-> LatticeMixin.of_. Coercion distrLatticeMixin : of_ >-> DistrLatticeMixin.of_. Definition DistrLatticeOfPOrderType disp (T : porderType disp) (m : of_ T) := DistrLatticeType (LatticeType T m) m. End Exports. End DistrLatticePOrderMixin. Import DistrLatticePOrderMixin.Exports. Module TotalLatticeMixin. Section TotalLatticeMixin. Variable (disp : unit) (T : latticeType 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 meetUl : @left_distributive T T meet join. Proof. pose leP x y := lcomparable_leP (comparableT x y). move=> x y z; case: (leP x z); case: (leP y z); case: (leP x y); case: (leP x z); case: (leP y z); case: (leP x y) => //= xy yz xz _ _ _; rewrite ?joinxx //. - by move: (le_lt_trans xz (lt_trans yz xy)); rewrite ltxx. - by move: (lt_le_trans xz (le_trans xy yz)); rewrite ltxx. Qed. Definition distrLatticeMixin := @DistrLatticeMixin _ T meetUl. Definition totalMixin : totalOrderMixin (DistrLatticeType T distrLatticeMixin) := m. End TotalLatticeMixin. Module Exports. Notation totalLatticeMixin := of_. Coercion distrLatticeMixin : of_ >-> DistrLatticeMixin.of_. Coercion totalMixin : of_ >-> totalOrderMixin. Definition OrderOfLattice disp (T : latticeType disp) (m : of_ T) := OrderType (DistrLatticeType T m) m. End Exports. End TotalLatticeMixin. Import TotalLatticeMixin.Exports. Module TotalPOrderMixin. Section TotalPOrderMixin. 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 : compare x y (min y x) (min x y) (max y x) (max x y) (y == x) (x == y) (x >= y) (x <= y) (x > y) (x < y). Proof. exact: comparable_ltgtP. Qed. Fact leP x y : le_xor_gt x y (min y x) (min x y) (max y x) (max x y) (x <= y) (y < x). Proof. exact: comparable_leP. Qed. Definition meet := @min _ T. Definition join := @max _ T. 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 /min !(fun_if, if_arg). case: (leP z y) (leP y x) (leP z x) => [] zy [] yx [] zx//=. by have := le_lt_trans (le_trans zy yx) zx; rewrite ltxx. by apply/eqP; rewrite eq_le zx ltW// (lt_trans yx). Qed. Fact joinA : associative join. Proof. move=> x y z; rewrite /meet /min !(fun_if, if_arg). case: (leP z y) (leP y x) (leP z x) => [] zy [] yx [] zx//=. by have := le_lt_trans (le_trans zy yx) zx; rewrite ltxx. by apply/eqP; rewrite eq_le zx ltW// (lt_trans yx). Qed. Fact joinKI y x : meet x (join x y) = x. Proof. rewrite /meet /join /min /max !(fun_if, if_arg). by have []// := ltgtP x y; rewrite ltxx. Qed. Fact meetKU y x : join x (meet x y) = x. Proof. rewrite /meet /join /min /max !(fun_if, if_arg). by have []// := ltgtP x y; rewrite ltxx. Qed. Fact leEmeet x y : (x <= y) = (meet x y == x). Proof. by rewrite /meet; case: leP => ?; rewrite ?eqxx ?lt_eqF. Qed. Definition latticeMixin := @LatticeMixin _ T _ _ meetC joinC meetA joinA joinKI meetKU leEmeet. Definition totalLatticeMixin : totalLatticeMixin (LatticeType T latticeMixin) := m. End TotalPOrderMixin. Module Exports. Notation totalPOrderMixin := of_. Coercion latticeMixin : of_ >-> LatticeMixin.of_. Coercion totalLatticeMixin : of_ >-> TotalLatticeMixin.of_. Definition OrderOfPOrder disp (T : porderType disp) (m : of_ T) := OrderType (DistrLatticeType (LatticeType T m) m) m. End Exports. End TotalPOrderMixin. Import TotalPOrderMixin.Exports. Module LtPOrderMixin. Section LtPOrderMixin. Variable (T : eqType). Record of_ := Build { le : rel T; lt : rel T; le_def : forall x y, le x y = (x == y) || lt x y; lt_irr : irreflexive lt; lt_trans : transitive lt; }. 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; case: 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 lePOrderMixin : lePOrderMixin T := @LePOrderMixin _ (le m) (lt m) lt_def le_refl le_anti le_trans. End LtPOrderMixin. Module Exports. Notation ltPOrderMixin := of_. Notation LtPOrderMixin := Build. Coercion lePOrderMixin : of_ >-> LePOrderMixin.of_. End Exports. End LtPOrderMixin. Import LtPOrderMixin.Exports. Module MeetJoinMixin. Section MeetJoinMixin. Variable (T : choiceType). Record of_ := Build { le : rel T; lt : rel T; meet : T -> T -> T; join : T -> T -> T; 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; 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; }. Variable (m : of_). 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 (lt_def m) le_refl le_anti le_trans. Let T_porderType := POrderType tt T porderMixin. Definition distrLatticeMixin : distrLatticePOrderMixin T_porderType := @DistrLatticePOrderMixin _ T_porderType _ _ (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 : of_ >-> lePOrderMixin. Coercion distrLatticeMixin : of_ >-> DistrLatticePOrderMixin.of_. Definition DistrLatticeOfChoiceType disp (T : choiceType) (m : of_ T) := DistrLatticeType (LatticeType (POrderType disp T m) m) m. End Exports. End MeetJoinMixin. Import MeetJoinMixin.Exports. Module LeOrderMixin. Section LeOrderMixin. Variables (T : choiceType). Record of_ := Build { le : rel T; lt : rel T; meet : T -> T -> T; join : T -> T -> T; lt_def : forall x y, lt x y = (y != x) && le 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 x y then y else x; le_anti : antisymmetric le; le_trans : transitive le; le_total : total le; }. Variables (m : of_). Fact le_refl : reflexive (le m). Proof. by move=> x; case: (le m x x) (le_total m x x). Qed. Definition lePOrderMixin := LePOrderMixin (lt_def m) le_refl (@le_anti m) (@le_trans m). Let T_orderType := OrderOfPOrder (le_total m : totalPOrderMixin (POrderType tt T lePOrderMixin)). Implicit Types (x y z : T_orderType). 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 distrLatticeMixin : meetJoinMixin T := @MeetJoinMixin _ (le m) (lt m) (meet m) (join m) le_def (lt_def m) meetC joinC meetA joinA joinKI meetKU meetUl meetxx. Let T_distrLatticeType := DistrLatticeOfChoiceType tt distrLatticeMixin. Definition totalMixin : totalOrderMixin T_distrLatticeType := le_total m. End LeOrderMixin. Module Exports. Notation leOrderMixin := of_. Notation LeOrderMixin := Build. Coercion distrLatticeMixin : of_ >-> meetJoinMixin. Coercion totalMixin : of_ >-> totalOrderMixin. Definition OrderOfChoiceType disp (T : choiceType) (m : of_ T) := OrderType (DistrLatticeOfChoiceType disp m) m. End Exports. End LeOrderMixin. Import LeOrderMixin.Exports. Module LtOrderMixin. Section LtOrderMixin. Variable (T : choiceType). Record of_ := Build { le : rel T; lt : rel T; meet : T -> T -> T; join : T -> T -> T; 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 x y then y else x; lt_irr : irreflexive lt; lt_trans : transitive lt; lt_total : forall x y, x != y -> lt x y || lt y x; }. Variables (m : of_). Fact lt_def x y : lt m x y = (y != x) && le m x y. Proof. by rewrite le_def; case: eqVneq => //= ->; rewrite lt_irr. Qed. Fact meet_def_le x y : meet m x y = if lt m x y then x else y. Proof. by rewrite meet_def lt_def; case: eqP. Qed. Fact join_def_le x y : join m x y = if lt m x y then y else x. Proof. by rewrite join_def lt_def; case: eqP. Qed. Fact le_anti : antisymmetric (le m). Proof. move=> x y; rewrite !le_def; case: eqVneq => //= _ /andP [] hxy. by move/(lt_trans hxy); rewrite lt_irr. Qed. Fact le_trans : transitive (le m). Proof. move=> y x z; rewrite !le_def; case: eqVneq => [->|_] //=. by case: eqVneq => [-> ->|_ hxy /(lt_trans hxy) ->]; rewrite orbT. Qed. Fact le_total : total (le m). Proof. by move=> x y; rewrite !le_def; case: eqVneq => //; exact: lt_total. Qed. Definition orderMixin : leOrderMixin T := @LeOrderMixin _ (le m) (lt m) (meet m) (join m) lt_def meet_def_le join_def_le le_anti le_trans le_total. End LtOrderMixin. Module Exports. Notation ltOrderMixin := of_. Notation LtOrderMixin := Build. Coercion orderMixin : of_ >-> leOrderMixin. End Exports. End LtOrderMixin. Import LtOrderMixin.Exports. Module CanMixin. Section CanMixin. Section Total. Variables (disp : unit) (T : porderType disp). Variables (disp' : unit) (T' : orderType disp') (f : T -> T'). Lemma MonoTotal : {mono f : x y / x <= y} -> totalPOrderMixin T' -> totalPOrderMixin T. Proof. by move=> f_mono T'_tot x y; rewrite -!f_mono le_total. Qed. End Total. Section Order. Variables (T : choiceType) (disp : unit). Section Partial. Variables (T' : porderType disp) (f : T -> T'). Section PCan. Variables (f' : T' -> option T) (f_can : pcancel f f'). Definition le (x y : T) := f x <= f y. Definition lt (x y : T) := f x < f y. Fact refl : reflexive le. Proof. by move=> ?; apply: lexx. Qed. Fact anti : antisymmetric le. Proof. by move=> x y /le_anti /(pcan_inj f_can). Qed. Fact trans : transitive le. Proof. by move=> y x z xy /(le_trans xy). Qed. Fact lt_def x y : lt x y = (y != x) && le x y. Proof. by rewrite /lt lt_def (inj_eq (pcan_inj f_can)). Qed. Definition PcanPOrder := LePOrderMixin lt_def refl anti trans. End PCan. Definition CanPOrder f' (f_can : cancel f f') := PcanPOrder (can_pcan f_can). End Partial. Section Total. Variables (T' : orderType disp) (f : T -> T'). Section PCan. Variables (f' : T' -> option T) (f_can : pcancel f f'). Let T_porderType := POrderType disp T (PcanPOrder f_can). Let total_le : total (le f). Proof. by apply: (@MonoTotal _ T_porderType _ _ f) => //; apply: le_total. Qed. Definition PcanOrder := LeOrderMixin (@lt_def _ _ _ f_can) (fun _ _ => erefl) (fun _ _ => erefl) (@anti _ _ _ f_can) (@trans _ _) total_le. End PCan. Definition CanOrder f' (f_can : cancel f f') := PcanOrder (can_pcan f_can). End Total. End Order. Section Lattice. Variables (disp : unit) (T : porderType disp). Variables (disp' : unit) (T' : latticeType disp') (f : T -> T'). Variables (f' : T' -> T) (f_can : cancel f f') (f'_can : cancel f' f). Variable (f_mono : {mono f : x y / x <= y}). Definition meet (x y : T) := f' (meet (f x) (f y)). Definition join (x y : T) := f' (join (f x) (f y)). Lemma meetC : commutative meet. Proof. by move=> x y; rewrite /meet meetC. Qed. Lemma joinC : commutative join. Proof. by move=> x y; rewrite /join joinC. Qed. Lemma meetA : associative meet. Proof. by move=> y x z; rewrite /meet !f'_can meetA. Qed. Lemma joinA : associative join. Proof. by move=> y x z; rewrite /join !f'_can joinA. Qed. Lemma joinKI y x : meet x (join x y) = x. Proof. by rewrite /meet /join f'_can joinKI f_can. Qed. Lemma meetKI y x : join x (meet x y) = x. Proof. by rewrite /join /meet f'_can meetKU f_can. Qed. Lemma meet_eql x y : (x <= y) = (meet x y == x). Proof. by rewrite /meet -(can_eq f_can) f'_can eq_meetl f_mono. Qed. Definition IsoLattice := @LatticeMixin _ T _ _ meetC joinC meetA joinA joinKI meetKI meet_eql. End Lattice. Section DistrLattice. Variables (disp : unit) (T : porderType disp). Variables (disp' : unit) (T' : distrLatticeType disp') (f : T -> T'). Variables (f' : T' -> T) (f_can : cancel f f') (f'_can : cancel f' f). Variable (f_mono : {mono f : x y / x <= y}). Lemma meetUl : left_distributive (meet f f') (join f f'). Proof. by move=> x y z; rewrite /meet /join !f'_can meetUl. Qed. Definition IsoDistrLattice := @DistrLatticeMixin _ (LatticeType T (IsoLattice f_can f'_can f_mono)) meetUl. End DistrLattice. End CanMixin. Module Exports. Notation MonoTotalMixin := MonoTotal. Notation PcanPOrderMixin := PcanPOrder. Notation CanPOrderMixin := CanPOrder. Notation PcanOrderMixin := PcanOrder. Notation CanOrderMixin := CanOrder. Notation IsoLatticeMixin := IsoLattice. Notation IsoDistrLatticeMixin := IsoDistrLattice. End Exports. End CanMixin. Import CanMixin.Exports. Module SubOrder. Section Partial. Context {disp : unit} {T : porderType disp} (P : {pred T}) (sT : subType P). Definition sub_POrderMixin := PcanPOrderMixin (@valK _ _ sT). Canonical sub_POrderType := Eval hnf in POrderType disp sT sub_POrderMixin. Lemma leEsub (x y : sT) : (x <= y) = (val x <= val y). Proof. by []. Qed. Lemma ltEsub (x y : sT) : (x < y) = (val x < val y). Proof. by []. Qed. End Partial. Section Total. Context {disp : unit} {T : orderType disp} (P : {pred T}) (sT : subType P). Definition sub_TotalOrderMixin : totalPOrderMixin (sub_POrderType sT) := @MonoTotalMixin _ _ _ _ val (fun _ _ => erefl) (@le_total _ T). Canonical sub_LatticeType := Eval hnf in LatticeType sT sub_TotalOrderMixin. Canonical sub_DistrLatticeType := Eval hnf in DistrLatticeType sT sub_TotalOrderMixin. Canonical sub_OrderType := Eval hnf in OrderType sT sub_TotalOrderMixin. End Total. Arguments sub_TotalOrderMixin {disp T} [P]. Module Exports. Notation "[ 'porderMixin' 'of' T 'by' <: ]" := (sub_POrderMixin _ : lePOrderMixin [eqType of T]) (at level 0, format "[ 'porderMixin' 'of' T 'by' <: ]") : form_scope. Notation "[ 'totalOrderMixin' 'of' T 'by' <: ]" := (sub_TotalOrderMixin _ : totalPOrderMixin [porderType of T]) (at level 0, only parsing) : form_scope. Canonical sub_POrderType. Canonical sub_LatticeType. Canonical sub_DistrLatticeType. Canonical sub_OrderType. Definition leEsub := @leEsub. Definition ltEsub := @ltEsub. End Exports. End SubOrder. Import SubOrder.Exports. (*************) (* INSTANCES *) (*************) (*******************************) (* Canonical structures on nat *) (*******************************) (******************************************************************************) (* This is an example of creation of multiple canonical declarations on the *) (* same type, with distinct displays, on the example of natural numbers. *) (* We declare two distinct canonical orders: *) (* - leq which is total, and where meet and join are minn and maxn, on nat *) (* - dvdn which is partial, and where meet and join are gcdn and lcmn, *) (* on a "copy" of nat we name natdiv *) (******************************************************************************) (******************************************************************************) (* The Module NatOrder defines leq as the canonical order on the type nat, *) (* i.e. without creating a "copy". We define and use nat_display and proceed *) (* like standard canonical structure declaration, except we use this display. *) (* We also use a single factory LeOrderMixin to instantiate three different *) (* canonical declarations porderType, distrLatticeType, orderType *) (* We finish by providing theorems to convert the operations of ordered and *) (* lattice types to their definition without structure abstraction. *) (******************************************************************************) Module NatOrder. Section NatOrder. Lemma nat_display : unit. Proof. exact: tt. Qed. Lemma ltn_def x y : (x < y)%N = (y != x) && (x <= y)%N. Proof. by rewrite ltn_neqAle eq_sym. Qed. Definition orderMixin := LeOrderMixin ltn_def (fun _ _ => erefl) (fun _ _ => erefl) anti_leq leq_trans leq_total. Canonical porderType := POrderType nat_display nat orderMixin. Canonical latticeType := LatticeType nat orderMixin. Canonical bLatticeType := BLatticeType nat (BottomMixin leq0n). Canonical distrLatticeType := DistrLatticeType nat orderMixin. Canonical bDistrLatticeType := [bDistrLatticeType of nat]. Canonical orderType := OrderType nat orderMixin. Lemma leEnat : le = leq. Proof. by []. Qed. Lemma ltEnat : lt = ltn. Proof. by []. Qed. Lemma minEnat : min = minn. Proof. by []. Qed. Lemma maxEnat : max = maxn. Proof. by []. Qed. Lemma botEnat : 0%O = 0%N :> nat. Proof. by []. Qed. End NatOrder. Module Exports. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical orderType. Definition leEnat := leEnat. Definition ltEnat := ltEnat. Definition minEnat := minEnat. Definition maxEnat := maxEnat. Definition botEnat := botEnat. End Exports. End NatOrder. Module NatMonotonyTheory. Section NatMonotonyTheory. Import NatOrder.Exports. Context {disp : unit} {T : porderType disp}. Variables (D : {pred nat}) (f : nat -> T). Hypothesis Dconvex : {in D &, forall i j k, i < k < j -> k \in D}. Lemma homo_ltn_lt_in : {in D, forall i, i.+1 \in D -> f i < f i.+1} -> {in D &, {homo f : i j / i < j}}. Proof. by apply: homo_ltn_in Dconvex; apply: lt_trans. Qed. Lemma incn_inP : {in D, forall i, i.+1 \in D -> f i < f i.+1} -> {in D &, {mono f : i j / i <= j}}. Proof. by move=> f_inc; apply/le_mono_in/homo_ltn_lt_in. Qed. Lemma nondecn_inP : {in D, forall i, i.+1 \in D -> f i <= f i.+1} -> {in D &, {homo f : i j / i <= j}}. Proof. by apply: homo_leq_in Dconvex => //; apply: le_trans. Qed. Lemma nhomo_ltn_lt_in : {in D, forall i, i.+1 \in D -> f i > f i.+1} -> {in D &, {homo f : i j /~ i < j}}. Proof. move=> f_dec; apply: homo_sym_in. by apply: homo_ltn_in Dconvex f_dec => ? ? ? ? /lt_trans->. Qed. Lemma decn_inP : {in D, forall i, i.+1 \in D -> f i > f i.+1} -> {in D &, {mono f : i j /~ i <= j}}. Proof. by move=> f_dec; apply/le_nmono_in/nhomo_ltn_lt_in. Qed. Lemma nonincn_inP : {in D, forall i, i.+1 \in D -> f i >= f i.+1} -> {in D &, {homo f : i j /~ i <= j}}. Proof. move=> /= f_dec; apply: homo_sym_in. by apply: homo_leq_in Dconvex f_dec => //= ? ? ? ? /le_trans->. Qed. Lemma homo_ltn_lt : (forall i, f i < f i.+1) -> {homo f : i j / i < j}. Proof. by apply: homo_ltn; apply: lt_trans. Qed. Lemma incnP : (forall i, f i < f i.+1) -> {mono f : i j / i <= j}. Proof. by move=> f_inc; apply/le_mono/homo_ltn_lt. Qed. Lemma nondecnP : (forall i, f i <= f i.+1) -> {homo f : i j / i <= j}. Proof. by apply: homo_leq => //; apply: le_trans. Qed. Lemma nhomo_ltn_lt : (forall i, f i > f i.+1) -> {homo f : i j /~ i < j}. Proof. move=> f_dec; apply: homo_sym. by apply: homo_ltn f_dec => ? ? ? ? /lt_trans->. Qed. Lemma decnP : (forall i, f i > f i.+1) -> {mono f : i j /~ i <= j}. Proof. by move=> f_dec; apply/le_nmono/nhomo_ltn_lt. Qed. Lemma nonincnP : (forall i, f i >= f i.+1) -> {homo f : i j /~ i <= j}. Proof. move=> /= f_dec; apply: homo_sym. by apply: homo_leq f_dec => //= ? ? ? ? /le_trans->. Qed. End NatMonotonyTheory. Arguments homo_ltn_lt_in {disp T} [D f]. Arguments incn_inP {disp T} [D f]. Arguments nondecn_inP {disp T} [D f]. Arguments nhomo_ltn_lt_in {disp T} [D f]. Arguments decn_inP {disp T} [D f]. Arguments nonincn_inP {disp T} [D f]. Arguments homo_ltn_lt {disp T} [f]. Arguments incnP {disp T} [f]. Arguments nondecnP {disp T} [f]. Arguments nhomo_ltn_lt {disp T} [f]. Arguments decnP {disp T} [f]. Arguments nonincnP {disp T} [f]. End NatMonotonyTheory. (****************************************************************************) (* The Module DvdSyntax introduces a new set of notations using the newly *) (* created display dvd_display. We first define the display as an opaque *) (* definition of type unit, and we use it as the first argument of the *) (* operator which display we want to change from the default one (here le, *) (* lt, dvd sdvd, meet, join, top and bottom, as well as big op notations on *) (* gcd and lcm). This notations will now be used for any ordered type which *) (* first parameter is set to dvd_display. *) (****************************************************************************) Lemma dvd_display : unit. Proof. exact: tt. Qed. Module DvdSyntax. Notation dvd := (@le dvd_display _). Notation "@ 'dvd' T" := (@le dvd_display T) (at level 10, T at level 8, only parsing) : fun_scope. Notation sdvd := (@lt dvd_display _). Notation "@ 'sdvd' T" := (@lt dvd_display T) (at level 10, T at level 8, only parsing) : fun_scope. Notation "x %| y" := (dvd x y) : order_scope. Notation "x %<| y" := (sdvd x y) : order_scope. Notation gcd := (@meet dvd_display _). Notation "@ 'gcd' T" := (@meet dvd_display T) (at level 10, T at level 8, only parsing) : fun_scope. Notation lcm := (@join dvd_display _). Notation "@ 'lcm' T" := (@join dvd_display T) (at level 10, T at level 8, only parsing) : fun_scope. Notation nat0 := (@top dvd_display _). Notation nat1 := (@bottom dvd_display _). Notation "\gcd_ ( i <- r | P ) F" := (\big[gcd/nat0]_(i <- r | P%B) F%O) : order_scope. Notation "\gcd_ ( i <- r ) F" := (\big[gcd/nat0]_(i <- r) F%O) : order_scope. Notation "\gcd_ ( i | P ) F" := (\big[gcd/nat0]_(i | P%B) F%O) : order_scope. Notation "\gcd_ i F" := (\big[gcd/nat0]_i F%O) : order_scope. Notation "\gcd_ ( i : I | P ) F" := (\big[gcd/nat0]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\gcd_ ( i : I ) F" := (\big[gcd/nat0]_(i : I) F%O) (only parsing) : order_scope. Notation "\gcd_ ( m <= i < n | P ) F" := (\big[gcd/nat0]_(m <= i < n | P%B) F%O) : order_scope. Notation "\gcd_ ( m <= i < n ) F" := (\big[gcd/nat0]_(m <= i < n) F%O) : order_scope. Notation "\gcd_ ( i < n | P ) F" := (\big[gcd/nat0]_(i < n | P%B) F%O) : order_scope. Notation "\gcd_ ( i < n ) F" := (\big[gcd/nat0]_(i < n) F%O) : order_scope. Notation "\gcd_ ( i 'in' A | P ) F" := (\big[gcd/nat0]_(i in A | P%B) F%O) : order_scope. Notation "\gcd_ ( i 'in' A ) F" := (\big[gcd/nat0]_(i in A) F%O) : order_scope. Notation "\lcm_ ( i <- r | P ) F" := (\big[lcm/nat1]_(i <- r | P%B) F%O) : order_scope. Notation "\lcm_ ( i <- r ) F" := (\big[lcm/nat1]_(i <- r) F%O) : order_scope. Notation "\lcm_ ( i | P ) F" := (\big[lcm/nat1]_(i | P%B) F%O) : order_scope. Notation "\lcm_ i F" := (\big[lcm/nat1]_i F%O) : order_scope. Notation "\lcm_ ( i : I | P ) F" := (\big[lcm/nat1]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\lcm_ ( i : I ) F" := (\big[lcm/nat1]_(i : I) F%O) (only parsing) : order_scope. Notation "\lcm_ ( m <= i < n | P ) F" := (\big[lcm/nat1]_(m <= i < n | P%B) F%O) : order_scope. Notation "\lcm_ ( m <= i < n ) F" := (\big[lcm/nat1]_(m <= i < n) F%O) : order_scope. Notation "\lcm_ ( i < n | P ) F" := (\big[lcm/nat1]_(i < n | P%B) F%O) : order_scope. Notation "\lcm_ ( i < n ) F" := (\big[lcm/nat1]_(i < n) F%O) : order_scope. Notation "\lcm_ ( i 'in' A | P ) F" := (\big[lcm/nat1]_(i in A | P%B) F%O) : order_scope. Notation "\lcm_ ( i 'in' A ) F" := (\big[lcm/nat1]_(i in A) F%O) : order_scope. End DvdSyntax. (******************************************************************************) (* The Module NatDvd defines dvdn as the canonical order on NatDvd.t, which *) (* is abbreviated using the notation natdvd at the end of the module. *) (* We use the newly defined dvd_display, described above. This looks *) (* like standard canonical structure declaration, except we use a display and *) (* we declare it on a "copy" of the type. *) (* We first recover structures that are common to both nat and natdiv *) (* (eqType, choiceType, countType) through the clone mechanisms, then we use *) (* a single factory MeetJoinMixin to instantiate both porderType and *) (* distrLatticeType canonical structures, and end with top and bottom. *) (* We finish by providing theorems to convert the operations of ordered and *) (* lattice types to their definition without structure abstraction. *) (******************************************************************************) Module NatDvd. Section NatDvd. Implicit Types m n p : nat. Lemma lcmnn n : lcmn n n = n. Proof. by case: n => // n; rewrite /lcmn gcdnn mulnK. Qed. Lemma le_def m n : m %| n = (gcdn m n == m)%N. Proof. by apply/gcdn_idPl/eqP. Qed. Lemma joinKI n m : gcdn m (lcmn m n) = m. Proof. by rewrite (gcdn_idPl _)// dvdn_lcml. Qed. Lemma meetKU n m : lcmn m (gcdn m n) = m. Proof. by rewrite (lcmn_idPl _)// dvdn_gcdl. Qed. Lemma meetUl : left_distributive gcdn lcmn. Proof. move=> [|m'] [|n'] [|p'] //=; rewrite ?lcmnn ?lcm0n ?lcmn0 ?gcd0n ?gcdn0//. - by rewrite gcdnC meetKU. - by rewrite lcmnC gcdnC meetKU. apply: eqn_from_log; rewrite ?(gcdn_gt0, lcmn_gt0)//= => p. by rewrite !(logn_gcd, logn_lcm) ?(gcdn_gt0, lcmn_gt0)// minn_maxl. Qed. Definition t_distrLatticeMixin := MeetJoinMixin le_def (fun _ _ => erefl _) gcdnC lcmnC gcdnA lcmnA joinKI meetKU meetUl gcdnn. Definition t := nat. Canonical eqType := [eqType of t]. Canonical choiceType := [choiceType of t]. Canonical countType := [countType of t]. Canonical porderType := POrderType dvd_display t t_distrLatticeMixin. Canonical latticeType := LatticeType t t_distrLatticeMixin. Canonical bLatticeType := BLatticeType t (BottomMixin (dvd1n : forall m : t, (1 %| m))). Canonical tbLatticeType := TBLatticeType t (TopMixin (dvdn0 : forall m : t, (m %| 0))). Canonical distrLatticeType := DistrLatticeType t t_distrLatticeMixin. Canonical bDistrLatticeType := [bDistrLatticeType of t]. Canonical tbDistrLatticeType := [tbDistrLatticeType of t]. Import DvdSyntax. Lemma dvdE : dvd = dvdn :> rel t. Proof. by []. Qed. Lemma sdvdE (m n : t) : m %<| n = (n != m) && (m %| n). Proof. by []. Qed. Lemma gcdE : gcd = gcdn :> (t -> t -> t). Proof. by []. Qed. Lemma lcmE : lcm = lcmn :> (t -> t -> t). Proof. by []. Qed. Lemma nat1E : nat1 = 1%N :> t. Proof. by []. Qed. Lemma nat0E : nat0 = 0%N :> t. Proof. by []. Qed. End NatDvd. Module Exports. Notation natdvd := t. Canonical eqType. Canonical choiceType. Canonical countType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Definition dvdEnat := dvdE. Definition sdvdEnat := sdvdE. Definition gcdEnat := gcdE. Definition lcmEnat := lcmE. Definition nat1E := nat1E. Definition nat0E := nat0E. End Exports. End NatDvd. (*******************************) (* Canonical structure on bool *) (*******************************) Module BoolOrder. Section BoolOrder. Implicit Types (x y : bool). Fact bool_display : unit. Proof. exact: tt. Qed. Fact andbE x y : x && y = if (x < y)%N then x else y. Proof. by case: x y => [] []. Qed. Fact orbE x y : x || y = if (x < y)%N then y else x. Proof. by case: x y => [] []. Qed. Fact ltn_def x y : (x < y)%N = (y != x) && (x <= y)%N. Proof. by case: x y => [] []. Qed. Fact anti : antisymmetric (leq : rel bool). Proof. by move=> x y /anti_leq /(congr1 odd); rewrite !oddb. Qed. Definition sub x y := x && ~~ y. Lemma subKI x y : y && sub x y = false. Proof. by case: x y => [] []. Qed. Lemma joinIB x y : (x && y) || sub x y = x. Proof. by case: x y => [] []. Qed. Definition orderMixin := LeOrderMixin ltn_def andbE orbE anti leq_trans leq_total. Canonical porderType := POrderType bool_display bool orderMixin. Canonical latticeType := LatticeType bool orderMixin. Canonical bLatticeType := BLatticeType bool (@BottomMixin _ _ false leq0n). Canonical tbLatticeType := TBLatticeType bool (@TopMixin _ _ true leq_b1). Canonical distrLatticeType := DistrLatticeType bool orderMixin. Canonical orderType := OrderType bool orderMixin. Canonical bDistrLatticeType := [bDistrLatticeType of bool]. Canonical tbDistrLatticeType := [tbDistrLatticeType of bool]. Canonical cbDistrLatticeType := CBDistrLatticeType bool (@CBDistrLatticeMixin _ _ (fun x y => x && ~~ y) subKI joinIB). Canonical ctbDistrLatticeType := CTBDistrLatticeType bool (@CTBDistrLatticeMixin _ _ sub negb (fun x => erefl : ~~ x = sub true x)). Canonical finPOrderType := [finPOrderType of bool]. Canonical finLatticeType := [finLatticeType of bool]. Canonical finDistrLatticeType := [finDistrLatticeType of bool]. Canonical finCDistrLatticeType := [finCDistrLatticeType of bool]. Canonical finOrderType := [finOrderType of bool]. Lemma leEbool : le = (leq : rel bool). Proof. by []. Qed. Lemma ltEbool x y : (x < y) = (x < y)%N. Proof. by []. Qed. Lemma andEbool : meet = andb. Proof. by []. Qed. Lemma orEbool : meet = andb. Proof. by []. Qed. Lemma subEbool x y : x `\` y = x && ~~ y. Proof. by []. Qed. Lemma complEbool : compl = negb. Proof. by []. Qed. End BoolOrder. Module Exports. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical cbDistrLatticeType. Canonical ctbDistrLatticeType. Canonical orderType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finOrderType. Canonical finCDistrLatticeType. Definition leEbool := leEbool. Definition ltEbool := ltEbool. Definition andEbool := andEbool. Definition orEbool := orEbool. Definition subEbool := subEbool. Definition complEbool := complEbool. End Exports. End BoolOrder. (*******************************) (* Definition of prod_display. *) (*******************************) Fact prod_display : unit. Proof. by []. Qed. Module Import ProdSyntax. Notation "<=^p%O" := (@le prod_display _) : fun_scope. Notation ">=^p%O" := (@ge prod_display _) : fun_scope. Notation ">=^p%O" := (@ge prod_display _) : fun_scope. Notation "<^p%O" := (@lt prod_display _) : fun_scope. Notation ">^p%O" := (@gt prod_display _) : fun_scope. Notation "=<^p%O" := (@comparable prod_display _) : fun_scope. Notation "><^p%O" := (fun x y => ~~ (@comparable prod_display _ x y)) : fun_scope. Notation "<=^p y" := (>=^p%O y) : order_scope. Notation "<=^p y :> T" := (<=^p (y : T)) (only parsing) : order_scope. Notation ">=^p y" := (<=^p%O y) : order_scope. Notation ">=^p y :> T" := (>=^p (y : T)) (only parsing) : order_scope. Notation "<^p y" := (>^p%O y) : order_scope. Notation "<^p y :> T" := (<^p (y : T)) (only parsing) : order_scope. Notation ">^p y" := (<^p%O y) : order_scope. Notation ">^p y :> T" := (>^p (y : T)) (only parsing) : order_scope. Notation "x <=^p y" := (<=^p%O x y) : order_scope. Notation "x <=^p y :> T" := ((x : T) <=^p (y : T)) (only parsing) : order_scope. Notation "x >=^p y" := (y <=^p x) (only parsing) : order_scope. Notation "x >=^p y :> T" := ((x : T) >=^p (y : T)) (only parsing) : order_scope. Notation "x <^p y" := (<^p%O x y) : order_scope. Notation "x <^p y :> T" := ((x : T) <^p (y : T)) (only parsing) : order_scope. Notation "x >^p y" := (y <^p x) (only parsing) : order_scope. Notation "x >^p y :> T" := ((x : T) >^p (y : T)) (only parsing) : order_scope. Notation "x <=^p y <=^p z" := ((x <=^p y) && (y <=^p z)) : order_scope. Notation "x <^p y <=^p z" := ((x <^p y) && (y <=^p z)) : order_scope. Notation "x <=^p y <^p z" := ((x <=^p y) && (y <^p z)) : order_scope. Notation "x <^p y <^p z" := ((x <^p y) && (y <^p z)) : order_scope. Notation "x <=^p y ?= 'iff' C" := ( T" := ((x : T) <=^p (y : T) ?= iff C) (only parsing) : order_scope. Notation ">=<^p y" := [pred x | >=<^p%O x y] : order_scope. Notation ">=<^p y :> T" := (>=<^p (y : T)) (only parsing) : order_scope. Notation "x >=<^p y" := (>=<^p%O x y) : order_scope. Notation "><^p y" := [pred x | ~~ (>=<^p%O x y)] : order_scope. Notation "><^p y :> T" := (><^p (y : T)) (only parsing) : order_scope. Notation "x ><^p y" := (~~ (><^p%O x y)) : order_scope. Notation "x `&^p` y" := (@meet prod_display _ x y) : order_scope. Notation "x `|^p` y" := (@join prod_display _ x y) : order_scope. Notation "\join^p_ ( i <- r | P ) F" := (\big[join/0]_(i <- r | P%B) F%O) : order_scope. Notation "\join^p_ ( i <- r ) F" := (\big[join/0]_(i <- r) F%O) : order_scope. Notation "\join^p_ ( i | P ) F" := (\big[join/0]_(i | P%B) F%O) : order_scope. Notation "\join^p_ i F" := (\big[join/0]_i F%O) : order_scope. Notation "\join^p_ ( i : I | P ) F" := (\big[join/0]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\join^p_ ( i : I ) F" := (\big[join/0]_(i : I) F%O) (only parsing) : order_scope. Notation "\join^p_ ( m <= i < n | P ) F" := (\big[join/0]_(m <= i < n | P%B) F%O) : order_scope. Notation "\join^p_ ( m <= i < n ) F" := (\big[join/0]_(m <= i < n) F%O) : order_scope. Notation "\join^p_ ( i < n | P ) F" := (\big[join/0]_(i < n | P%B) F%O) : order_scope. Notation "\join^p_ ( i < n ) F" := (\big[join/0]_(i < n) F%O) : order_scope. Notation "\join^p_ ( i 'in' A | P ) F" := (\big[join/0]_(i in A | P%B) F%O) : order_scope. Notation "\join^p_ ( i 'in' A ) F" := (\big[join/0]_(i in A) F%O) : order_scope. Notation "\meet^p_ ( i <- r | P ) F" := (\big[meet/1]_(i <- r | P%B) F%O) : order_scope. Notation "\meet^p_ ( i <- r ) F" := (\big[meet/1]_(i <- r) F%O) : order_scope. Notation "\meet^p_ ( i | P ) F" := (\big[meet/1]_(i | P%B) F%O) : order_scope. Notation "\meet^p_ i F" := (\big[meet/1]_i F%O) : order_scope. Notation "\meet^p_ ( i : I | P ) F" := (\big[meet/1]_(i : I | P%B) F%O) (only parsing) : order_scope. Notation "\meet^p_ ( i : I ) F" := (\big[meet/1]_(i : I) F%O) (only parsing) : order_scope. Notation "\meet^p_ ( m <= i < n | P ) F" := (\big[meet/1]_(m <= i < n | P%B) F%O) : order_scope. Notation "\meet^p_ ( m <= i < n ) F" := (\big[meet/1]_(m <= i < n) F%O) : order_scope. Notation "\meet^p_ ( i < n | P ) F" := (\big[meet/1]_(i < n | P%B) F%O) : order_scope. Notation "\meet^p_ ( i < n ) F" := (\big[meet/1]_(i < n) F%O) : order_scope. Notation "\meet^p_ ( i 'in' A | P ) F" := (\big[meet/1]_(i in A | P%B) F%O) : order_scope. Notation "\meet^p_ ( i 'in' A ) F" := (\big[meet/1]_(i in A) F%O) : order_scope. End ProdSyntax. (*******************************) (* Definition of lexi_display. *) (*******************************) Fact lexi_display : unit. Proof. by []. Qed. Module Import LexiSyntax. Notation "<=^l%O" := (@le lexi_display _) : fun_scope. Notation ">=^l%O" := (@ge lexi_display _) : fun_scope. Notation ">=^l%O" := (@ge lexi_display _) : fun_scope. Notation "<^l%O" := (@lt lexi_display _) : fun_scope. Notation ">^l%O" := (@gt lexi_display _) : fun_scope. Notation "=<^l%O" := (@comparable lexi_display _) : fun_scope. Notation "><^l%O" := (fun x y => ~~ (@comparable lexi_display _ x y)) : fun_scope. Notation "<=^l y" := (>=^l%O y) : order_scope. Notation "<=^l y :> T" := (<=^l (y : T)) (only parsing) : order_scope. Notation ">=^l y" := (<=^l%O y) : order_scope. Notation ">=^l y :> T" := (>=^l (y : T)) (only parsing) : order_scope. Notation "<^l y" := (>^l%O y) : order_scope. Notation "<^l y :> T" := (<^l (y : T)) (only parsing) : order_scope. Notation ">^l y" := (<^l%O y) : order_scope. Notation ">^l y :> T" := (>^l (y : T)) (only parsing) : order_scope. Notation "x <=^l y" := (<=^l%O x y) : order_scope. Notation "x <=^l y :> T" := ((x : T) <=^l (y : T)) (only parsing) : order_scope. Notation "x >=^l y" := (y <=^l x) (only parsing) : order_scope. Notation "x >=^l y :> T" := ((x : T) >=^l (y : T)) (only parsing) : order_scope. Notation "x <^l y" := (<^l%O x y) : order_scope. Notation "x <^l y :> T" := ((x : T) <^l (y : T)) (only parsing) : order_scope. Notation "x >^l y" := (y <^l x) (only parsing) : order_scope. Notation "x >^l y :> T" := ((x : T) >^l (y : T)) (only parsing) : order_scope. Notation "x <=^l y <=^l z" := ((x <=^l y) && (y <=^l z)) : order_scope. Notation "x <^l y <=^l z" := ((x <^l y) && (y <=^l z)) : order_scope. Notation "x <=^l y <^l z" := ((x <=^l y) && (y <^l z)) : order_scope. Notation "x <^l y <^l z" := ((x <^l y) && (y <^l z)) : order_scope. Notation "x <=^l y ?= 'iff' C" := ( T" := ((x : T) <=^l (y : T) ?= iff C) (only parsing) : order_scope. Notation ">=<^l y" := [pred x | >=<^l%O x y] : order_scope. Notation ">=<^l y :> T" := (>=<^l (y : T)) (only parsing) : order_scope. Notation "x >=<^l y" := (>=<^l%O x y) : order_scope. Notation "><^l y" := [pred x | ~~ (>=<^l%O x y)] : order_scope. Notation "><^l y :> T" := (><^l (y : T)) (only parsing) : order_scope. Notation "x ><^l y" := (~~ (><^l%O x y)) : order_scope. Notation meetlexi := (@meet lexi_display _). Notation joinlexi := (@join lexi_display _). Notation "x `&^l` y" := (meetlexi x y) : order_scope. Notation "x `|^l` y" := (joinlexi x y) : order_scope. End LexiSyntax. (*************************************************) (* We declare a "copy" of the cartesian product, *) (* which has canonical product order. *) (*************************************************) Module ProdOrder. Section ProdOrder. Definition type (disp : unit) (T T' : Type) := (T * T')%type. Context {disp1 disp2 disp3 : unit}. Local Notation "T * T'" := (type disp3 T T') : type_scope. Canonical eqType (T T' : eqType):= Eval hnf in [eqType of T * T']. Canonical choiceType (T T' : choiceType):= Eval hnf in [choiceType of T * T']. Canonical countType (T T' : countType):= Eval hnf in [countType of T * T']. Canonical finType (T T' : finType):= Eval hnf in [finType of T * T']. Section POrder. Variable (T : porderType disp1) (T' : porderType disp2). Implicit Types (x y : T * T'). Definition le x y := (x.1 <= y.1) && (x.2 <= y.2). Fact refl : reflexive le. Proof. by move=> ?; rewrite /le !lexx. Qed. 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 (rrefl _) refl anti trans. Canonical porderType := POrderType disp3 (T * T') porderMixin. Lemma leEprod x y : (x <= y) = (x.1 <= y.1) && (x.2 <= y.2). Proof. by []. Qed. Lemma ltEprod x y : (x < y) = [&& x != y, x.1 <= y.1 & x.2 <= y.2]. Proof. by rewrite lt_neqAle. Qed. Lemma le_pair (x1 y1 : T) (x2 y2 : T') : (x1, x2) <= (y1, y2) :> T * T' = (x1 <= y1) && (x2 <= y2). Proof. by []. Qed. Lemma lt_pair (x1 y1 : T) (x2 y2 : T') : (x1, x2) < (y1, y2) :> T * T' = [&& (x1 != y1) || (x2 != y2), x1 <= y1 & x2 <= y2]. Proof. by rewrite ltEprod negb_and. Qed. 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 eqE /= -!leEmeet. Qed. Definition latticeMixin := Lattice.Mixin meetC joinC meetA joinA joinKI meetKU leEmeet. Canonical latticeType := LatticeType (T * T') latticeMixin. Lemma meetEprod x y : x `&` y = (x.1 `&` y.1, x.2 `&` y.2). Proof. by []. Qed. Lemma joinEprod x y : x `|` y = (x.1 `|` y.1, x.2 `|` y.2). Proof. by []. Qed. End Lattice. Section BLattice. Variable (T : bLatticeType disp1) (T' : bLatticeType disp2). Fact le0x (x : T * T') : (0, 0) <= x :> T * T'. Proof. by rewrite /<=%O /= /le !le0x. Qed. Canonical bLatticeType := BLatticeType (T * T') (BLattice.Mixin le0x). Lemma botEprod : 0 = (0, 0) :> T * T'. Proof. by []. Qed. End BLattice. Section TBLattice. Variable (T : tbLatticeType disp1) (T' : tbLatticeType disp2). Fact lex1 (x : T * T') : x <= (top, top). Proof. by rewrite /<=%O /= /le !lex1. Qed. Canonical tbLatticeType := TBLatticeType (T * T') (TBLattice.Mixin lex1). Lemma topEprod : 1 = (1, 1) :> T * T'. Proof. by []. Qed. End TBLattice. Section DistrLattice. Variable (T : distrLatticeType disp1) (T' : distrLatticeType disp2). Fact meetUl : left_distributive (@meet T T') (@join T T'). Proof. by move=> ? ? ?; congr pair; rewrite meetUl. Qed. Definition distrLatticeMixin := DistrLatticeMixin meetUl. Canonical distrLatticeType := DistrLatticeType (T * T') distrLatticeMixin. End DistrLattice. Canonical bDistrLatticeType (T : bDistrLatticeType disp1) (T' : bDistrLatticeType disp2) := [bDistrLatticeType of T * T']. Canonical tbDistrLatticeType (T : tbDistrLatticeType disp1) (T' : tbDistrLatticeType disp2) := [tbDistrLatticeType of T * T']. Section CBDistrLattice. Variable (T : cbDistrLatticeType disp1) (T' : cbDistrLatticeType 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 cbDistrLatticeMixin := CBDistrLatticeMixin subKI joinIB. Canonical cbDistrLatticeType := CBDistrLatticeType (T * T') cbDistrLatticeMixin. Lemma subEprod x y : x `\` y = (x.1 `\` y.1, x.2 `\` y.2). Proof. by []. Qed. End CBDistrLattice. Section CTBDistrLattice. Variable (T : ctbDistrLatticeType disp1) (T' : ctbDistrLatticeType disp2). Implicit Types (x y : T * T'). Definition compl x : T * T' := (~` x.1, ~` x.2). Lemma complE x : compl x = sub 1 x. Proof. by congr pair; rewrite complE. Qed. Definition ctbDistrLatticeMixin := CTBDistrLatticeMixin complE. Canonical ctbDistrLatticeType := CTBDistrLatticeType (T * T') ctbDistrLatticeMixin. Lemma complEprod x : ~` x = (~` x.1, ~` x.2). Proof. by []. Qed. End CTBDistrLattice. 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 finDistrLatticeType (T : finDistrLatticeType disp1) (T' : finDistrLatticeType disp2) := [finDistrLatticeType of T * T']. Canonical finCDistrLatticeType (T : finCDistrLatticeType disp1) (T' : finCDistrLatticeType disp2) := [finCDistrLatticeType of T * T']. End ProdOrder. Module Exports. Notation "T *prod[ d ] T'" := (type d T T') (at level 70, d at next level, format "T *prod[ d ] T'") : type_scope. Notation "T *p T'" := (type prod_display T T') (at level 70, format "T *p T'") : type_scope. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical cbDistrLatticeType. Canonical ctbDistrLatticeType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finCDistrLatticeType. Definition leEprod := @leEprod. Definition ltEprod := @ltEprod. Definition le_pair := @le_pair. Definition lt_pair := @lt_pair. Definition meetEprod := @meetEprod. Definition joinEprod := @joinEprod. Definition botEprod := @botEprod. Definition topEprod := @topEprod. Definition subEprod := @subEprod. Definition complEprod := @complEprod. End Exports. End ProdOrder. Import ProdOrder.Exports. Module DefaultProdOrder. Section DefaultProdOrder. Context {disp1 disp2 : unit}. Canonical prod_porderType (T : porderType disp1) (T' : porderType disp2) := [porderType of T * T' for [porderType of T *p T']]. Canonical prod_latticeType (T : latticeType disp1) (T' : latticeType disp2) := [latticeType of T * T' for [latticeType of T *p T']]. Canonical prod_bLatticeType (T : bLatticeType disp1) (T' : bLatticeType disp2) := [bLatticeType of T * T' for [bLatticeType of T *p T']]. Canonical prod_tbLatticeType (T : tbLatticeType disp1) (T' : tbLatticeType disp2) := [tbLatticeType of T * T' for [tbLatticeType of T *p T']]. Canonical prod_distrLatticeType (T : distrLatticeType disp1) (T' : distrLatticeType disp2) := [distrLatticeType of T * T' for [distrLatticeType of T *p T']]. Canonical prod_bDistrLatticeType (T : bDistrLatticeType disp1) (T' : bDistrLatticeType disp2) := [bDistrLatticeType of T * T']. Canonical prod_tbDistrLatticeType (T : tbDistrLatticeType disp1) (T' : tbDistrLatticeType disp2) := [tbDistrLatticeType of T * T']. Canonical prod_cbDistrLatticeType (T : cbDistrLatticeType disp1) (T' : cbDistrLatticeType disp2) := [cbDistrLatticeType of T * T' for [cbDistrLatticeType of T *p T']]. Canonical prod_ctbDistrLatticeType (T : ctbDistrLatticeType disp1) (T' : ctbDistrLatticeType disp2) := [ctbDistrLatticeType of T * T' for [ctbDistrLatticeType of T *p T']]. Canonical prod_finPOrderType (T : finPOrderType disp1) (T' : finPOrderType disp2) := [finPOrderType of T * T']. Canonical prod_finLatticeType (T : finLatticeType disp1) (T' : finLatticeType disp2) := [finLatticeType of T * T']. Canonical prod_finDistrLatticeType (T : finDistrLatticeType disp1) (T' : finDistrLatticeType disp2) := [finDistrLatticeType of T * T']. Canonical prod_finCDistrLatticeType (T : finCDistrLatticeType disp1) (T' : finCDistrLatticeType disp2) := [finCDistrLatticeType of T * T']. End DefaultProdOrder. End DefaultProdOrder. (********************************************************) (* We declare lexicographic ordering on dependent pairs *) (********************************************************) Module SigmaOrder. Section SigmaOrder. Context {disp1 disp2 : unit}. Section POrder. Variable (T : porderType disp1) (T' : T -> porderType disp2). Implicit Types (x y : {t : T & T' t}). Definition le x y := (tag x <= tag y) && ((tag x >= tag y) ==> (tagged x <= tagged_as x y)). Definition lt x y := (tag x <= tag y) && ((tag x >= tag y) ==> (tagged x < tagged_as x y)). Fact refl : reflexive le. Proof. by move=> [x x']; rewrite /le tagged_asE/= !lexx. Qed. Fact anti : antisymmetric le. Proof. rewrite /le => -[x x'] [y y']/=; case: comparableP => //= eq_xy. by case: _ / eq_xy in y' *; rewrite !tagged_asE => /le_anti ->. Qed. Fact trans : transitive le. Proof. move=> [y y'] [x x'] [z z'] /andP[/= lexy lexy'] /andP[/= leyz leyz']. rewrite /= /le (le_trans lexy) //=; apply/implyP => lezx. elim: _ / (@le_anti _ _ x y) in y' z' lexy' leyz' *; last first. by rewrite lexy (le_trans leyz). elim: _ / (@le_anti _ _ x z) in z' leyz' *; last by rewrite (le_trans lexy). by rewrite lexx !tagged_asE/= in lexy' leyz' *; rewrite (le_trans lexy'). Qed. Fact lt_def x y : lt x y = (y != x) && le x y. Proof. rewrite /lt /le; case: x y => [x x'] [y y']//=; rewrite andbCA. case: (comparableP x y) => //= xy; last first. by case: _ / xy in y' *; rewrite !tagged_asE eq_Tagged/= lt_def. by rewrite andbT; symmetry; apply: contraTneq xy => -[yx _]; rewrite yx ltxx. Qed. Definition porderMixin := LePOrderMixin lt_def refl anti trans. Canonical porderType := POrderType disp2 {t : T & T' t} porderMixin. Lemma leEsig x y : x <= y = (tag x <= tag y) && ((tag x >= tag y) ==> (tagged x <= tagged_as x y)). Proof. by []. Qed. Lemma ltEsig x y : x < y = (tag x <= tag y) && ((tag x >= tag y) ==> (tagged x < tagged_as x y)). Proof. by []. Qed. Lemma le_Taggedl x (u : T' (tag x)) : (Tagged T' u <= x) = (u <= tagged x). Proof. by case: x => [t v]/= in u *; rewrite leEsig/= lexx/= tagged_asE. Qed. Lemma le_Taggedr x (u : T' (tag x)) : (x <= Tagged T' u) = (tagged x <= u). Proof. by case: x => [t v]/= in u *; rewrite leEsig/= lexx/= tagged_asE. Qed. Lemma lt_Taggedl x (u : T' (tag x)) : (Tagged T' u < x) = (u < tagged x). Proof. by case: x => [t v]/= in u *; rewrite ltEsig/= lexx/= tagged_asE. Qed. Lemma lt_Taggedr x (u : T' (tag x)) : (x < Tagged T' u) = (tagged x < u). Proof. by case: x => [t v]/= in u *; rewrite ltEsig/= lexx/= tagged_asE. Qed. End POrder. Section Total. Variable (T : orderType disp1) (T' : T -> orderType disp2). Implicit Types (x y : {t : T & T' t}). Fact total : totalPOrderMixin [porderType of {t : T & T' t}]. Proof. move=> x y; rewrite !leEsig; case: (ltgtP (tag x) (tag y)) => //=. case: x y => [x x'] [y y']/= eqxy; elim: _ /eqxy in y' *. by rewrite !tagged_asE le_total. Qed. Canonical latticeType := LatticeType {t : T & T' t} total. Canonical distrLatticeType := DistrLatticeType {t : T & T' t} total. Canonical orderType := OrderType {t : T & T' t} total. End Total. Section FinDistrLattice. Variable (T : finOrderType disp1) (T' : T -> finOrderType disp2). Fact le0x (x : {t : T & T' t}) : Tagged T' (0 : T' 0) <= x. Proof. rewrite leEsig /=; case: comparableP (le0x (tag x)) => //=. by case: x => //= x px x0; rewrite x0 in px *; rewrite tagged_asE le0x. Qed. Canonical bLatticeType := BLatticeType {t : T & T' t} (BLattice.Mixin le0x). Canonical bDistrLatticeType := [bDistrLatticeType of {t : T & T' t}]. Lemma botEsig : 0 = Tagged T' (0 : T' 0). Proof. by []. Qed. Fact lex1 (x : {t : T & T' t}) : x <= Tagged T' (1 : T' 1). Proof. rewrite leEsig /=; case: comparableP (lex1 (tag x)) => //=. by case: x => //= x px x0; rewrite x0 in px *; rewrite tagged_asE lex1. Qed. Canonical tbLatticeType := TBLatticeType {t : T & T' t} (TBLattice.Mixin lex1). Canonical tbDistrLatticeType := [tbDistrLatticeType of {t : T & T' t}]. Lemma topEsig : 1 = Tagged T' (1 : T' 1). Proof. by []. Qed. End FinDistrLattice. Canonical finPOrderType (T : finPOrderType disp1) (T' : T -> finPOrderType disp2) := [finPOrderType of {t : T & T' t}]. Canonical finLatticeType (T : finOrderType disp1) (T' : T -> finOrderType disp2) := [finLatticeType of {t : T & T' t}]. Canonical finDistrLatticeType (T : finOrderType disp1) (T' : T -> finOrderType disp2) := [finDistrLatticeType of {t : T & T' t}]. Canonical finOrderType (T : finOrderType disp1) (T' : T -> finOrderType disp2) := [finOrderType of {t : T & T' t}]. End SigmaOrder. Module Exports. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical orderType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finOrderType. Definition leEsig := @leEsig. Definition ltEsig := @ltEsig. Definition le_Taggedl := @le_Taggedl. Definition lt_Taggedl := @lt_Taggedl. Definition le_Taggedr := @le_Taggedr. Definition lt_Taggedr := @lt_Taggedr. Definition topEsig := @topEsig. Definition botEsig := @botEsig. End Exports. End SigmaOrder. Import SigmaOrder.Exports. (*************************************************) (* We declare a "copy" of the cartesian product, *) (* which has canonical lexicographic order. *) (*************************************************) Module ProdLexiOrder. Section ProdLexiOrder. Definition type (disp : unit) (T T' : Type) := (T * T')%type. Context {disp1 disp2 disp3 : unit}. Local Notation "T * T'" := (type disp3 T T') : type_scope. Canonical eqType (T T' : eqType):= Eval hnf in [eqType of T * T']. Canonical choiceType (T T' : choiceType):= Eval hnf in [choiceType of T * T']. Canonical countType (T T' : countType):= Eval hnf in [countType of T * T']. Canonical finType (T T' : finType):= Eval hnf in [finType of T * T']. 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)). Definition lt x y := (x.1 <= y.1) && ((x.1 >= y.1) ==> (x.2 < y.2)). Fact refl : reflexive le. Proof. by move=> ?; rewrite /le !lexx. Qed. Fact anti : antisymmetric le. Proof. by rewrite /le => -[x x'] [y y'] /=; case: comparableP => //= -> /le_anti->. 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. Fact lt_def x y : lt x y = (y != x) && le x y. Proof. rewrite /lt /le; case: x y => [x1 x2] [y1 y2]//=; rewrite xpair_eqE. by case: (comparableP x1 y1); rewrite lt_def. Qed. Definition porderMixin := LePOrderMixin lt_def refl anti trans. Canonical porderType := POrderType disp3 (T * T') porderMixin. Lemma leEprodlexi x y : (x <= y) = (x.1 <= y.1) && ((x.1 >= y.1) ==> (x.2 <= y.2)). Proof. by []. Qed. Lemma ltEprodlexi x y : (x < y) = (x.1 <= y.1) && ((x.1 >= y.1) ==> (x.2 < y.2)). Proof. by []. Qed. Lemma lexi_pair (x1 y1 : T) (x2 y2 : T') : (x1, x2) <= (y1, y2) :> T * T' = (x1 <= y1) && ((x1 >= y1) ==> (x2 <= y2)). Proof. by []. Qed. Lemma ltxi_pair (x1 y1 : T) (x2 y2 : T') : (x1, x2) < (y1, y2) :> T * T' = (x1 <= y1) && ((x1 >= y1) ==> (x2 < y2)). Proof. by []. Qed. End POrder. Section Total. Variable (T : orderType disp1) (T' : orderType disp2). Implicit Types (x y : T * T'). Fact total : totalPOrderMixin [porderType of T * T']. Proof. move=> x y; rewrite /<=%O /= /le; case: ltgtP => //= _; exact: le_total. Qed. Canonical latticeType := LatticeType (T * T') total. Canonical distrLatticeType := DistrLatticeType (T * T') total. Canonical orderType := OrderType (T * T') total. End Total. Section FinDistrLattice. Variable (T : finOrderType disp1) (T' : finOrderType disp2). Fact le0x (x : T * T') : (0, 0) <= x :> T * T'. Proof. by case: x => // x1 x2; rewrite leEprodlexi/= !le0x implybT. Qed. Canonical bLatticeType := BLatticeType (T * T') (BLattice.Mixin le0x). Canonical bDistrLatticeType := [bDistrLatticeType of T * T']. Lemma botEprodlexi : 0 = (0, 0) :> T * T'. Proof. by []. Qed. Fact lex1 (x : T * T') : x <= (1, 1) :> T * T'. Proof. by case: x => // x1 x2; rewrite leEprodlexi/= !lex1 implybT. Qed. Canonical tbLatticeType := TBLatticeType (T * T') (TBLattice.Mixin lex1). Canonical tbDistrLatticeType := [tbDistrLatticeType of T * T']. Lemma topEprodlexi : 1 = (1, 1) :> T * T'. Proof. by []. Qed. End FinDistrLattice. Canonical finPOrderType (T : finPOrderType disp1) (T' : finPOrderType disp2) := [finPOrderType of T * T']. Canonical finLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [finLatticeType of T * T']. Canonical finDistrLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [finDistrLatticeType of T * T']. Canonical finOrderType (T : finOrderType disp1) (T' : finOrderType disp2) := [finOrderType of T * T']. Lemma sub_prod_lexi d (T : POrder.Exports.porderType disp1) (T' : POrder.Exports.porderType disp2) : subrel (<=%O : rel (T *prod[d] T')) (<=%O : rel (T * T')). Proof. by case=> [x1 x2] [y1 y2]; rewrite leEprod leEprodlexi /=; case: comparableP. Qed. End ProdLexiOrder. Module Exports. Notation "T *lexi[ d ] T'" := (type d T T') (at level 70, d at next level, format "T *lexi[ d ] T'") : type_scope. Notation "T *l T'" := (type lexi_display T T') (at level 70, format "T *l T'") : type_scope. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical orderType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finOrderType. Definition leEprodlexi := @leEprodlexi. Definition ltEprodlexi := @ltEprodlexi. Definition lexi_pair := @lexi_pair. Definition ltxi_pair := @ltxi_pair. Definition topEprodlexi := @topEprodlexi. Definition botEprodlexi := @botEprodlexi. Definition sub_prod_lexi := @sub_prod_lexi. End Exports. End ProdLexiOrder. Import ProdLexiOrder.Exports. Module DefaultProdLexiOrder. Section DefaultProdLexiOrder. Context {disp1 disp2 : unit}. Canonical prodlexi_porderType (T : porderType disp1) (T' : porderType disp2) := [porderType of T * T' for [porderType of T *l T']]. Canonical prodlexi_latticeType (T : orderType disp1) (T' : orderType disp2) := [latticeType of T * T' for [latticeType of T *l T']]. Canonical prodlexi_bLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [bLatticeType of T * T' for [bLatticeType of T *l T']]. Canonical prodlexi_tbLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [tbLatticeType of T * T' for [tbLatticeType of T *l T']]. Canonical prodlexi_distrLatticeType (T : orderType disp1) (T' : orderType disp2) := [distrLatticeType of T * T' for [distrLatticeType of T *l T']]. Canonical prodlexi_orderType (T : orderType disp1) (T' : orderType disp2) := [orderType of T * T' for [orderType of T *l T']]. Canonical prodlexi_bDistrLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [bDistrLatticeType of T * T']. Canonical prodlexi_tbDistrLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [tbDistrLatticeType of T * T']. Canonical prodlexi_finPOrderType (T : finPOrderType disp1) (T' : finPOrderType disp2) := [finPOrderType of T * T']. Canonical prodlexi_finLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [finLatticeType of T * T']. Canonical prodlexi_finDistrLatticeType (T : finOrderType disp1) (T' : finOrderType disp2) := [finDistrLatticeType of T * T']. Canonical prodlexi_finOrderType (T : finOrderType disp1) (T' : finOrderType disp2) := [finOrderType of T * T']. End DefaultProdLexiOrder. End DefaultProdLexiOrder. (*****************************************) (* We declare a "copy" of the sequences, *) (* which has canonical product order. *) (*****************************************) Module SeqProdOrder. Section SeqProdOrder. Definition type (disp : unit) T := seq T. Context {disp disp' : unit}. Local Notation seq := (type disp'). Canonical eqType (T : eqType):= Eval hnf in [eqType of seq T]. Canonical choiceType (T : choiceType):= Eval hnf in [choiceType of seq T]. Canonical countType (T : countType):= Eval hnf in [countType of seq T]. Section POrder. Variable T : porderType disp. Implicit Types s : seq T. Fixpoint le s1 s2 := if s1 isn't x1 :: s1' then true else if s2 isn't x2 :: s2' then false else (x1 <= x2) && le s1' s2'. Fact refl : reflexive le. Proof. by elim=> //= ? ? ?; rewrite !lexx. Qed. Fact anti : antisymmetric le. Proof. by elim=> [|x s ihs] [|y s'] //=; rewrite andbACA => /andP[/le_anti-> /ihs->]. Qed. Fact trans : transitive le. Proof. elim=> [|y ys ihs] [|x xs] [|z zs] //= /andP[xy xys] /andP[yz yzs]. by rewrite (le_trans xy)// ihs. Qed. Definition porderMixin := LePOrderMixin (rrefl _) refl anti trans. Canonical porderType := POrderType disp' (seq T) porderMixin. Lemma leEseq s1 s2 : s1 <= s2 = if s1 isn't x1 :: s1' then true else if s2 isn't x2 :: s2' then false else (x1 <= x2) && (s1' <= s2' :> seq _). Proof. by case: s1. Qed. Lemma le0s s : [::] <= s :> seq _. Proof. by []. Qed. Lemma les0 s : s <= [::] = (s == [::]). Proof. by rewrite leEseq. Qed. Lemma le_cons x1 s1 x2 s2 : x1 :: s1 <= x2 :: s2 :> seq _ = (x1 <= x2) && (s1 <= s2). Proof. by []. Qed. End POrder. Section Lattice. 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. by rewrite /<=%O /=; elim: x y => [|? ? ih] [|? ?] //=; rewrite eqE leEmeet ih. Qed. Definition latticeMixin := Lattice.Mixin meetC joinC meetA joinA joinKI meetKU leEmeet. Canonical latticeType := LatticeType (seq T) latticeMixin. Lemma meetEseq s1 s2 : s1 `&` s2 = [seq x.1 `&` x.2 | x <- zip s1 s2]. Proof. by elim: s1 s2 => [|x s1 ihs1] [|y s2]//=; rewrite -ihs1. Qed. Lemma meet_cons x1 s1 x2 s2 : (x1 :: s1 : seq T) `&` (x2 :: s2) = (x1 `&` x2) :: s1 `&` s2. Proof. by []. Qed. Lemma joinEseq s1 s2 : s1 `|` s2 = match s1, s2 with | [::], _ => s2 | _, [::] => s1 | x1 :: s1', x2 :: s2' => (x1 `|` x2) :: ((s1' : seq _) `|` s2') end. Proof. by case: s1. Qed. Lemma join_cons x1 s1 x2 s2 : (x1 :: s1 : seq T) `|` (x2 :: s2) = (x1 `|` x2) :: s1 `|` s2. Proof. by []. Qed. Canonical bLatticeType := BLatticeType (seq T) (BLattice.Mixin (@le0s _)). Lemma botEseq : 0 = [::] :> seq T. Proof. by []. Qed. End Lattice. Section DistrLattice. Variable T : distrLatticeType disp. Fact meetUl : left_distributive (@meet T) (@join T). Proof. by elim=> [|? ? ih] [|? ?] [|? ?] //=; rewrite meetUl ih. Qed. Definition distrLatticeMixin := DistrLatticeMixin meetUl. Canonical distrLatticeType := DistrLatticeType (seq T) distrLatticeMixin. Canonical bDistrLatticeType := [bDistrLatticeType of seq T]. End DistrLattice. End SeqProdOrder. Module Exports. Notation seqprod_with := type. Notation seqprod := (type prod_display). Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Definition leEseq := @leEseq. Definition le0s := @le0s. Definition les0 := @les0. Definition le_cons := @le_cons. Definition botEseq := @botEseq. Definition meetEseq := @meetEseq. Definition meet_cons := @meet_cons. Definition joinEseq := @joinEseq. End Exports. End SeqProdOrder. Import SeqProdOrder.Exports. Module DefaultSeqProdOrder. Section DefaultSeqProdOrder. Context {disp : unit}. Canonical seqprod_porderType (T : porderType disp) := [porderType of seq T for [porderType of seqprod T]]. Canonical seqprod_latticeType (T : latticeType disp) := [latticeType of seq T for [latticeType of seqprod T]]. Canonical seqprod_ndbLatticeType (T : latticeType disp) := [bLatticeType of seq T for [bLatticeType of seqprod T]]. Canonical seqprod_distrLatticeType (T : distrLatticeType disp) := [distrLatticeType of seq T for [distrLatticeType of seqprod T]]. Canonical seqprod_bDistrLatticeType (T : bDistrLatticeType disp) := [bDistrLatticeType of seq T]. End DefaultSeqProdOrder. End DefaultSeqProdOrder. (*********************************************) (* We declare a "copy" of the sequences, *) (* which has canonical lexicographic order. *) (*********************************************) Module SeqLexiOrder. Section SeqLexiOrder. Definition type (disp : unit) T := seq T. Context {disp disp' : unit}. Local Notation seq := (type disp'). Canonical eqType (T : eqType):= Eval hnf in [eqType of seq T]. Canonical choiceType (T : choiceType):= Eval hnf in [choiceType of seq T]. Canonical countType (T : countType):= Eval hnf in [countType of seq T]. Section POrder. Variable T : porderType disp. Implicit Types s : seq T. Fixpoint le s1 s2 := if s1 isn't x1 :: s1' then true else if s2 isn't x2 :: s2' then false else (x1 <= x2) && ((x1 >= x2) ==> le s1' s2'). Fixpoint lt s1 s2 := if s2 isn't x2 :: s2' then false else if s1 isn't x1 :: s1' then true else (x1 <= x2) && ((x1 >= x2) ==> lt s1' s2'). Fact refl: reflexive le. Proof. by elim => [|x s ih] //=; rewrite lexx. Qed. 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 trans: transitive le. Proof. elim=> [|y sy ihs] [|x sx] [|z sz] //=; case: (comparableP x y) => //= [xy|->]. by move=> _ /andP[/(lt_le_trans xy) xz _]; rewrite (ltW xz)// lt_geF. by case: comparableP => //= _; apply: ihs. Qed. Lemma lt_def s1 s2 : lt s1 s2 = (s2 != s1) && le s1 s2. Proof. elim: s1 s2 => [|x s1 ihs1] [|y s2]//=. by rewrite eqseq_cons ihs1; case: comparableP. Qed. Definition porderMixin := LePOrderMixin lt_def refl anti trans. Canonical porderType := POrderType disp' (seq T) porderMixin. Lemma leEseqlexi s1 s2 : s1 <= s2 = if s1 isn't x1 :: s1' then true else if s2 isn't x2 :: s2' then false else (x1 <= x2) && ((x1 >= x2) ==> (s1' <= s2' :> seq T)). Proof. by case: s1. Qed. Lemma ltEseqlexi s1 s2 : s1 < s2 = if s2 isn't x2 :: s2' then false else if s1 isn't x1 :: s1' then true else (x1 <= x2) && ((x1 >= x2) ==> (s1' < s2' :> seq T)). Proof. by case: s1. Qed. Lemma lexi0s s : [::] <= s :> seq T. Proof. by []. Qed. Lemma lexis0 s : s <= [::] = (s == [::]). Proof. by rewrite leEseqlexi. Qed. Lemma ltxi0s s : ([::] < s :> seq T) = (s != [::]). Proof. by case: s. Qed. Lemma ltxis0 s : s < [::] = false. Proof. by rewrite ltEseqlexi. Qed. Lemma lexi_cons x1 s1 x2 s2 : x1 :: s1 <= x2 :: s2 :> seq T = (x1 <= x2) && ((x1 >= x2) ==> (s1 <= s2)). Proof. by []. Qed. Lemma ltxi_cons x1 s1 x2 s2 : x1 :: s1 < x2 :: s2 :> seq T = (x1 <= x2) && ((x1 >= x2) ==> (s1 < s2)). Proof. by []. Qed. Lemma lexi_lehead x s1 y s2 : x :: s1 <= y :: s2 :> seq T -> x <= y. Proof. by rewrite lexi_cons => /andP[]. Qed. Lemma ltxi_lehead x s1 y s2 : x :: s1 < y :: s2 :> seq T -> x <= y. Proof. by rewrite ltxi_cons => /andP[]. Qed. Lemma eqhead_lexiE (x : T) s1 s2 : (x :: s1 <= x :: s2 :> seq _) = (s1 <= s2). Proof. by rewrite lexi_cons lexx. Qed. Lemma eqhead_ltxiE (x : T) s1 s2 : (x :: s1 < x :: s2 :> seq _) = (s1 < s2). Proof. by rewrite ltxi_cons lexx. Qed. Lemma neqhead_lexiE (x y : T) s1 s2 : x != y -> (x :: s1 <= y :: s2 :> seq _) = (x < y). Proof. by rewrite lexi_cons; case: comparableP. Qed. Lemma neqhead_ltxiE (x y : T) s1 s2 : x != y -> (x :: s1 < y :: s2 :> seq _) = (x < y). Proof. by rewrite ltxi_cons; case: (comparableP x y). Qed. End POrder. Section Total. Variable T : orderType disp. Implicit Types s : seq T. Fact total : totalPOrderMixin [porderType of seq T]. Proof. suff: total (<=%O : rel (seq T)) by []. by elim=> [|x1 s1 ihs1] [|x2 s2]//=; rewrite !lexi_cons; case: ltgtP => /=. Qed. Canonical latticeType := LatticeType (seq T) total. Canonical bLatticeType := BLatticeType (seq T) (BLattice.Mixin (@lexi0s _)). Canonical distrLatticeType := DistrLatticeType (seq T) total. Canonical bDistrLatticeType := [bDistrLatticeType of seq T]. Canonical orderType := OrderType (seq T) total. End Total. Lemma sub_seqprod_lexi d (T : POrder.Exports.porderType disp) : subrel (<=%O : rel (seqprod_with d T)) (<=%O : rel (seq T)). Proof. elim=> [|x1 s1 ihs1] [|x2 s2]//=; rewrite le_cons lexi_cons /=. by move=> /andP[-> /ihs1->]; rewrite implybT. Qed. End SeqLexiOrder. Module Exports. Notation seqlexi_with := type. Notation seqlexi := (type lexi_display). Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical orderType. Definition leEseqlexi := @leEseqlexi. Definition lexi0s := @lexi0s. Definition lexis0 := @lexis0. Definition lexi_cons := @lexi_cons. Definition lexi_lehead := @lexi_lehead. Definition eqhead_lexiE := @eqhead_lexiE. Definition neqhead_lexiE := @neqhead_lexiE. Definition ltEseqltxi := @ltEseqlexi. Definition ltxi0s := @ltxi0s. Definition ltxis0 := @ltxis0. Definition ltxi_cons := @ltxi_cons. Definition ltxi_lehead := @ltxi_lehead. Definition eqhead_ltxiE := @eqhead_ltxiE. Definition neqhead_ltxiE := @neqhead_ltxiE. Definition sub_seqprod_lexi := @sub_seqprod_lexi. End Exports. End SeqLexiOrder. Import SeqLexiOrder.Exports. Module DefaultSeqLexiOrder. Section DefaultSeqLexiOrder. Context {disp : unit}. Canonical seqlexi_porderType (T : porderType disp) := [porderType of seq T for [porderType of seqlexi T]]. Canonical seqlexi_latticeType (T : orderType disp) := [latticeType of seq T for [latticeType of seqlexi T]]. Canonical seqlexi_bLatticeType (T : orderType disp) := [bLatticeType of seq T for [bLatticeType of seqlexi T]]. Canonical seqlexi_distrLatticeType (T : orderType disp) := [distrLatticeType of seq T for [distrLatticeType of seqlexi T]]. Canonical seqlexi_bDistrLatticeType (T : orderType disp) := [bDistrLatticeType of seq T]. Canonical seqlexi_orderType (T : orderType disp) := [orderType of seq T for [orderType of seqlexi T]]. End DefaultSeqLexiOrder. End DefaultSeqLexiOrder. (***************************************) (* We declare a "copy" of the tuples, *) (* which has canonical product order. *) (***************************************) Module TupleProdOrder. Import DefaultSeqProdOrder. Section TupleProdOrder. Definition type (disp : unit) n T := n.-tuple T. Context {disp disp' : unit}. Local Notation "n .-tuple" := (type disp' n) : type_scope. Section Basics. Variable (n : nat). Canonical eqType (T : eqType):= Eval hnf in [eqType of n.-tuple T]. Canonical choiceType (T : choiceType):= Eval hnf in [choiceType of n.-tuple T]. Canonical countType (T : countType):= Eval hnf in [countType of n.-tuple T]. Canonical finType (T : finType):= Eval hnf in [finType of n.-tuple T]. End Basics. Section POrder. Implicit Types (T : porderType disp). Definition porderMixin n T := [porderMixin of n.-tuple T by <:]. Canonical porderType n T := POrderType disp' (n.-tuple T) (porderMixin n T). Lemma leEtprod n T (t1 t2 : n.-tuple T) : t1 <= t2 = [forall i, tnth t1 i <= tnth t2 i]. Proof. elim: n => [|n IHn] in t1 t2 *. by rewrite tuple0 [t2]tuple0/= lexx; symmetry; apply/forallP => []. case: (tupleP t1) (tupleP t2) => [x1 {}t1] [x2 {}t2]. rewrite [_ <= _]le_cons [t1 <= t2 :> seq _]IHn. apply/idP/forallP => [/andP[lex12 /forallP/= let12 i]|lext12]. by case: (unliftP ord0 i) => [j ->|->]//; rewrite !tnthS. rewrite (lext12 ord0)/=; apply/forallP=> i. by have := lext12 (lift ord0 i); rewrite !tnthS. Qed. Lemma ltEtprod n T (t1 t2 : n.-tuple T) : t1 < t2 = [exists i, tnth t1 i != tnth t2 i] && [forall i, tnth t1 i <= tnth t2 i]. Proof. by rewrite lt_neqAle leEtprod eqEtuple negb_forall. Qed. End POrder. Section Lattice. Variables (n : nat) (T : latticeType disp). Implicit Types (t : n.-tuple T). Definition meet t1 t2 : n.-tuple T := [tuple of [seq x.1 `&` x.2 | x <- zip t1 t2]]. Definition join t1 t2 : n.-tuple T := [tuple of [seq x.1 `|` x.2 | x <- zip t1 t2]]. Fact tnth_meet t1 t2 i : tnth (meet t1 t2) i = tnth t1 i `&` tnth t2 i. Proof. rewrite tnth_map -(tnth_map fst) -(tnth_map snd) -/unzip1 -/unzip2. by rewrite !(tnth_nth (tnth_default t1 i))/= unzip1_zip ?unzip2_zip ?size_tuple. Qed. Fact tnth_join t1 t2 i : tnth (join t1 t2) i = tnth t1 i `|` tnth t2 i. Proof. rewrite tnth_map -(tnth_map fst) -(tnth_map snd) -/unzip1 -/unzip2. by rewrite !(tnth_nth (tnth_default t1 i))/= unzip1_zip ?unzip2_zip ?size_tuple. Qed. Fact meetC : commutative meet. Proof. by move=> t1 t2; apply: eq_from_tnth => i; rewrite !tnth_meet meetC. Qed. Fact joinC : commutative join. Proof. by move=> t1 t2; apply: eq_from_tnth => i; rewrite !tnth_join joinC. Qed. Fact meetA : associative meet. Proof. by move=> t1 t2 t3; apply: eq_from_tnth => i; rewrite !tnth_meet meetA. Qed. Fact joinA : associative join. Proof. by move=> t1 t2 t3; apply: eq_from_tnth => i; rewrite !tnth_join joinA. Qed. Fact joinKI t2 t1 : meet t1 (join t1 t2) = t1. Proof. by apply: eq_from_tnth => i; rewrite tnth_meet tnth_join joinKI. Qed. Fact meetKU y x : join x (meet x y) = x. Proof. by apply: eq_from_tnth => i; rewrite tnth_join tnth_meet meetKU. Qed. Fact leEmeet t1 t2 : (t1 <= t2) = (meet t1 t2 == t1). Proof. rewrite leEtprod eqEtuple; apply: eq_forallb => /= i. by rewrite tnth_meet leEmeet. Qed. Definition latticeMixin := Lattice.Mixin meetC joinC meetA joinA joinKI meetKU leEmeet. Canonical latticeType := LatticeType (n.-tuple T) latticeMixin. Lemma meetEtprod t1 t2 : t1 `&` t2 = [tuple of [seq x.1 `&` x.2 | x <- zip t1 t2]]. Proof. by []. Qed. Lemma joinEtprod t1 t2 : t1 `|` t2 = [tuple of [seq x.1 `|` x.2 | x <- zip t1 t2]]. Proof. by []. Qed. End Lattice. Section BLattice. Variables (n : nat) (T : bLatticeType disp). Implicit Types (t : n.-tuple T). Fact le0x t : [tuple of nseq n 0] <= t :> n.-tuple T. Proof. by rewrite leEtprod; apply/forallP => i; rewrite tnth_nseq le0x. Qed. Canonical bLatticeType := BLatticeType (n.-tuple T) (BLattice.Mixin le0x). Lemma botEtprod : 0 = [tuple of nseq n 0] :> n.-tuple T. Proof. by []. Qed. End BLattice. Section TBLattice. Variables (n : nat) (T : tbLatticeType disp). Implicit Types (t : n.-tuple T). Fact lex1 t : t <= [tuple of nseq n 1] :> n.-tuple T. Proof. by rewrite leEtprod; apply/forallP => i; rewrite tnth_nseq lex1. Qed. Canonical tbLatticeType := TBLatticeType (n.-tuple T) (TBLattice.Mixin lex1). Lemma topEtprod : 1 = [tuple of nseq n 1] :> n.-tuple T. Proof. by []. Qed. End TBLattice. Section DistrLattice. Variables (n : nat) (T : distrLatticeType disp). Implicit Types (t : n.-tuple T). Fact meetUl : left_distributive (@meet n T) (@join n T). Proof. move=> t1 t2 t3; apply: eq_from_tnth => i. by rewrite !(tnth_meet, tnth_join) meetUl. Qed. Definition distrLatticeMixin := DistrLatticeMixin meetUl. Canonical distrLatticeType := DistrLatticeType (n.-tuple T) distrLatticeMixin. End DistrLattice. Canonical bDistrLatticeType (n : nat) (T : bDistrLatticeType disp) := [bDistrLatticeType of n.-tuple T]. Canonical tbDistrLatticeType (n : nat) (T : tbDistrLatticeType disp) := [tbDistrLatticeType of n.-tuple T]. Section CBDistrLattice. Variables (n : nat) (T : cbDistrLatticeType disp). Implicit Types (t : n.-tuple T). Definition sub t1 t2 : n.-tuple T := [tuple of [seq x.1 `\` x.2 | x <- zip t1 t2]]. Fact tnth_sub t1 t2 i : tnth (sub t1 t2) i = tnth t1 i `\` tnth t2 i. Proof. rewrite tnth_map -(tnth_map fst) -(tnth_map snd) -/unzip1 -/unzip2. by rewrite !(tnth_nth (tnth_default t1 i))/= unzip1_zip ?unzip2_zip ?size_tuple. Qed. Lemma subKI t1 t2 : t2 `&` sub t1 t2 = 0. Proof. by apply: eq_from_tnth => i; rewrite tnth_meet tnth_sub subKI tnth_nseq. Qed. Lemma joinIB t1 t2 : t1 `&` t2 `|` sub t1 t2 = t1. Proof. by apply: eq_from_tnth => i; rewrite tnth_join tnth_meet tnth_sub joinIB. Qed. Definition cbDistrLatticeMixin := CBDistrLatticeMixin subKI joinIB. Canonical cbDistrLatticeType := CBDistrLatticeType (n.-tuple T) cbDistrLatticeMixin. Lemma subEtprod t1 t2 : t1 `\` t2 = [tuple of [seq x.1 `\` x.2 | x <- zip t1 t2]]. Proof. by []. Qed. End CBDistrLattice. Section CTBDistrLattice. Variables (n : nat) (T : ctbDistrLatticeType disp). Implicit Types (t : n.-tuple T). Definition compl t : n.-tuple T := map_tuple compl t. Fact tnth_compl t i : tnth (compl t) i = ~` tnth t i. Proof. by rewrite tnth_map. Qed. Lemma complE t : compl t = sub 1 t. Proof. by apply: eq_from_tnth => i; rewrite tnth_compl tnth_sub complE tnth_nseq. Qed. Definition ctbDistrLatticeMixin := CTBDistrLatticeMixin complE. Canonical ctbDistrLatticeType := CTBDistrLatticeType (n.-tuple T) ctbDistrLatticeMixin. Lemma complEtprod t : ~` t = [tuple of [seq ~` x | x <- t]]. Proof. by []. Qed. End CTBDistrLattice. Canonical finPOrderType n (T : finPOrderType disp) := [finPOrderType of n.-tuple T]. Canonical finLatticeType n (T : finLatticeType disp) := [finLatticeType of n.-tuple T]. Canonical finDistrLatticeType n (T : finDistrLatticeType disp) := [finDistrLatticeType of n.-tuple T]. Canonical finCDistrLatticeType n (T : finCDistrLatticeType disp) := [finCDistrLatticeType of n.-tuple T]. End TupleProdOrder. Module Exports. Notation "n .-tupleprod[ disp ]" := (type disp n) (at level 2, disp at next level, format "n .-tupleprod[ disp ]") : type_scope. Notation "n .-tupleprod" := (n.-tupleprod[prod_display]) (at level 2, format "n .-tupleprod") : type_scope. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical cbDistrLatticeType. Canonical ctbDistrLatticeType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finCDistrLatticeType. Definition leEtprod := @leEtprod. Definition ltEtprod := @ltEtprod. Definition meetEtprod := @meetEtprod. Definition joinEtprod := @joinEtprod. Definition botEtprod := @botEtprod. Definition topEtprod := @topEtprod. Definition subEtprod := @subEtprod. Definition complEtprod := @complEtprod. Definition tnth_meet := @tnth_meet. Definition tnth_join := @tnth_join. Definition tnth_sub := @tnth_sub. Definition tnth_compl := @tnth_compl. End Exports. End TupleProdOrder. Import TupleProdOrder.Exports. Module DefaultTupleProdOrder. Section DefaultTupleProdOrder. Context {disp : unit}. Canonical tprod_porderType n (T : porderType disp) := [porderType of n.-tuple T for [porderType of n.-tupleprod T]]. Canonical tprod_latticeType n (T : latticeType disp) := [latticeType of n.-tuple T for [latticeType of n.-tupleprod T]]. Canonical tprod_bLatticeType n (T : bLatticeType disp) := [bLatticeType of n.-tuple T for [bLatticeType of n.-tupleprod T]]. Canonical tprod_tbLatticeType n (T : tbLatticeType disp) := [tbLatticeType of n.-tuple T for [tbLatticeType of n.-tupleprod T]]. Canonical tprod_distrLatticeType n (T : distrLatticeType disp) := [distrLatticeType of n.-tuple T for [distrLatticeType of n.-tupleprod T]]. Canonical tprod_bDistrLatticeType n (T : bDistrLatticeType disp) := [bDistrLatticeType of n.-tuple T]. Canonical tprod_tbDistrLatticeType n (T : tbDistrLatticeType disp) := [tbDistrLatticeType of n.-tuple T]. Canonical tprod_cbDistrLatticeType n (T : cbDistrLatticeType disp) := [cbDistrLatticeType of n.-tuple T for [cbDistrLatticeType of n.-tupleprod T]]. Canonical tprod_ctbDistrLatticeType n (T : ctbDistrLatticeType disp) := [ctbDistrLatticeType of n.-tuple T for [ctbDistrLatticeType of n.-tupleprod T]]. Canonical tprod_finPOrderType n (T : finPOrderType disp) := [finPOrderType of n.-tuple T]. Canonical tprod_finLatticeType n (T : finLatticeType disp) := [finLatticeType of n.-tuple T]. Canonical tprod_finDistrLatticeType n (T : finDistrLatticeType disp) := [finDistrLatticeType of n.-tuple T]. Canonical tprod_finCDistrLatticeType n (T : finCDistrLatticeType disp) := [finCDistrLatticeType of n.-tuple T]. End DefaultTupleProdOrder. End DefaultTupleProdOrder. (*********************************************) (* We declare a "copy" of the tuples, *) (* which has canonical lexicographic order. *) (*********************************************) Module TupleLexiOrder. Section TupleLexiOrder. Import DefaultSeqLexiOrder. Definition type (disp : unit) n T := n.-tuple T. Context {disp disp' : unit}. Local Notation "n .-tuple" := (type disp' n) : type_scope. Section Basics. Variable (n : nat). Canonical eqType (T : eqType):= Eval hnf in [eqType of n.-tuple T]. Canonical choiceType (T : choiceType):= Eval hnf in [choiceType of n.-tuple T]. Canonical countType (T : countType):= Eval hnf in [countType of n.-tuple T]. Canonical finType (T : finType):= Eval hnf in [finType of n.-tuple T]. End Basics. Section POrder. Implicit Types (T : porderType disp). Definition porderMixin n T := [porderMixin of n.-tuple T by <:]. Canonical porderType n T := POrderType disp' (n.-tuple T) (porderMixin n T). Lemma lexi_tupleP n T (t1 t2 : n.-tuple T) : reflect (exists k : 'I_n.+1, forall i : 'I_n, (i <= k)%N -> tnth t1 i <= tnth t2 i ?= iff (i != k :> nat)) (t1 <= t2). Proof. elim: n => [|n IHn] in t1 t2 *. by rewrite tuple0 [t2]tuple0/= lexx; constructor; exists ord0 => -[]. case: (tupleP t1) (tupleP t2) => [x1 {}t1] [x2 {}t2]. rewrite [_ <= _]lexi_cons; apply: (iffP idP) => [|[k leif_xt12]]. case: comparableP => //= [ltx12 _|-> /IHn[k kP]]. exists ord0 => i; rewrite leqn0 => /eqP/(@ord_inj n.+1 i ord0)->. by apply/leifP; rewrite !tnth0. exists (lift ord0 k) => i; case: (unliftP ord0 i) => [j ->|-> _]. by rewrite !ltnS => /kP; rewrite !tnthS. by apply/leifP; rewrite !tnth0 eqxx. have /= := leif_xt12 ord0 isT; rewrite !tnth0 => leif_x12. rewrite leif_x12/=; move: leif_x12 leif_xt12 => /leifP. case: (unliftP ord0 k) => {k} [k-> /eqP<-{x2}|-> /lt_geF->//] leif_xt12. rewrite lexx implyTb; apply/IHn; exists k => i le_ik. by have := leif_xt12 (lift ord0 i) le_ik; rewrite !tnthS. Qed. Lemma ltxi_tupleP n T (t1 t2 : n.-tuple T) : reflect (exists k : 'I_n, forall i : 'I_n, (i <= k)%N -> tnth t1 i <= tnth t2 i ?= iff (i != k :> nat)) (t1 < t2). Proof. elim: n => [|n IHn] in t1 t2 *. by rewrite tuple0 [t2]tuple0/= ltxx; constructor => - [] []. case: (tupleP t1) (tupleP t2) => [x1 {}t1] [x2 {}t2]. rewrite [_ < _]ltxi_cons; apply: (iffP idP) => [|[k leif_xt12]]. case: (comparableP x1 x2) => //= [ltx12 _|-> /IHn[k kP]]. exists ord0 => i; rewrite leqn0 => /eqP/(@ord_inj n.+1 i ord0)->. by apply/leifP; rewrite !tnth0. exists (lift ord0 k) => i; case: (unliftP ord0 i) => {i} [i ->|-> _]. by rewrite !ltnS => /kP; rewrite !tnthS. by apply/leifP; rewrite !tnth0 eqxx. have /= := leif_xt12 ord0 isT; rewrite !tnth0 => leif_x12. rewrite leif_x12/=; move: leif_x12 leif_xt12 => /leifP. case: (unliftP ord0 k) => {k} [k-> /eqP<-{x2}|-> /lt_geF->//] leif_xt12. rewrite lexx implyTb; apply/IHn; exists k => i le_ik. by have := leif_xt12 (lift ord0 i) le_ik; rewrite !tnthS. Qed. Lemma ltxi_tuplePlt n T (t1 t2 : n.-tuple T) : reflect (exists2 k : 'I_n, forall i : 'I_n, (i < k)%N -> tnth t1 i = tnth t2 i & tnth t1 k < tnth t2 k) (t1 < t2). Proof. apply: (iffP (ltxi_tupleP _ _)) => [[k kP]|[k kP ltk12]]. exists k => [i i_lt|]; last by rewrite (lt_leif (kP _ _)) ?eqxx ?leqnn. by have /eqTleif->// := kP i (ltnW i_lt); rewrite ltn_eqF. by exists k => i; case: ltngtP => //= [/kP-> _|/ord_inj-> _]; apply/leifP. Qed. End POrder. Section Total. Variables (n : nat) (T : orderType disp). Implicit Types (t : n.-tuple T). Definition total : totalPOrderMixin [porderType of n.-tuple T] := [totalOrderMixin of n.-tuple T by <:]. Canonical latticeType := LatticeType (n.-tuple T) total. Canonical distrLatticeType := DistrLatticeType (n.-tuple T) total. Canonical orderType := OrderType (n.-tuple T) total. End Total. Section BDistrLattice. Variables (n : nat) (T : finOrderType disp). Implicit Types (t : n.-tuple T). Fact le0x t : [tuple of nseq n 0] <= t :> n.-tuple T. Proof. by apply: sub_seqprod_lexi; apply: le0x (t : n.-tupleprod T). Qed. Canonical bLatticeType := BLatticeType (n.-tuple T) (BLattice.Mixin le0x). Canonical bDistrLatticeType := [bDistrLatticeType of n.-tuple T]. Lemma botEtlexi : 0 = [tuple of nseq n 0] :> n.-tuple T. Proof. by []. Qed. End BDistrLattice. Section TBDistrLattice. Variables (n : nat) (T : finOrderType disp). Implicit Types (t : n.-tuple T). Fact lex1 t : t <= [tuple of nseq n 1]. Proof. by apply: sub_seqprod_lexi; apply: lex1 (t : n.-tupleprod T). Qed. Canonical tbLatticeType := TBLatticeType (n.-tuple T) (TBLattice.Mixin lex1). Canonical tbDistrLatticeType := [tbDistrLatticeType of n.-tuple T]. Lemma topEtlexi : 1 = [tuple of nseq n 1] :> n.-tuple T. Proof. by []. Qed. End TBDistrLattice. Canonical finPOrderType n (T : finPOrderType disp) := [finPOrderType of n.-tuple T]. Canonical finLatticeType n (T : finOrderType disp) := [finLatticeType of n.-tuple T]. Canonical finDistrLatticeType n (T : finOrderType disp) := [finDistrLatticeType of n.-tuple T]. Canonical finOrderType n (T : finOrderType disp) := [finOrderType of n.-tuple T]. Lemma sub_tprod_lexi d n (T : POrder.Exports.porderType disp) : subrel (<=%O : rel (n.-tupleprod[d] T)) (<=%O : rel (n.-tuple T)). Proof. exact: sub_seqprod_lexi. Qed. End TupleLexiOrder. Module Exports. Notation "n .-tuplelexi[ disp ]" := (type disp n) (at level 2, disp at next level, format "n .-tuplelexi[ disp ]") : order_scope. Notation "n .-tuplelexi" := (n.-tuplelexi[lexi_display]) (at level 2, format "n .-tuplelexi") : order_scope. Canonical eqType. Canonical choiceType. Canonical countType. Canonical finType. Canonical porderType. Canonical latticeType. Canonical bLatticeType. Canonical tbLatticeType. Canonical distrLatticeType. Canonical orderType. Canonical bDistrLatticeType. Canonical tbDistrLatticeType. Canonical finPOrderType. Canonical finLatticeType. Canonical finDistrLatticeType. Canonical finOrderType. Definition lexi_tupleP := @lexi_tupleP. Arguments lexi_tupleP {disp disp' n T t1 t2}. Definition ltxi_tupleP := @ltxi_tupleP. Arguments ltxi_tupleP {disp disp' n T t1 t2}. Definition ltxi_tuplePlt := @ltxi_tuplePlt. Arguments ltxi_tuplePlt {disp disp' n T t1 t2}. Definition topEtlexi := @topEtlexi. Definition botEtlexi := @botEtlexi. Definition sub_tprod_lexi := @sub_tprod_lexi. End Exports. End TupleLexiOrder. Import TupleLexiOrder.Exports. Module DefaultTupleLexiOrder. Section DefaultTupleLexiOrder. Context {disp : unit}. Canonical tlexi_porderType n (T : porderType disp) := [porderType of n.-tuple T for [porderType of n.-tuplelexi T]]. Canonical tlexi_latticeType n (T : orderType disp) := [latticeType of n.-tuple T for [latticeType of n.-tuplelexi T]]. Canonical tlexi_bLatticeType n (T : finOrderType disp) := [bLatticeType of n.-tuple T for [bLatticeType of n.-tuplelexi T]]. Canonical tlexi_tbLatticeType n (T : finOrderType disp) := [tbLatticeType of n.-tuple T for [tbLatticeType of n.-tuplelexi T]]. Canonical tlexi_distrLatticeType n (T : orderType disp) := [distrLatticeType of n.-tuple T for [distrLatticeType of n.-tuplelexi T]]. Canonical tlexi_bDistrLatticeType n (T : finOrderType disp) := [bDistrLatticeType of n.-tuple T]. Canonical tlexi_tbDistrLatticeType n (T : finOrderType disp) := [tbDistrLatticeType of n.-tuple T]. Canonical tlexi_orderType n (T : orderType disp) := [orderType of n.-tuple T for [orderType of n.-tuplelexi T]]. Canonical tlexi_finPOrderType n (T : finPOrderType disp) := [finPOrderType of n.-tuple T]. Canonical tlexi_finLatticeType n (T : finOrderType disp) := [finLatticeType of n.-tuple T]. Canonical tlexi_finDistrLatticeType n (T : finOrderType disp) := [finDistrLatticeType of n.-tuple T]. Canonical tlexi_finOrderType n (T : finOrderType disp) := [finOrderType of n.-tuple T]. End DefaultTupleLexiOrder. End DefaultTupleLexiOrder. Module Import DualOrder. Section DualOrder. Context {disp : unit}. Variable O : orderType disp. Lemma dual_totalMixin : totalOrderMixin [distrLatticeType of O^d]. Proof. by move=> x y; rewrite le_total. Qed. Canonical dual_orderType := OrderType O^d dual_totalMixin. End DualOrder. Canonical dual_finOrderType d (T : finOrderType d) := [finOrderType of T^d]. End DualOrder. Module Syntax. Export POSyntax. Export LatticeSyntax. Export BLatticeSyntax. Export TBLatticeSyntax. Export CBDistrLatticeSyntax. Export CTBDistrLatticeSyntax. Export DualSyntax. Export DvdSyntax. End Syntax. Module LTheory. Export POCoercions. Export POrderTheory. Export DualPOrder. Export DualLattice. Export LatticeTheoryMeet. Export LatticeTheoryJoin. Export DistrLatticeTheory. Export BLatticeTheory. Export DualTBLattice. Export TBLatticeTheory. Export BDistrLatticeTheory. Export DualTBDistrLattice. Export TBDistrLatticeTheory. Export DualOrder. End LTheory. Module CTheory. Export LTheory CBDistrLatticeTheory CTBDistrLatticeTheory. End CTheory. Module TTheory. Export LTheory TotalTheory. End TTheory. Module Theory. Export CTheory TotalTheory. End Theory. End Order. Export Order.Syntax. 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.DistrLattice.Exports. Export Order.BDistrLattice.Exports. Export Order.TBDistrLattice.Exports. Export Order.FinDistrLattice.Exports. Export Order.CBDistrLattice.Exports. Export Order.CTBDistrLattice.Exports. Export Order.FinCDistrLattice.Exports. Export Order.Total.Exports. Export Order.FinTotal.Exports. Export Order.LePOrderMixin.Exports. Export Order.BottomMixin.Exports. Export Order.TopMixin.Exports. Export Order.LatticeMixin.Exports. Export Order.DistrLatticeMixin.Exports. Export Order.CBDistrLatticeMixin.Exports. Export Order.CTBDistrLatticeMixin.Exports. Export Order.TotalOrderMixin.Exports. Export Order.DistrLatticePOrderMixin.Exports. Export Order.TotalLatticeMixin.Exports. Export Order.TotalPOrderMixin.Exports. Export Order.LtPOrderMixin.Exports. Export Order.MeetJoinMixin.Exports. Export Order.LeOrderMixin.Exports. Export Order.LtOrderMixin.Exports. Export Order.CanMixin.Exports. Export Order.SubOrder.Exports. Export Order.NatOrder.Exports. Export Order.NatMonotonyTheory. Export Order.NatDvd.Exports. Export Order.BoolOrder.Exports. Export Order.ProdOrder.Exports. Export Order.SigmaOrder.Exports. Export Order.ProdLexiOrder.Exports. Export Order.SeqProdOrder.Exports. Export Order.SeqLexiOrder.Exports. Export Order.TupleProdOrder.Exports. Export Order.TupleLexiOrder.Exports. Module DefaultProdOrder := Order.DefaultProdOrder. Module DefaultSeqProdOrder := Order.DefaultSeqProdOrder. Module DefaultTupleProdOrder := Order.DefaultTupleProdOrder. Module DefaultProdLexiOrder := Order.DefaultProdLexiOrder. Module DefaultSeqLexiOrder := Order.DefaultSeqLexiOrder. Module DefaultTupleLexiOrder := Order.DefaultTupleLexiOrder. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/path.v000066400000000000000000001720321375767750300222440ustar00rootroot00000000000000(* (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. (******************************************************************************) (* The basic theory of paths over an eqType; this file is essentially a *) (* complement to seq.v. Paths are non-empty sequences that obey a progression *) (* relation. They are passed around in three parts: the head and tail of the *) (* sequence, and a proof of a (boolean) predicate asserting the progression. *) (* This "exploded" view is rarely embarrassing, as the first two parameters *) (* are usually inferred from the type of the third; on the contrary, it saves *) (* the hassle of constantly constructing and destructing a dependent record. *) (* We define similarly cycles, for which we allow the empty sequence, *) (* which represents a non-rooted empty cycle; by contrast, the "empty" path *) (* from a point x is the one-item sequence containing only x. *) (* We allow duplicates; uniqueness, if desired (as is the case for several *) (* geometric constructions), must be asserted separately. We do provide *) (* shorthand, but only for cycles, because the equational properties of *) (* "path" and "uniq" are unfortunately incompatible (esp. wrt "cat"). *) (* We define notations for the common cases of function paths, where the *) (* progress relation is actually a function. In detail: *) (* path e x p == x :: p is an e-path [:: x_0; x_1; ... ; x_n], i.e., we *) (* e x_i x_{i+1} for all i < n. The path x :: p starts at x *) (* and ends at last x p. *) (* fpath f x p == x :: p is an f-path, where f is a function, i.e., p is of *) (* the form [:: f x; f (f x); ...]. This is just a notation *) (* for path (frel f) x p. *) (* sorted e s == s is an e-sorted sequence: either s = [::], or s = x :: p *) (* is an e-path (this is often used with e = leq or ltn). *) (* cycle e c == c is an e-cycle: either c = [::], or c = x :: p with *) (* x :: (rcons p x) an e-path. *) (* fcycle f c == c is an f-cycle, for a function f. *) (* traject f x n == the f-path of size n starting at x *) (* := [:: x; f x; ...; iter n.-1 f x] *) (* looping f x n == the f-paths of size greater than n starting at x loop *) (* back, or, equivalently, traject f x n contains all *) (* iterates of f at x. *) (* merge e s1 s2 == the e-sorted merge of sequences s1 and s2: this is always *) (* a permutation of s1 ++ s2, and is e-sorted when s1 and s2 *) (* are and e is total. *) (* sort e s == a permutation of the sequence s, that is e-sorted when e *) (* is total (computed by a merge sort with the merge function *) (* above). This sort function is also designed to be stable. *) (* mem2 s x y == x, then y occur in the sequence (path) s; this is *) (* non-strict: mem2 s x x = (x \in s). *) (* next c x == the successor of the first occurrence of x in the sequence *) (* c (viewed as a cycle), or x if x \notin c. *) (* prev c x == the predecessor of the first occurrence of x in the *) (* sequence c (viewed as a cycle), or x if x \notin c. *) (* arc c x y == the sub-arc of the sequence c (viewed as a cycle) starting *) (* at the first occurrence of x in c, and ending just before *) (* the next occurrence of y (in cycle order); arc c x y *) (* returns an unspecified sub-arc of c if x and y do not both *) (* occur in c. *) (* ucycle e c <-> ucycleb e c (ucycle e c is a Coercion target of type Prop) *) (* ufcycle f c <-> c is a simple f-cycle, for a function f. *) (* shorten x p == the tail a duplicate-free subpath of x :: p with the same *) (* endpoints (x and last x p), obtained by removing all loops *) (* from x :: p. *) (* rel_base e e' h b <-> the function h is a functor from relation e to *) (* relation e', EXCEPT at points whose image under h satisfy *) (* the "base" predicate b: *) (* e' (h x) (h y) = e x y UNLESS b (h x) holds *) (* This is the statement of the side condition of the path *) (* functorial mapping lemma map_path. *) (* fun_base f f' h b <-> the function h is a functor from function f to f', *) (* except at the preimage of predicate b under h. *) (* We also provide three segmenting dependently-typed lemmas (splitP, splitPl *) (* and splitPr) whose elimination split a path x0 :: p at an internal point x *) (* as follows: *) (* - splitP applies when x \in p; it replaces p with (rcons p1 x ++ p2), so *) (* that x appears explicitly at the end of the left part. The elimination *) (* of splitP will also simultaneously replace take (index x p) with p1 and *) (* drop (index x p).+1 p with p2. *) (* - splitPl applies when x \in x0 :: p; it replaces p with p1 ++ p2 and *) (* simultaneously generates an equation x = last x0 p. *) (* - splitPr applies when x \in p; it replaces p with (p1 ++ x :: p2), so x *) (* appears explicitly at the start of the right part. *) (* The parts p1 and p2 are computed using index/take/drop in all cases, but *) (* only splitP attempts to substitute the explicit values. The substitution *) (* of p can be deferred using the dependent equation generation feature of *) (* ssreflect, e.g.: case/splitPr def_p: {1}p / x_in_p => [p1 p2] generates *) (* the equation p = p1 ++ p2 instead of performing the substitution outright. *) (* Similarly, eliminating the loop removal lemma shortenP simultaneously *) (* replaces shorten e x p with a fresh constant p', and last x p with *) (* last x p'. *) (* Note that although all "path" functions actually operate on the *) (* underlying sequence, we provide a series of lemmas that define their *) (* interaction with the path and cycle predicates, e.g., the cat_path equation*) (* can be used to split the path predicate after splitting the underlying *) (* sequence. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Paths. Variables (n0 : nat) (T : Type). Section Path. Variables (x0_cycle : T) (e : rel T). Fixpoint path x (p : seq T) := if p is y :: p' then e x y && path y p' else true. Lemma cat_path x p1 p2 : path x (p1 ++ p2) = path x p1 && path (last x p1) p2. Proof. by elim: p1 x => [|y p1 Hrec] x //=; rewrite Hrec -!andbA. Qed. Lemma rcons_path x p y : path x (rcons p y) = path x p && e (last x p) y. Proof. by rewrite -cats1 cat_path /= andbT. Qed. Lemma pathP x p x0 : reflect (forall i, i < size p -> e (nth x0 (x :: p) i) (nth x0 p i)) (path x p). Proof. elim: p x => [|y p IHp] x /=; first by left. apply: (iffP andP) => [[e_xy /IHp e_p [] //] | e_p]. by split; [apply: (e_p 0) | apply/(IHp y) => i; apply: e_p i.+1]. Qed. Definition cycle p := if p is x :: p' then path x (rcons p' x) else true. Lemma cycle_path p : cycle p = path (last x0_cycle p) p. Proof. by case: p => //= x p; rewrite rcons_path andbC. Qed. Lemma rot_cycle p : cycle (rot n0 p) = cycle p. Proof. case: n0 p => [|n] [|y0 p] //=; first by rewrite /rot /= cats0. rewrite /rot /= -[p in RHS](cat_take_drop n) -cats1 -catA cat_path. case: (drop n p) => [|z0 q]; rewrite /= -cats1 !cat_path /= !andbT andbC //. by rewrite last_cat; repeat bool_congr. Qed. Lemma rotr_cycle p : cycle (rotr n0 p) = cycle p. Proof. by rewrite -rot_cycle rotrK. Qed. Definition sorted s := if s is x :: s' then path x s' else true. Lemma path_sorted x s : path x s -> sorted s. Proof. by case: s => //= y s /andP[]. Qed. Lemma path_min_sorted x s : all (e x) s -> path x s = sorted s. Proof. by case: s => //= y s /andP [->]. Qed. End Path. Section SubPath_in. Variable (P : {pred T}) (e e' : rel T). Hypothesis (ee' : {in P &, subrel e e'}). Lemma sub_path_in x s : all P (x :: s) -> path e x s -> path e' x s. Proof. by elim: s x => //= y s ihs x /and3P [? ? ?] /andP [/ee' -> //]; apply/ihs/andP. Qed. Lemma sub_cycle_in s : all P s -> cycle e s -> cycle e' s. Proof. case: s => //= x s /andP [Px Ps]. by apply: sub_path_in; rewrite /= all_rcons Px. Qed. Lemma sub_sorted_in s : all P s -> sorted e s -> sorted e' s. Proof. by case: s => //; apply: sub_path_in. Qed. End SubPath_in. Section EqPath_in. Variable (P : {pred T}) (e e' : rel T). Hypothesis (ee' : {in P &, e =2 e'}). Let e_e' : {in P &, subrel e e'}. Proof. by move=> ? ? ? ?; rewrite ee'. Qed. Let e'_e : {in P &, subrel e' e}. Proof. by move=> ? ? ? ?; rewrite ee'. Qed. Lemma eq_path_in x s : all P (x :: s) -> path e x s = path e' x s. Proof. by move=> Pxs; apply/idP/idP; apply: sub_path_in Pxs. Qed. Lemma eq_cycle_in s : all P s -> cycle e s = cycle e' s. Proof. by move=> Ps; apply/idP/idP; apply: sub_cycle_in Ps. Qed. End EqPath_in. Section SubPath. Variables e e' : rel T. Lemma sub_path : subrel e e' -> forall x p, path e x p -> path e' x p. Proof. by move=> ? ? ?; apply/sub_path_in/all_predT; apply: in2W. Qed. Lemma sub_cycle : subrel e e' -> subpred (cycle e) (cycle e'). Proof. by move=> ee' [] // ? ?; apply: sub_path. Qed. Lemma sub_sorted : subrel e e' -> subpred (sorted e) (sorted e'). Proof. by move=> ee' [] //=; apply: sub_path. Qed. Lemma eq_path : e =2 e' -> path e =2 path e'. Proof. by move=> ? ? ?; apply/eq_path_in/all_predT; apply: in2W. Qed. Lemma eq_cycle : e =2 e' -> cycle e =1 cycle e'. Proof. by move=> ee' [] // ? ?; apply: eq_path. Qed. End SubPath. Section Transitive_in. Variables (P : {pred T}) (leT : rel T). Lemma order_path_min_in x s : {in P & &, transitive leT} -> all P (x :: s) -> path leT x s -> all (leT x) s. Proof. move=> leT_tr; elim: s => //= y s ihs /and3P [Px Py Ps] /andP [xy ys]. rewrite xy {}ihs ?Px //=; case: s Ps ys => //= z s /andP [Pz Ps] /andP [yz ->]. by rewrite (leT_tr _ _ _ Py Px Pz). Qed. Hypothesis leT_tr : {in P & &, transitive leT}. Lemma path_mask_in x m s : all P (x :: s) -> path leT x s -> path leT x (mask m s). Proof. elim: m s x => [|[] m ih] [|y s] x //=. by case/and3P=> ? ? ? /andP [-> /ih ->] //; apply/andP. case/andP=> Px Pys /andP [xy ys]; case/andP: (Pys) => Py Ps. case: (mask _ _) (all_mask m Ps) (ih s y Pys ys) => //=. by move=> z t /andP [Pz Pt] /andP [] /(leT_tr Py Px Pz xy) ->. Qed. Lemma path_filter_in x a s : all P (x :: s) -> path leT x s -> path leT x (filter a s). Proof. by move=> Pxs; rewrite filter_mask; exact: path_mask_in. Qed. Lemma sorted_mask_in m s : all P s -> sorted leT s -> sorted leT (mask m s). Proof. elim: m s => [|[] m ih] [|x s] //= Pxs; first exact: path_mask_in. by move/path_sorted/ih; apply; case/andP: Pxs. Qed. Lemma sorted_filter_in a s : all P s -> sorted leT s -> sorted leT (filter a s). Proof. rewrite filter_mask; exact: sorted_mask_in. Qed. Lemma path_sorted_inE x s : all P (x :: s) -> path leT x s = all (leT x) s && sorted leT s. Proof. move=> Pxs; apply/idP/idP => [xs|/andP[/path_min_sorted<-//]]. by rewrite (order_path_min_in leT_tr) //; apply: path_sorted xs. Qed. Lemma sorted_ltn_nth_in x0 s : all P s -> sorted leT s -> {in [pred n | n < size s] &, {homo nth x0 s : i j / i < j >-> leT i j}}. Proof. elim: s => // x s ihs Pxs path_xs [|i] [|j] //=; rewrite -!topredE /= !ltnS. by move=> _ js _; apply/all_nthP/js/order_path_min_in. by apply/ihs/path_sorted/path_xs; case/andP: Pxs. Qed. Hypothesis leT_refl : {in P, reflexive leT}. Lemma sorted_leq_nth_in x0 s : all P s -> sorted leT s -> {in [pred n | n < size s] &, {homo nth x0 s : i j / i <= j >-> leT i j}}. Proof. move=> Ps s_sorted x y xs ys; rewrite leq_eqVlt=> /predU1P[->|]. exact/leT_refl/all_nthP. exact: sorted_ltn_nth_in. Qed. End Transitive_in. Section Transitive. Variable (leT : rel T). Lemma order_path_min x s : transitive leT -> path leT x s -> all (leT x) s. Proof. by move=> leT_tr; apply/order_path_min_in/all_predT => //; apply: in3W. Qed. Hypothesis leT_tr : transitive leT. Let leT_tr' : {in predT & &, transitive leT}. Proof. exact: in3W. Qed. Lemma path_mask x m s : path leT x s -> path leT x (mask m s). Proof. exact/path_mask_in/all_predT. Qed. Lemma path_filter x a s : path leT x s -> path leT x (filter a s). Proof. exact/path_filter_in/all_predT. Qed. Lemma sorted_mask m s : sorted leT s -> sorted leT (mask m s). Proof. exact/sorted_mask_in/all_predT. Qed. Lemma sorted_filter a s : sorted leT s -> sorted leT (filter a s). Proof. exact/sorted_filter_in/all_predT. Qed. Lemma path_sortedE x s : path leT x s = all (leT x) s && sorted leT s. Proof. exact/path_sorted_inE/all_predT. Qed. Lemma sorted_ltn_nth x0 s : sorted leT s -> {in [pred n | n < size s] &, {homo nth x0 s : i j / i < j >-> leT i j}}. Proof. exact/sorted_ltn_nth_in/all_predT. Qed. Hypothesis leT_refl : reflexive leT. Lemma sorted_leq_nth x0 s : sorted leT s -> {in [pred n | n < size s] &, {homo nth x0 s : i j / i <= j >-> leT i j}}. Proof. exact/sorted_leq_nth_in/all_predT. Qed. End Transitive. End Paths. Arguments pathP {T e x p}. Arguments path_sorted {T e x s}. Arguments path_min_sorted {T e x s}. Arguments order_path_min_in {T P leT x s}. Arguments path_mask_in {T P leT} leT_tr {x m s}. Arguments path_filter_in {T P leT} leT_tr {x a s}. Arguments sorted_mask_in {T P leT} leT_tr {m s}. Arguments sorted_filter_in {T P leT} leT_tr {a s}. Arguments path_sorted_inE {T P leT} leT_tr {x s}. Arguments sorted_ltn_nth_in {T P leT} leT_tr x0 {s}. Arguments sorted_leq_nth_in {T P leT} leT_tr leT_refl x0 {s}. Arguments order_path_min {T leT x s}. Arguments path_mask {T leT} leT_tr {x} m {s}. Arguments path_filter {T leT} leT_tr {x} a {s}. Arguments sorted_mask {T leT} leT_tr m {s}. Arguments sorted_filter {T leT} leT_tr a {s}. Arguments path_sortedE {T leT} leT_tr x s. Arguments sorted_ltn_nth {T leT} leT_tr x0 {s}. Arguments sorted_leq_nth {T leT} leT_tr leT_refl x0 {s}. Lemma cycle_catC (T : Type) (e : rel T) (p q : seq T) : cycle e (p ++ q) = cycle e (q ++ p). Proof. by rewrite -rot_size_cat rot_cycle. Qed. Section RevPath. Variables (T : Type) (e : rel T). Lemma rev_path x p : path e (last x p) (rev (belast x p)) = path (fun z => e^~ z) x p. Proof. elim: p x => //= y p IHp x; rewrite rev_cons rcons_path -{}IHp andbC. by rewrite -(last_cons x) -rev_rcons -lastI rev_cons last_rcons. Qed. Lemma rev_cycle p : cycle e (rev p) = cycle (fun z => e^~ z) p. Proof. case: p => //= x p; rewrite -rev_path last_rcons belast_rcons rev_cons. by rewrite -[in LHS]cats1 cycle_catC. Qed. Lemma rev_sorted p : sorted e (rev p) = sorted (fun z => e^~ z) p. Proof. by case: p => //= x p; rewrite -rev_path lastI rev_rcons. Qed. End RevPath. Section HomoPath. Variables (T T' : Type) (P : {pred T}) (f : T -> T') (e : rel T) (e' : rel T'). Lemma path_map x s : path e' (f x) (map f s) = path (relpre f e') x s. Proof. by elim: s x => //= y s <-. Qed. Lemma cycle_map s : cycle e' (map f s) = cycle (relpre f e') s. Proof. by case: s => //= ? ?; rewrite -map_rcons path_map. Qed. Lemma sorted_map s : sorted e' (map f s) = sorted (relpre f e') s. Proof. by case: s; last apply: path_map. Qed. Lemma homo_path_in x s : {in P &, {homo f : x y / e x y >-> e' x y}} -> all P (x :: s) -> path e x s -> path e' (f x) (map f s). Proof. by move=> f_mono; rewrite path_map; apply: sub_path_in. Qed. Lemma homo_cycle_in s : {in P &, {homo f : x y / e x y >-> e' x y}} -> all P s -> cycle e s -> cycle e' (map f s). Proof. by move=> f_mono; rewrite cycle_map; apply: sub_cycle_in. Qed. Lemma homo_sorted_in s : {in P &, {homo f : x y / e x y >-> e' x y}} -> all P s -> sorted e s -> sorted e' (map f s). Proof. by move=> f_mono; rewrite sorted_map; apply: sub_sorted_in. Qed. Lemma mono_path_in x s : {in P &, {mono f : x y / e x y >-> e' x y}} -> all P (x :: s) -> path e' (f x) (map f s) = path e x s. Proof. by move=> f_mono; rewrite path_map; apply: eq_path_in. Qed. Lemma mono_cycle_in s : {in P &, {mono f : x y / e x y >-> e' x y}} -> all P s -> cycle e' (map f s) = cycle e s. Proof. by move=> f_mono; rewrite cycle_map; apply: eq_cycle_in. Qed. Lemma mono_sorted_in s : {in P &, {mono f : x y / e x y >-> e' x y}} -> all P s -> sorted e' (map f s) = sorted e s. Proof. by case: s => // x s; apply: mono_path_in. Qed. Lemma homo_path x s : {homo f : x y / e x y >-> e' x y} -> path e x s -> path e' (f x) (map f s). Proof. by move=> f_homo; rewrite path_map; apply: sub_path. Qed. Lemma homo_cycle : {homo f : x y / e x y >-> e' x y} -> {homo map f : s / cycle e s >-> cycle e' s}. Proof. by move=> f_homo s hs; rewrite cycle_map (sub_cycle _ hs). Qed. Lemma homo_sorted : {homo f : x y / e x y >-> e' x y} -> {homo map f : s / sorted e s >-> sorted e' s}. Proof. by move/homo_path => ? []. Qed. Lemma mono_path x s : {mono f : x y / e x y >-> e' x y} -> path e' (f x) (map f s) = path e x s. Proof. by move=> f_mon; rewrite path_map; apply: eq_path. Qed. Lemma mono_cycle : {mono f : x y / e x y >-> e' x y} -> {mono map f : s / cycle e s >-> cycle e' s}. Proof. by move=> ? ?; rewrite cycle_map; apply: eq_cycle. Qed. Lemma mono_sorted : {mono f : x y / e x y >-> e' x y} -> {mono map f : s / sorted e s >-> sorted e' s}. Proof. by move=> f_mon [] //= x s; apply: mono_path. Qed. End HomoPath. Arguments path_map {T T' f e'}. Arguments cycle_map {T T' f e'}. Arguments sorted_map {T T' f e'}. Arguments homo_path_in {T T' P f e e' x s}. Arguments homo_cycle_in {T T' P f e e' s}. Arguments homo_sorted_in {T T' P f e e' s}. Arguments mono_path_in {T T' P f e e' x s}. Arguments mono_cycle_in {T T' P f e e' s}. Arguments mono_sorted_in {T T' P f e e' s}. Arguments homo_path {T T' f e e' x s}. Arguments homo_cycle {T T' f e e'}. Arguments homo_sorted {T T' f e e'}. Arguments mono_path {T T' f e e' x s}. Arguments mono_cycle {T T' f e e'}. Arguments mono_sorted {T T' f e e'}. Section EqSorted. Variables (T : eqType) (leT : rel T). Implicit Type s : seq T. Local Notation path := (path leT). Local Notation sorted := (sorted leT). Lemma subseq_path_in x s1 s2 : {in x :: s2 & &, transitive leT} -> subseq s1 s2 -> path x s2 -> path x s1. Proof. by move=> tr /subseqP [m _ ->]; apply/(path_mask_in tr). Qed. Lemma subseq_sorted_in s1 s2 : {in s2 & &, transitive leT} -> subseq s1 s2 -> sorted s2 -> sorted s1. Proof. by move=> tr /subseqP [m _ ->]; apply/(sorted_mask_in tr). Qed. Lemma sorted_ltn_index_in s : {in s & &, transitive leT} -> sorted s -> {in s &, forall x y, index x s < index y s -> leT x y}. Proof. case: s => // x0 s' leT_tr s_sorted x y xs ys. move/(sorted_ltn_nth_in leT_tr x0 (allss (_ :: _)) s_sorted). by rewrite ?nth_index ?[_ \in gtn _]index_mem //; apply. Qed. Lemma sorted_leq_index_in s : {in s & &, transitive leT} -> {in s, reflexive leT} -> sorted s -> {in s &, forall x y, index x s <= index y s -> leT x y}. Proof. case: s => // x0 s' leT_tr leT_refl s_sorted x y xs ys. move/(sorted_leq_nth_in leT_tr leT_refl x0 (allss (_ :: _)) s_sorted). by rewrite ?nth_index ?[_ \in gtn _]index_mem //; apply. Qed. Hypothesis leT_tr : transitive leT. Lemma subseq_path x s1 s2 : subseq s1 s2 -> path x s2 -> path x s1. Proof. by apply: subseq_path_in; apply: in3W. Qed. Lemma subseq_sorted s1 s2 : subseq s1 s2 -> sorted s2 -> sorted s1. Proof. by apply: subseq_sorted_in; apply: in3W. Qed. Lemma sorted_uniq : irreflexive leT -> forall s, sorted s -> uniq s. Proof. move=> leT_irr; elim=> //= x s IHs s_ord. rewrite (IHs (path_sorted s_ord)) andbT; apply/negP=> s_x. by case/allPn: (order_path_min leT_tr s_ord); exists x; rewrite // leT_irr. Qed. Lemma sorted_eq : antisymmetric leT -> forall s1 s2, sorted s1 -> sorted s2 -> perm_eq s1 s2 -> s1 = s2. Proof. move=> leT_asym; elim=> [|x1 s1 IHs1] s2 //= ord_s1 ord_s2 eq_s12. by case: {+}s2 (perm_size eq_s12). have s2_x1: x1 \in s2 by rewrite -(perm_mem eq_s12) mem_head. case: s2 s2_x1 eq_s12 ord_s2 => //= x2 s2; rewrite in_cons. case: eqP => [<- _| ne_x12 /= s2_x1] eq_s12 ord_s2. by rewrite {IHs1}(IHs1 s2) ?(@path_sorted _ leT x1) // -(perm_cons x1). case: (ne_x12); apply: leT_asym; rewrite (allP (order_path_min _ ord_s2))//. have: x2 \in x1 :: s1 by rewrite (perm_mem eq_s12) mem_head. case/predU1P=> [eq_x12 | s1_x2]; first by case ne_x12. by rewrite (allP (order_path_min _ ord_s1)). Qed. Lemma irr_sorted_eq : irreflexive leT -> forall s1 s2, sorted s1 -> sorted s2 -> s1 =i s2 -> s1 = s2. Proof. move=> leT_irr s1 s2 s1_sort s2_sort eq_s12. have: antisymmetric leT. by move=> m n /andP[? ltnm]; case/idP: (leT_irr m); apply: leT_tr ltnm. by move/sorted_eq; apply=> //; apply: uniq_perm => //; apply: sorted_uniq. Qed. Lemma sorted_ltn_index s : sorted s -> {in s &, forall x y, index x s < index y s -> leT x y}. Proof. case: s => // x0 s' s_sorted x y xs ys /(sorted_ltn_nth leT_tr x0 s_sorted). by rewrite ?nth_index ?[_ \in gtn _]index_mem //; apply. Qed. Hypothesis leT_refl : reflexive leT. Lemma sorted_leq_index s : sorted s -> {in s &, forall x y, index x s <= index y s -> leT x y}. Proof. case: s => // x0 s' s_sorted x y xs ys. move/(sorted_leq_nth leT_tr leT_refl x0 s_sorted). by rewrite ?nth_index ?[_ \in gtn _]index_mem //; apply. Qed. End EqSorted. Arguments sorted_ltn_index_in {T leT s} leT_tr s_sorted. Arguments sorted_leq_index_in {T leT s} leT_tr leT_refl s_sorted. Arguments sorted_ltn_index {T leT} leT_tr {s}. Arguments sorted_leq_index {T leT} leT_tr leT_refl {s}. Section EqSorted_in. Variables (T : eqType) (leT : rel T). Implicit Type s : seq T. Lemma sorted_uniq_in s : {in s & &, transitive leT} -> {in s, irreflexive leT} -> sorted leT s -> uniq s. Proof. move=> /in3_sig leT_tr /in1_sig leT_irr; case/all_sigP: (allss s) => s' ->. by rewrite sorted_map (map_inj_uniq val_inj); exact: sorted_uniq. Qed. Lemma sorted_eq_in s1 s2 : {in s1 & &, transitive leT} -> {in s1 &, antisymmetric leT} -> sorted leT s1 -> sorted leT s2 -> perm_eq s1 s2 -> s1 = s2. Proof. move=> /in3_sig leT_tr /in2_sig/(_ _ _ _)/val_inj leT_anti + + /[dup] s1s2. have /all_sigP[s1' ->] := allss s1. have /all_sigP[{s1s2}s2 ->] : all (mem s1) s2 by rewrite -(perm_all _ s1s2). by rewrite !sorted_map => ss1' ss2 /(perm_map_inj val_inj)/(sorted_eq leT_tr)->. Qed. Lemma irr_sorted_eq_in s1 s2 : {in s1 & &, transitive leT} -> {in s1, irreflexive leT} -> sorted leT s1 -> sorted leT s2 -> s1 =i s2 -> s1 = s2. Proof. move=> /in3_sig leT_tr /in1_sig leT_irr + + /[dup] s1s2. have /all_sigP[s1' ->] := allss s1. have /all_sigP[s2' ->] : all (mem s1) s2 by rewrite -(eq_all_r s1s2). rewrite !sorted_map => ss1' ss2' {}s1s2; congr map. by apply: (irr_sorted_eq leT_tr) => // x; rewrite -!(mem_map val_inj). Qed. End EqSorted_in. Section EqPath. Variables (n0 : nat) (T : eqType) (e : rel T). Implicit Type p : seq T. Variant split x : seq T -> seq T -> seq T -> Type := Split p1 p2 : split x (rcons p1 x ++ p2) p1 p2. Lemma splitP p x (i := index x p) : x \in p -> split x p (take i p) (drop i.+1 p). Proof. by rewrite -has_pred1 => /split_find[? ? ? /eqP->]; constructor. Qed. Variant splitl x1 x : seq T -> Type := Splitl p1 p2 of last x1 p1 = x : splitl x1 x (p1 ++ p2). Lemma splitPl x1 p x : x \in x1 :: p -> splitl x1 x p. Proof. rewrite inE; case: eqP => [->| _ /splitP[]]; first by rewrite -(cat0s p). by split; apply: last_rcons. Qed. Variant splitr x : seq T -> Type := Splitr p1 p2 : splitr x (p1 ++ x :: p2). Lemma splitPr p x : x \in p -> splitr x p. Proof. by case/splitP=> p1 p2; rewrite cat_rcons. Qed. Fixpoint next_at x y0 y p := match p with | [::] => if x == y then y0 else x | y' :: p' => if x == y then y' else next_at x y0 y' p' end. Definition next p x := if p is y :: p' then next_at x y y p' else x. Fixpoint prev_at x y0 y p := match p with | [::] => if x == y0 then y else x | y' :: p' => if x == y' then y else prev_at x y0 y' p' end. Definition prev p x := if p is y :: p' then prev_at x y y p' else x. Lemma next_nth p x : next p x = if x \in p then if p is y :: p' then nth y p' (index x p) else x else x. Proof. case: p => //= y0 p. elim: p {2 3 5}y0 => [|y' p IHp] y /=; rewrite (eq_sym y) inE; by case: ifP => // _; apply: IHp. Qed. Lemma prev_nth p x : prev p x = if x \in p then if p is y :: p' then nth y p (index x p') else x else x. Proof. case: p => //= y0 p; rewrite inE orbC. elim: p {2 5}y0 => [|y' p IHp] y; rewrite /= ?inE // (eq_sym y'). by case: ifP => // _; apply: IHp. Qed. Lemma mem_next p x : (next p x \in p) = (x \in p). Proof. rewrite next_nth; case p_x: (x \in p) => //. case: p (index x p) p_x => [|y0 p'] //= i _; rewrite inE. have [lt_ip | ge_ip] := ltnP i (size p'); first by rewrite orbC mem_nth. by rewrite nth_default ?eqxx. Qed. Lemma mem_prev p x : (prev p x \in p) = (x \in p). Proof. rewrite prev_nth; case p_x: (x \in p) => //; case: p => [|y0 p] // in p_x *. by apply mem_nth; rewrite /= ltnS index_size. Qed. (* ucycleb is the boolean predicate, but ucycle is defined as a Prop *) (* so that it can be used as a coercion target. *) Definition ucycleb p := cycle e p && uniq p. Definition ucycle p : Prop := cycle e p && uniq p. (* Projections, used for creating local lemmas. *) Lemma ucycle_cycle p : ucycle p -> cycle e p. Proof. by case/andP. Qed. Lemma ucycle_uniq p : ucycle p -> uniq p. Proof. by case/andP. Qed. Lemma next_cycle p x : cycle e p -> x \in p -> e x (next p x). Proof. case: p => //= y0 p; elim: p {1 3 5}y0 => [|z p IHp] y /=; rewrite inE. by rewrite andbT; case: (x =P y) => // ->. by case/andP=> eyz /IHp; case: (x =P y) => // ->. Qed. Lemma prev_cycle p x : cycle e p -> x \in p -> e (prev p x) x. Proof. case: p => //= y0 p; rewrite inE orbC. elim: p {1 5}y0 => [|z p IHp] y /=; rewrite ?inE. by rewrite andbT; case: (x =P y0) => // ->. by case/andP=> eyz /IHp; case: (x =P z) => // ->. Qed. Lemma rot_ucycle p : ucycle (rot n0 p) = ucycle p. Proof. by rewrite /ucycle rot_uniq rot_cycle. Qed. Lemma rotr_ucycle p : ucycle (rotr n0 p) = ucycle p. Proof. by rewrite /ucycle rotr_uniq rotr_cycle. Qed. (* The "appears no later" partial preorder defined by a path. *) Definition mem2 p x y := y \in drop (index x p) p. Lemma mem2l p x y : mem2 p x y -> x \in p. Proof. by rewrite /mem2 -!index_mem size_drop ltn_subRL; apply/leq_ltn_trans/leq_addr. Qed. Lemma mem2lf {p x y} : x \notin p -> mem2 p x y = false. Proof. exact/contraNF/mem2l. Qed. Lemma mem2r p x y : mem2 p x y -> y \in p. Proof. by rewrite -[in y \in p](cat_take_drop (index x p) p) mem_cat orbC /mem2 => ->. Qed. Lemma mem2rf {p x y} : y \notin p -> mem2 p x y = false. Proof. exact/contraNF/mem2r. Qed. Lemma mem2_cat p1 p2 x y : mem2 (p1 ++ p2) x y = mem2 p1 x y || mem2 p2 x y || (x \in p1) && (y \in p2). Proof. rewrite [LHS]/mem2 index_cat fun_if if_arg !drop_cat addKn. case: ifPn => [p1x | /mem2lf->]; last by rewrite ltnNge leq_addr orbF. by rewrite index_mem p1x mem_cat -orbA (orb_idl (@mem2r _ _ _)). Qed. Lemma mem2_splice p1 p3 x y p2 : mem2 (p1 ++ p3) x y -> mem2 (p1 ++ p2 ++ p3) x y. Proof. by rewrite !mem2_cat mem_cat andb_orr orbC => /or3P[]->; rewrite ?orbT. Qed. Lemma mem2_splice1 p1 p3 x y z : mem2 (p1 ++ p3) x y -> mem2 (p1 ++ z :: p3) x y. Proof. exact: mem2_splice [::z]. Qed. Lemma mem2_cons x p y z : mem2 (x :: p) y z = (if x == y then z \in x :: p else mem2 p y z). Proof. by rewrite [LHS]/mem2 /=; case: ifP. Qed. Lemma mem2_seq1 x y z : mem2 [:: x] y z = (y == x) && (z == x). Proof. by rewrite mem2_cons eq_sym inE. Qed. Lemma mem2_last y0 p x : mem2 p x (last y0 p) = (x \in p). Proof. apply/idP/idP; first exact: mem2l; rewrite -index_mem /mem2 => p_x. by rewrite -nth_last -(subnKC p_x) -nth_drop mem_nth // size_drop subnSK. Qed. Lemma mem2l_cat {p1 p2 x} : x \notin p1 -> mem2 (p1 ++ p2) x =1 mem2 p2 x. Proof. by move=> p1'x y; rewrite mem2_cat (negPf p1'x) mem2lf ?orbF. Qed. Lemma mem2r_cat {p1 p2 x y} : y \notin p2 -> mem2 (p1 ++ p2) x y = mem2 p1 x y. Proof. by move=> p2'y; rewrite mem2_cat (negPf p2'y) -orbA orbC andbF mem2rf. Qed. Lemma mem2lr_splice {p1 p2 p3 x y} : x \notin p2 -> y \notin p2 -> mem2 (p1 ++ p2 ++ p3) x y = mem2 (p1 ++ p3) x y. Proof. move=> p2'x p2'y; rewrite catA !mem2_cat !mem_cat. by rewrite (negPf p2'x) (negPf p2'y) (mem2lf p2'x) andbF !orbF. Qed. Lemma mem2E s x y : mem2 s x y = subseq (if x == y then [:: x] else [:: x; y]) s. Proof. elim: s => [| h s]; first by case: ifP. rewrite mem2_cons => ->. do 2 rewrite inE (fun_if subseq) !if_arg !sub1seq /=. by have [->|] := eqVneq; case: eqVneq. Qed. Variant split2r x y : seq T -> Type := Split2r p1 p2 of y \in x :: p2 : split2r x y (p1 ++ x :: p2). Lemma splitP2r p x y : mem2 p x y -> split2r x y p. Proof. move=> pxy; have px := mem2l pxy. have:= pxy; rewrite /mem2 (drop_nth x) ?index_mem ?nth_index //. by case/splitP: px => p1 p2; rewrite cat_rcons. Qed. Fixpoint shorten x p := if p is y :: p' then if x \in p then shorten x p' else y :: shorten y p' else [::]. Variant shorten_spec x p : T -> seq T -> Type := ShortenSpec p' of path e x p' & uniq (x :: p') & subpred (mem p') (mem p) : shorten_spec x p (last x p') p'. Lemma shortenP x p : path e x p -> shorten_spec x p (last x p) (shorten x p). Proof. move=> e_p; have: x \in x :: p by apply: mem_head. elim: p x {1 3 5}x e_p => [|y2 p IHp] x y1. by rewrite mem_seq1 => _ /eqP->. rewrite inE orbC /= => /andP[ey12 {}/IHp IHp]. case: ifPn => [y2p_x _ | not_y2p_x /eqP def_x]. have [p' e_p' Up' p'p] := IHp _ y2p_x. by split=> // y /p'p; apply: predU1r. have [p' e_p' Up' p'p] := IHp y2 (mem_head y2 p). have{} p'p z: z \in y2 :: p' -> z \in y2 :: p. by rewrite !inE; case: (z == y2) => // /p'p. rewrite -(last_cons y1) def_x; split=> //=; first by rewrite ey12. by rewrite (contra (p'p y1)) -?def_x. Qed. End EqPath. (* Ordered paths and sorting. *) Section SortSeq. Variables (T : Type) (leT : rel T). Local Notation path := (path leT). Local Notation sorted := (sorted leT). Fixpoint merge s1 := if s1 is x1 :: s1' then let fix merge_s1 s2 := if s2 is x2 :: s2' then if leT x1 x2 then x1 :: merge s1' s2 else x2 :: merge_s1 s2' else s1 in merge_s1 else id. Arguments merge !s1 !s2 : rename. Fixpoint merge_sort_push s1 ss := match ss with | [::] :: ss' | [::] as ss' => s1 :: ss' | s2 :: ss' => [::] :: merge_sort_push (merge s2 s1) ss' end. Fixpoint merge_sort_pop s1 ss := if ss is s2 :: ss' then merge_sort_pop (merge s2 s1) ss' else s1. Fixpoint merge_sort_rec ss s := if s is [:: x1, x2 & s'] then let s1 := if leT x1 x2 then [:: x1; x2] else [:: x2; x1] in merge_sort_rec (merge_sort_push s1 ss) s' else merge_sort_pop s ss. Definition sort := merge_sort_rec [::]. (* The following definition `sort_rec1` is an auxiliary function for *) (* inductive reasoning on `sort`. One can rewrite `sort le s` to *) (* `sort_rec1 le [::] s` by `sortE` and apply the simple structural induction *) (* on `s` to reason about it. *) Fixpoint sort_rec1 ss s := if s is x :: s then sort_rec1 (merge_sort_push [:: x] ss) s else merge_sort_pop [::] ss. Lemma sortE s : sort s = sort_rec1 [::] s. Proof. transitivity (sort_rec1 [:: nil] s); last by case: s. rewrite /sort; move: [::] {2}_.+1 (ltnSn (size s)./2) => ss n. by elim: n => // n IHn in ss s *; case: s => [|x [|y s]] //= /IHn->. Qed. Hypothesis leT_total : total leT. Lemma merge_path x s1 s2 : path x s1 -> path x s2 -> path x (merge s1 s2). Proof. elim: s1 s2 x => //= x1 s1 IHs1. elim=> //= x2 s2 IHs2 x /andP[le_x_x1 ord_s1] /andP[le_x_x2 ord_s2]. case: ifP => le_x21 /=; first by rewrite le_x_x1 {}IHs1 //= le_x21. by rewrite le_x_x2 IHs2 //=; have:= leT_total x1 x2; rewrite le_x21 /= => ->. Qed. Lemma merge_sorted s1 s2 : sorted s1 -> sorted s2 -> sorted (merge s1 s2). Proof. case: s1 s2 => [|x1 s1] [|x2 s2] //= ord_s1 ord_s2. case: ifP => le_x21 /=; first by apply: merge_path => //=; rewrite le_x21. apply: (@merge_path x2 (x1 :: s1)) => //=. by have:= (leT_total x1 x2); rewrite le_x21 /= => ->. Qed. Lemma sort_sorted s : sorted (sort s). Proof. rewrite sortE; have: all sorted [::] by []. elim: s [::] => /= [|x s ihs] ss allss. - elim: ss [::] (isT : sorted [::]) allss => //= s ss ihss t ht /andP [hs]. exact/ihss/merge_sorted. - apply/ihs; elim: ss [:: x] allss (isT : sorted [:: x]) => /= [_ _ -> //|]. by move=> {x s ihs} [|x s] ss ihss t /andP [] hs allss ht; [rewrite /= ht | apply/ihss/merge_sorted]. Qed. Lemma size_merge s1 s2 : size (merge s1 s2) = size (s1 ++ s2). Proof. rewrite size_cat; elim: s1 s2 => // x s1 IH1. elim=> //= [|y s2 IH2]; first by rewrite addn0. by case: leT; rewrite /= ?IH1 ?IH2 !addnS. Qed. Remark size_merge_sort_push s1 : let graded ss := forall i, size (nth [::] ss i) \in pred2 0 (2 ^ (i + 1)) in size s1 = 2 -> {homo merge_sort_push s1 : ss / graded ss}. Proof. set n := {2}1; rewrite -[RHS]/(2 ^ n) => graded sz_s1 ss. elim: ss => [|s2 ss IHss] in (n) graded s1 sz_s1 * => sz_ss i //=. by case: i => [|[]] //; rewrite sz_s1 inE eqxx orbT. case: s2 i => [|x s2] [|i] //= in sz_ss *; first by rewrite sz_s1 inE eqxx orbT. exact: (sz_ss i.+1). rewrite addSnnS; apply: IHss i => [|i]; last by rewrite -addSnnS (sz_ss i.+1). by rewrite size_merge size_cat sz_s1 (eqnP (sz_ss 0)) addnn expnS mul2n. Qed. Hypothesis leT_tr : transitive leT. Lemma sorted_merge s t : sorted (s ++ t) -> merge s t = s ++ t. Proof. elim: s => //= x s; case: t; rewrite ?cats0 //= => y t ih hp. move: (order_path_min leT_tr hp). by rewrite ih ?(path_sorted hp) // all_cat /= => /and3P [_ -> _]. Qed. Lemma sorted_sort s : sorted s -> sort s = s. Proof. pose catss := foldr (fun x => cat ^~ x) (Nil T). rewrite -{1 3}[s]/(catss [::] ++ s) sortE; elim: s [::] => /= [|x s ihs] ss. - elim: ss [::] => //= s ss ihss t; rewrite -catA => h_sorted. rewrite -ihss ?sorted_merge //. by elim: (catss _) h_sorted => //= ? ? ih /path_sorted. - move=> h_sorted. suff x_ss_E: catss (merge_sort_push [:: x] ss) = catss ([:: x] :: ss) by rewrite (catA _ [:: _]) -[catss _ ++ _]/(catss ([:: x] :: ss)) -x_ss_E ihs // x_ss_E /= -catA. have {h_sorted}: sorted (catss ss ++ [:: x]). case: (catss _) h_sorted => //= ? ?. by rewrite (catA _ [:: _]) cat_path => /andP []. elim: ss [:: x] => {x s ihs} //= -[|x s] ss ihss t h_sorted; rewrite /= cats0 // sorted_merge ?ihss ?catA //. by elim: (catss ss) h_sorted => //= ? ? ih /path_sorted. Qed. End SortSeq. Arguments merge {T} relT !s1 !s2 : rename. Arguments merge_path {T leT} leT_total {x s1 s2}. Arguments merge_sorted {T leT} leT_total {s1 s2}. Arguments sort_sorted {T leT} leT_total s. Arguments sorted_merge {T leT} leT_tr {s t}. Arguments sorted_sort {T leT} leT_tr {s}. Section SortMap. Variables (T T' : Type) (f : T' -> T). Section Monotonicity. Variables (leT' : rel T') (leT : rel T). Hypothesis f_mono : {mono f : x y / leT' x y >-> leT x y}. Lemma map_merge : {morph map f : s1 s2 / merge leT' s1 s2 >-> merge leT s1 s2}. Proof. elim=> //= x s1 IHs1; elim => [|y s2 IHs2] //=; rewrite f_mono. by case: leT'; rewrite /= ?IHs1 ?IHs2. Qed. Lemma map_sort : {morph map f : s1 / sort leT' s1 >-> sort leT s1}. Proof. move=> s; rewrite !sortE -[[::] in RHS]/(map (map f) [::]). elim: s [::] => /= [|x s ihs] ss; rewrite -/(map f [::]) -/(map f [:: _]); first by elim: ss [::] => //= x ss ihss ?; rewrite ihss map_merge. rewrite ihs -/(map f [:: x]); congr sort_rec1. by elim: ss [:: x] => {x s ihs} [|[|x s] ss ihss] //= ?; rewrite ihss map_merge. Qed. End Monotonicity. Variable leT : rel T. Lemma merge_map s1 s2 : merge leT (map f s1) (map f s2) = map f (merge (relpre f leT) s1 s2). Proof. exact/esym/map_merge. Qed. Lemma sort_map s : sort leT (map f s) = map f (sort (relpre f leT) s). Proof. exact/esym/map_sort. Qed. End SortMap. Arguments map_merge {T T' f leT' leT}. Arguments map_sort {T T' f leT' leT}. Arguments merge_map {T T' f leT}. Arguments sort_map {T T' f leT}. Section SortSeq_in. Variables (T : Type) (P : {pred T}) (leT : rel T). Let le_sT := relpre (val : sig P -> _) leT. Hypothesis leT_total : {in P &, total leT}. Let le_sT_total : total le_sT := in2_sig leT_total. Lemma sort_sorted_in s : all P s -> sorted leT (sort leT s). Proof. by move=> /all_sigP[? ->]; rewrite sort_map sorted_map sort_sorted. Qed. Hypothesis leT_tr : {in P & &, transitive leT}. Let le_sT_tr : transitive le_sT := in3_sig leT_tr. Lemma sorted_sort_in s : all P s -> sorted leT s -> sort leT s = s. Proof. by move=> /all_sigP [{}s ->]; rewrite sort_map sorted_map => /sorted_sort->. Qed. End SortSeq_in. Arguments sort_sorted_in {T P leT} leT_total {s}. Arguments sorted_sort_in {T P leT} leT_tr {s}. Section EqSortSeq. Variables (T : eqType) (leT : rel T). Lemma perm_merge s1 s2 : perm_eql (merge leT s1 s2) (s1 ++ s2). Proof. apply/permPl; rewrite perm_sym; elim: s1 s2 => //= x1 s1 IHs1. elim; rewrite ?cats0 //= => x2 s2 IHs2. by case: ifP; last rewrite (perm_catCA (_ :: _) [:: x2]); rewrite perm_cons. Qed. Lemma mem_merge s1 s2 : merge leT s1 s2 =i s1 ++ s2. Proof. by apply: perm_mem; rewrite perm_merge. Qed. Lemma merge_uniq s1 s2 : uniq (merge leT s1 s2) = uniq (s1 ++ s2). Proof. by apply: perm_uniq; rewrite perm_merge. Qed. Lemma perm_sort s : perm_eql (sort leT s) s. Proof. apply/permPl; rewrite sortE perm_sym -{1}[s]/(flatten [::] ++ s). elim: s [::] => /= [|x s ihs] ss. - elim: ss [::] => //= s ss ihss t. by rewrite -(permPr (ihss _)) -catA perm_catCA perm_cat2l -perm_merge. - rewrite -(permPr (ihs _)) -(perm_catCA [:: x]) catA perm_cat2r. elim: {x s ihs} ss [:: x] => [|[|x s] ss ihss] t //. by rewrite -(permPr (ihss _)) catA perm_cat2r perm_catC -perm_merge. Qed. Lemma mem_sort s : sort leT s =i s. Proof. by apply: perm_mem; rewrite perm_sort. Qed. Lemma sort_uniq s : uniq (sort leT s) = uniq s. Proof. by apply: perm_uniq; rewrite perm_sort. Qed. Lemma perm_sortP : total leT -> transitive leT -> antisymmetric leT -> forall s1 s2, reflect (sort leT s1 = sort leT s2) (perm_eq s1 s2). Proof. move=> leT_total leT_tr leT_asym s1 s2. apply: (iffP idP) => eq12; last by rewrite -perm_sort eq12 perm_sort. apply: (sorted_eq leT_tr leT_asym); rewrite ?sort_sorted //. by rewrite perm_sort (permPl eq12) -perm_sort. Qed. End EqSortSeq. Lemma perm_sort_inP (T : eqType) (leT : rel T) (s1 s2 : seq T) : {in s1 &, total leT} -> {in s1 & &, transitive leT} -> {in s1 &, antisymmetric leT} -> reflect (sort leT s1 = sort leT s2) (perm_eq s1 s2). Proof. move=> /in2_sig leT_total /in3_sig leT_tr /in2_sig/(_ _ _ _)/val_inj leT_asym. apply: (iffP idP) => s1s2; last by rewrite -(perm_sort leT) s1s2 perm_sort. move: (s1s2); have /all_sigP[s1' ->] := allss s1. have /all_sigP[{s1s2}s2 ->] : all (mem s1) s2 by rewrite -(perm_all _ s1s2). by rewrite !sort_map => /(perm_map_inj val_inj) /(perm_sortP leT_total)->. Qed. Lemma perm_iota_sort (T : Type) (leT : rel T) x0 s : {i_s : seq nat | perm_eq i_s (iota 0 (size s)) & sort leT s = map (nth x0 s) i_s}. Proof. exists (sort (relpre (nth x0 s) leT) (iota 0 (size s))). by rewrite perm_sort. by rewrite -[X in sort leT X](mkseq_nth x0) sort_map. Qed. Lemma all_sort (T : Type) (P : {pred T}) (leT : rel T) s : all P (sort leT s) = all P s. Proof. case: s => // x s; move: (x :: s) => {}s. rewrite -(mkseq_nth x s) sort_map !all_map. by apply: perm_all; rewrite perm_sort. Qed. Lemma size_sort (T : Type) (leT : rel T) s : size (sort leT s) = size s. Proof. case: s => [|x s] //; have [s1 pp qq] := perm_iota_sort leT x (x :: s). by rewrite qq size_map (perm_size pp) size_iota. Qed. Lemma ltn_sorted_uniq_leq s : sorted ltn s = uniq s && sorted leq s. Proof. case: s => //= n s; elim: s n => //= m s IHs n. rewrite inE ltn_neqAle negb_or IHs -!andbA. case sn: (n \in s); last do !bool_congr. rewrite andbF; apply/and5P=> [[ne_nm lenm _ _ le_ms]]; case/negP: ne_nm. by rewrite eqn_leq lenm; apply: (allP (order_path_min leq_trans le_ms)). Qed. Lemma iota_sorted i n : sorted leq (iota i n). Proof. by elim: n i => // [[|n] //= IHn] i; rewrite IHn leqW. Qed. Lemma iota_ltn_sorted i n : sorted ltn (iota i n). Proof. by rewrite ltn_sorted_uniq_leq iota_sorted iota_uniq. Qed. Section Stability_merge. Variables (T : Type) (leT leT' : rel T). Hypothesis (leT_total : total leT) (leT'_tr : transitive leT'). Let leT_lex := [rel x y | leT x y && (leT y x ==> leT' x y)]. Lemma merge_stable_path x s1 s2 : allrel leT' s1 s2 -> path leT_lex x s1 -> path leT_lex x s2 -> path leT_lex x (merge leT s1 s2). Proof. elim: s1 s2 x => //= x s1 ih1; elim => //= y s2 ih2 h. rewrite allrel_cons2 => /and4P [xy' xs2 ys1 s1s2] /andP [hx xs1] /andP [hy ys2]. case: ifP => xy /=; rewrite (hx, hy) /=. - by apply: ih1; rewrite ?allrel_consr ?ys1 //= xy xy' implybT. - by apply: ih2; have:= leT_total x y; rewrite ?allrel_consl ?xs2 ?xy //= => ->. Qed. Lemma merge_stable_sorted s1 s2 : allrel leT' s1 s2 -> sorted leT_lex s1 -> sorted leT_lex s2 -> sorted leT_lex (merge leT s1 s2). Proof. case: s1 s2 => [|x s1] [|y s2] //=; rewrite allrel_consl allrel_consr /= -andbA. case/and4P => [xy' xs2 ys1 s1s2] xs1 ys2; rewrite -/(merge _ (_ :: _)). by case: ifP (leT_total x y) => /= xy yx; apply/merge_stable_path; rewrite /= ?(allrel_consl, allrel_consr, xs2, ys1, xy, yx, xy', implybT). Qed. End Stability_merge. Section Stability_iota. Variables (leN : rel nat) (leN_total : total leN) (leN_tr : transitive leN). Let lt_lex := [rel n m | leN n m && (leN m n ==> (n < m))]. Local Arguments iota : simpl never. Local Arguments size : simpl never. Local Arguments cat : simpl never. Let push_invariant := fix push_invariant (ss : seq (seq nat)) := if ss is s :: ss' then sorted lt_lex s && perm_eq s (iota (size (flatten ss')) (size s)) && push_invariant ss' else true. Let push_stable s1 ss : push_invariant (s1 :: ss) -> push_invariant (merge_sort_push leN s1 ss). Proof. elim: ss s1 => [] // [] //= m s2 ss ihss s1; rewrite -2!andbA. move=> /and5P [sorted_s1 perm_s1 sorted_s2 perm_s2 hss]; apply: ihss. rewrite hss size_merge size_cat iotaD addnC -size_cat perm_merge perm_cat //. rewrite merge_stable_sorted //; apply/allrelP => n p. rewrite (perm_mem perm_s1) (perm_mem perm_s2) !mem_iota size_cat addnC. by move=> /andP [_ n_lt] /andP [] /(leq_trans n_lt). Qed. Let pop_stable s1 ss : push_invariant (s1 :: ss) -> sorted lt_lex (merge_sort_pop leN s1 ss). Proof. elim: ss s1 => [s1 /andP [] /andP [] //|s2 ss ihss s1]; rewrite /= -2!andbA. move=> /and5P [sorted_s1 perm_s1 sorted_s2 perm_s2 hss]; apply: ihss. rewrite /= hss size_merge size_cat iotaD addnC -size_cat perm_merge perm_cat //. rewrite merge_stable_sorted //; apply/allrelP => n p. rewrite (perm_mem perm_s1) (perm_mem perm_s2) !mem_iota size_cat addnC. by move=> /andP [_ n_lt] /andP [] /(leq_trans n_lt). Qed. Lemma sort_iota_stable n : sorted lt_lex (sort leN (iota 0 n)). Proof. rewrite sortE -[0]/(size (@flatten nat [::])). have: push_invariant [::] by []. elim: n [::] => [|n ihn] ss hss; first exact: pop_stable. have: push_invariant ([:: size (flatten ss)] :: ss) by rewrite /= perm_refl. move/push_stable/ihn; congr (sorted _ (sort_rec1 _ _ (iota _ _))). rewrite -[_.+1]/(size ([:: size (flatten ss)] ++ _)). elim: (ss) [:: _] => [|[|? ?] ? ihss] //= ?. by rewrite ihss !size_cat size_merge size_cat -addnA addnCA. Qed. End Stability_iota. Lemma sort_stable T (leT leT' : rel T) : total leT -> transitive leT' -> forall s : seq T, sorted leT' s -> sorted [rel x y | leT x y && (leT y x ==> leT' x y)] (sort leT s). Proof. move=> leT_total leT'_tr s sorted_s; case Ds: s => // [x s1]. rewrite -{s1}Ds -(mkseq_nth x s) sort_map. have leN_total: total (relpre (nth x s) leT) by move=> n m; apply: leT_total. apply: (homo_sorted_in _ (allss _)) (sort_iota_stable leN_total _) => /= y z. rewrite !mem_sort !mem_iota !leq0n add0n /= => ys zs /andP [->] /=. by case: (leT _ _); first apply: sorted_ltn_nth. Qed. Lemma filter_sort T (leT : rel T) : total leT -> transitive leT -> forall p s, filter p (sort leT s) = sort leT (filter p s). Proof. move=> leT_total leT_tr p s; case Ds: s => // [x s1]. pose leN := relpre (nth x s) leT. pose lt_lex := [rel n m | leN n m && (leN m n ==> (n < m))]. have lt_lex_tr: transitive lt_lex. rewrite /lt_lex /leN => ? ? ? /= /andP [xy xy'] /andP [yz yz']. rewrite (leT_tr _ _ _ xy yz); apply/implyP => zx; move: xy' yz'. by rewrite (leT_tr _ _ _ yz zx) (leT_tr _ _ _ zx xy); apply: ltn_trans. rewrite -{s1}Ds -(mkseq_nth x s) !(filter_map, sort_map); congr map. apply/(@irr_sorted_eq _ lt_lex); rewrite /lt_lex /leN //=. - by move=> ?; rewrite /= ltnn implybF andbN. - exact/sorted_filter/sort_iota_stable. - exact/sort_stable/sorted_filter/iota_ltn_sorted/ltn_trans/ltn_trans. - by move=> ?; rewrite !(mem_filter, mem_sort). Qed. Lemma sort_stable_in T (P : {pred T}) (leT leT' : rel T) : {in P &, total leT} -> {in P & &, transitive leT'} -> forall s : seq T, all P s -> sorted leT' s -> sorted [rel x y | leT x y && (leT y x ==> leT' x y)] (sort leT s). Proof. move=> /in2_sig leT_total /in3_sig leT_tr _ /all_sigP[s ->]. by rewrite sort_map !sorted_map; apply: sort_stable. Qed. Lemma filter_sort_in T (P : {pred T}) (leT : rel T) : {in P &, total leT} -> {in P & &, transitive leT} -> forall p s, all P s -> filter p (sort leT s) = sort leT (filter p s). Proof. move=> /in2_sig leT_total /in3_sig leT_tr p _ /all_sigP[s ->]. by rewrite !(sort_map, filter_map) filter_sort. Qed. Section Stability_mask. Variables (T : Type) (leT : rel T). Variables (leT_total : total leT) (leT_tr : transitive leT). Lemma mask_sort s m : {m_s : bitseq | mask m_s (sort leT s) = sort leT (mask m s)}. Proof. case Ds: {-}s => [|x s1]; [by rewrite Ds; case: m; exists [::] | clear s1 Ds]. rewrite -(mkseq_nth x s) -map_mask !sort_map. exists [seq i \in mask m (iota 0 (size s)) | i <- sort (xrelpre (nth x s) leT) (iota 0 (size s))]. rewrite -map_mask -filter_mask [in RHS]mask_filter ?iota_uniq ?filter_sort //. by move=> ? ? ?; exact: leT_tr. Qed. Lemma sorted_mask_sort s m : sorted leT (mask m s) -> {m_s | mask m_s (sort leT s) = mask m s}. Proof. by move/(sorted_sort leT_tr) <-; exact: mask_sort. Qed. End Stability_mask. Section Stability_mask_in. Variables (T : Type) (P : {pred T}) (leT : rel T). Hypothesis leT_total : {in P &, total leT}. Hypothesis leT_tr : {in P & &, transitive leT}. Let le_sT := relpre (val : sig P -> _) leT. Let le_sT_total : total le_sT := in2_sig leT_total. Let le_sT_tr : transitive le_sT := in3_sig leT_tr. Lemma mask_sort_in s m : all P s -> {m_s : bitseq | mask m_s (sort leT s) = sort leT (mask m s)}. Proof. move=> /all_sigP [{}s ->]; case: (mask_sort (leT := le_sT) _ _ s m) => //. by move=> m' m'E; exists m'; rewrite -map_mask !sort_map -map_mask m'E. Qed. Lemma sorted_mask_sort_in s m : all P s -> sorted leT (mask m s) -> {m_s | mask m_s (sort leT s) = mask m s}. Proof. move=> ? /(sorted_sort_in leT_tr _) <-; [exact: mask_sort_in | exact: all_mask]. Qed. End Stability_mask_in. Section Stability_subseq. Variables (T : eqType) (leT : rel T). Variables (leT_total : total leT) (leT_tr : transitive leT). Lemma subseq_sort : {homo sort leT : t s / subseq t s}. Proof. move=> _ s /subseqP [m _ ->]. case: (mask_sort leT_total leT_tr s m) => m' <-; exact: mask_subseq. Qed. Lemma sorted_subseq_sort t s : subseq t s -> sorted leT t -> subseq t (sort leT s). Proof. by move=> subseq_ts /(sorted_sort leT_tr) <-; exact: subseq_sort. Qed. Lemma mem2_sort s x y : leT x y -> mem2 s x y -> mem2 (sort leT s) x y. Proof. move=> lexy; rewrite !mem2E => /subseq_sort. by case: eqP => // _; rewrite {1}/sort /= lexy /=. Qed. End Stability_subseq. Section Stability_subseq_in. Variables (T : eqType) (leT : rel T). Lemma subseq_sort_in t s : {in s &, total leT} -> {in s & &, transitive leT} -> subseq t s -> subseq (sort leT t) (sort leT s). Proof. move=> leT_total leT_tr /subseqP [m _ ->]. have [m' <-] := mask_sort_in leT_total leT_tr m (allss _). exact: mask_subseq. Qed. Lemma sorted_subseq_sort_in t s : {in s &, total leT} -> {in s & &, transitive leT} -> subseq t s -> sorted leT t -> subseq t (sort leT s). Proof. move=> ? leT_tr ? /(sorted_sort_in leT_tr) <-; last exact/allP/mem_subseq. exact: subseq_sort_in. Qed. Lemma mem2_sort_in s : {in s &, total leT} -> {in s & &, transitive leT} -> forall x y, leT x y -> mem2 s x y -> mem2 (sort leT s) x y. Proof. move=> leT_total leT_tr x y lexy; rewrite !mem2E. by move/subseq_sort_in; case: (_ == _); rewrite /sort /= ?lexy; apply. Qed. End Stability_subseq_in. (* Function trajectories. *) Notation fpath f := (path (coerced_frel f)). Notation fcycle f := (cycle (coerced_frel f)). Notation ufcycle f := (ucycle (coerced_frel f)). Prenex Implicits path next prev cycle ucycle mem2. Section Trajectory. Variables (T : Type) (f : T -> T). Fixpoint traject x n := if n is n'.+1 then x :: traject (f x) n' else [::]. Lemma trajectS x n : traject x n.+1 = x :: traject (f x) n. Proof. by []. Qed. Lemma trajectSr x n : traject x n.+1 = rcons (traject x n) (iter n f x). Proof. by elim: n x => //= n IHn x; rewrite IHn -iterSr. Qed. Lemma last_traject x n : last x (traject (f x) n) = iter n f x. Proof. by case: n => // n; rewrite iterSr trajectSr last_rcons. Qed. Lemma traject_iteri x n : traject x n = iteri n (fun i => rcons^~ (iter i f x)) [::]. Proof. by elim: n => //= n <-; rewrite -trajectSr. Qed. Lemma size_traject x n : size (traject x n) = n. Proof. by elim: n x => //= n IHn x //=; rewrite IHn. Qed. Lemma nth_traject i n : i < n -> forall x, nth x (traject x n) i = iter i f x. Proof. elim: n => // n IHn; rewrite ltnS => le_i_n x. rewrite trajectSr nth_rcons size_traject. by case: ltngtP le_i_n => [? _||->] //; apply: IHn. Qed. Lemma trajectD m n x : traject x (m + n) = traject x m ++ traject (iter m f x) n. Proof. by elim: m => //m IHm in x *; rewrite addSn !trajectS IHm -iterSr. Qed. Lemma take_traject n k x : k <= n -> take k (traject x n) = traject x k. Proof. by move=> /subnKC<-; rewrite trajectD take_size_cat ?size_traject. Qed. End Trajectory. Section EqTrajectory. Variables (T : eqType) (f : T -> T). Lemma eq_fpath f' : f =1 f' -> fpath f =2 fpath f'. Proof. by move/eq_frel/eq_path. Qed. Lemma eq_fcycle f' : f =1 f' -> fcycle f =1 fcycle f'. Proof. by move/eq_frel/eq_cycle. Qed. Lemma fpathE x p : fpath f x p -> p = traject f (f x) (size p). Proof. by elim: p => //= y p IHp in x * => /andP[/eqP{y}<- /IHp<-]. Qed. Lemma fpathP x p : reflect (exists n, p = traject f (f x) n) (fpath f x p). Proof. apply: (iffP idP) => [/fpathE->|[n->]]; first by exists (size p). by elim: n => //= n IHn in x *; rewrite eqxx IHn. Qed. Lemma fpath_traject x n : fpath f x (traject f (f x) n). Proof. by apply/(fpathP x); exists n. Qed. Definition looping x n := iter n f x \in traject f x n. Lemma loopingP x n : reflect (forall m, iter m f x \in traject f x n) (looping x n). Proof. apply: (iffP idP) => loop_n; last exact: loop_n. case: n => // n in loop_n *; elim=> [|m /= IHm]; first exact: mem_head. move: (fpath_traject x n) loop_n; rewrite /looping !iterS -last_traject /=. move: (iter m f x) IHm => y /splitPl[p1 p2 def_y]. rewrite cat_path last_cat def_y; case: p2 => // z p2 /and3P[_ /eqP-> _] _. by rewrite inE mem_cat mem_head !orbT. Qed. Lemma trajectP x n y : reflect (exists2 i, i < n & y = iter i f x) (y \in traject f x n). Proof. elim: n x => [|n IHn] x /=; first by right; case. rewrite inE; have [-> | /= neq_xy] := eqP; first by left; exists 0. apply: {IHn}(iffP (IHn _)) => [[i] | [[|i]]] // lt_i_n ->. by exists i.+1; rewrite ?iterSr. by exists i; rewrite ?iterSr. Qed. Lemma looping_uniq x n : uniq (traject f x n.+1) = ~~ looping x n. Proof. rewrite /looping; elim: n x => [|n IHn] x //. rewrite [n.+1 in LHS]lock [iter]lock /= -!lock {}IHn -iterSr -negb_or inE. congr (~~ _); apply: orb_id2r => /trajectP no_loop. apply/idP/eqP => [/trajectP[m le_m_n def_x] | {1}<-]; last first. by rewrite iterSr -last_traject mem_last. have loop_m: looping x m.+1 by rewrite /looping iterSr -def_x mem_head. have/trajectP[[|i] // le_i_m def_fn1x] := loopingP _ _ loop_m n.+1. by case: no_loop; exists i; rewrite -?iterSr // -ltnS (leq_trans le_i_m). Qed. End EqTrajectory. Arguments fpathP {T f x p}. Arguments loopingP {T f x n}. Arguments trajectP {T f x n y}. Prenex Implicits traject. Section Fcycle. Variables (T : eqType) (f : T -> T) (p : seq T) (f_p : fcycle f p). Lemma nextE (x : T) (p_x : x \in p) : next p x = f x. Proof. exact/esym/eqP/(next_cycle f_p). Qed. Lemma mem_fcycle : {homo f : x / x \in p}. Proof. by move=> x xp; rewrite -nextE// mem_next. Qed. Lemma inj_cycle : {in p &, injective f}. Proof. apply: can_in_inj (iter (size p).-1 f) _ => x /rot_to[i q rip]. have /fpathE qxE : fcycle f (x :: q) by rewrite -rip rot_cycle. have -> : size p = size (rcons q x) by rewrite size_rcons -(size_rot i) rip. by rewrite -iterSr -last_traject prednK -?qxE ?size_rcons// last_rcons. Qed. End Fcycle. Section UniqCycle. Variables (n0 : nat) (T : eqType) (e : rel T) (p : seq T). Hypothesis Up : uniq p. Lemma prev_next : cancel (next p) (prev p). Proof. move=> x; rewrite prev_nth mem_next next_nth; case p_x: (x \in p) => //. case Dp: p Up p_x => // [y q]; rewrite [uniq _]/= -Dp => /andP[q'y Uq] p_x. rewrite -[RHS](nth_index y p_x); congr (nth y _ _); set i := index x p. have: i <= size q by rewrite -index_mem -/i Dp in p_x. case: ltngtP => // [lt_i_q|->] _; first by rewrite index_uniq. by apply/eqP; rewrite nth_default // eqn_leq index_size leqNgt index_mem. Qed. Lemma next_prev : cancel (prev p) (next p). Proof. move=> x; rewrite next_nth mem_prev prev_nth; case p_x: (x \in p) => //. case def_p: p p_x => // [y q]; rewrite -def_p => p_x. rewrite index_uniq //; last by rewrite def_p ltnS index_size. case q_x: (x \in q); first exact: nth_index. rewrite nth_default; last by rewrite leqNgt index_mem q_x. by apply/eqP; rewrite def_p inE q_x orbF eq_sym in p_x. Qed. Lemma cycle_next : fcycle (next p) p. Proof. case def_p: p Up => [|x q] Uq //; rewrite -[in next _]def_p. apply/(pathP x)=> i; rewrite size_rcons => le_i_q. rewrite -cats1 -cat_cons nth_cat le_i_q /= next_nth {}def_p mem_nth //. rewrite index_uniq // nth_cat /= ltn_neqAle andbC -ltnS le_i_q. by case: (i =P _) => //= ->; rewrite subnn nth_default. Qed. Lemma cycle_prev : cycle (fun x y => x == prev p y) p. Proof. apply: etrans cycle_next; symmetry; case def_p: p => [|x q] //. by apply: eq_path; rewrite -def_p; apply: (can2_eq prev_next next_prev). Qed. Lemma cycle_from_next : (forall x, x \in p -> e x (next p x)) -> cycle e p. Proof. case: p (next p) cycle_next => //= [x q] n; rewrite -(belast_rcons x q x). move: {q}(rcons q x) => q n_q /allP. by elim: q x n_q => //= _ q IHq x /andP[/eqP <- n_q] /andP[-> /IHq->]. Qed. Lemma cycle_from_prev : (forall x, x \in p -> e (prev p x) x) -> cycle e p. Proof. move=> e_p; apply: cycle_from_next => x. by rewrite -mem_next => /e_p; rewrite prev_next. Qed. Lemma next_rot : next (rot n0 p) =1 next p. Proof. move=> x; have n_p := cycle_next; rewrite -(rot_cycle n0) in n_p. case p_x: (x \in p); last by rewrite !next_nth mem_rot p_x. by rewrite (eqP (next_cycle n_p _)) ?mem_rot. Qed. Lemma prev_rot : prev (rot n0 p) =1 prev p. Proof. move=> x; have p_p := cycle_prev; rewrite -(rot_cycle n0) in p_p. case p_x: (x \in p); last by rewrite !prev_nth mem_rot p_x. by rewrite (eqP (prev_cycle p_p _)) ?mem_rot. Qed. End UniqCycle. Section UniqRotrCycle. Variables (n0 : nat) (T : eqType) (p : seq T). Hypothesis Up : uniq p. Lemma next_rotr : next (rotr n0 p) =1 next p. Proof. exact: next_rot. Qed. Lemma prev_rotr : prev (rotr n0 p) =1 prev p. Proof. exact: prev_rot. Qed. End UniqRotrCycle. Section UniqCycleRev. Variable T : eqType. Implicit Type p : seq T. Lemma prev_rev p : uniq p -> prev (rev p) =1 next p. Proof. move=> Up x; case p_x: (x \in p); last first. by rewrite next_nth prev_nth mem_rev p_x. case/rot_to: p_x (Up) => [i q def_p] Urp; rewrite -rev_uniq in Urp. rewrite -(prev_rotr i Urp); do 2 rewrite -(prev_rotr 1) ?rotr_uniq //. rewrite -rev_rot -(next_rot i Up) {i p Up Urp}def_p. by case: q => // y q; rewrite !rev_cons !(=^~ rcons_cons, rotr1_rcons) /= eqxx. Qed. Lemma next_rev p : uniq p -> next (rev p) =1 prev p. Proof. by move=> Up x; rewrite -[p in RHS]revK prev_rev // rev_uniq. Qed. End UniqCycleRev. Section MapPath. Variables (T T' : Type) (h : T' -> T) (e : rel T) (e' : rel T'). Definition rel_base (b : pred T) := forall x' y', ~~ b (h x') -> e (h x') (h y') = e' x' y'. Lemma map_path b x' p' (Bb : rel_base b) : ~~ has (preim h b) (belast x' p') -> path e (h x') (map h p') = path e' x' p'. Proof. by elim: p' x' => [|y' p' IHp'] x' //= /norP[/Bb-> /IHp'->]. Qed. End MapPath. Section MapEqPath. Variables (T T' : eqType) (h : T' -> T) (e : rel T) (e' : rel T'). Hypothesis Ih : injective h. Lemma mem2_map x' y' p' : mem2 (map h p') (h x') (h y') = mem2 p' x' y'. Proof. by rewrite [LHS]/mem2 (index_map Ih) -map_drop mem_map. Qed. Lemma next_map p : uniq p -> forall x, next (map h p) (h x) = h (next p x). Proof. move=> Up x; case p_x: (x \in p); last by rewrite !next_nth (mem_map Ih) p_x. case/rot_to: p_x => i p' def_p. rewrite -(next_rot i Up); rewrite -(map_inj_uniq Ih) in Up. rewrite -(next_rot i Up) -map_rot {i p Up}def_p /=. by case: p' => [|y p''] //=; rewrite !eqxx. Qed. Lemma prev_map p : uniq p -> forall x, prev (map h p) (h x) = h (prev p x). Proof. move=> Up x; rewrite -[x in LHS](next_prev Up) -(next_map Up). by rewrite prev_next ?map_inj_uniq. Qed. End MapEqPath. Definition fun_base (T T' : eqType) (h : T' -> T) f f' := rel_base h (frel f) (frel f'). Section CycleArc. Variable T : eqType. Implicit Type p : seq T. Definition arc p x y := let px := rot (index x p) p in take (index y px) px. Lemma arc_rot i p : uniq p -> {in p, arc (rot i p) =2 arc p}. Proof. move=> Up x p_x y; congr (fun q => take (index y q) q); move: Up p_x {y}. rewrite -{1 2 5 6}(cat_take_drop i p) /rot cat_uniq => /and3P[_ Up12 _]. rewrite !drop_cat !take_cat !index_cat mem_cat orbC. case p2x: (x \in drop i p) => /= => [_ | p1x]. rewrite index_mem p2x [x \in _](negbTE (hasPn Up12 _ p2x)) /= addKn. by rewrite ltnNge leq_addr catA. by rewrite p1x index_mem p1x addKn ltnNge leq_addr /= catA. Qed. Lemma left_arc x y p1 p2 (p := x :: p1 ++ y :: p2) : uniq p -> arc p x y = x :: p1. Proof. rewrite /arc /p [index x _]/= eqxx rot0 -cat_cons cat_uniq index_cat. move: (x :: p1) => xp1 /and3P[_ /norP[/= /negbTE-> _] _]. by rewrite eqxx addn0 take_size_cat. Qed. Lemma right_arc x y p1 p2 (p := x :: p1 ++ y :: p2) : uniq p -> arc p y x = y :: p2. Proof. rewrite -[p]cat_cons -rot_size_cat rot_uniq => Up. by rewrite arc_rot ?left_arc ?mem_head. Qed. Variant rot_to_arc_spec p x y := RotToArcSpec i p1 p2 of x :: p1 = arc p x y & y :: p2 = arc p y x & rot i p = x :: p1 ++ y :: p2 : rot_to_arc_spec p x y. Lemma rot_to_arc p x y : uniq p -> x \in p -> y \in p -> x != y -> rot_to_arc_spec p x y. Proof. move=> Up p_x p_y ne_xy; case: (rot_to p_x) (p_y) (Up) => [i q def_p] q_y. rewrite -(mem_rot i) def_p inE eq_sym (negbTE ne_xy) in q_y. rewrite -(rot_uniq i) def_p. case/splitPr: q / q_y def_p => q1 q2 def_p Uq12; exists i q1 q2 => //. by rewrite -(arc_rot i Up p_x) def_p left_arc. by rewrite -(arc_rot i Up p_y) def_p right_arc. Qed. End CycleArc. Prenex Implicits arc. Notation "@ 'eq_sorted'" := (deprecate eq_sorted sorted_eq) (at level 10, only parsing) : fun_scope. Notation "@ 'eq_sorted_irr'" := (deprecate eq_sorted_irr irr_sorted_eq) (at level 10, only parsing) : fun_scope. Notation "@ 'sorted_lt_nth'" := (fun (T : Type) (leT : rel T) (leT_tr : transitive leT) => deprecate sorted_lt_nth sorted_ltn_nth leT_tr) (at level 10, only parsing) : fun_scope. Notation "@ 'sorted_le_nth'" := (fun (T : Type) (leT : rel T) (leT_tr : transitive leT) => deprecate sorted_le_nth sorted_leq_nth leT_tr) (at level 10, only parsing) : fun_scope. Notation "@ 'ltn_index'" := (fun (T : eqType) (leT : rel T) (leT_tr : transitive leT) => deprecate ltn_index sorted_ltn_index leT_tr) (at level 10, only parsing) : fun_scope. Notation "@ 'leq_index'" := (fun (T : eqType) (leT : rel T) (leT_tr : transitive leT) => deprecate leq_index sorted_leq_index leT_tr) (at level 10, only parsing) : fun_scope. Notation "@ 'subseq_order_path'" := (deprecate subseq_order_path subseq_path) (at level 10, only parsing) : fun_scope. Notation eq_sorted := (fun le_tr le_asym => @eq_sorted _ _ le_tr le_asym _ _) (only parsing). Notation eq_sorted_irr := (fun le_tr le_irr => @eq_sorted_irr _ _ le_tr le_irr _ _) (only parsing). Notation sorted_lt_nth := (fun leT_tr x0 => @sorted_lt_nth _ _ leT_tr x0 _) (only parsing). Notation sorted_le_nth := (fun leT_tr leT_refl x0 => @sorted_le_nth _ _ leT_tr leT_refl x0 _) (only parsing). Notation ltn_index := (fun leT_tr => @ltn_index _ _ leT_tr _) (only parsing). Notation leq_index := (fun leT_tr leT_refl => @leq_index _ _ leT_tr leT_refl _) (only parsing). Notation subseq_order_path := (fun leT_tr => @subseq_order_path _ _ leT_tr _ _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/pg-ssr.el000066400000000000000000000035771375767750300226650ustar00rootroot00000000000000;; Customization of Proof General for highlighting ssreflect tactics. (defcustom coq-user-tactics-db '(("nat_congr" "ncongr" "nat_congr" t "nat_congr") ("nat_norm" "nnorm" "nat_norm" t "nat_norm") ("bool_congr" "bcongr" "bool_congr" t "bool_congr") ("prop_congr" "prcongr" "prop_congr" t "prop_congr") ("move" "m" "move" t "move") ("set" "set" "set # := #" t "set") ("have" "hv" "have # : #" t "have") ("gen have" "genhv" "gen have : / #" t "gen have") ("generally have" "generhv" "generally have : / #" t "generally have") ("congr" "con" "congr #" t "congr") ("wlog" "wlog" "wlog : / #" t "wlog") ("without loss" "wilog" "without loss #" t "without loss") ("unlock" "unlock" "unlock #" t "unlock") ("suffices" "suffices" "suffices # : #" t "suffices") ("suff" "suff" "suff # : #" t "suff") ) "Extended list of tactics, includings ssr and user defined ones") (defcustom coq-user-commands-db '(("Prenex Implicits" "pi" "Prenex Implicits #" t "Prenex\\s-+Implicits") ("Hint View for" "hv" "Hint View for #" t "Hint\\s-+View\\s-+for") ("inside" "ins" nil f "inside") ("outside" "outs" nil f "outside") ("Canonical " nil "Canonical #." t "Canonical") ) "Extended list of commands, includings ssr and user defined ones") (defcustom coq-user-tacticals-db '(("last" "lst" nil t "last")) "Extended list of tacticals, includings ssr and user defined ones") (defcustom coq-user-reserved-db '("is" "isn't" "nosimpl" "of") "Extended list of keywords, includings ssr and user defined ones") (defcustom coq-user-solve-tactics-db '(("done" nil "done" nil "done") ) "Extended list of closing tactic(al)s, includings ssr and user defined ones") ;; This works only with the cvs version (> 3.7) of Proof General. (defcustom coq-variable-highlight-enable nil "Activates partial bound variable highlighting" ) math-comp-mathcomp-1.12.0/mathcomp/ssreflect/prime.v000066400000000000000000001626361375767750300224350ustar00rootroot00000000000000(* (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 fintype div bigop. (******************************************************************************) (* This file contains the definitions of: *) (* prime p <=> p is a prime. *) (* primes m == the sorted list of prime divisors of m > 1, else [::]. *) (* pfactor p e == the value p ^ e of a prime factor (p, e). *) (* NumFactor f == print version of a prime factor, converting the prime *) (* component to a Num (which can print large values). *) (* prime_decomp m == the list of prime factors of m > 1, sorted by primes. *) (* logn p m == the e such that (p ^ e) \in prime_decomp n, else 0. *) (* trunc_log p m == the largest e such that p ^ e <= m, or 0 if p or m is 0. *) (* pdiv n == the smallest prime divisor of n > 1, else 1. *) (* max_pdiv n == the largest prime divisor of n > 1, else 1. *) (* divisors m == the sorted list of divisors of m > 0, else [::]. *) (* totient n == the Euler totient (#|{i < n | i and n coprime}|). *) (* nat_pred == the type of explicit collective nat predicates. *) (* := simpl_pred nat. *) (* -> We allow the coercion nat >-> nat_pred, interpreting p as pred1 p. *) (* -> We define a predType for nat_pred, enabling the notation p \in pi. *) (* -> We don't have nat_pred >-> pred, which would imply nat >-> Funclass. *) (* pi^' == the complement of pi : nat_pred, i.e., the nat_pred such *) (* that (p \in pi^') = (p \notin pi). *) (* \pi(n) == the set of prime divisors of n, i.e., the nat_pred such *) (* that (p \in \pi(n)) = (p \in primes n). *) (* \pi(A) == the set of primes of #|A|, with A a collective predicate *) (* over a finite Type. *) (* -> The notation \pi(A) is implemented with a collapsible Coercion. The *) (* type of A must coerce to finpred_sort (e.g., by coercing to {set T}) *) (* and not merely implement the predType interface (as seq T does). *) (* -> The expression #|A| will only appear in \pi(A) after simplification *) (* collapses the coercion, so it is advisable to do so early on. *) (* pi.-nat n <=> n > 0 and all prime divisors of n are in pi. *) (* n`_pi == the pi-part of n -- the largest pi.-nat divisor of n. *) (* := \prod_(0 <= p < n.+1 | p \in pi) p ^ logn p n. *) (* -> The nat >-> nat_pred coercion lets us write p.-nat n and n`_p. *) (* In addition to the lemmas relevant to these definitions, this file also *) (* contains the dvdn_sum lemma, so that bigop.v doesn't depend on div.v. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (* The complexity of any arithmetic operation with the Peano representation *) (* is pretty dreadful, so using algorithms for "harder" problems such as *) (* factoring, that are geared for efficient arithmetic leads to dismal *) (* performance -- it takes a significant time, for instance, to compute the *) (* divisors of just a two-digit number. On the other hand, for Peano *) (* integers, prime factoring (and testing) is linear-time with a small *) (* constant factor -- indeed, the same as converting in and out of a binary *) (* representation. This is implemented by the code below, which is then *) (* used to give the "standard" definitions of prime, primes, and divisors, *) (* which can then be used casually in proofs with moderately-sized numeric *) (* values (indeed, the code here performs well for up to 6-digit numbers). *) Module Import PrimeDecompAux. (* We start with faster mod-2 and 2-valuation functions. *) Fixpoint edivn2 q r := if r is r'.+2 then edivn2 q.+1 r' else (q, r). Lemma edivn2P n : edivn_spec n 2 (edivn2 0 n). Proof. rewrite -[n]odd_double_half addnC -{1}[n./2]addn0 -{1}mul2n mulnC. elim: n./2 {1 4}0 => [|r IHr] q; first by case (odd n) => /=. by rewrite addSnnS; apply: IHr. Qed. Fixpoint elogn2 e q r {struct q} := match q, r with | 0, _ | _, 0 => (e, q) | q'.+1, 1 => elogn2 e.+1 q' q' | q'.+1, r'.+2 => elogn2 e q' r' end. Arguments elogn2 : simpl nomatch. Variant elogn2_spec n : nat * nat -> Type := Elogn2Spec e m of n = 2 ^ e * m.*2.+1 : elogn2_spec n (e, m). Lemma elogn2P n : elogn2_spec n.+1 (elogn2 0 n n). Proof. rewrite -[n.+1]mul1n -[1]/(2 ^ 0) -[n in _ * n.+1](addKn n n) addnn. elim: n {1 4 6}n {2 3}0 (leqnn n) => [|q IHq] [|[|r]] e //=; last first. by move/ltnW; apply: IHq. rewrite subn1 prednK // -mul2n mulnA -expnSr. by rewrite -[q in _ * q.+1](addKn q q) addnn => _; apply: IHq. Qed. Definition ifnz T n (x y : T) := if n is 0 then y else x. Variant ifnz_spec T n (x y : T) : T -> Type := | IfnzPos of n > 0 : ifnz_spec n x y x | IfnzZero of n = 0 : ifnz_spec n x y y. Lemma ifnzP T n (x y : T) : ifnz_spec n x y (ifnz n x y). Proof. by case: n => [|n]; [right | left]. Qed. (* The list of divisors and the Euler function are computed directly from *) (* the decomposition, using a merge_sort variant sort of the divisor list. *) Definition add_divisors f divs := let: (p, e) := f in let add1 divs' := merge leq (map (NatTrec.mul p) divs') divs in iter e add1 divs. Import NatTrec. Definition add_totient_factor f m := let: (p, e) := f in p.-1 * p ^ e.-1 * m. Definition cons_pfactor (p e : nat) pd := ifnz e ((p, e) :: pd) pd. Notation "p ^? e :: pd" := (cons_pfactor p e pd) (at level 30, e at level 30, pd at level 60) : nat_scope. End PrimeDecompAux. (* For pretty-printing. *) Definition NumFactor (f : nat * nat) := ([Num of f.1], f.2). Definition pfactor p e := p ^ e. Section prime_decomp. Import NatTrec. Local Fixpoint prime_decomp_rec m k a b c e := let p := k.*2.+1 in if a is a'.+1 then if b - (ifnz e 1 k - c) is b'.+1 then [rec m, k, a', b', ifnz c c.-1 (ifnz e p.-2 1), e] else if (b == 0) && (c == 0) then let b' := k + a' in [rec b'.*2.+3, k, a', b', k.-1, e.+1] else let bc' := ifnz e (ifnz b (k, 0) (edivn2 0 c)) (b, c) in p ^? e :: ifnz a' [rec m, k.+1, a'.-1, bc'.1 + a', bc'.2, 0] [:: (m, 1)] else if (b == 0) && (c == 0) then [:: (p, e.+2)] else p ^? e :: [:: (m, 1)] where "[ 'rec' m , k , a , b , c , e ]" := (prime_decomp_rec m k a b c e). Definition prime_decomp n := let: (e2, m2) := elogn2 0 n.-1 n.-1 in if m2 < 2 then 2 ^? e2 :: 3 ^? m2 :: [::] else let: (a, bc) := edivn m2.-2 3 in let: (b, c) := edivn (2 - bc) 2 in 2 ^? e2 :: [rec m2.*2.+1, 1, a, b, c, 0]. End prime_decomp. Definition primes n := unzip1 (prime_decomp n). Definition prime p := if prime_decomp p is [:: (_ , 1)] then true else false. Definition nat_pred := simpl_pred nat. Definition pi_arg := nat. Coercion pi_arg_of_nat (n : nat) : pi_arg := n. Coercion pi_arg_of_fin_pred T pT (A : @fin_pred_sort T pT) : pi_arg := #|A|. Arguments pi_arg_of_nat n /. Arguments pi_arg_of_fin_pred {T pT} A /. Definition pi_of (n : pi_arg) : nat_pred := [pred p in primes n]. Notation "\pi ( n )" := (pi_of n) (at level 2, format "\pi ( n )") : nat_scope. Notation "\p 'i' ( A )" := \pi(#|A|) (at level 2, format "\p 'i' ( A )") : nat_scope. Definition pdiv n := head 1 (primes n). Definition max_pdiv n := last 1 (primes n). Definition divisors n := foldr add_divisors [:: 1] (prime_decomp n). Definition totient n := foldr add_totient_factor (n > 0) (prime_decomp n). (* Correctness of the decomposition algorithm. *) Lemma prime_decomp_correct : let pd_val pd := \prod_(f <- pd) pfactor f.1 f.2 in let lb_dvd q m := ~~ has [pred d | d %| m] (index_iota 2 q) in let pf_ok f := lb_dvd f.1 f.1 && (0 < f.2) in let pd_ord q pd := path ltn q (unzip1 pd) in let pd_ok q n pd := [/\ n = pd_val pd, all pf_ok pd & pd_ord q pd] in forall n, n > 0 -> pd_ok 1 n (prime_decomp n). Proof. rewrite unlock => pd_val lb_dvd pf_ok pd_ord pd_ok. have leq_pd_ok m p q pd: q <= p -> pd_ok p m pd -> pd_ok q m pd. rewrite /pd_ok /pd_ord; case: pd => [|[r _] pd] //= leqp [<- ->]. by case/andP=> /(leq_trans _)->. have apd_ok m e q p pd: lb_dvd p p || (e == 0) -> q < p -> pd_ok p m pd -> pd_ok q (p ^ e * m) (p ^? e :: pd). - case: e => [|e]; rewrite orbC /= => pr_p ltqp. by rewrite mul1n; apply: leq_pd_ok; apply: ltnW. by rewrite /pd_ok /pd_ord /pf_ok /= pr_p ltqp => [[<- -> ->]]. case=> // n _; rewrite /prime_decomp. case: elogn2P => e2 m2 -> {n}; case: m2 => [|[|abc]]; try exact: apd_ok. rewrite [_.-2]/= !ltnS ltn0 natTrecE; case: edivnP => a bc ->{abc}. case: edivnP => b c def_bc /= ltc2 ltbc3; apply: (apd_ok) => //. move def_m: _.*2.+1 => m; set k := {2}1; rewrite -[2]/k.*2; set e := 0. pose p := k.*2.+1; rewrite -{1}[m]mul1n -[1]/(p ^ e)%N. have{def_m bc def_bc ltc2 ltbc3}: let kb := (ifnz e k 1).*2 in [&& k > 0, p < m, lb_dvd p m, c < kb & lb_dvd p p || (e == 0)] /\ m + (b * kb + c).*2 = p ^ 2 + (a * p).*2. - rewrite -def_m [in lb_dvd _ _]def_m; split=> //=; last first. by rewrite -def_bc addSn -doubleD 2!addSn -addnA subnKC // addnC. rewrite ltc2 /lb_dvd /index_iota /= dvdn2 -def_m. by rewrite [_.+2]lock /= odd_double. have [n] := ubnP a. elim: n => // n IHn in a (k) p m b c (e) * => /ltnSE-le_a_n []. set kb := _.*2; set d := _ + c => /and5P[lt0k ltpm leppm ltc pr_p def_m]. have def_k1: k.-1.+1 = k := ltn_predK lt0k. have def_kb1: kb.-1.+1 = kb by rewrite /kb -def_k1; case e. have eq_bc_0: (b == 0) && (c == 0) = (d == 0). by rewrite addn_eq0 muln_eq0 orbC -def_kb1. have lt1p: 1 < p by rewrite ltnS double_gt0. have co_p_2: coprime p 2 by rewrite /coprime gcdnC gcdnE modn2 /= odd_double. have if_d0: d = 0 -> [/\ m = (p + a.*2) * p, lb_dvd p p & lb_dvd p (p + a.*2)]. move=> d0; have{d0} def_m: m = (p + a.*2) * p. by rewrite d0 addn0 -!mul2n mulnA -mulnDl in def_m *. split=> //; apply/hasPn=> r /(hasPn leppm); apply: contra => /= dv_r. by rewrite def_m dvdn_mull. by rewrite def_m dvdn_mulr. case def_a: a => [|a'] /= in le_a_n *; rewrite !natTrecE -/p {}eq_bc_0. case: d if_d0 def_m => [[//| def_m {}pr_p pr_m'] _ | d _ def_m] /=. rewrite def_m def_a addn0 mulnA -2!expnSr. by split; rewrite /pd_ord /pf_ok /= ?muln1 ?pr_p ?leqnn. apply: apd_ok; rewrite // /pd_ok /= /pfactor expn1 muln1 /pd_ord /= ltpm. rewrite /pf_ok !andbT /=; split=> //; apply: contra leppm. case/hasP=> r /=; rewrite mem_index_iota => /andP[lt1r ltrm] dvrm; apply/hasP. have [ltrp | lepr] := ltnP r p. by exists r; rewrite // mem_index_iota lt1r. case/dvdnP: dvrm => q def_q; exists q; last by rewrite def_q /= dvdn_mulr. rewrite mem_index_iota -(ltn_pmul2r (ltnW lt1r)) -def_q mul1n ltrm. move: def_m; rewrite def_a addn0 -(@ltn_pmul2r p) // mulnn => <-. apply: (@leq_ltn_trans m); first by rewrite def_q leq_mul. by rewrite -addn1 leq_add2l. have def_k2: k.*2 = ifnz e 1 k * kb. by rewrite /kb; case: (e) => [|e']; rewrite (mul1n, muln2). case def_b': (b - _) => [|b']; last first. have ->: ifnz e k.*2.-1 1 = kb.-1 by rewrite /kb; case e. apply: IHn => {n le_a_n}//; rewrite -/p -/kb; split=> //. rewrite lt0k ltpm leppm pr_p andbT /=. by case: ifnzP; [move/ltn_predK->; apply: ltnW | rewrite def_kb1]. apply: (@addIn p.*2). rewrite -2!addnA -!doubleD -addnA -mulSnr -def_a -def_m /d. have ->: b * kb = b' * kb + (k.*2 - c * kb + kb). rewrite addnCA addnC -mulSnr -def_b' def_k2 -mulnBl -mulnDl subnK //. by rewrite ltnW // -subn_gt0 def_b'. rewrite -addnA; congr (_ + (_ + _).*2). case: (c) ltc; first by rewrite -addSnnS def_kb1 subn0 addn0 addnC. rewrite /kb; case e => [[] // _ | e' c' _] /=; last first. by rewrite subnDA subnn addnC addSnnS. by rewrite mul1n -doubleB -doubleD subn1 !addn1 def_k1. have ltdp: d < p. move/eqP: def_b'; rewrite subn_eq0 -(@leq_pmul2r kb); last first. by rewrite -def_kb1. rewrite mulnBl -def_k2 ltnS -(leq_add2r c); move/leq_trans; apply. have{} ltc: c < k.*2. by apply: (leq_trans ltc); rewrite leq_double /kb; case e. rewrite -{2}(subnK (ltnW ltc)) leq_add2r leq_sub2l //. by rewrite -def_kb1 mulnS leq_addr. case def_d: d if_d0 => [|d'] => [[//|{ltdp pr_p}def_m pr_p pr_m'] | _]. rewrite eqxx -doubleS -addnS -def_a doubleD -addSn -/p def_m. rewrite mulnCA mulnC -expnSr. apply: IHn => {n le_a_n}//; rewrite -/p -/kb; split. rewrite lt0k -addn1 leq_add2l {1}def_a pr_m' pr_p /= def_k1 -addnn. by rewrite leq_addr. rewrite -addnA -doubleD addnCA def_a addSnnS def_k1 -(addnC k) -mulnSr. by rewrite -[_.*2.+1]/p mulnDl doubleD addnA -mul2n mulnA mul2n -mulSn. have next_pm: lb_dvd p.+2 m. rewrite /lb_dvd /index_iota (addKn 2) -(subnK lt1p) iotaD has_cat. apply/norP; split; rewrite //= orbF subnKC // orbC. apply/norP; split; apply/dvdnP=> [[q def_q]]. case/hasP: leppm; exists 2; first by rewrite /p -(subnKC lt0k). by rewrite /= def_q dvdn_mull // dvdn2 /= odd_double. move/(congr1 (dvdn p)): def_m; rewrite -!mul2n mulnA -mulnDl. rewrite dvdn_mull // dvdn_addr; last by rewrite def_q dvdn_mull. case/dvdnP=> r; rewrite mul2n => def_r; move: ltdp (congr1 odd def_r). rewrite odd_double -ltn_double def_r -mul2n ltn_pmul2r //. by case: r def_r => [|[|[]]] //; rewrite def_d // mul1n /= odd_double. apply: apd_ok => //; case: a' def_a le_a_n => [|a'] def_a => [_ | lta] /=. rewrite /pd_ok /= /pfactor expn1 muln1 /pd_ord /= ltpm /pf_ok !andbT /=. split=> //; apply: contra next_pm. case/hasP=> q; rewrite mem_index_iota => /andP[lt1q ltqm] dvqm; apply/hasP. have [ltqp | lepq] := ltnP q p.+2. by exists q; rewrite // mem_index_iota lt1q. case/dvdnP: dvqm => r def_r; exists r; last by rewrite def_r /= dvdn_mulr. rewrite mem_index_iota -(ltn_pmul2r (ltnW lt1q)) -def_r mul1n ltqm /=. rewrite -(@ltn_pmul2l p.+2) //; apply: (@leq_ltn_trans m). by rewrite def_r mulnC leq_mul. rewrite -addn2 mulnn sqrnD mul2n muln2 -addnn addnACA. by rewrite def_a mul1n in def_m; rewrite -def_m addnS /= ltnS -addnA leq_addr. set bc := ifnz _ _ _; apply: leq_pd_ok (leqnSn _) _. rewrite -doubleS -{1}[m]mul1n -[1]/(k.+1.*2.+1 ^ 0)%N. apply: IHn; first exact: ltnW. rewrite doubleS -/p [ifnz 0 _ _]/=; do 2?split => //. rewrite orbT next_pm /= -(leq_add2r d.*2) def_m 2!addSnnS -doubleS leq_add. - move: ltc; rewrite /kb {}/bc andbT; case e => //= e' _; case: ifnzP => //. by case: edivn2P. - by rewrite -[p in p < _]muln1 ltn_pmul2l. by rewrite leq_double def_a mulSn (leq_trans ltdp) ?leq_addr. rewrite mulnDl !muln2 -addnA addnCA doubleD addnCA. rewrite (_ : _ + bc.2 = d); last first. rewrite /d {}/bc /kb -muln2. case: (e) (b) def_b' => //= _ []; first by case: edivn2P. by case c; do 2?case; rewrite // mul1n /= muln2. rewrite def_m 3!doubleS addnC -(addn2 p) sqrnD mul2n muln2 -3!addnA. congr (_ + _); rewrite 4!addnS -!doubleD; congr _.*2.+2.+2. by rewrite def_a -add2n mulnDl -addnA -muln2 -mulnDr mul2n. Qed. Lemma primePn n : reflect (n < 2 \/ exists2 d, 1 < d < n & d %| n) (~~ prime n). Proof. rewrite /prime; case: n => [|[|p2]]; try by do 2!left. case: (@prime_decomp_correct p2.+2) => //; rewrite unlock. case: prime_decomp => [|[q [|[|e]]] pd] //=; last first; last by rewrite andbF. rewrite {1}/pfactor 2!expnS -!mulnA /=. case: (_ ^ _ * _) => [|u -> _ /andP[lt1q _]]; first by rewrite !muln0. left; right; exists q; last by rewrite dvdn_mulr. have lt0q := ltnW lt1q; rewrite lt1q -[q in q < _]muln1 ltn_pmul2l //. by rewrite -[2]muln1 leq_mul. rewrite {1}/pfactor expn1; case: pd => [|[r e] pd] /=; last first. case: e => [|e] /=; first by rewrite !andbF. rewrite {1}/pfactor expnS -mulnA. case: (_ ^ _ * _) => [|u -> _ /and3P[lt1q ltqr _]]; first by rewrite !muln0. left; right; exists q; last by rewrite dvdn_mulr. by rewrite lt1q -[q in q < _]mul1n ltn_mul // -[q.+1]muln1 leq_mul. rewrite muln1 !andbT => def_q pr_q lt1q; right=> [[]] // [d]. by rewrite def_q -mem_index_iota => in_d_2q dv_d_q; case/hasP: pr_q; exists d. Qed. Lemma primeP p : reflect (p > 1 /\ forall d, d %| p -> xpred2 1 p d) (prime p). Proof. rewrite -[prime p]negbK; have [npr_p | pr_p] := primePn p. right=> [[lt1p pr_p]]; case: npr_p => [|[d n1pd]]. by rewrite ltnNge lt1p. by move/pr_p=> /orP[] /eqP def_d; rewrite def_d ltnn ?andbF in n1pd. have [lep1 | lt1p] := leqP; first by case: pr_p; left. left; split=> // d dv_d_p; apply/norP=> [[nd1 ndp]]; case: pr_p; right. exists d; rewrite // andbC 2!ltn_neqAle ndp eq_sym nd1. by have lt0p := ltnW lt1p; rewrite dvdn_leq // (dvdn_gt0 lt0p). Qed. Lemma prime_nt_dvdP d p : prime p -> d != 1 -> reflect (d = p) (d %| p). Proof. case/primeP=> _ min_p d_neq1; apply: (iffP idP) => [/min_p|-> //]. by rewrite (negPf d_neq1) /= => /eqP. Qed. Arguments primeP {p}. Arguments primePn {n}. Lemma prime_gt1 p : prime p -> 1 < p. Proof. by case/primeP. Qed. Lemma prime_gt0 p : prime p -> 0 < p. Proof. by move/prime_gt1; apply: ltnW. Qed. Hint Resolve prime_gt1 prime_gt0 : core. Lemma prod_prime_decomp n : n > 0 -> n = \prod_(f <- prime_decomp n) f.1 ^ f.2. Proof. by case/prime_decomp_correct. Qed. Lemma even_prime p : prime p -> p = 2 \/ odd p. Proof. move=> pr_p; case odd_p: (odd p); [by right | left]. have: 2 %| p by rewrite dvdn2 odd_p. by case/primeP: pr_p => _ dv_p /dv_p/(2 =P p). Qed. Lemma prime_oddPn p : prime p -> reflect (p = 2) (~~ odd p). Proof. by move=> p_pr; apply: (iffP idP) => [|-> //]; case/even_prime: p_pr => ->. Qed. Lemma odd_prime_gt2 p : odd p -> prime p -> p > 2. Proof. by move=> odd_p /prime_gt1; apply: odd_gt2. Qed. Lemma mem_prime_decomp n p e : (p, e) \in prime_decomp n -> [/\ prime p, e > 0 & p ^ e %| n]. Proof. case: (posnP n) => [-> //| /prime_decomp_correct[def_n mem_pd ord_pd pd_pe]]. have /andP[pr_p ->] := allP mem_pd _ pd_pe; split=> //; last first. case/splitPr: pd_pe def_n => pd1 pd2 ->. by rewrite big_cat big_cons /= mulnCA dvdn_mulr. have lt1p: 1 < p. apply: (allP (order_path_min ltn_trans ord_pd)). by apply/mapP; exists (p, e). apply/primeP; split=> // d dv_d_p; apply/norP=> [[nd1 ndp]]. case/hasP: pr_p; exists d => //. rewrite mem_index_iota andbC 2!ltn_neqAle ndp eq_sym nd1. by have lt0p := ltnW lt1p; rewrite dvdn_leq // (dvdn_gt0 lt0p). Qed. Lemma prime_coprime p m : prime p -> coprime p m = ~~ (p %| m). Proof. case/primeP=> p_gt1 p_pr; apply/eqP/negP=> [d1 | ndv_pm]. case/dvdnP=> k def_m; rewrite -(addn0 m) def_m gcdnMDl gcdn0 in d1. by rewrite d1 in p_gt1. by apply: gcdn_def => // d /p_pr /orP[] /eqP->. Qed. Lemma dvdn_prime2 p q : prime p -> prime q -> (p %| q) = (p == q). Proof. move=> pr_p pr_q; apply: negb_inj. by rewrite eqn_dvd negb_and -!prime_coprime // coprime_sym orbb. Qed. Lemma Euclid_dvd1 p : prime p -> (p %| 1) = false. Proof. by rewrite dvdn1; case: eqP => // ->. Qed. Lemma Euclid_dvdM m n p : prime p -> (p %| m * n) = (p %| m) || (p %| n). Proof. move=> pr_p; case dv_pm: (p %| m); first exact: dvdn_mulr. by rewrite Gauss_dvdr // prime_coprime // dv_pm. Qed. Lemma Euclid_dvd_prod (I : Type) (r : seq I) (P : pred I) (f : I -> nat) p : prime p -> p %| \prod_(i <- r | P i) f i = \big[orb/false]_(i <- r | P i) (p %| f i). Proof. move=> pP; apply: big_morph=> [x y|]; [exact: Euclid_dvdM | exact: Euclid_dvd1]. Qed. Lemma Euclid_dvdX m n p : prime p -> (p %| m ^ n) = (p %| m) && (n > 0). Proof. case: n => [|n] pr_p; first by rewrite andbF Euclid_dvd1. by apply: (inv_inj negbK); rewrite !andbT -!prime_coprime // coprime_pexpr. Qed. Lemma mem_primes p n : (p \in primes n) = [&& prime p, n > 0 & p %| n]. Proof. rewrite andbCA; have [-> // | /= n_gt0] := posnP. apply/mapP/andP=> [[[q e]]|[pr_p]] /=. case/mem_prime_decomp=> pr_q e_gt0 /dvdnP [u ->] -> {p}. by rewrite -(prednK e_gt0) expnS mulnCA dvdn_mulr. rewrite [n in _ %| n]prod_prime_decomp // big_seq. apply big_ind => [| u v IHu IHv | [q e] /= mem_qe dv_p_qe]. - by rewrite Euclid_dvd1. - by rewrite Euclid_dvdM // => /orP[]. exists (q, e) => //=; case/mem_prime_decomp: mem_qe => pr_q _ _. by rewrite Euclid_dvdX // dvdn_prime2 // in dv_p_qe; case: eqP dv_p_qe. Qed. Lemma sorted_primes n : sorted ltn (primes n). Proof. by case: (posnP n) => [-> // | /prime_decomp_correct[_ _]]; apply: path_sorted. Qed. Lemma eq_primes m n : (primes m =i primes n) <-> (primes m = primes n). Proof. split=> [eqpr| -> //]. by apply: (irr_sorted_eq ltn_trans ltnn); rewrite ?sorted_primes. Qed. Lemma primes_uniq n : uniq (primes n). Proof. exact: (sorted_uniq ltn_trans ltnn (sorted_primes n)). Qed. (* The smallest prime divisor *) Lemma pi_pdiv n : (pdiv n \in \pi(n)) = (n > 1). Proof. case: n => [|[|n]] //; rewrite /pdiv !inE /primes. have:= prod_prime_decomp (ltn0Sn n.+1); rewrite unlock. by case: prime_decomp => //= pf pd _; rewrite mem_head. Qed. Lemma pdiv_prime n : 1 < n -> prime (pdiv n). Proof. by rewrite -pi_pdiv mem_primes; case/and3P. Qed. Lemma pdiv_dvd n : pdiv n %| n. Proof. by case: n (pi_pdiv n) => [|[|n]] //; rewrite mem_primes=> /and3P[]. Qed. Lemma pi_max_pdiv n : (max_pdiv n \in \pi(n)) = (n > 1). Proof. rewrite !inE -pi_pdiv /max_pdiv /pdiv !inE. by case: (primes n) => //= p ps; rewrite mem_head mem_last. Qed. Lemma max_pdiv_prime n : n > 1 -> prime (max_pdiv n). Proof. by rewrite -pi_max_pdiv mem_primes => /andP[]. Qed. Lemma max_pdiv_dvd n : max_pdiv n %| n. Proof. by case: n (pi_max_pdiv n) => [|[|n]] //; rewrite mem_primes => /andP[]. Qed. Lemma pdiv_leq n : 0 < n -> pdiv n <= n. Proof. by move=> n_gt0; rewrite dvdn_leq // pdiv_dvd. Qed. Lemma max_pdiv_leq n : 0 < n -> max_pdiv n <= n. Proof. by move=> n_gt0; rewrite dvdn_leq // max_pdiv_dvd. Qed. Lemma pdiv_gt0 n : 0 < pdiv n. Proof. by case: n => [|[|n]] //; rewrite prime_gt0 ?pdiv_prime. Qed. Lemma max_pdiv_gt0 n : 0 < max_pdiv n. Proof. by case: n => [|[|n]] //; rewrite prime_gt0 ?max_pdiv_prime. Qed. Hint Resolve pdiv_gt0 max_pdiv_gt0 : core. Lemma pdiv_min_dvd m d : 1 < d -> d %| m -> pdiv m <= d. Proof. case: (posnP m) => [->|mpos] lt1d dv_d_m; first exact: ltnW. rewrite /pdiv; apply: leq_trans (pdiv_leq (ltnW lt1d)). have: pdiv d \in primes m. by rewrite mem_primes mpos pdiv_prime // (dvdn_trans (pdiv_dvd d)). case: (primes m) (sorted_primes m) => //= p pm ord_pm; rewrite inE. by case/predU1P => [-> | /(allP (order_path_min ltn_trans ord_pm)) /ltnW]. Qed. Lemma max_pdiv_max n p : p \in \pi(n) -> p <= max_pdiv n. Proof. rewrite /max_pdiv !inE => n_p. case/splitPr: n_p (sorted_primes n) => p1 p2; rewrite last_cat -cat_rcons /=. rewrite headI /= cat_path -(last_cons 0) -headI last_rcons; case/andP=> _. move/(order_path_min ltn_trans); case/lastP: p2 => //= p2 q. by rewrite all_rcons last_rcons ltn_neqAle -andbA => /and3P[]. Qed. Lemma ltn_pdiv2_prime n : 0 < n -> n < pdiv n ^ 2 -> prime n. Proof. case def_n: n => [|[|n']] // _; rewrite -def_n => lt_n_p2. suffices ->: n = pdiv n by rewrite pdiv_prime ?def_n. apply/eqP; rewrite eqn_leq leqNgt andbC pdiv_leq; last by rewrite def_n. apply/contraL: lt_n_p2 => lt_pm_m; case/dvdnP: (pdiv_dvd n) => q def_q. rewrite -leqNgt [n in _ <= n]def_q leq_pmul2r // pdiv_min_dvd //. by rewrite -[pdiv n]mul1n [n in _ < n]def_q ltn_pmul2r in lt_pm_m. by rewrite def_q dvdn_mulr. Qed. Lemma primePns n : reflect (n < 2 \/ exists p, [/\ prime p, p ^ 2 <= n & p %| n]) (~~ prime n). Proof. apply: (iffP idP) => [npr_p|]; last first. case=> [|[p [pr_p le_p2_n dv_p_n]]]; first by case: n => [|[]]. apply/negP=> pr_n; move: dv_p_n le_p2_n; rewrite dvdn_prime2 //; move/eqP->. by rewrite leqNgt -[n in n < _]muln1 ltn_pmul2l ?prime_gt1 ?prime_gt0. have [lt1p|] := leqP; [right | by left]. exists (pdiv n); rewrite pdiv_dvd pdiv_prime //; split=> //. by case: leqP npr_p => // /ltn_pdiv2_prime -> //; exact: ltnW. Qed. Arguments primePns {n}. Lemma pdivP n : n > 1 -> {p | prime p & p %| n}. Proof. by move=> lt1n; exists (pdiv n); rewrite ?pdiv_dvd ?pdiv_prime. Qed. Lemma primesM m n p : m > 0 -> n > 0 -> (p \in primes (m * n)) = (p \in primes m) || (p \in primes n). Proof. move=> m_gt0 n_gt0; rewrite !mem_primes muln_gt0 m_gt0 n_gt0. by case pr_p: (prime p); rewrite // Euclid_dvdM. Qed. Lemma primesX m n : n > 0 -> primes (m ^ n) = primes m. Proof. case: n => // n _; rewrite expnS; have [-> // | m_gt0] := posnP m. apply/eq_primes => /= p; elim: n => [|n IHn]; first by rewrite muln1. by rewrite primesM ?(expn_gt0, expnS, IHn, orbb, m_gt0). Qed. Lemma primes_prime p : prime p -> primes p = [::p]. Proof. move=> pr_p; apply: (irr_sorted_eq ltn_trans ltnn) => // [|q]. exact: sorted_primes. rewrite mem_seq1 mem_primes prime_gt0 //=. by apply/andP/idP=> [[pr_q q_p] | /eqP-> //]; rewrite -dvdn_prime2. Qed. Lemma coprime_has_primes m n : 0 < m -> 0 < n -> coprime m n = ~~ has (mem (primes m)) (primes n). Proof. move=> m_gt0 n_gt0; apply/eqP/hasPn=> [mn1 p | no_p_mn]. rewrite /= !mem_primes m_gt0 n_gt0 /= => /andP[pr_p p_n]. have:= prime_gt1 pr_p; rewrite pr_p ltnNge -mn1 /=; apply: contra => p_m. by rewrite dvdn_leq ?gcdn_gt0 ?m_gt0 // dvdn_gcd ?p_m. apply/eqP; rewrite eqn_leq gcdn_gt0 m_gt0 andbT leqNgt; apply/negP. move/pdiv_prime; set p := pdiv _ => pr_p. move/implyP: (no_p_mn p); rewrite /= !mem_primes m_gt0 n_gt0 pr_p /=. by rewrite !(dvdn_trans (pdiv_dvd _)) // (dvdn_gcdl, dvdn_gcdr). Qed. Lemma pdiv_id p : prime p -> pdiv p = p. Proof. by move=> p_pr; rewrite /pdiv primes_prime. Qed. Lemma pdiv_pfactor p k : prime p -> pdiv (p ^ k.+1) = p. Proof. by move=> p_pr; rewrite /pdiv primesX ?primes_prime. Qed. (* Primes are unbounded. *) Lemma prime_above m : {p | m < p & prime p}. Proof. have /pdivP[p pr_p p_dv_m1]: 1 < m`! + 1 by rewrite addn1 ltnS fact_gt0. exists p => //; rewrite ltnNge; apply: contraL p_dv_m1 => p_le_m. by rewrite dvdn_addr ?dvdn_fact ?prime_gt0 // gtnNdvd ?prime_gt1. Qed. (* "prime" logarithms and p-parts. *) Fixpoint logn_rec d m r := match r, edivn m d with | r'.+1, (_.+1 as m', 0) => (logn_rec d m' r').+1 | _, _ => 0 end. Definition logn p m := if prime p then logn_rec p m m else 0. Lemma lognE p m : logn p m = if [&& prime p, 0 < m & p %| m] then (logn p (m %/ p)).+1 else 0. Proof. rewrite /logn /dvdn; case p_pr: (prime p) => //. case def_m: m => // [m']; rewrite !andTb [LHS]/= -def_m /divn modn_def. case: edivnP def_m => [[|q] [|r] -> _] // def_m; congr _.+1; rewrite [_.1]/=. have{m def_m}: q < m'. by rewrite -ltnS -def_m addn0 mulnC -{1}[q.+1]mul1n ltn_pmul2r // prime_gt1. elim/ltn_ind: m' {q}q.+1 (ltn0Sn q) => -[_ []|r IHr m] //= m_gt0 le_mr. rewrite -[m in logn_rec _ _ m]prednK //=. case: edivnP => [[|q] [|_] def_q _] //; rewrite addn0 in def_q. have{def_q} lt_qm1: q < m.-1. by rewrite -[q.+1]muln1 -ltnS prednK // def_q ltn_pmul2l // prime_gt1. have{le_mr} le_m1r: m.-1 <= r by rewrite -ltnS prednK. by rewrite (IHr r) ?(IHr m.-1) // (leq_trans lt_qm1). Qed. Lemma logn_gt0 p n : (0 < logn p n) = (p \in primes n). Proof. by rewrite lognE -mem_primes; case: {+}(p \in _). Qed. Lemma ltn_log0 p n : n < p -> logn p n = 0. Proof. by case: n => [|n] ltnp; rewrite lognE ?andbF // gtnNdvd ?andbF. Qed. Lemma logn0 p : logn p 0 = 0. Proof. by rewrite /logn if_same. Qed. Lemma logn1 p : logn p 1 = 0. Proof. by rewrite lognE dvdn1 /= andbC; case: eqP => // ->. Qed. Lemma pfactor_gt0 p n : 0 < p ^ logn p n. Proof. by rewrite expn_gt0 lognE; case: (posnP p) => // ->. Qed. Hint Resolve pfactor_gt0 : core. Lemma pfactor_dvdn p n m : prime p -> m > 0 -> (p ^ n %| m) = (n <= logn p m). Proof. move=> p_pr; elim: n m => [|n IHn] m m_gt0; first exact: dvd1n. rewrite lognE p_pr m_gt0 /=; case dv_pm: (p %| m); last first. apply/dvdnP=> [] [/= q def_m]. by rewrite def_m expnS mulnCA dvdn_mulr in dv_pm. case/dvdnP: dv_pm m_gt0 => q ->{m}; rewrite muln_gt0 => /andP[p_gt0 q_gt0]. by rewrite expnSr dvdn_pmul2r // mulnK // IHn. Qed. Lemma pfactor_dvdnn p n : p ^ logn p n %| n. Proof. case: n => // n; case pr_p: (prime p); first by rewrite pfactor_dvdn. by rewrite lognE pr_p dvd1n. Qed. Lemma logn_prime p q : prime q -> logn p q = (p == q). Proof. move=> pr_q; have q_gt0 := prime_gt0 pr_q; rewrite lognE q_gt0 /=. case pr_p: (prime p); last by case: eqP pr_p pr_q => // -> ->. by rewrite dvdn_prime2 //; case: eqP => // ->; rewrite divnn q_gt0 logn1. Qed. Lemma pfactor_coprime p n : prime p -> n > 0 -> {m | coprime p m & n = m * p ^ logn p n}. Proof. move=> p_pr n_gt0; set k := logn p n. have dv_pk_n: p ^ k %| n by rewrite pfactor_dvdn. exists (n %/ p ^ k); last by rewrite divnK. rewrite prime_coprime // -(@dvdn_pmul2r (p ^ k)) ?expn_gt0 ?prime_gt0 //. by rewrite -expnS divnK // pfactor_dvdn // ltnn. Qed. Lemma pfactorK p n : prime p -> logn p (p ^ n) = n. Proof. move=> p_pr; have pn_gt0: p ^ n > 0 by rewrite expn_gt0 prime_gt0. apply/eqP; rewrite eqn_leq -pfactor_dvdn // dvdnn andbT. by rewrite -(leq_exp2l _ _ (prime_gt1 p_pr)) dvdn_leq // pfactor_dvdn. Qed. Lemma pfactorKpdiv p n : prime p -> logn (pdiv (p ^ n)) (p ^ n) = n. Proof. by case: n => // n p_pr; rewrite pdiv_pfactor ?pfactorK. Qed. Lemma dvdn_leq_log p m n : 0 < n -> m %| n -> logn p m <= logn p n. Proof. move=> n_gt0 dv_m_n; have m_gt0 := dvdn_gt0 n_gt0 dv_m_n. case p_pr: (prime p); last by do 2!rewrite lognE p_pr /=. by rewrite -pfactor_dvdn //; apply: dvdn_trans dv_m_n; rewrite pfactor_dvdn. Qed. Lemma ltn_logl p n : 0 < n -> logn p n < n. Proof. move=> n_gt0; have [p_gt1 | p_le1] := boolP (1 < p). by rewrite (leq_trans (ltn_expl _ p_gt1)) // dvdn_leq ?pfactor_dvdnn. by rewrite lognE (contraNF (@prime_gt1 _)). Qed. Lemma logn_Gauss p m n : coprime p m -> logn p (m * n) = logn p n. Proof. move=> co_pm; case p_pr: (prime p); last by rewrite /logn p_pr. have [-> | n_gt0] := posnP n; first by rewrite muln0. have [m0 | m_gt0] := posnP m; first by rewrite m0 prime_coprime ?dvdn0 in co_pm. have mn_gt0: m * n > 0 by rewrite muln_gt0 m_gt0. apply/eqP; rewrite eqn_leq andbC dvdn_leq_log ?dvdn_mull //. set k := logn p _; have: p ^ k %| m * n by rewrite pfactor_dvdn. by rewrite Gauss_dvdr ?coprimeXl // -pfactor_dvdn. Qed. Lemma logn_coprime p m : coprime p m -> logn p m = 0. Proof. by move=> coprime_pm; rewrite -[m]muln1 logn_Gauss// logn1. Qed. Lemma lognM p m n : 0 < m -> 0 < n -> logn p (m * n) = logn p m + logn p n. Proof. case p_pr: (prime p); last by rewrite /logn p_pr. have xlp := pfactor_coprime p_pr. case/xlp=> m' co_m' def_m /xlp[n' co_n' def_n] {xlp}. rewrite [in LHS]def_m [in LHS]def_n mulnCA -mulnA -expnD !logn_Gauss //. exact: pfactorK. Qed. Lemma lognX p m n : logn p (m ^ n) = n * logn p m. Proof. case p_pr: (prime p); last by rewrite /logn p_pr muln0. elim: n => [|n IHn]; first by rewrite logn1. have [->|m_gt0] := posnP m; first by rewrite exp0n // lognE andbF muln0. by rewrite expnS lognM ?IHn // expn_gt0 m_gt0. Qed. Lemma logn_div p m n : m %| n -> logn p (n %/ m) = logn p n - logn p m. Proof. rewrite dvdn_eq => /eqP def_n. case: (posnP n) => [-> |]; first by rewrite div0n logn0. by rewrite -{1 3}def_n muln_gt0 => /andP[q_gt0 m_gt0]; rewrite lognM ?addnK. Qed. Lemma dvdn_pfactor p d n : prime p -> reflect (exists2 m, m <= n & d = p ^ m) (d %| p ^ n). Proof. move=> p_pr; have pn_gt0: p ^ n > 0 by rewrite expn_gt0 prime_gt0. apply: (iffP idP) => [dv_d_pn|[m le_m_n ->]]; last first. by rewrite -(subnK le_m_n) expnD dvdn_mull. exists (logn p d); first by rewrite -(pfactorK n p_pr) dvdn_leq_log. have d_gt0: d > 0 by apply: dvdn_gt0 dv_d_pn. case: (pfactor_coprime p_pr d_gt0) => q co_p_q def_d. rewrite [LHS]def_d ((q =P 1) _) ?mul1n // -dvdn1. suff: q %| p ^ n * 1 by rewrite Gauss_dvdr // coprime_sym coprimeXl. by rewrite muln1 (dvdn_trans _ dv_d_pn) // def_d dvdn_mulr. Qed. Lemma prime_decompE n : prime_decomp n = [seq (p, logn p n) | p <- primes n]. Proof. case: n => // n; pose f0 := (0, 0); rewrite -map_comp. apply: (@eq_from_nth _ f0) => [|i lt_i_n]; first by rewrite size_map. rewrite (nth_map f0) //; case def_f: (nth _ _ i) => [p e] /=. congr (_, _); rewrite [n.+1]prod_prime_decomp //. have: (p, e) \in prime_decomp n.+1 by rewrite -def_f mem_nth. case/mem_prime_decomp=> pr_p _ _. rewrite (big_nth f0) big_mkord (bigD1 (Ordinal lt_i_n)) //=. rewrite def_f mulnC logn_Gauss ?pfactorK //. apply big_ind => [|m1 m2 com1 com2| [j ltj] /=]; first exact: coprimen1. by rewrite coprimeMr com1. rewrite -val_eqE /= => nji; case def_j: (nth _ _ j) => [q e1] /=. have: (q, e1) \in prime_decomp n.+1 by rewrite -def_j mem_nth. case/mem_prime_decomp=> pr_q e1_gt0 _; rewrite coprime_pexpr //. rewrite prime_coprime // dvdn_prime2 //; apply: contra nji => eq_pq. rewrite -(nth_uniq 0 _ _ (primes_uniq n.+1)) ?size_map //=. by rewrite !(nth_map f0) // def_f def_j /= eq_sym. Qed. (* Some combinatorial formulae. *) Lemma divn_count_dvd d n : n %/ d = \sum_(1 <= i < n.+1) (d %| i). Proof. have [-> | d_gt0] := posnP d; first by rewrite big_add1 divn0 big1. apply: (@addnI (d %| 0)); rewrite -(@big_ltn _ 0 _ 0 _ (dvdn d)) // big_mkord. rewrite (partition_big (fun i : 'I_n.+1 => inord (i %/ d)) 'I_(n %/ d).+1) //=. rewrite dvdn0 add1n -[_.+1 in LHS]card_ord -sum1_card. apply: eq_bigr => [[q ?] _]. rewrite (bigD1 (inord (q * d))) /eq_op /= !inordK ?ltnS -?leq_divRL ?mulnK //. rewrite dvdn_mull ?big1 // => [[i /= ?] /andP[/eqP <- /negPf]]. by rewrite eq_sym dvdn_eq inordK ?ltnS ?leq_div2r // => ->. Qed. Lemma logn_count_dvd p n : prime p -> logn p n = \sum_(1 <= k < n) (p ^ k %| n). Proof. rewrite big_add1 => p_prime; case: n => [|n]; first by rewrite logn0 big_geq. rewrite big_mkord -big_mkcond (eq_bigl _ _ (fun _ => pfactor_dvdn _ _ _)) //=. by rewrite big_ord_narrow ?sum1_card ?card_ord // -ltnS ltn_logl. Qed. (* Truncated real log. *) Definition trunc_log p n := let fix loop n k := if k is k'.+1 then if p <= n then (loop (n %/ p) k').+1 else 0 else 0 in loop n n. Lemma trunc_log_bounds p n : 1 < p -> 0 < n -> let k := trunc_log p n in p ^ k <= n < p ^ k.+1. Proof. rewrite {+}/trunc_log => p_gt1; have p_gt0 := ltnW p_gt1. set loop := (loop in loop n n); set m := n; rewrite [in n in loop m n]/m. have: m <= n by []; elim: n m => [|n IHn] [|m] //= /ltnSE-le_m_n _. have [le_p_n | // ] := leqP p _; rewrite 2!expnSr -leq_divRL -?ltn_divLR //. by apply: IHn; rewrite ?divn_gt0 // -ltnS (leq_trans (ltn_Pdiv _ _)). Qed. Lemma trunc_log_ltn p n : 1 < p -> n < p ^ (trunc_log p n).+1. Proof. have [-> | n_gt0] := posnP n; first by move=> /ltnW; rewrite expn_gt0. by case/trunc_log_bounds/(_ n_gt0)/andP. Qed. Lemma trunc_logP p n : 1 < p -> 0 < n -> p ^ trunc_log p n <= n. Proof. by move=> p_gt1 /(trunc_log_bounds p_gt1)/andP[]. Qed. Lemma trunc_log_max p k j : 1 < p -> p ^ j <= k -> j <= trunc_log p k. Proof. move=> p_gt1 le_pj_k; rewrite -ltnS -(@ltn_exp2l p) //. exact: leq_ltn_trans (trunc_log_ltn _ _). Qed. (* pi- parts *) (* Testing for membership in set of prime factors. *) Canonical nat_pred_pred := Eval hnf in [predType of nat_pred]. Coercion nat_pred_of_nat (p : nat) : nat_pred := pred1 p. Section NatPreds. Variables (n : nat) (pi : nat_pred). Definition negn : nat_pred := [predC pi]. Definition pnat : pred nat := fun m => (m > 0) && all (mem pi) (primes m). Definition partn := \prod_(0 <= p < n.+1 | p \in pi) p ^ logn p n. End NatPreds. Notation "pi ^'" := (negn pi) (at level 2, format "pi ^'") : nat_scope. Notation "pi .-nat" := (pnat pi) (at level 2, format "pi .-nat") : nat_scope. Notation "n `_ pi" := (partn n pi) : nat_scope. Section PnatTheory. Implicit Types (n p : nat) (pi rho : nat_pred). Lemma negnK pi : pi^'^' =i pi. Proof. by move=> p; apply: negbK. Qed. Lemma eq_negn pi1 pi2 : pi1 =i pi2 -> pi1^' =i pi2^'. Proof. by move=> eq_pi n; rewrite 3!inE /= eq_pi. Qed. Lemma eq_piP m n : \pi(m) =i \pi(n) <-> \pi(m) = \pi(n). Proof. rewrite /pi_of; have eqs := irr_sorted_eq ltn_trans ltnn. by split=> [|-> //] /(eqs _ _ (sorted_primes m) (sorted_primes n)) ->. Qed. Lemma part_gt0 pi n : 0 < n`_pi. Proof. exact: prodn_gt0. Qed. Hint Resolve part_gt0 : core. Lemma sub_in_partn pi1 pi2 n : {in \pi(n), {subset pi1 <= pi2}} -> n`_pi1 %| n`_pi2. Proof. move=> pi12; rewrite ![n`__]big_mkcond /=. apply (big_ind2 (fun m1 m2 => m1 %| m2)) => // [*|p _]; first exact: dvdn_mul. rewrite lognE -mem_primes; case: ifP => pi1p; last exact: dvd1n. by case: ifP => pr_p; [rewrite pi12 | rewrite if_same]. Qed. Lemma eq_in_partn pi1 pi2 n : {in \pi(n), pi1 =i pi2} -> n`_pi1 = n`_pi2. Proof. by move=> pi12; apply/eqP; rewrite eqn_dvd ?sub_in_partn // => p /pi12->. Qed. Lemma eq_partn pi1 pi2 n : pi1 =i pi2 -> n`_pi1 = n`_pi2. Proof. by move=> pi12; apply: eq_in_partn => p _. Qed. Lemma partnNK pi n : n`_pi^'^' = n`_pi. Proof. by apply: eq_partn; apply: negnK. Qed. Lemma widen_partn m pi n : n <= m -> n`_pi = \prod_(0 <= p < m.+1 | p \in pi) p ^ logn p n. Proof. move=> le_n_m; rewrite big_mkcond /=. rewrite [n`_pi](big_nat_widen _ _ m.+1) // big_mkcond /=. apply: eq_bigr => p _; rewrite ltnS lognE. by case: and3P => [[_ n_gt0 p_dv_n]|]; rewrite ?if_same // andbC dvdn_leq. Qed. Lemma eq_partn_from_log m n (pi : nat_pred) : 0 < m -> 0 < n -> {in pi, logn^~ m =1 logn^~ n} -> m`_pi = n`_pi. Proof. move=> m0 n0 eq_log; rewrite !(@widen_partn (maxn m n)) ?leq_maxl ?leq_maxr//. by apply: eq_bigr => p /eq_log ->. Qed. Lemma partn0 pi : 0`_pi = 1. Proof. by apply: big1_seq => [] [|n]; rewrite andbC. Qed. Lemma partn1 pi : 1`_pi = 1. Proof. by apply: big1_seq => [] [|[|n]]; rewrite andbC. Qed. Lemma partnM pi m n : m > 0 -> n > 0 -> (m * n)`_pi = m`_pi * n`_pi. Proof. have le_pmul m' n': m' > 0 -> n' <= m' * n' by move/prednK <-; apply: leq_addr. move=> mpos npos; rewrite !(@widen_partn (n * m)) 3?(le_pmul, mulnC) //. rewrite !big_mkord -big_split; apply: eq_bigr => p _ /=. by rewrite lognM // expnD. Qed. Lemma partnX pi m n : (m ^ n)`_pi = m`_pi ^ n. Proof. elim: n => [|n IHn]; first exact: partn1. rewrite expnS; have [->|m_gt0] := posnP m; first by rewrite partn0 exp1n. by rewrite expnS partnM ?IHn // expn_gt0 m_gt0. Qed. Lemma partn_dvd pi m n : n > 0 -> m %| n -> m`_pi %| n`_pi. Proof. move=> n_gt0 dvmn; case/dvdnP: dvmn n_gt0 => q ->{n}. by rewrite muln_gt0 => /andP[q_gt0 m_gt0]; rewrite partnM ?dvdn_mull. Qed. Lemma p_part p n : n`_p = p ^ logn p n. Proof. case (posnP (logn p n)) => [log0 |]. by rewrite log0 [n`_p]big1_seq // => q /andP [/eqP ->]; rewrite log0. rewrite logn_gt0 mem_primes; case/and3P=> _ n_gt0 dv_p_n. have le_p_n: p < n.+1 by rewrite ltnS dvdn_leq. by rewrite [n`_p]big_mkord (big_pred1 (Ordinal le_p_n)). Qed. Lemma p_part_eq1 p n : (n`_p == 1) = (p \notin \pi(n)). Proof. rewrite mem_primes p_part lognE; case: and3P => // [[p_pr _ _]]. by rewrite -dvdn1 pfactor_dvdn // logn1. Qed. Lemma p_part_gt1 p n : (n`_p > 1) = (p \in \pi(n)). Proof. by rewrite ltn_neqAle part_gt0 andbT eq_sym p_part_eq1 negbK. Qed. Lemma primes_part pi n : primes n`_pi = filter (mem pi) (primes n). Proof. have ltnT := ltn_trans; have [->|n_gt0] := posnP n; first by rewrite partn0. apply: (irr_sorted_eq ltnT ltnn); rewrite ?(sorted_primes, sorted_filter) //. move=> p; rewrite mem_filter /= !mem_primes n_gt0 part_gt0 /=. apply/andP/and3P=> [[p_pr] | [pi_p p_pr dv_p_n]]. rewrite /partn; apply big_ind => [|n1 n2 IHn1 IHn2|q pi_q]. - by rewrite dvdn1; case: eqP p_pr => // ->. - by rewrite Euclid_dvdM //; case/orP. rewrite -{1}(expn1 p) pfactor_dvdn // lognX muln_gt0. rewrite logn_gt0 mem_primes n_gt0 - andbA /=; case/and3P=> pr_q dv_q_n. by rewrite logn_prime //; case: eqP => // ->. have le_p_n: p < n.+1 by rewrite ltnS dvdn_leq. rewrite [n`_pi]big_mkord (bigD1 (Ordinal le_p_n)) //= dvdn_mulr //. by rewrite lognE p_pr n_gt0 dv_p_n expnS dvdn_mulr. Qed. Lemma filter_pi_of n m : n < m -> filter \pi(n) (index_iota 0 m) = primes n. Proof. move=> lt_n_m; have ltnT := ltn_trans; apply: (irr_sorted_eq ltnT ltnn). - by rewrite sorted_filter // iota_ltn_sorted. - exact: sorted_primes. move=> p; rewrite mem_filter mem_index_iota /= mem_primes; case: and3P => //. by case=> _ n_gt0 dv_p_n; apply: leq_ltn_trans lt_n_m; apply: dvdn_leq. Qed. Lemma partn_pi n : n > 0 -> n`_\pi(n) = n. Proof. move=> n_gt0; rewrite [RHS]prod_prime_decomp // prime_decompE big_map. by rewrite -[n`__]big_filter filter_pi_of. Qed. Lemma partnT n : n > 0 -> n`_predT = n. Proof. move=> n_gt0; rewrite -[RHS]partn_pi // [RHS]/partn big_mkcond /=. by apply: eq_bigr => p _; rewrite -logn_gt0; case: (logn p _). Qed. Lemma eqn_from_log m n : 0 < m -> 0 < n -> logn^~ m =1 logn^~ n -> m = n. Proof. by move=> ? ? /(@in1W _ predT)/eq_partn_from_log; rewrite !partnT// => ->. Qed. Lemma partnC pi n : n > 0 -> n`_pi * n`_pi^' = n. Proof. move=> n_gt0; rewrite -[RHS]partnT /partn //. do 2!rewrite mulnC big_mkcond /=; rewrite -big_split; apply: eq_bigr => p _ /=. by rewrite mulnC inE /=; case: (p \in pi); rewrite /= (muln1, mul1n). Qed. Lemma dvdn_part pi n : n`_pi %| n. Proof. by case: n => // n; rewrite -{2}[n.+1](@partnC pi) // dvdn_mulr. Qed. Lemma logn_part p m : logn p m`_p = logn p m. Proof. case p_pr: (prime p); first by rewrite p_part pfactorK. by rewrite lognE (lognE p m) p_pr. Qed. Lemma partn_lcm pi m n : m > 0 -> n > 0 -> (lcmn m n)`_pi = lcmn m`_pi n`_pi. Proof. move=> m_gt0 n_gt0; have p_gt0: lcmn m n > 0 by rewrite lcmn_gt0 m_gt0. apply/eqP; rewrite eqn_dvd dvdn_lcm !partn_dvd ?dvdn_lcml ?dvdn_lcmr //. rewrite -(dvdn_pmul2r (part_gt0 pi^' (lcmn m n))) partnC // dvdn_lcm !andbT. rewrite -[m in m %| _](partnC pi m_gt0) andbC -[n in n %| _](partnC pi n_gt0). by rewrite !dvdn_mul ?partn_dvd ?dvdn_lcml ?dvdn_lcmr. Qed. Lemma partn_gcd pi m n : m > 0 -> n > 0 -> (gcdn m n)`_pi = gcdn m`_pi n`_pi. Proof. move=> m_gt0 n_gt0; have p_gt0: gcdn m n > 0 by rewrite gcdn_gt0 m_gt0. apply/eqP; rewrite eqn_dvd dvdn_gcd !partn_dvd ?dvdn_gcdl ?dvdn_gcdr //=. rewrite -(dvdn_pmul2r (part_gt0 pi^' (gcdn m n))) partnC // dvdn_gcd. rewrite -[m in _ %| m](partnC pi m_gt0) andbC -[n in _%| n](partnC pi n_gt0). by rewrite !dvdn_mul ?partn_dvd ?dvdn_gcdl ?dvdn_gcdr. Qed. Lemma partn_biglcm (I : finType) (P : pred I) F pi : (forall i, P i -> F i > 0) -> (\big[lcmn/1%N]_(i | P i) F i)`_pi = \big[lcmn/1%N]_(i | P i) (F i)`_pi. Proof. move=> F_gt0; set m := \big[lcmn/1%N]_(i | P i) F i. have m_gt0: 0 < m by elim/big_ind: m => // p q p_gt0; rewrite lcmn_gt0 p_gt0. apply/eqP; rewrite eqn_dvd andbC; apply/andP; split. by apply/dvdn_biglcmP=> i Pi; rewrite partn_dvd // (@biglcmn_sup _ i). rewrite -(dvdn_pmul2r (part_gt0 pi^' m)) partnC //. apply/dvdn_biglcmP=> i Pi; rewrite -(partnC pi (F_gt0 i Pi)) dvdn_mul //. by rewrite (@biglcmn_sup _ i). by rewrite partn_dvd // (@biglcmn_sup _ i). Qed. Lemma partn_biggcd (I : finType) (P : pred I) F pi : #|SimplPred P| > 0 -> (forall i, P i -> F i > 0) -> (\big[gcdn/0]_(i | P i) F i)`_pi = \big[gcdn/0]_(i | P i) (F i)`_pi. Proof. move=> ntP F_gt0; set d := \big[gcdn/0]_(i | P i) F i. have d_gt0: 0 < d. case/card_gt0P: ntP => i /= Pi; have:= F_gt0 i Pi. rewrite !lt0n -!dvd0n; apply: contra => dv0d. by rewrite (dvdn_trans dv0d) // (@biggcdn_inf _ i). apply/eqP; rewrite eqn_dvd; apply/andP; split. by apply/dvdn_biggcdP=> i Pi; rewrite partn_dvd ?F_gt0 // (@biggcdn_inf _ i). rewrite -(dvdn_pmul2r (part_gt0 pi^' d)) partnC //. apply/dvdn_biggcdP=> i Pi; rewrite -(partnC pi (F_gt0 i Pi)) dvdn_mul //. by rewrite (@biggcdn_inf _ i). by rewrite partn_dvd ?F_gt0 // (@biggcdn_inf _ i). Qed. Lemma logn_gcd p m n : 0 < m -> 0 < n -> logn p (gcdn m n) = minn (logn p m) (logn p n). Proof. move=> m_gt0 n_gt0; case p_pr: (prime p); last by rewrite /logn p_pr. by apply: (@expnI p); rewrite ?prime_gt1// expn_min -!p_part partn_gcd. Qed. Lemma logn_lcm p m n : 0 < m -> 0 < n -> logn p (lcmn m n) = maxn (logn p m) (logn p n). Proof. move=> m_gt0 n_gt0; rewrite /lcmn logn_div ?dvdn_mull ?dvdn_gcdr//. by rewrite lognM// logn_gcd// -addn_min_max addnC addnK. Qed. Lemma sub_in_pnat pi rho n : {in \pi(n), {subset pi <= rho}} -> pi.-nat n -> rho.-nat n. Proof. rewrite /pnat => subpi /andP[-> pi_n]. by apply/allP=> p pr_p; apply: subpi => //; apply: (allP pi_n). Qed. Lemma eq_in_pnat pi rho n : {in \pi(n), pi =i rho} -> pi.-nat n = rho.-nat n. Proof. by move=> eqpi; apply/idP/idP; apply: sub_in_pnat => p /eqpi->. Qed. Lemma eq_pnat pi rho n : pi =i rho -> pi.-nat n = rho.-nat n. Proof. by move=> eqpi; apply: eq_in_pnat => p _. Qed. Lemma pnatNK pi n : pi^'^'.-nat n = pi.-nat n. Proof. exact: eq_pnat (negnK pi). Qed. Lemma pnatI pi rho n : [predI pi & rho].-nat n = pi.-nat n && rho.-nat n. Proof. by rewrite /pnat andbCA all_predI !andbA andbb. Qed. Lemma pnatM pi m n : pi.-nat (m * n) = pi.-nat m && pi.-nat n. Proof. rewrite /pnat muln_gt0 andbCA -andbA andbCA. case: posnP => // n_gt0; case: posnP => //= m_gt0. apply/allP/andP=> [pi_mn | [pi_m pi_n] p]. by split; apply/allP=> p m_p; apply: pi_mn; rewrite primesM // m_p ?orbT. by rewrite primesM // => /orP[]; [apply: (allP pi_m) | apply: (allP pi_n)]. Qed. Lemma pnatX pi m n : pi.-nat (m ^ n) = pi.-nat m || (n == 0). Proof. by case: n => [|n]; rewrite orbC // /pnat expn_gt0 orbC primesX. Qed. Lemma part_pnat pi n : pi.-nat n`_pi. Proof. rewrite /pnat primes_part part_gt0. by apply/allP=> p; rewrite mem_filter => /andP[]. Qed. Lemma pnatE pi p : prime p -> pi.-nat p = (p \in pi). Proof. by move=> pr_p; rewrite /pnat prime_gt0 ?primes_prime //= andbT. Qed. Lemma pnat_id p : prime p -> p.-nat p. Proof. by move=> pr_p; rewrite pnatE ?inE /=. Qed. Lemma coprime_pi' m n : m > 0 -> n > 0 -> coprime m n = \pi(m)^'.-nat n. Proof. by move=> m_gt0 n_gt0; rewrite /pnat n_gt0 all_predC coprime_has_primes. Qed. Lemma pnat_pi n : n > 0 -> \pi(n).-nat n. Proof. by rewrite /pnat => ->; apply/allP. Qed. Lemma pi_of_dvd m n : m %| n -> n > 0 -> {subset \pi(m) <= \pi(n)}. Proof. move=> m_dv_n n_gt0 p; rewrite !mem_primes n_gt0 => /and3P[-> _ p_dv_m]. exact: dvdn_trans p_dv_m m_dv_n. Qed. Lemma pi_ofM m n : m > 0 -> n > 0 -> \pi(m * n) =i [predU \pi(m) & \pi(n)]. Proof. by move=> m_gt0 n_gt0 p; apply: primesM. Qed. Lemma pi_of_part pi n : n > 0 -> \pi(n`_pi) =i [predI \pi(n) & pi]. Proof. by move=> n_gt0 p; rewrite /pi_of primes_part mem_filter andbC. Qed. Lemma pi_of_exp p n : n > 0 -> \pi(p ^ n) = \pi(p). Proof. by move=> n_gt0; rewrite /pi_of primesX. Qed. Lemma pi_of_prime p : prime p -> \pi(p) =i (p : nat_pred). Proof. by move=> pr_p q; rewrite /pi_of primes_prime // mem_seq1. Qed. Lemma p'natEpi p n : n > 0 -> p^'.-nat n = (p \notin \pi(n)). Proof. by case: n => // n _; rewrite /pnat all_predC has_pred1. Qed. Lemma p'natE p n : prime p -> p^'.-nat n = ~~ (p %| n). Proof. case: n => [|n] p_pr; first by case: p p_pr. by rewrite p'natEpi // mem_primes p_pr. Qed. Lemma pnatPpi pi n p : pi.-nat n -> p \in \pi(n) -> p \in pi. Proof. by case/andP=> _ /allP; apply. Qed. Lemma pnat_dvd m n pi : m %| n -> pi.-nat n -> pi.-nat m. Proof. by case/dvdnP=> q ->; rewrite pnatM; case/andP. Qed. Lemma pnat_div m n pi : m %| n -> pi.-nat n -> pi.-nat (n %/ m). Proof. case/dvdnP=> q ->; rewrite pnatM andbC => /andP[]. by case: m => // m _; rewrite mulnK. Qed. Lemma pnat_coprime pi m n : pi.-nat m -> pi^'.-nat n -> coprime m n. Proof. case/andP=> m_gt0 pi_m /andP[n_gt0 pi'_n]; rewrite coprime_has_primes //. by apply/hasPn=> p /(allP pi'_n); apply/contra/allP. Qed. Lemma p'nat_coprime pi m n : pi^'.-nat m -> pi.-nat n -> coprime m n. Proof. by move=> pi'm pi_n; rewrite (pnat_coprime pi'm) ?pnatNK. Qed. Lemma sub_pnat_coprime pi rho m n : {subset rho <= pi^'} -> pi.-nat m -> rho.-nat n -> coprime m n. Proof. by move=> pi'rho pi_m /(sub_in_pnat (in1W pi'rho)); apply: pnat_coprime. Qed. Lemma coprime_partC pi m n : coprime m`_pi n`_pi^'. Proof. by apply: (@pnat_coprime pi); apply: part_pnat. Qed. Lemma pnat_1 pi n : pi.-nat n -> pi^'.-nat n -> n = 1. Proof. by move=> pi_n pi'_n; rewrite -(eqnP (pnat_coprime pi_n pi'_n)) gcdnn. Qed. Lemma part_pnat_id pi n : pi.-nat n -> n`_pi = n. Proof. case/andP=> n_gt0 pi_n; rewrite -[RHS]partnT // /partn big_mkcond /=. apply: eq_bigr=> p _; have [->|] := posnP (logn p n); first by rewrite if_same. by rewrite logn_gt0 => /(allP pi_n)/= ->. Qed. Lemma part_p'nat pi n : pi^'.-nat n -> n`_pi = 1. Proof. case/andP=> n_gt0 pi'_n; apply: big1_seq => p /andP[pi_p _]. by have [-> //|] := posnP (logn p n); rewrite logn_gt0; case/(allP pi'_n)/negP. Qed. Lemma partn_eq1 pi n : n > 0 -> (n`_pi == 1) = pi^'.-nat n. Proof. move=> n_gt0; apply/eqP/idP=> [pi_n_1|]; last exact: part_p'nat. by rewrite -(partnC pi n_gt0) pi_n_1 mul1n part_pnat. Qed. Lemma pnatP pi n : n > 0 -> reflect (forall p, prime p -> p %| n -> p \in pi) (pi.-nat n). Proof. move=> n_gt0; rewrite /pnat n_gt0. apply: (iffP allP) => /= pi_n p => [pr_p p_n|]. by rewrite pi_n // mem_primes pr_p n_gt0. by rewrite mem_primes n_gt0 /=; case/andP; move: p. Qed. Lemma pi_pnat pi p n : p.-nat n -> p \in pi -> pi.-nat n. Proof. move=> p_n pi_p; have [n_gt0 _] := andP p_n. by apply/pnatP=> // q q_pr /(pnatP _ n_gt0 p_n _ q_pr)/eqnP->. Qed. Lemma p_natP p n : p.-nat n -> {k | n = p ^ k}. Proof. by move=> p_n; exists (logn p n); rewrite -p_part part_pnat_id. Qed. Lemma pi'_p'nat pi p n : pi^'.-nat n -> p \in pi -> p^'.-nat n. Proof. by move=> pi'n pi_p; apply: sub_in_pnat pi'n => q _; apply: contraNneq => ->. Qed. Lemma pi_p'nat p pi n : pi.-nat n -> p \in pi^' -> p^'.-nat n. Proof. by move=> pi_n; apply: pi'_p'nat; rewrite pnatNK. Qed. Lemma partn_part pi rho n : {subset pi <= rho} -> n`_rho`_pi = n`_pi. Proof. move=> pi_sub_rho; have [->|n_gt0] := posnP n; first by rewrite !partn0 partn1. rewrite -[in RHS](partnC rho n_gt0) partnM //. suffices: pi^'.-nat n`_rho^' by move/part_p'nat->; rewrite muln1. by apply: sub_in_pnat (part_pnat _ _) => q _; apply/contra/pi_sub_rho. Qed. Lemma partnI pi rho n : n`_[predI pi & rho] = n`_pi`_rho. Proof. rewrite -(@partnC [predI pi & rho] _`_rho) //. symmetry; rewrite 2?partn_part; try by move=> p /andP []. rewrite mulnC part_p'nat ?mul1n // pnatNK pnatI part_pnat andbT. exact: pnat_dvd (dvdn_part _ _) (part_pnat _ _). Qed. Lemma odd_2'nat n : odd n = 2^'.-nat n. Proof. by case: n => // n; rewrite p'natE // dvdn2 negbK. Qed. End PnatTheory. Hint Resolve part_gt0 : core. (************************************) (* Properties of the divisors list. *) (************************************) Lemma divisors_correct n : n > 0 -> [/\ uniq (divisors n), sorted leq (divisors n) & forall d, (d \in divisors n) = (d %| n)]. Proof. move/prod_prime_decomp=> def_n; rewrite {4}def_n {def_n}. have: all prime (primes n) by apply/allP=> p; rewrite mem_primes; case/andP. have:= primes_uniq n; rewrite /primes /divisors; move/prime_decomp: n. elim=> [|[p e] pd] /=; first by split=> // d; rewrite big_nil dvdn1 mem_seq1. rewrite big_cons /=; move: (foldr _ _ pd) => divs. move=> IHpd /andP[npd_p Upd] /andP[pr_p pr_pd]. have lt0p: 0 < p by apply: prime_gt0. have {IHpd Upd}[Udivs Odivs mem_divs] := IHpd Upd pr_pd. have ndivs_p m: p * m \notin divs. suffices: p \notin divs; rewrite !mem_divs. by apply: contra => /dvdnP[n ->]; rewrite mulnCA dvdn_mulr. have ndv_p_1: ~~(p %| 1) by rewrite dvdn1 neq_ltn orbC prime_gt1. rewrite big_seq; elim/big_ind: _ => [//|u v npu npv|[q f] /= pd_qf]. by rewrite Euclid_dvdM //; apply/norP. elim: (f) => // f'; rewrite expnS Euclid_dvdM // orbC negb_or => -> {f'}/=. have pd_q: q \in unzip1 pd by apply/mapP; exists (q, f). by apply: contra npd_p; rewrite dvdn_prime2 // ?(allP pr_pd) // => /eqP->. elim: e => [|e] /=; first by split=> // d; rewrite mul1n. have Tmulp_inj: injective (NatTrec.mul p). by move=> u v /eqP; rewrite !natTrecE eqn_pmul2l // => /eqP. move: (iter e _ _) => divs' [Udivs' Odivs' mem_divs']; split=> [||d]. - rewrite merge_uniq cat_uniq map_inj_uniq // Udivs Udivs' andbT /=. apply/hasP=> [[d dv_d /mapP[d' _ def_d]]]. by case/idPn: dv_d; rewrite def_d natTrecE. - rewrite (merge_sorted leq_total) //; case: (divs') Odivs' => //= d ds. rewrite (@map_path _ _ _ _ leq xpred0) ?has_pred0 // => u v _. by rewrite !natTrecE leq_pmul2l. rewrite mem_merge mem_cat; case dv_d_p: (p %| d). case/dvdnP: dv_d_p => d' ->{d}; rewrite mulnC (negbTE (ndivs_p d')) orbF. rewrite expnS -mulnA dvdn_pmul2l // -mem_divs'. by rewrite -(mem_map Tmulp_inj divs') natTrecE. case pdiv_d: (_ \in _). by case/mapP: pdiv_d dv_d_p => d' _ ->; rewrite natTrecE dvdn_mulr. rewrite mem_divs Gauss_dvdr // coprime_sym. by rewrite coprimeXl ?prime_coprime ?dv_d_p. Qed. Lemma sorted_divisors n : sorted leq (divisors n). Proof. by case: (posnP n) => [-> | /divisors_correct[]]. Qed. Lemma divisors_uniq n : uniq (divisors n). Proof. by case: (posnP n) => [-> | /divisors_correct[]]. Qed. Lemma sorted_divisors_ltn n : sorted ltn (divisors n). Proof. by rewrite ltn_sorted_uniq_leq divisors_uniq sorted_divisors. Qed. Lemma dvdn_divisors d m : 0 < m -> (d %| m) = (d \in divisors m). Proof. by case/divisors_correct. Qed. Lemma divisor1 n : 1 \in divisors n. Proof. by case: n => // n; rewrite -dvdn_divisors // dvd1n. Qed. Lemma divisors_id n : 0 < n -> n \in divisors n. Proof. by move/dvdn_divisors <-. Qed. (* Big sum / product lemmas*) Lemma dvdn_sum d I r (K : pred I) F : (forall i, K i -> d %| F i) -> d %| \sum_(i <- r | K i) F i. Proof. by move=> dF; elim/big_ind: _ => //; apply: dvdn_add. Qed. Lemma dvdn_partP n m : 0 < n -> reflect (forall p, p \in \pi(n) -> n`_p %| m) (n %| m). Proof. move=> n_gt0; apply: (iffP idP) => n_dvd_m => [p _|]. by apply: dvdn_trans n_dvd_m; apply: dvdn_part. have [-> // | m_gt0] := posnP m. rewrite -(partnT n_gt0) -(partnT m_gt0). rewrite !(@widen_partn (m + n)) ?leq_addl ?leq_addr // /in_mem /=. elim/big_ind2: _ => // [* | q _]; first exact: dvdn_mul. have [-> // | ] := posnP (logn q n); rewrite logn_gt0 => q_n. have pr_q: prime q by move: q_n; rewrite mem_primes; case/andP. by have:= n_dvd_m q q_n; rewrite p_part !pfactor_dvdn // pfactorK. Qed. Lemma modn_partP n a b : 0 < n -> reflect (forall p : nat, p \in \pi(n) -> a = b %[mod n`_p]) (a == b %[mod n]). Proof. move=> n_gt0; wlog le_b_a: a b / b <= a. move=> IH; case: (leqP b a) => [|/ltnW] /IH {IH}// IH. by rewrite eq_sym; apply: (iffP IH) => eqab p /eqab. rewrite eqn_mod_dvd //; apply: (iffP (dvdn_partP _ n_gt0)) => eqab p /eqab; by rewrite -eqn_mod_dvd // => /eqP. Qed. (* The Euler totient function *) Lemma totientE n : n > 0 -> totient n = \prod_(p <- primes n) (p.-1 * p ^ (logn p n).-1). Proof. move=> n_gt0; rewrite /totient n_gt0 prime_decompE unlock. by elim: (primes n) => //= [p pr ->]; rewrite !natTrecE. Qed. Lemma totient_gt0 n : (0 < totient n) = (0 < n). Proof. case: n => // n; rewrite totientE // big_seq_cond prodn_cond_gt0 // => p. by rewrite mem_primes muln_gt0 expn_gt0; case: p => [|[|]]. Qed. Lemma totient_pfactor p e : prime p -> e > 0 -> totient (p ^ e) = p.-1 * p ^ e.-1. Proof. move=> p_pr e_gt0; rewrite totientE ?expn_gt0 ?prime_gt0 //. by rewrite primesX // primes_prime // unlock /= muln1 pfactorK. Qed. Lemma totient_prime p : prime p -> totient p = p.-1. Proof. by move=> p_prime; rewrite -{1}[p]expn1 totient_pfactor // muln1. Qed. Lemma totient_coprime m n : coprime m n -> totient (m * n) = totient m * totient n. Proof. move=> co_mn; have [-> //| m_gt0] := posnP m. have [->|n_gt0] := posnP n; first by rewrite !muln0. rewrite !totientE ?muln_gt0 ?m_gt0 //. have /(perm_big _)->: perm_eq (primes (m * n)) (primes m ++ primes n). apply: uniq_perm => [||p]; first exact: primes_uniq. by rewrite cat_uniq !primes_uniq -coprime_has_primes // co_mn. by rewrite mem_cat primesM. rewrite big_cat /= !big_seq. congr (_ * _); apply: eq_bigr => p; rewrite mem_primes => /and3P[_ _ dvp]. rewrite (mulnC m) logn_Gauss //; move: co_mn. by rewrite -(divnK dvp) coprimeMl => /andP[]. rewrite logn_Gauss //; move: co_mn. by rewrite coprime_sym -(divnK dvp) coprimeMl => /andP[]. Qed. Lemma totient_count_coprime n : totient n = \sum_(0 <= d < n) coprime n d. Proof. elim/ltn_ind: n => // n IHn. case: (leqP n 1) => [|lt1n]; first by rewrite unlock; case: (n) => [|[]]. pose p := pdiv n; have p_pr: prime p by apply: pdiv_prime. have p1 := prime_gt1 p_pr; have p0 := ltnW p1. pose np := n`_p; pose np' := n`_p^'. have co_npp': coprime np np' by rewrite coprime_partC. have [n0 np0 np'0]: [/\ n > 0, np > 0 & np' > 0] by rewrite ltnW ?part_gt0. have def_n: n = np * np' by rewrite partnC. have lnp0: 0 < logn p n by rewrite lognE p_pr n0 pdiv_dvd. pose in_mod k (k0 : k > 0) d := Ordinal (ltn_pmod d k0). rewrite {1}def_n totient_coprime // {IHn}(IHn np') ?big_mkord; last first. by rewrite def_n ltn_Pmull // /np p_part -(expn0 p) ltn_exp2l. have ->: totient np = #|[pred d : 'I_np | coprime np d]|. rewrite [np in LHS]p_part totient_pfactor //=; set q := p ^ _. apply: (@addnI (1 * q)); rewrite -mulnDl [1 + _]prednK // mul1n. have def_np: np = p * q by rewrite -expnS prednK // -p_part. pose mulp := [fun d : 'I_q => in_mod _ np0 (p * d)]. rewrite -def_np -{1}[np]card_ord -(cardC (mem (codom mulp))). rewrite card_in_image => [|[d1 ltd1] [d2 ltd2] /= _ _ []]; last first. move/eqP; rewrite def_np -!muln_modr ?modn_small //. by rewrite eqn_pmul2l // => eq_op12; apply/eqP. rewrite card_ord; congr (q + _); apply: eq_card => d /=. rewrite !inE [np in coprime np _]p_part coprime_pexpl ?prime_coprime //. congr (~~ _); apply/codomP/idP=> [[d' -> /=] | /dvdnP[r def_d]]. by rewrite def_np -muln_modr // dvdn_mulr. do [rewrite mulnC; case: d => d ltd /=] in def_d *. have ltr: r < q by rewrite -(ltn_pmul2l p0) -def_np -def_d. by exists (Ordinal ltr); apply: val_inj; rewrite /= -def_d modn_small. pose h (d : 'I_n) := (in_mod _ np0 d, in_mod _ np'0 d). pose h' (d : 'I_np * 'I_np') := in_mod _ n0 (chinese np np' d.1 d.2). rewrite -!big_mkcond -sum_nat_const pair_big (reindex_onto h h') => [|[d d'] _]. apply: eq_bigl => [[d ltd] /=]; rewrite !inE -val_eqE /= andbC !coprime_modr. by rewrite def_n -chinese_mod // -coprimeMl -def_n modn_small ?eqxx. apply/eqP; rewrite /eq_op /= /eq_op /= !modn_dvdm ?dvdn_part //. by rewrite chinese_modl // chinese_modr // !modn_small ?eqxx ?ltn_ord. Qed. Notation "@ 'primes_mul'" := (deprecate primes_mul primesM) (at level 10, only parsing) : fun_scope. Notation "@ 'primes_exp'" := (deprecate primes_exp primesX) (at level 10, only parsing) : fun_scope. Notation primes_mul := (@primes_mul _ _) (only parsing). Notation primes_exp := (fun m => @primes_exp m _) (only parsing). Notation pnat_mul := (deprecate pnat_mul pnatM) (only parsing). Notation pnat_exp := (deprecate pnat_exp pnatX) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/seq.v000066400000000000000000004332761375767750300221120ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat. (******************************************************************************) (* The seq type is the ssreflect type for sequences; it is an alias for the *) (* standard Coq list type. The ssreflect library equips it with many *) (* operations, as well as eqType and predType (and, later, choiceType) *) (* structures. The operations are geared towards reflection: they generally *) (* expect and provide boolean predicates, e.g., the membership predicate *) (* expects an eqType. To avoid any confusion we do not Import the Coq List *) (* module. *) (* As there is no true subtyping in Coq, we don't use a type for non-empty *) (* sequences; rather, we pass explicitly the head and tail of the sequence. *) (* The empty sequence is especially bothersome for subscripting, since it *) (* forces us to pass a default value. This default value can often be hidden *) (* by a notation. *) (* Here is the list of seq operations: *) (* ** Constructors: *) (* seq T == the type of sequences of items of type T. *) (* bitseq == seq bool. *) (* [::], nil, Nil T == the empty sequence (of type T). *) (* x :: s, cons x s, Cons T x s == the sequence x followed by s (of type T). *) (* [:: x] == the singleton sequence. *) (* [:: x_0; ...; x_n] == the explicit sequence of the x_i. *) (* [:: x_0, ..., x_n & s] == the sequence of the x_i, followed by s. *) (* rcons s x == the sequence s, followed by x. *) (* All of the above, except rcons, can be used in patterns. We define a view *) (* lastP and an induction principle last_ind that can be used to decompose *) (* or traverse a sequence in a right to left order. The view lemma lastP has *) (* a dependent family type, so the ssreflect tactic case/lastP: p => [|p' x] *) (* will generate two subgoals in which p has been replaced by [::] and by *) (* rcons p' x, respectively. *) (* ** Factories: *) (* nseq n x == a sequence of n x's. *) (* ncons n x s == a sequence of n x's, followed by s. *) (* seqn n x_0 ... x_n-1 == the sequence of the x_i; can be partially applied. *) (* iota m n == the sequence m, m + 1, ..., m + n - 1. *) (* mkseq f n == the sequence f 0, f 1, ..., f (n - 1). *) (* ** Sequential access: *) (* head x0 s == the head (zero'th item) of s if s is non-empty, else x0. *) (* ohead s == None if s is empty, else Some x when the head of s is x. *) (* behead s == s minus its head, i.e., s' if s = x :: s', else [::]. *) (* last x s == the last element of x :: s (which is non-empty). *) (* belast x s == x :: s minus its last item. *) (* ** Dimensions: *) (* size s == the number of items (length) in s. *) (* shape ss == the sequence of sizes of the items of the sequence of *) (* sequences ss. *) (* ** Random access: *) (* nth x0 s i == the item i of s (numbered from 0), or x0 if s does *) (* not have at least i+1 items (i.e., size x <= i) *) (* s`_i == standard notation for nth x0 s i for a default x0, *) (* e.g., 0 for rings. *) (* set_nth x0 s i y == s where item i has been changed to y; if s does not *) (* have an item i, it is first padded with copies of x0 *) (* to size i+1. *) (* incr_nth s i == the nat sequence s with item i incremented (s is *) (* first padded with 0's to size i+1, if needed). *) (* ** Predicates: *) (* nilp s <=> s is [::]. *) (* := (size s == 0). *) (* x \in s == x appears in s (this requires an eqType for T). *) (* index x s == the first index at which x appears in s, or size s if *) (* x \notin s. *) (* has a s <=> a holds for some item in s, where a is an applicative *) (* bool predicate. *) (* all a s <=> a holds for all items in s. *) (* 'has_aP <-> the view reflect (exists2 x, x \in s & A x) (has a s), *) (* where aP x : reflect (A x) (a x). *) (* 'all_aP <=> the view for reflect {in s, forall x, A x} (all a s). *) (* all2 r s t <=> the (bool) relation r holds for all _respective_ items *) (* in s and t, which must also have the same size, i.e., *) (* for s := [:: x1; ...; x_m] and t := [:: y1; ...; y_n], *) (* the condition [&& r x_1 y_1, ..., r x_n y_n & m == n]. *) (* find p s == the index of the first item in s for which p holds, *) (* or size s if no such item is found. *) (* count p s == the number of items of s for which p holds. *) (* count_mem x s == the multiplicity of x in s, i.e., count (pred1 x) s. *) (* tally s == a tally of s, i.e., a sequence of (item, multiplicity) *) (* pairs for all items in sequence s (without duplicates). *) (* incr_tally bs x == increment the multiplicity of x in the tally bs, or add *) (* x with multiplicity 1 at then end if x is not in bs. *) (* bs \is a wf_tally <=> bs is well-formed tally, with no duplicate items or *) (* null multiplicities. *) (* tally_seq bs == the expansion of a tally bs into a sequence where each *) (* (x, n) pair expands into a sequence of n x's. *) (* constant s <=> all items in s are identical (trivial if s = [::]). *) (* uniq s <=> all the items in s are pairwise different. *) (* subseq s1 s2 <=> s1 is a subsequence of s2, i.e., s1 = mask m s2 for *) (* some m : bitseq (see below). *) (* perm_eq s1 s2 <=> s2 is a permutation of s1, i.e., s1 and s2 have the *) (* items (with the same repetitions), but possibly in a *) (* different order. *) (* perm_eql s1 s2 <-> s1 and s2 behave identically on the left of perm_eq. *) (* perm_eqr s1 s2 <-> s1 and s2 behave identically on the right of perm_eq. *) (* --> These left/right transitive versions of perm_eq make it easier to *) (* chain a sequence of equivalences. *) (* permutations s == a duplicate-free list of all permutations of s. *) (* ** Filtering: *) (* filter p s == the subsequence of s consisting of all the items *) (* for which the (boolean) predicate p holds. *) (* rem x s == the subsequence of s, where the first occurrence *) (* of x has been removed (compare filter (predC1 x) s *) (* where ALL occurrences of x are removed). *) (* undup s == the subsequence of s containing only the first *) (* occurrence of each item in s, i.e., s with all *) (* duplicates removed. *) (* mask m s == the subsequence of s selected by m : bitseq, with *) (* item i of s selected by bit i in m (extra items or *) (* bits are ignored. *) (* ** Surgery: *) (* s1 ++ s2, cat s1 s2 == the concatenation of s1 and s2. *) (* take n s == the sequence containing only the first n items of s *) (* (or all of s if size s <= n). *) (* drop n s == s minus its first n items ([::] if size s <= n) *) (* rot n s == s rotated left n times (or s if size s <= n). *) (* := drop n s ++ take n s *) (* rotr n s == s rotated right n times (or s if size s <= n). *) (* rev s == the (linear time) reversal of s. *) (* catrev s1 s2 == the reversal of s1 followed by s2 (this is the *) (* recursive form of rev). *) (* ** Dependent iterator: for s : seq S and t : S -> seq T *) (* [seq E | x <- s, y <- t] := flatten [seq [seq E | x <- t] | y <- s] *) (* == the sequence of all the f x y, with x and y drawn from *) (* s and t, respectively, in row-major order, *) (* and where t is possibly dependent in elements of s *) (* allpairs_dep f s t := self expanding definition for *) (* [seq f x y | x <- s, y <- t y] *) (* ** Iterators: for s == [:: x_1, ..., x_n], t == [:: y_1, ..., y_m], *) (* allpairs f s t := same as allpairs_dep but where t is non dependent, *) (* i.e. self expanding definition for *) (* [seq f x y | x <- s, y <- t] *) (* := [:: f x_1 y_1; ...; f x_1 y_m; f x_2 y_1; ...; f x_n y_m] *) (* allrel r xs ys := all [pred x | all (r x) ys] xs *) (* == r x y holds whenever x is in xs and y is in ys *) (* all2rel r xs := allrel r xs xs *) (* == the proposition r x y holds for all possible x, y in xs. *) (* map f s == the sequence [:: f x_1, ..., f x_n]. *) (* pmap pf s == the sequence [:: y_i1, ..., y_ik] where i1 < ... < ik, *) (* pf x_i = Some y_i, and pf x_j = None iff j is not in *) (* {i1, ..., ik}. *) (* foldr f a s == the right fold of s by f (i.e., the natural iterator). *) (* := f x_1 (f x_2 ... (f x_n a)) *) (* sumn s == x_1 + (x_2 + ... + (x_n + 0)) (when s : seq nat). *) (* foldl f a s == the left fold of s by f. *) (* := f (f ... (f a x_1) ... x_n-1) x_n *) (* scanl f a s == the sequence of partial accumulators of foldl f a s. *) (* := [:: f a x_1; ...; foldl f a s] *) (* pairmap f a s == the sequence of f applied to consecutive items in a :: s. *) (* := [:: f a x_1; f x_1 x_2; ...; f x_n-1 x_n] *) (* zip s t == itemwise pairing of s and t (dropping any extra items). *) (* := [:: (x_1, y_1); ...; (x_mn, y_mn)] with mn = minn n m. *) (* unzip1 s == [:: (x_1).1; ...; (x_n).1] when s : seq (S * T). *) (* unzip2 s == [:: (x_1).2; ...; (x_n).2] when s : seq (S * T). *) (* flatten s == x_1 ++ ... ++ x_n ++ [::] when s : seq (seq T). *) (* reshape r s == s reshaped into a sequence of sequences whose sizes are *) (* given by r (truncating if s is too long or too short). *) (* := [:: [:: x_1; ...; x_r1]; *) (* [:: x_(r1 + 1); ...; x_(r0 + r1)]; *) (* ...; *) (* [:: x_(r1 + ... + r(k-1) + 1); ...; x_(r0 + ... rk)]] *) (* flatten_index sh r c == the index, in flatten ss, of the item of indexes *) (* (r, c) in any sequence of sequences ss of shape sh *) (* := sh_1 + sh_2 + ... + sh_r + c *) (* reshape_index sh i == the index, in reshape sh s, of the sequence *) (* containing the i-th item of s. *) (* reshape_offset sh i == the offset, in the (reshape_index sh i)-th *) (* sequence of reshape sh s of the i-th item of s *) (* ** Notation for manifest comprehensions: *) (* [seq x <- s | C] := filter (fun x => C) s. *) (* [seq E | x <- s] := map (fun x => E) s. *) (* [seq x <- s | C1 & C2] := [seq x <- s | C1 && C2]. *) (* [seq E | x <- s & C] := [seq E | x <- [seq x | C]]. *) (* --> The above allow optional type casts on the eigenvariables, as in *) (* [seq x : T <- s | C] or [seq E | x : T <- s, y : U <- t]. The cast may be *) (* needed as type inference considers E or C before s. *) (* We are quite systematic in providing lemmas to rewrite any composition *) (* of two operations. "rev", whose simplifications are not natural, is *) (* protected with nosimpl. *) (* ** The following are equivalent: *) (* [<-> P0; P1; ..; Pn] <-> P0, P1, ..., Pn are all equivalent. *) (* := P0 -> P1 -> ... -> Pn -> P0 *) (* if T : [<-> P0; P1; ..; Pn] is such an equivalence, and i, j are in nat *) (* then T i j is a proof of the equivalence Pi <-> Pj between Pi and Pj; *) (* when i (resp. j) is out of bounds, Pi (resp. Pj) defaults to P0. *) (* The tactic tfae splits the goal into n+1 implications to prove. *) (* An example of use can be found in fingraph theorem orbitPcycle. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope seq_scope. Reserved Notation "[ '<->' P0 ; P1 ; .. ; Pn ]" (at level 0, format "[ '<->' '[' P0 ; '/' P1 ; '/' .. ; '/' Pn ']' ]"). Delimit Scope seq_scope with SEQ. Open Scope seq_scope. (* Inductive seq (T : Type) : Type := Nil | Cons of T & seq T. *) Notation seq := list. Bind Scope seq_scope with list. Arguments cons {T%type} x s%SEQ : rename. Arguments nil {T%type} : rename. Notation Cons T := (@cons T) (only parsing). Notation Nil T := (@nil T) (only parsing). (* As :: and ++ are (improperly) declared in Init.datatypes, we only rebind *) (* them here. *) Infix "::" := cons : seq_scope. Notation "[ :: ]" := nil (at level 0, format "[ :: ]") : seq_scope. Notation "[ :: x1 ]" := (x1 :: [::]) (at level 0, format "[ :: x1 ]") : seq_scope. Notation "[ :: x & s ]" := (x :: s) (at level 0, only parsing) : seq_scope. Notation "[ :: x1 , x2 , .. , xn & s ]" := (x1 :: x2 :: .. (xn :: s) ..) (at level 0, format "'[hv' [ :: '[' x1 , '/' x2 , '/' .. , '/' xn ']' '/ ' & s ] ']'" ) : seq_scope. Notation "[ :: x1 ; x2 ; .. ; xn ]" := (x1 :: x2 :: .. [:: xn] ..) (at level 0, format "[ :: '[' x1 ; '/' x2 ; '/' .. ; '/' xn ']' ]" ) : seq_scope. Section Sequences. Variable n0 : nat. (* numerical parameter for take, drop et al *) Variable T : Type. (* must come before the implicit Type *) Variable x0 : T. (* default for head/nth *) Implicit Types x y z : T. Implicit Types m n : nat. Implicit Type s : seq T. Fixpoint size s := if s is _ :: s' then (size s').+1 else 0. Lemma size0nil s : size s = 0 -> s = [::]. Proof. by case: s. Qed. Definition nilp s := size s == 0. Lemma nilP s : reflect (s = [::]) (nilp s). Proof. by case: s => [|x s]; constructor. Qed. Definition ohead s := if s is x :: _ then Some x else None. Definition head s := if s is x :: _ then x else x0. Definition behead s := if s is _ :: s' then s' else [::]. Lemma size_behead s : size (behead s) = (size s).-1. Proof. by case: s. Qed. (* Factories *) Definition ncons n x := iter n (cons x). Definition nseq n x := ncons n x [::]. Lemma size_ncons n x s : size (ncons n x s) = n + size s. Proof. by elim: n => //= n ->. Qed. Lemma size_nseq n x : size (nseq n x) = n. Proof. by rewrite size_ncons addn0. Qed. (* n-ary, dependently typed constructor. *) Fixpoint seqn_type n := if n is n'.+1 then T -> seqn_type n' else seq T. Fixpoint seqn_rec f n : seqn_type n := if n is n'.+1 return seqn_type n then fun x => seqn_rec (fun s => f (x :: s)) n' else f [::]. Definition seqn := seqn_rec id. (* Sequence catenation "cat". *) Fixpoint cat s1 s2 := if s1 is x :: s1' then x :: s1' ++ s2 else s2 where "s1 ++ s2" := (cat s1 s2) : seq_scope. Lemma cat0s s : [::] ++ s = s. Proof. by []. Qed. Lemma cat1s x s : [:: x] ++ s = x :: s. Proof. by []. Qed. Lemma cat_cons x s1 s2 : (x :: s1) ++ s2 = x :: s1 ++ s2. Proof. by []. Qed. Lemma cat_nseq n x s : nseq n x ++ s = ncons n x s. Proof. by elim: n => //= n ->. Qed. Lemma nseqD n1 n2 x : nseq (n1 + n2) x = nseq n1 x ++ nseq n2 x. Proof. by rewrite cat_nseq /nseq /ncons iterD. Qed. Lemma cats0 s : s ++ [::] = s. Proof. by elim: s => //= x s ->. Qed. Lemma catA s1 s2 s3 : s1 ++ s2 ++ s3 = (s1 ++ s2) ++ s3. Proof. by elim: s1 => //= x s1 ->. Qed. Lemma size_cat s1 s2 : size (s1 ++ s2) = size s1 + size s2. Proof. by elim: s1 => //= x s1 ->. Qed. (* last, belast, rcons, and last induction. *) Fixpoint rcons s z := if s is x :: s' then x :: rcons s' z else [:: z]. Lemma rcons_cons x s z : rcons (x :: s) z = x :: rcons s z. Proof. by []. Qed. Lemma cats1 s z : s ++ [:: z] = rcons s z. Proof. by elim: s => //= x s ->. Qed. Fixpoint last x s := if s is x' :: s' then last x' s' else x. Fixpoint belast x s := if s is x' :: s' then x :: (belast x' s') else [::]. Lemma lastI x s : x :: s = rcons (belast x s) (last x s). Proof. by elim: s x => [|y s IHs] x //=; rewrite IHs. Qed. Lemma last_cons x y s : last x (y :: s) = last y s. Proof. by []. Qed. Lemma size_rcons s x : size (rcons s x) = (size s).+1. Proof. by rewrite -cats1 size_cat addnC. Qed. Lemma size_belast x s : size (belast x s) = size s. Proof. by elim: s x => [|y s IHs] x //=; rewrite IHs. Qed. Lemma last_cat x s1 s2 : last x (s1 ++ s2) = last (last x s1) s2. Proof. by elim: s1 x => [|y s1 IHs] x //=; rewrite IHs. Qed. Lemma last_rcons x s z : last x (rcons s z) = z. Proof. by rewrite -cats1 last_cat. Qed. Lemma belast_cat x s1 s2 : belast x (s1 ++ s2) = belast x s1 ++ belast (last x s1) s2. Proof. by elim: s1 x => [|y s1 IHs] x //=; rewrite IHs. Qed. Lemma belast_rcons x s z : belast x (rcons s z) = x :: s. Proof. by rewrite lastI -!cats1 belast_cat. Qed. Lemma cat_rcons x s1 s2 : rcons s1 x ++ s2 = s1 ++ x :: s2. Proof. by rewrite -cats1 -catA. Qed. Lemma rcons_cat x s1 s2 : rcons (s1 ++ s2) x = s1 ++ rcons s2 x. Proof. by rewrite -!cats1 catA. Qed. Variant last_spec : seq T -> Type := | LastNil : last_spec [::] | LastRcons s x : last_spec (rcons s x). Lemma lastP s : last_spec s. Proof. case: s => [|x s]; [left | rewrite lastI; right]. Qed. Lemma last_ind P : P [::] -> (forall s x, P s -> P (rcons s x)) -> forall s, P s. Proof. move=> Hnil Hlast s; rewrite -(cat0s s). elim: s [::] Hnil => [|x s2 IHs] s1 Hs1; first by rewrite cats0. by rewrite -cat_rcons; apply/IHs/Hlast. Qed. (* Sequence indexing. *) Fixpoint nth s n {struct n} := if s is x :: s' then if n is n'.+1 then @nth s' n' else x else x0. Fixpoint set_nth s n y {struct n} := if s is x :: s' then if n is n'.+1 then x :: @set_nth s' n' y else y :: s' else ncons n x0 [:: y]. Lemma nth0 s : nth s 0 = head s. Proof. by []. Qed. Lemma nth_default s n : size s <= n -> nth s n = x0. Proof. by elim: s n => [|x s IHs] []. Qed. Lemma nth_nil n : nth [::] n = x0. Proof. by case: n. Qed. Lemma last_nth x s : last x s = nth (x :: s) (size s). Proof. by elim: s x => [|y s IHs] x /=. Qed. Lemma nth_last s : nth s (size s).-1 = last x0 s. Proof. by case: s => //= x s; rewrite last_nth. Qed. Lemma nth_behead s n : nth (behead s) n = nth s n.+1. Proof. by case: s n => [|x s] [|n]. Qed. Lemma nth_cat s1 s2 n : nth (s1 ++ s2) n = if n < size s1 then nth s1 n else nth s2 (n - size s1). Proof. by elim: s1 n => [|x s1 IHs] []. Qed. Lemma nth_rcons s x n : nth (rcons s x) n = if n < size s then nth s n else if n == size s then x else x0. Proof. by elim: s n => [|y s IHs] [] //=; apply: nth_nil. Qed. Lemma nth_rcons_default s i : nth (rcons s x0) i = nth s i. Proof. by rewrite nth_rcons; case: ltngtP => //[/ltnW ?|->]; rewrite nth_default. Qed. Lemma nth_ncons m x s n : nth (ncons m x s) n = if n < m then x else nth s (n - m). Proof. by elim: m n => [|m IHm] []. Qed. Lemma nth_nseq m x n : nth (nseq m x) n = (if n < m then x else x0). Proof. by elim: m n => [|m IHm] []. Qed. Lemma eq_from_nth s1 s2 : size s1 = size s2 -> (forall i, i < size s1 -> nth s1 i = nth s2 i) -> s1 = s2. Proof. elim: s1 s2 => [|x1 s1 IHs1] [|x2 s2] //= [eq_sz] eq_s12. by rewrite [x1](eq_s12 0) // (IHs1 s2) // => i; apply: (eq_s12 i.+1). Qed. Lemma size_set_nth s n y : size (set_nth s n y) = maxn n.+1 (size s). Proof. rewrite maxnC; elim: s n => [|x s IHs] [|n] //=. - by rewrite size_ncons addn1. - by rewrite IHs maxnSS. Qed. Lemma set_nth_nil n y : set_nth [::] n y = ncons n x0 [:: y]. Proof. by case: n. Qed. Lemma nth_set_nth s n y : nth (set_nth s n y) =1 [eta nth s with n |-> y]. Proof. elim: s n => [|x s IHs] [|n] [|m] //=; rewrite ?nth_nil ?IHs // nth_ncons eqSS. case: ltngtP => // [lt_nm | ->]; last by rewrite subnn. by rewrite nth_default // subn_gt0. Qed. Lemma set_set_nth s n1 y1 n2 y2 (s2 := set_nth s n2 y2) : set_nth (set_nth s n1 y1) n2 y2 = if n1 == n2 then s2 else set_nth s2 n1 y1. Proof. have [-> | ne_n12] := eqVneq. apply: eq_from_nth => [|i _]; first by rewrite !size_set_nth maxnA maxnn. by do 2!rewrite !nth_set_nth /=; case: eqP. apply: eq_from_nth => [|i _]; first by rewrite !size_set_nth maxnCA. by do 2!rewrite !nth_set_nth /=; case: eqP => // ->; case: eqVneq ne_n12. Qed. (* find, count, has, all. *) Section SeqFind. Variable a : pred T. Fixpoint find s := if s is x :: s' then if a x then 0 else (find s').+1 else 0. Fixpoint filter s := if s is x :: s' then if a x then x :: filter s' else filter s' else [::]. Fixpoint count s := if s is x :: s' then a x + count s' else 0. Fixpoint has s := if s is x :: s' then a x || has s' else false. Fixpoint all s := if s is x :: s' then a x && all s' else true. Lemma size_filter s : size (filter s) = count s. Proof. by elim: s => //= x s <-; case (a x). Qed. Lemma has_count s : has s = (0 < count s). Proof. by elim: s => //= x s ->; case (a x). Qed. Lemma count_size s : count s <= size s. Proof. by elim: s => //= x s; case: (a x); last apply: leqW. Qed. Lemma all_count s : all s = (count s == size s). Proof. elim: s => //= x s; case: (a x) => _ //=. by rewrite add0n eqn_leq andbC ltnNge count_size. Qed. Lemma filter_all s : all (filter s). Proof. by elim: s => //= x s IHs; case: ifP => //= ->. Qed. Lemma all_filterP s : reflect (filter s = s) (all s). Proof. apply: (iffP idP) => [| <-]; last exact: filter_all. by elim: s => //= x s IHs /andP[-> Hs]; rewrite IHs. Qed. Lemma filter_id s : filter (filter s) = filter s. Proof. by apply/all_filterP; apply: filter_all. Qed. Lemma has_find s : has s = (find s < size s). Proof. by elim: s => //= x s IHs; case (a x); rewrite ?leqnn. Qed. Lemma find_size s : find s <= size s. Proof. by elim: s => //= x s IHs; case (a x). Qed. Lemma find_cat s1 s2 : find (s1 ++ s2) = if has s1 then find s1 else size s1 + find s2. Proof. by elim: s1 => //= x s1 IHs; case: (a x) => //; rewrite IHs (fun_if succn). Qed. Lemma has_nil : has [::] = false. Proof. by []. Qed. Lemma has_seq1 x : has [:: x] = a x. Proof. exact: orbF. Qed. Lemma has_nseq n x : has (nseq n x) = (0 < n) && a x. Proof. by elim: n => //= n ->; apply: andKb. Qed. Lemma has_seqb (b : bool) x : has (nseq b x) = b && a x. Proof. by rewrite has_nseq lt0b. Qed. Lemma all_nil : all [::] = true. Proof. by []. Qed. Lemma all_seq1 x : all [:: x] = a x. Proof. exact: andbT. Qed. Lemma all_nseq n x : all (nseq n x) = (n == 0) || a x. Proof. by elim: n => //= n ->; apply: orKb. Qed. Lemma all_nseqb (b : bool) x : all (nseq b x) = b ==> a x. Proof. by rewrite all_nseq eqb0 implybE. Qed. Lemma filter_nseq n x : filter (nseq n x) = nseq (a x * n) x. Proof. by elim: n => /= [|n ->]; case: (a x). Qed. Lemma count_nseq n x : count (nseq n x) = a x * n. Proof. by rewrite -size_filter filter_nseq size_nseq. Qed. Lemma find_nseq n x : find (nseq n x) = ~~ a x * n. Proof. by elim: n => /= [|n ->]; case: (a x). Qed. Lemma nth_find s : has s -> a (nth s (find s)). Proof. by elim: s => //= x s IHs; case a_x: (a x). Qed. Lemma before_find s i : i < find s -> a (nth s i) = false. Proof. by elim: s i => //= x s IHs; case: ifP => // a'x [|i] // /(IHs i). Qed. Lemma hasNfind s : ~~ has s -> find s = size s. Proof. by rewrite has_find; case: ltngtP (find_size s). Qed. Lemma filter_cat s1 s2 : filter (s1 ++ s2) = filter s1 ++ filter s2. Proof. by elim: s1 => //= x s1 ->; case (a x). Qed. Lemma filter_rcons s x : filter (rcons s x) = if a x then rcons (filter s) x else filter s. Proof. by rewrite -!cats1 filter_cat /=; case (a x); rewrite /= ?cats0. Qed. Lemma count_cat s1 s2 : count (s1 ++ s2) = count s1 + count s2. Proof. by rewrite -!size_filter filter_cat size_cat. Qed. Lemma has_cat s1 s2 : has (s1 ++ s2) = has s1 || has s2. Proof. by elim: s1 => [|x s1 IHs] //=; rewrite IHs orbA. Qed. Lemma has_rcons s x : has (rcons s x) = a x || has s. Proof. by rewrite -cats1 has_cat has_seq1 orbC. Qed. Lemma all_cat s1 s2 : all (s1 ++ s2) = all s1 && all s2. Proof. by elim: s1 => [|x s1 IHs] //=; rewrite IHs andbA. Qed. Lemma all_rcons s x : all (rcons s x) = a x && all s. Proof. by rewrite -cats1 all_cat all_seq1 andbC. Qed. End SeqFind. Lemma eq_find a1 a2 : a1 =1 a2 -> find a1 =1 find a2. Proof. by move=> Ea; elim=> //= x s IHs; rewrite Ea IHs. Qed. Lemma eq_filter a1 a2 : a1 =1 a2 -> filter a1 =1 filter a2. Proof. by move=> Ea; elim=> //= x s IHs; rewrite Ea IHs. Qed. Lemma eq_count a1 a2 : a1 =1 a2 -> count a1 =1 count a2. Proof. by move=> Ea s; rewrite -!size_filter (eq_filter Ea). Qed. Lemma eq_has a1 a2 : a1 =1 a2 -> has a1 =1 has a2. Proof. by move=> Ea s; rewrite !has_count (eq_count Ea). Qed. Lemma eq_all a1 a2 : a1 =1 a2 -> all a1 =1 all a2. Proof. by move=> Ea s; rewrite !all_count (eq_count Ea). Qed. Lemma all_filter (p q : pred T) xs : all p (filter q xs) = all [pred i | q i ==> p i] xs. Proof. by elim: xs => //= x xs <-; case: (q x). Qed. Section SubPred. Variable (a1 a2 : pred T). Hypothesis s12 : subpred a1 a2. Lemma sub_find s : find a2 s <= find a1 s. Proof. by elim: s => //= x s IHs; case: ifP => // /(contraFF (@s12 x))->. Qed. Lemma sub_has s : has a1 s -> has a2 s. Proof. by rewrite !has_find; apply: leq_ltn_trans (sub_find s). Qed. Lemma sub_count s : count a1 s <= count a2 s. Proof. by elim: s => //= x s; apply: leq_add; case a1x: (a1 x); rewrite // s12. Qed. Lemma sub_all s : all a1 s -> all a2 s. Proof. by rewrite !all_count !eqn_leq !count_size => /leq_trans-> //; apply: sub_count. Qed. End SubPred. Lemma filter_pred0 s : filter pred0 s = [::]. Proof. by elim: s. Qed. Lemma filter_predT s : filter predT s = s. Proof. by elim: s => //= x s ->. Qed. Lemma filter_predI a1 a2 s : filter (predI a1 a2) s = filter a1 (filter a2 s). Proof. by elim: s => //= x s ->; rewrite andbC; case: (a2 x). Qed. Lemma count_pred0 s : count pred0 s = 0. Proof. by rewrite -size_filter filter_pred0. Qed. Lemma count_predT s : count predT s = size s. Proof. by rewrite -size_filter filter_predT. Qed. Lemma count_predUI a1 a2 s : count (predU a1 a2) s + count (predI a1 a2) s = count a1 s + count a2 s. Proof. elim: s => //= x s IHs; rewrite /= addnACA [RHS]addnACA IHs. by case: (a1 x) => //; rewrite addn0. Qed. Lemma count_predC a s : count a s + count (predC a) s = size s. Proof. by elim: s => //= x s IHs; rewrite addnACA IHs; case: (a _). Qed. Lemma count_filter a1 a2 s : count a1 (filter a2 s) = count (predI a1 a2) s. Proof. by rewrite -!size_filter filter_predI. Qed. Lemma has_pred0 s : has pred0 s = false. Proof. by rewrite has_count count_pred0. Qed. Lemma has_predT s : has predT s = (0 < size s). Proof. by rewrite has_count count_predT. Qed. Lemma has_predC a s : has (predC a) s = ~~ all a s. Proof. by elim: s => //= x s ->; case (a x). Qed. Lemma has_predU a1 a2 s : has (predU a1 a2) s = has a1 s || has a2 s. Proof. by elim: s => //= x s ->; rewrite -!orbA; do !bool_congr. Qed. Lemma all_pred0 s : all pred0 s = (size s == 0). Proof. by rewrite all_count count_pred0 eq_sym. Qed. Lemma all_predT s : all predT s. Proof. by rewrite all_count count_predT. Qed. Lemma all_predC a s : all (predC a) s = ~~ has a s. Proof. by elim: s => //= x s ->; case (a x). Qed. Lemma all_predI a1 a2 s : all (predI a1 a2) s = all a1 s && all a2 s. Proof. apply: (can_inj negbK); rewrite negb_and -!has_predC -has_predU. by apply: eq_has => x; rewrite /= negb_and. Qed. (* Surgery: drop, take, rot, rotr. *) Fixpoint drop n s {struct s} := match s, n with | _ :: s', n'.+1 => drop n' s' | _, _ => s end. Lemma drop_behead : drop n0 =1 iter n0 behead. Proof. by elim: n0 => [|n IHn] [|x s] //; rewrite iterSr -IHn. Qed. Lemma drop0 s : drop 0 s = s. Proof. by case: s. Qed. Lemma drop1 : drop 1 =1 behead. Proof. by case=> [|x [|y s]]. Qed. Lemma drop_oversize n s : size s <= n -> drop n s = [::]. Proof. by elim: s n => [|x s IHs] []. Qed. Lemma drop_size s : drop (size s) s = [::]. Proof. by rewrite drop_oversize // leqnn. Qed. Lemma drop_cons x s : drop n0 (x :: s) = if n0 is n.+1 then drop n s else x :: s. Proof. by []. Qed. Lemma size_drop s : size (drop n0 s) = size s - n0. Proof. by elim: s n0 => [|x s IHs] []. Qed. Lemma drop_cat s1 s2 : drop n0 (s1 ++ s2) = if n0 < size s1 then drop n0 s1 ++ s2 else drop (n0 - size s1) s2. Proof. by elim: s1 n0 => [|x s1 IHs] []. Qed. Lemma drop_size_cat n s1 s2 : size s1 = n -> drop n (s1 ++ s2) = s2. Proof. by move <-; elim: s1 => //=; rewrite drop0. Qed. Lemma nconsK n x : cancel (ncons n x) (drop n). Proof. by elim: n => // -[]. Qed. Lemma drop_drop s n1 n2 : drop n1 (drop n2 s) = drop (n1 + n2) s. Proof. by elim: s n2 => // x s ihs [|n2]; rewrite ?drop0 ?addn0 ?addnS /=. Qed. Fixpoint take n s {struct s} := match s, n with | x :: s', n'.+1 => x :: take n' s' | _, _ => [::] end. Lemma take0 s : take 0 s = [::]. Proof. by case: s. Qed. Lemma take_oversize n s : size s <= n -> take n s = s. Proof. by elim: s n => [|x s IHs] [|n] //= /IHs->. Qed. Lemma take_size s : take (size s) s = s. Proof. exact: take_oversize. Qed. Lemma take_cons x s : take n0 (x :: s) = if n0 is n.+1 then x :: (take n s) else [::]. Proof. by []. Qed. Lemma drop_rcons s : n0 <= size s -> forall x, drop n0 (rcons s x) = rcons (drop n0 s) x. Proof. by elim: s n0 => [|y s IHs] []. Qed. Lemma cat_take_drop s : take n0 s ++ drop n0 s = s. Proof. by elim: s n0 => [|x s IHs] [|n] //=; rewrite IHs. Qed. Lemma size_takel s : n0 <= size s -> size (take n0 s) = n0. Proof. by move/subKn; rewrite -size_drop -[in size s](cat_take_drop s) size_cat addnK. Qed. Lemma size_take s : size (take n0 s) = if n0 < size s then n0 else size s. Proof. have [le_sn | lt_ns] := leqP (size s) n0; first by rewrite take_oversize. by rewrite size_takel // ltnW. Qed. Lemma take_cat s1 s2 : take n0 (s1 ++ s2) = if n0 < size s1 then take n0 s1 else s1 ++ take (n0 - size s1) s2. Proof. elim: s1 n0 => [|x s1 IHs] [|n] //=. by rewrite ltnS subSS -(fun_if (cons x)) -IHs. Qed. Lemma take_size_cat n s1 s2 : size s1 = n -> take n (s1 ++ s2) = s1. Proof. by move <-; elim: s1 => [|x s1 IHs]; rewrite ?take0 //= IHs. Qed. Lemma takel_cat s1 s2 : n0 <= size s1 -> take n0 (s1 ++ s2) = take n0 s1. Proof. by rewrite take_cat; case: ltngtP => // ->; rewrite subnn take0 take_size cats0. Qed. Lemma nth_drop s i : nth (drop n0 s) i = nth s (n0 + i). Proof. rewrite -[s in RHS]cat_take_drop nth_cat size_take ltnNge. case: ltnP => [?|le_s_n0]; rewrite ?(leq_trans le_s_n0) ?leq_addr ?addKn //=. by rewrite drop_oversize // !nth_default. Qed. Lemma find_ltn p s i : has p (take i s) -> find p s < i. Proof. by elim: s i => [|y s ihs] [|i]//=; case: (p _) => //= /ihs. Qed. Lemma has_take p s i : has p s -> has p (take i s) = (find p s < i). Proof. by elim: s i => [|y s ihs] [|i]//=; case: (p _) => //= /ihs ->. Qed. Lemma has_take_leq (p : pred T) (s : seq T) i : i <= size s -> has p (take i s) = (find p s < i). Proof. by elim: s i => [|y s ihs] [|i]//=; case: (p _) => //= /ihs ->. Qed. Lemma nth_take i : i < n0 -> forall s, nth (take n0 s) i = nth s i. Proof. move=> lt_i_n0 s; case lt_n0_s: (n0 < size s). by rewrite -[s in RHS]cat_take_drop nth_cat size_take lt_n0_s /= lt_i_n0. by rewrite -[s in LHS]cats0 take_cat lt_n0_s /= cats0. Qed. Lemma take_take i j : i <= j -> forall s, take i (take j s) = take i s. Proof. move=> ij s; elim: s i j ij => [// | a s IHs] [|i] [|j] //=. by rewrite ltnS => /IHs ->. Qed. Lemma take_drop i j s : take i (drop j s) = drop j (take (i + j) s). Proof. by rewrite addnC; elim: s i j => // x s IHs [|i] [|j] /=. Qed. Lemma takeD i j s : take (i + j) s = take i s ++ take j (drop i s). Proof. elim: i j s => [|i IHi] [|j] [|a s] //; first by rewrite take0 addn0 cats0. by rewrite addSn /= IHi. Qed. Lemma takeC i j s : take i (take j s) = take j (take i s). Proof. wlog i_le_j : i j / i <= j. by move=> Hwlog; case: (leqP i j) => [|/ltnW] /Hwlog ->. rewrite take_take // [RHS]take_oversize // (leq_trans _ i_le_j) //. elim: i s {i_le_j} => [|i IHi] s; first by rewrite take0. by case: s => [|a s]//; rewrite /= ltnS. Qed. Lemma take_nseq i j x : i <= j -> take i (nseq j x) = nseq i x. Proof. by move=>/subnKC <-; rewrite nseqD take_size_cat // size_nseq. Qed. Lemma drop_nseq i j x : drop i (nseq j x) = nseq (j - i) x. Proof. case: (leqP i j) => [/subnKC {1}<-|/ltnW j_le_i]. by rewrite nseqD drop_size_cat // size_nseq. by rewrite drop_oversize ?size_nseq // (eqP j_le_i). Qed. (* drop_nth and take_nth below do NOT use the default n0, because the "n" *) (* can be inferred from the condition, whereas the nth default value x0 *) (* will have to be given explicitly (and this will provide "d" as well). *) Lemma drop_nth n s : n < size s -> drop n s = nth s n :: drop n.+1 s. Proof. by elim: s n => [|x s IHs] [|n] Hn //=; rewrite ?drop0 1?IHs. Qed. Lemma take_nth n s : n < size s -> take n.+1 s = rcons (take n s) (nth s n). Proof. by elim: s n => [|x s IHs] //= [|n] Hn /=; rewrite ?take0 -?IHs. Qed. (* Rotation *) Definition rot n s := drop n s ++ take n s. Lemma rot0 s : rot 0 s = s. Proof. by rewrite /rot drop0 take0 cats0. Qed. Lemma size_rot s : size (rot n0 s) = size s. Proof. by rewrite -[s in RHS]cat_take_drop /rot !size_cat addnC. Qed. Lemma rot_oversize n s : size s <= n -> rot n s = s. Proof. by move=> le_s_n; rewrite /rot take_oversize ?drop_oversize. Qed. Lemma rot_size s : rot (size s) s = s. Proof. exact: rot_oversize. Qed. Lemma has_rot s a : has a (rot n0 s) = has a s. Proof. by rewrite has_cat orbC -has_cat cat_take_drop. Qed. Lemma rot_size_cat s1 s2 : rot (size s1) (s1 ++ s2) = s2 ++ s1. Proof. by rewrite /rot take_size_cat ?drop_size_cat. Qed. Definition rotr n s := rot (size s - n) s. Lemma rotK : cancel (rot n0) (rotr n0). Proof. move=> s; rewrite /rotr size_rot -size_drop {2}/rot. by rewrite rot_size_cat cat_take_drop. Qed. Lemma rot_inj : injective (rot n0). Proof. exact (can_inj rotK). Qed. (* (efficient) reversal *) Fixpoint catrev s1 s2 := if s1 is x :: s1' then catrev s1' (x :: s2) else s2. Definition rev s := catrev s [::]. Lemma catrev_catl s t u : catrev (s ++ t) u = catrev t (catrev s u). Proof. by elim: s u => /=. Qed. Lemma catrev_catr s t u : catrev s (t ++ u) = catrev s t ++ u. Proof. by elim: s t => //= x s IHs t; rewrite -IHs. Qed. Lemma catrevE s t : catrev s t = rev s ++ t. Proof. by rewrite -catrev_catr. Qed. Lemma rev_cons x s : rev (x :: s) = rcons (rev s) x. Proof. by rewrite -cats1 -catrevE. Qed. Lemma size_rev s : size (rev s) = size s. Proof. by elim: s => // x s IHs; rewrite rev_cons size_rcons IHs. Qed. Lemma rev_cat s t : rev (s ++ t) = rev t ++ rev s. Proof. by rewrite -catrev_catr -catrev_catl. Qed. Lemma rev_rcons s x : rev (rcons s x) = x :: rev s. Proof. by rewrite -cats1 rev_cat. Qed. Lemma revK : involutive rev. Proof. by elim=> //= x s IHs; rewrite rev_cons rev_rcons IHs. Qed. Lemma nth_rev n s : n < size s -> nth (rev s) n = nth s (size s - n.+1). Proof. elim/last_ind: s => // s x IHs in n *. rewrite rev_rcons size_rcons ltnS subSS -cats1 nth_cat /=. case: n => [|n] lt_n_s; first by rewrite subn0 ltnn subnn. by rewrite subnSK //= leq_subr IHs. Qed. Lemma filter_rev a s : filter a (rev s) = rev (filter a s). Proof. by elim: s => //= x s IH; rewrite fun_if !rev_cons filter_rcons IH. Qed. Lemma count_rev a s : count a (rev s) = count a s. Proof. by rewrite -!size_filter filter_rev size_rev. Qed. Lemma has_rev a s : has a (rev s) = has a s. Proof. by rewrite !has_count count_rev. Qed. Lemma all_rev a s : all a (rev s) = all a s. Proof. by rewrite !all_count count_rev size_rev. Qed. Lemma rev_nseq n x : rev (nseq n x) = nseq n x. Proof. by elim: n => // n IHn; rewrite -[in LHS]addn1 nseqD rev_cat IHn. Qed. End Sequences. Prenex Implicits size ncons nseq head ohead behead last rcons belast. Arguments seqn {T} n. Prenex Implicits cat take drop rot rotr catrev. Prenex Implicits find count nth all has filter. Arguments rev {T} s : simpl never. Arguments nth : simpl nomatch. Arguments set_nth : simpl nomatch. Arguments take : simpl nomatch. Arguments drop : simpl nomatch. Arguments nilP {T s}. Arguments all_filterP {T a s}. Arguments rotK n0 {T} s : rename. Arguments rot_inj {n0 T} [s1 s2] eq_rot_s12 : rename. Arguments revK {T} s : rename. Notation count_mem x := (count (pred_of_simpl (pred1 x))). Infix "++" := cat : seq_scope. Notation "[ 'seq' x <- s | C ]" := (filter (fun x => C%B) s) (at level 0, x at level 99, format "[ '[hv' 'seq' x <- s '/ ' | C ] ']'") : seq_scope. Notation "[ 'seq' x <- s | C1 & C2 ]" := [seq x <- s | C1 && C2] (at level 0, x at level 99, format "[ '[hv' 'seq' x <- s '/ ' | C1 '/ ' & C2 ] ']'") : seq_scope. Notation "[ 'seq' x : T <- s | C ]" := (filter (fun x : T => C%B) s) (at level 0, x at level 99, only parsing). Notation "[ 'seq' x : T <- s | C1 & C2 ]" := [seq x : T <- s | C1 && C2] (at level 0, x at level 99, only parsing). (* Double induction/recursion. *) Lemma seq_ind2 {S T} (P : seq S -> seq T -> Type) : P [::] [::] -> (forall x y s t, size s = size t -> P s t -> P (x :: s) (y :: t)) -> forall s t, size s = size t -> P s t. Proof. by move=> Pnil Pcons; elim=> [|x s IHs] [|y t] //= [eq_sz]; apply/Pcons/IHs. Qed. Section FindSpec. Variable (T : Type) (a : {pred T}) (s : seq T). Variant find_spec : bool -> nat -> Type := | NotFound of ~~ has a s : find_spec false (size s) | Found (i : nat) of i < size s & (forall x0, a (nth x0 s i)) & (forall x0 j, j < i -> a (nth x0 s j) = false) : find_spec true i. Lemma findP : find_spec (has a s) (find a s). Proof. have [a_s|aNs] := boolP (has a s); last by rewrite hasNfind//; constructor. by constructor=> [|x0|x0]; rewrite -?has_find ?nth_find//; apply: before_find. Qed. End FindSpec. Arguments findP {T}. Section RotRcons. Variable T : Type. Implicit Types (x : T) (s : seq T). Lemma rot1_cons x s : rot 1 (x :: s) = rcons s x. Proof. by rewrite /rot /= take0 drop0 -cats1. Qed. Lemma rcons_inj s1 s2 x1 x2 : rcons s1 x1 = rcons s2 x2 :> seq T -> (s1, x1) = (s2, x2). Proof. by rewrite -!rot1_cons => /rot_inj[-> ->]. Qed. Lemma rcons_injl x : injective (rcons^~ x). Proof. by move=> s1 s2 /rcons_inj[]. Qed. Lemma rcons_injr s : injective (rcons s). Proof. by move=> x1 x2 /rcons_inj[]. Qed. End RotRcons. Arguments rcons_inj {T s1 x1 s2 x2} eq_rcons : rename. Arguments rcons_injl {T} x [s1 s2] eq_rcons : rename. Arguments rcons_injr {T} s [x1 x2] eq_rcons : rename. (* Equality and eqType for seq. *) Section EqSeq. Variables (n0 : nat) (T : eqType) (x0 : T). Local Notation nth := (nth x0). Implicit Types (x y z : T) (s : seq T). Fixpoint eqseq s1 s2 {struct s2} := match s1, s2 with | [::], [::] => true | x1 :: s1', x2 :: s2' => (x1 == x2) && eqseq s1' s2' | _, _ => false end. Lemma eqseqP : Equality.axiom eqseq. Proof. move; elim=> [|x1 s1 IHs] [|x2 s2]; do [by constructor | simpl]. have [<-|neqx] := x1 =P x2; last by right; case. by apply: (iffP (IHs s2)) => [<-|[]]. Qed. Canonical seq_eqMixin := EqMixin eqseqP. Canonical seq_eqType := Eval hnf in EqType (seq T) seq_eqMixin. Lemma eqseqE : eqseq = eq_op. Proof. by []. Qed. Lemma eqseq_cons x1 x2 s1 s2 : (x1 :: s1 == x2 :: s2) = (x1 == x2) && (s1 == s2). Proof. by []. Qed. Lemma eqseq_cat s1 s2 s3 s4 : size s1 = size s2 -> (s1 ++ s3 == s2 ++ s4) = (s1 == s2) && (s3 == s4). Proof. elim: s1 s2 => [|x1 s1 IHs] [|x2 s2] //= [sz12]. by rewrite !eqseq_cons -andbA IHs. Qed. Lemma eqseq_rcons s1 s2 x1 x2 : (rcons s1 x1 == rcons s2 x2) = (s1 == s2) && (x1 == x2). Proof. by rewrite -(can_eq revK) !rev_rcons eqseq_cons andbC (can_eq revK). Qed. Lemma size_eq0 s : (size s == 0) = (s == [::]). Proof. exact: (sameP nilP eqP). Qed. Lemma has_filter a s : has a s = (filter a s != [::]). Proof. by rewrite -size_eq0 size_filter has_count lt0n. Qed. (* mem_seq and index. *) (* mem_seq defines a predType for seq. *) Fixpoint mem_seq (s : seq T) := if s is y :: s' then xpredU1 y (mem_seq s') else xpred0. Definition seq_eqclass := seq T. Identity Coercion seq_of_eqclass : seq_eqclass >-> seq. Coercion pred_of_seq (s : seq_eqclass) : {pred T} := mem_seq s. Canonical seq_predType := PredType (pred_of_seq : seq T -> pred T). (* The line below makes mem_seq a canonical instance of topred. *) Canonical mem_seq_predType := PredType mem_seq. Lemma in_cons y s x : (x \in y :: s) = (x == y) || (x \in s). Proof. by []. Qed. Lemma in_nil x : (x \in [::]) = false. Proof. by []. Qed. Lemma mem_seq1 x y : (x \in [:: y]) = (x == y). Proof. by rewrite in_cons orbF. Qed. (* to be repeated after the Section discharge. *) Let inE := (mem_seq1, in_cons, inE). Lemma mem_seq2 x y z : (x \in [:: y; z]) = xpred2 y z x. Proof. by rewrite !inE. Qed. Lemma mem_seq3 x y z t : (x \in [:: y; z; t]) = xpred3 y z t x. Proof. by rewrite !inE. Qed. Lemma mem_seq4 x y z t u : (x \in [:: y; z; t; u]) = xpred4 y z t u x. Proof. by rewrite !inE. Qed. Lemma mem_cat x s1 s2 : (x \in s1 ++ s2) = (x \in s1) || (x \in s2). Proof. by elim: s1 => //= y s1 IHs; rewrite !inE /= -orbA -IHs. Qed. Lemma mem_rcons s y : rcons s y =i y :: s. Proof. by move=> x; rewrite -cats1 /= mem_cat mem_seq1 orbC in_cons. Qed. Lemma mem_head x s : x \in x :: s. Proof. exact: predU1l. Qed. Lemma mem_last x s : last x s \in x :: s. Proof. by rewrite lastI mem_rcons mem_head. Qed. Lemma mem_behead s : {subset behead s <= s}. Proof. by case: s => // y s x; apply: predU1r. Qed. Lemma mem_belast s y : {subset belast y s <= y :: s}. Proof. by move=> x ys'x; rewrite lastI mem_rcons mem_behead. Qed. Lemma mem_nth s n : n < size s -> nth s n \in s. Proof. by elim: s n => // x s IHs [_|n sz_s]; rewrite ?mem_head // mem_behead ?IHs. Qed. Lemma mem_take s x : x \in take n0 s -> x \in s. Proof. by move=> s0x; rewrite -(cat_take_drop n0 s) mem_cat /= s0x. Qed. Lemma mem_drop s x : x \in drop n0 s -> x \in s. Proof. by move=> s0'x; rewrite -(cat_take_drop n0 s) mem_cat /= s0'x orbT. Qed. Lemma last_eq s z x y : x != y -> z != y -> (last x s == y) = (last z s == y). Proof. by move=> /negPf xz /negPf yz; case: s => [|t s]//; rewrite xz yz. Qed. Section Filters. Implicit Type a : pred T. Lemma hasP {a s} : reflect (exists2 x, x \in s & a x) (has a s). Proof. elim: s => [|y s IHs] /=; first by right; case. have [a_y | a'y] := @idP (a y); first by left; exists y; rewrite ?mem_head. apply: (iffP IHs) => -[x]; first by exists x; first apply: mem_behead. by case/predU1P=> [->|] //; exists x. Qed. Lemma allP {a s} : reflect {in s, forall x, a x} (all a s). Proof. rewrite -[all _ _]negbK -has_predC. apply: (iffP idP) => [s'a' x s_x | a_s]; last by apply/hasP=> /= -[x /a_s->]. by apply: contraR s'a' => a'x; apply/hasP; exists x. Qed. Lemma hasPn a s : reflect {in s, forall x, ~~ a x} (~~ has a s). Proof. by rewrite -all_predC; apply: allP. Qed. Lemma allPn a s : reflect (exists2 x, x \in s & ~~ a x) (~~ all a s). Proof. by rewrite -has_predC; apply: hasP. Qed. Lemma allss s : all (mem s) s. Proof. exact/allP. Qed. Lemma mem_filter a x s : (x \in filter a s) = a x && (x \in s). Proof. rewrite andbC; elim: s => //= y s IHs. rewrite (fun_if (fun s' : seq T => x \in s')) !in_cons {}IHs. by case: eqP => [->|_]; case (a y); rewrite /= ?andbF. Qed. Variables (a : pred T) (s : seq T) (A : T -> Prop). Hypothesis aP : forall x, reflect (A x) (a x). Lemma hasPP : reflect (exists2 x, x \in s & A x) (has a s). Proof. by apply: (iffP hasP) => -[x ? /aP]; exists x. Qed. Lemma allPP : reflect {in s, forall x, A x} (all a s). Proof. by apply: (iffP allP) => a_s x /a_s/aP. Qed. End Filters. Notation "'has_ view" := (hasPP _ (fun _ => view)) (at level 4, right associativity, format "''has_' view"). Notation "'all_ view" := (allPP _ (fun _ => view)) (at level 4, right associativity, format "''all_' view"). Section EqIn. Variables a1 a2 : pred T. Lemma eq_in_filter s : {in s, a1 =1 a2} -> filter a1 s = filter a2 s. Proof. elim: s => //= x s IHs eq_a. by rewrite eq_a ?mem_head ?IHs // => y s_y; apply: eq_a; apply: mem_behead. Qed. Lemma eq_in_find s : {in s, a1 =1 a2} -> find a1 s = find a2 s. Proof. elim: s => //= x s IHs eq_a12; rewrite eq_a12 ?mem_head // IHs // => y s'y. by rewrite eq_a12 // mem_behead. Qed. Lemma eq_in_count s : {in s, a1 =1 a2} -> count a1 s = count a2 s. Proof. by move/eq_in_filter=> eq_a12; rewrite -!size_filter eq_a12. Qed. Lemma eq_in_all s : {in s, a1 =1 a2} -> all a1 s = all a2 s. Proof. by move=> eq_a12; rewrite !all_count eq_in_count. Qed. Lemma eq_in_has s : {in s, a1 =1 a2} -> has a1 s = has a2 s. Proof. by move/eq_in_filter=> eq_a12; rewrite !has_filter eq_a12. Qed. End EqIn. Lemma eq_has_r s1 s2 : s1 =i s2 -> has^~ s1 =1 has^~ s2. Proof. by move=> Es a; apply/hasP/hasP=> -[x sx ax]; exists x; rewrite ?Es in sx *. Qed. Lemma eq_all_r s1 s2 : s1 =i s2 -> all^~ s1 =1 all^~ s2. Proof. by move=> Es a; apply/negb_inj; rewrite -!has_predC (eq_has_r Es). Qed. Lemma has_sym s1 s2 : has (mem s1) s2 = has (mem s2) s1. Proof. by apply/hasP/hasP=> -[x]; exists x. Qed. Lemma has_pred1 x s : has (pred1 x) s = (x \in s). Proof. by rewrite -(eq_has (mem_seq1^~ x)) (has_sym [:: x]) /= orbF. Qed. Lemma mem_rev s : rev s =i s. Proof. by move=> a; rewrite -!has_pred1 has_rev. Qed. (* Constant sequences, i.e., the image of nseq. *) Definition constant s := if s is x :: s' then all (pred1 x) s' else true. Lemma all_pred1P x s : reflect (s = nseq (size s) x) (all (pred1 x) s). Proof. elim: s => [|y s IHs] /=; first by left. case: eqP => [->{y} | ne_xy]; last by right=> [] [? _]; case ne_xy. by apply: (iffP IHs) => [<- //| []]. Qed. Lemma all_pred1_constant x s : all (pred1 x) s -> constant s. Proof. by case: s => //= y s /andP[/eqP->]. Qed. Lemma all_pred1_nseq x n : all (pred1 x) (nseq n x). Proof. by rewrite all_nseq /= eqxx orbT. Qed. Lemma mem_nseq n x y : (y \in nseq n x) = (0 < n) && (y == x). Proof. by rewrite -has_pred1 has_nseq eq_sym. Qed. Lemma nseqP n x y : reflect (y = x /\ n > 0) (y \in nseq n x). Proof. by rewrite mem_nseq andbC; apply: (iffP andP) => -[/eqP]. Qed. Lemma constant_nseq n x : constant (nseq n x). Proof. exact: all_pred1_constant (all_pred1_nseq x n). Qed. (* Uses x0 *) Lemma constantP s : reflect (exists x, s = nseq (size s) x) (constant s). Proof. apply: (iffP idP) => [| [x ->]]; last exact: constant_nseq. case: s => [|x s] /=; first by exists x0. by move/all_pred1P=> def_s; exists x; rewrite -def_s. Qed. (* Duplicate-freenes. *) Fixpoint uniq s := if s is x :: s' then (x \notin s') && uniq s' else true. Lemma cons_uniq x s : uniq (x :: s) = (x \notin s) && uniq s. Proof. by []. Qed. Lemma cat_uniq s1 s2 : uniq (s1 ++ s2) = [&& uniq s1, ~~ has (mem s1) s2 & uniq s2]. Proof. elim: s1 => [|x s1 IHs]; first by rewrite /= has_pred0. by rewrite has_sym /= mem_cat !negb_or has_sym IHs -!andbA; do !bool_congr. Qed. Lemma uniq_catC s1 s2 : uniq (s1 ++ s2) = uniq (s2 ++ s1). Proof. by rewrite !cat_uniq has_sym andbCA andbA andbC. Qed. Lemma uniq_catCA s1 s2 s3 : uniq (s1 ++ s2 ++ s3) = uniq (s2 ++ s1 ++ s3). Proof. by rewrite !catA -!(uniq_catC s3) !(cat_uniq s3) uniq_catC !has_cat orbC. Qed. Lemma rcons_uniq s x : uniq (rcons s x) = (x \notin s) && uniq s. Proof. by rewrite -cats1 uniq_catC. Qed. Lemma filter_uniq s a : uniq s -> uniq (filter a s). Proof. elim: s => //= x s IHs /andP[s'x]; case: ifP => //= a_x /IHs->. by rewrite mem_filter a_x s'x. Qed. Lemma rot_uniq s : uniq (rot n0 s) = uniq s. Proof. by rewrite /rot uniq_catC cat_take_drop. Qed. Lemma rev_uniq s : uniq (rev s) = uniq s. Proof. elim: s => // x s IHs. by rewrite rev_cons -cats1 cat_uniq /= andbT andbC mem_rev orbF IHs. Qed. Lemma count_memPn x s : reflect (count_mem x s = 0) (x \notin s). Proof. by rewrite -has_pred1 has_count -eqn0Ngt; apply: eqP. Qed. Lemma count_uniq_mem s x : uniq s -> count_mem x s = (x \in s). Proof. elim: s => //= y s IHs /andP[/negbTE s'y /IHs-> {IHs}]. by rewrite in_cons; case: (eqVneq y x) => // <-; rewrite s'y. Qed. Lemma leq_uniq_countP x s1 s2 : uniq s1 -> reflect (x \in s1 -> x \in s2) (count_mem x s1 <= count_mem x s2). Proof. move/count_uniq_mem->; case: (boolP (_ \in _)) => //= _; last by constructor. by rewrite -has_pred1 has_count; apply: (iffP idP) => //; apply. Qed. Lemma leq_uniq_count s1 s2 : uniq s1 -> {subset s1 <= s2} -> (forall x, count_mem x s1 <= count_mem x s2). Proof. by move=> s1_uniq s1_s2 x; apply/leq_uniq_countP/s1_s2. Qed. Lemma filter_pred1_uniq s x : uniq s -> x \in s -> filter (pred1 x) s = [:: x]. Proof. move=> uniq_s s_x; rewrite (all_pred1P _ _ (filter_all _ _)). by rewrite size_filter count_uniq_mem ?s_x. Qed. (* Removing duplicates *) Fixpoint undup s := if s is x :: s' then if x \in s' then undup s' else x :: undup s' else [::]. Lemma size_undup s : size (undup s) <= size s. Proof. by elim: s => //= x s IHs; case: (x \in s) => //=; apply: ltnW. Qed. Lemma mem_undup s : undup s =i s. Proof. move=> x; elim: s => //= y s IHs. by case s_y: (y \in s); rewrite !inE IHs //; case: eqP => [->|]. Qed. Lemma undup_uniq s : uniq (undup s). Proof. by elim: s => //= x s IHs; case s_x: (x \in s); rewrite //= mem_undup s_x. Qed. Lemma undup_id s : uniq s -> undup s = s. Proof. by elim: s => //= x s IHs /andP[/negbTE-> /IHs->]. Qed. Lemma ltn_size_undup s : (size (undup s) < size s) = ~~ uniq s. Proof. by elim: s => //= x s IHs; case s_x: (x \in s); rewrite //= ltnS size_undup. Qed. Lemma filter_undup p s : filter p (undup s) = undup (filter p s). Proof. elim: s => //= x s IHs; rewrite (fun_if undup) fun_if /= mem_filter /=. by rewrite (fun_if (filter p)) /= IHs; case: ifP => -> //=; apply: if_same. Qed. Lemma undup_nil s : undup s = [::] -> s = [::]. Proof. by case: s => //= x s; rewrite -mem_undup; case: ifP; case: undup. Qed. Lemma undup_cat s t : undup (s ++ t) = [seq x <- undup s | x \notin t] ++ undup t. Proof. by elim: s => //= x s ->; rewrite mem_cat; do 2 case: in_mem => //=. Qed. Lemma undup_rcons s x : undup (rcons s x) = rcons [seq y <- undup s | y != x] x. Proof. by rewrite -!cats1 undup_cat; congr cat; apply: eq_filter => y; rewrite inE. Qed. (* Lookup *) Definition index x := find (pred1 x). Lemma index_size x s : index x s <= size s. Proof. by rewrite /index find_size. Qed. Lemma index_mem x s : (index x s < size s) = (x \in s). Proof. by rewrite -has_pred1 has_find. Qed. Lemma memNindex x s : x \notin s -> index x s = size s. Proof. by rewrite -has_pred1 => /hasNfind. Qed. Lemma nth_index x s : x \in s -> nth s (index x s) = x. Proof. by rewrite -has_pred1 => /(nth_find x0)/eqP. Qed. Lemma index_cat x s1 s2 : index x (s1 ++ s2) = if x \in s1 then index x s1 else size s1 + index x s2. Proof. by rewrite /index find_cat has_pred1. Qed. Lemma index_ltn x s i : x \in take i s -> index x s < i. Proof. by rewrite -has_pred1; apply: find_ltn. Qed. Lemma in_take x s i : x \in s -> (x \in take i s) = (index x s < i). Proof. by rewrite -?has_pred1; apply: has_take. Qed. Lemma in_take_leq x s i : i <= size s -> (x \in take i s) = (index x s < i). Proof. by rewrite -?has_pred1; apply: has_take_leq. Qed. Lemma nthK s: uniq s -> {in gtn (size s), cancel (nth s) (index^~ s)}. Proof. elim: s => //= x s IHs /andP[s'x Us] i; rewrite inE ltnS eq_sym -if_neg. by case: i => /= [_|i lt_i_s]; rewrite ?eqxx ?IHs ?(memPn s'x) ?mem_nth. Qed. Lemma index_uniq i s : i < size s -> uniq s -> index (nth s i) s = i. Proof. by move/nthK. Qed. Lemma index_head x s : index x (x :: s) = 0. Proof. by rewrite /= eqxx. Qed. Lemma index_last x s : uniq (x :: s) -> index (last x s) (x :: s) = size s. Proof. rewrite lastI rcons_uniq -cats1 index_cat size_belast. by case: ifP => //=; rewrite eqxx addn0. Qed. Lemma nth_uniq s i j : i < size s -> j < size s -> uniq s -> (nth s i == nth s j) = (i == j). Proof. by move=> lti ltj /nthK/can_in_eq->. Qed. Lemma uniqPn s : reflect (exists i j, [/\ i < j, j < size s & nth s i = nth s j]) (~~ uniq s). Proof. apply: (iffP idP) => [|[i [j [ltij ltjs]]]]; last first. by apply: contra_eqN => Us; rewrite nth_uniq ?ltn_eqF // (ltn_trans ltij). elim: s => // x s IHs /nandP[/negbNE | /IHs[i [j]]]; last by exists i.+1, j.+1. by exists 0, (index x s).+1; rewrite !ltnS index_mem /= nth_index. Qed. Lemma uniqP s : reflect {in gtn (size s) &, injective (nth s)} (uniq s). Proof. apply: (iffP idP) => [/nthK/can_in_inj// | nth_inj]. apply/uniqPn => -[i [j [ltij ltjs /nth_inj/eqP/idPn]]]. by rewrite !inE (ltn_trans ltij ltjs) ltn_eqF //=; case. Qed. Lemma mem_rot s : rot n0 s =i s. Proof. by move=> x; rewrite -[s in RHS](cat_take_drop n0) !mem_cat /= orbC. Qed. Lemma eqseq_rot s1 s2 : (rot n0 s1 == rot n0 s2) = (s1 == s2). Proof. exact/inj_eq/rot_inj. Qed. Lemma drop_index s (n := index x0 s) : x0 \in s -> drop n s = x0 :: drop n.+1 s. Proof. by move=> xs; rewrite (drop_nth x0) ?index_mem ?nth_index. Qed. (* lemmas about the pivot pattern [_ ++ _ :: _] *) Lemma index_pivot x s1 s2 (s := s1 ++ x :: s2) : x \notin s1 -> index x s = size s1. Proof. by rewrite index_cat/= eqxx addn0; case: ifPn. Qed. Lemma take_pivot x s2 s1 (s := s1 ++ x :: s2) : x \notin s1 -> take (index x s) s = s1. Proof. by move=> /index_pivot->; rewrite take_size_cat. Qed. Lemma rev_pivot x s1 s2 : rev (s1 ++ x :: s2) = rev s2 ++ x :: rev s1. Proof. by rewrite rev_cat rev_cons cat_rcons. Qed. Lemma eqseq_pivot2l x s1 s2 s3 s4 : x \notin s1 -> x \notin s3 -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. move=> xNs1 xNs3; apply/idP/idP => [E|/andP[/eqP-> /eqP->]//]. suff S : size s1 = size s3 by rewrite eqseq_cat// eqseq_cons eqxx in E. by rewrite -(index_pivot s2 xNs1) (eqP E) index_pivot. Qed. Lemma eqseq_pivot2r x s1 s2 s3 s4 : x \notin s2 -> x \notin s4 -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. move=> xNs2 xNs4; rewrite -(can_eq revK) !rev_pivot. by rewrite eqseq_pivot2l ?mem_rev // !(can_eq revK) andbC. Qed. Lemma eqseq_pivotl x s1 s2 s3 s4 : x \notin s1 -> x \notin s2 -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. move=> xNs1 xNs2; apply/idP/idP => [E|/andP[/eqP-> /eqP->]//]. rewrite -(@eqseq_pivot2l x)//; have /eqP/(congr1 (count_mem x)) := E. rewrite !count_cat/= eqxx !addnS (count_memPn _ _ xNs1) (count_memPn _ _ xNs2). by move=> -[/esym/eqP]; rewrite addn_eq0 => /andP[/eqP/count_memPn]. Qed. Lemma eqseq_pivotr x s1 s2 s3 s4 : x \notin s3 -> x \notin s4 -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. by move=> *; rewrite eq_sym eqseq_pivotl//; case: eqVneq => /=. Qed. Lemma uniq_eqseq_pivotl x s1 s2 s3 s4 : uniq (s1 ++ x :: s2) -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. by rewrite uniq_catC/= mem_cat => /andP[/norP[? ?] _]; rewrite eqseq_pivotl. Qed. Lemma uniq_eqseq_pivotr x s1 s2 s3 s4 : uniq (s3 ++ x :: s4) -> (s1 ++ x :: s2 == s3 ++ x :: s4) = (s1 == s3) && (s2 == s4). Proof. by move=> ?; rewrite eq_sym uniq_eqseq_pivotl//; case: eqVneq => /=. Qed. End EqSeq. Arguments eqseq : simpl nomatch. Section RotIndex. Variables (T : eqType). Implicit Types x y z : T. Lemma rot_index s x (i := index x s) : x \in s -> rot i s = x :: (drop i.+1 s ++ take i s). Proof. by move=> x_s; rewrite /rot drop_index. Qed. Variant rot_to_spec s x := RotToSpec i s' of rot i s = x :: s'. Lemma rot_to s x : x \in s -> rot_to_spec s x. Proof. by move=> /rot_index /RotToSpec. Qed. End RotIndex. Definition inE := (mem_seq1, in_cons, inE). Prenex Implicits mem_seq1 constant uniq undup index. Arguments eqseq {T} !_ !_. Arguments pred_of_seq {T} s x /. Arguments eqseqP {T x y}. Arguments hasP {T a s}. Arguments hasPn {T a s}. Arguments allP {T a s}. Arguments allPn {T a s}. Arguments nseqP {T n x y}. Arguments count_memPn {T x s}. Arguments uniqPn {T} x0 {s}. Arguments uniqP {T} x0 {s}. (* Since both `all (mem s) s` and `all (pred_of_seq s) s` may appear in *) (* goals, the following hint has to be declared using the `Hint Extern` *) (* command. Additionally, `mem` and `pred_of_seq` in the above terms do not *) (* reduce to each other; thus, stating `allss` in the form of one of them *) (* makes `apply: allss` failing for the other case. Since both `mem` and *) (* `pred_of_seq` reduce to `mem_seq`, the following explicit type annotation *) (* for `allss` makes it work for both cases. *) Hint Extern 0 (is_true (all _ _)) => apply: (allss : forall T s, all (mem_seq s) s) : core. Section NthTheory. Lemma nthP (T : eqType) (s : seq T) x x0 : reflect (exists2 i, i < size s & nth x0 s i = x) (x \in s). Proof. apply: (iffP idP) => [|[n Hn <-]]; last exact: mem_nth. by exists (index x s); [rewrite index_mem | apply nth_index]. Qed. Variable T : Type. Lemma has_nthP (a : pred T) s x0 : reflect (exists2 i, i < size s & a (nth x0 s i)) (has a s). Proof. elim: s => [|x s IHs] /=; first by right; case. case nax: (a x); first by left; exists 0. by apply: (iffP IHs) => [[i]|[[|i]]]; [exists i.+1 | rewrite nax | exists i]. Qed. Lemma all_nthP (a : pred T) s x0 : reflect (forall i, i < size s -> a (nth x0 s i)) (all a s). Proof. rewrite -(eq_all (fun x => negbK (a x))) all_predC. case: (has_nthP _ _ x0) => [na_s | a_s]; [right=> a_s | left=> i lti]. by case: na_s => i lti; rewrite a_s. by apply/idPn=> na_si; case: a_s; exists i. Qed. End NthTheory. Lemma set_nth_default T s (y0 x0 : T) n : n < size s -> nth x0 s n = nth y0 s n. Proof. by elim: s n => [|y s' IHs] [|n] //= /IHs. Qed. Lemma headI T s (x : T) : rcons s x = head x s :: behead (rcons s x). Proof. by case: s. Qed. Arguments nthP {T s x}. Arguments has_nthP {T a s}. Arguments all_nthP {T a s}. Definition bitseq := seq bool. Canonical bitseq_eqType := Eval hnf in [eqType of bitseq]. Canonical bitseq_predType := Eval hnf in [predType of bitseq]. (* Generalizations of splitP (from path.v): split_find_nth and split_find *) Section FindNth. Variables (T : Type). Implicit Types (x : T) (p : pred T) (s : seq T). Variant split_find_nth_spec p : seq T -> seq T -> seq T -> T -> Type := FindNth x s1 s2 of p x & ~~ has p s1 : split_find_nth_spec p (rcons s1 x ++ s2) s1 s2 x. Lemma split_find_nth x0 p s (i := find p s) : has p s -> split_find_nth_spec p s (take i s) (drop i.+1 s) (nth x0 s i). Proof. move=> p_s; rewrite -[X in split_find_nth_spec _ X](cat_take_drop i s). rewrite (drop_nth x0 _) -?has_find// -cat_rcons. by constructor; [apply: nth_find | rewrite has_take -?leqNgt]. Qed. Variant split_find_spec p : seq T -> seq T -> seq T -> Type := FindSplit x s1 s2 of p x & ~~ has p s1 : split_find_spec p (rcons s1 x ++ s2) s1 s2. Lemma split_find p s (i := find p s) : has p s -> split_find_spec p s (take i s) (drop i.+1 s). Proof. by case: s => // x ? in i * => ?; case: split_find_nth => //; constructor. Qed. Lemma nth_rcons_cat_find x0 p s1 s2 x (s := rcons s1 x ++ s2) : p x -> ~~ has p s1 -> nth x0 s (find p s) = x. Proof. move=> pz pNs1; rewrite /s cat_rcons find_cat (negPf pNs1). by rewrite nth_cat/= pz addn0 subnn ltnn. Qed. End FindNth. (* Incrementing the ith nat in a seq nat, padding with 0's if needed. This *) (* allows us to use nat seqs as bags of nats. *) Fixpoint incr_nth v i {struct i} := if v is n :: v' then if i is i'.+1 then n :: incr_nth v' i' else n.+1 :: v' else ncons i 0 [:: 1]. Arguments incr_nth : simpl nomatch. Lemma nth_incr_nth v i j : nth 0 (incr_nth v i) j = (i == j) + nth 0 v j. Proof. elim: v i j => [|n v IHv] [|i] [|j] //=; rewrite ?eqSS ?addn0 //; try by case j. elim: i j => [|i IHv] [|j] //=; rewrite ?eqSS //; by case j. Qed. Lemma size_incr_nth v i : size (incr_nth v i) = if i < size v then size v else i.+1. Proof. elim: v i => [|n v IHv] [|i] //=; first by rewrite size_ncons /= addn1. by rewrite IHv; apply: fun_if. Qed. Lemma incr_nth_inj v : injective (incr_nth v). Proof. move=> i j /(congr1 (nth 0 ^~ i)); apply: contra_eq => neq_ij. by rewrite !nth_incr_nth eqn_add2r eqxx /nat_of_bool ifN_eqC. Qed. Lemma incr_nthC v i j : incr_nth (incr_nth v i) j = incr_nth (incr_nth v j) i. Proof. apply: (@eq_from_nth _ 0) => [|k _]; last by rewrite !nth_incr_nth addnCA. by do !rewrite size_incr_nth leqNgt if_neg -/(maxn _ _); apply: maxnAC. Qed. (* Equality up to permutation *) Section PermSeq. Variable T : eqType. Implicit Type s : seq T. Definition perm_eq s1 s2 := all [pred x | count_mem x s1 == count_mem x s2] (s1 ++ s2). Lemma permP s1 s2 : reflect (count^~ s1 =1 count^~ s2) (perm_eq s1 s2). Proof. apply: (iffP allP) => /= [eq_cnt1 a | eq_cnt x _]; last exact/eqP. have [n le_an] := ubnP (count a (s1 ++ s2)); elim: n => // n IHn in a le_an *. have [/eqP|] := posnP (count a (s1 ++ s2)). by rewrite count_cat addn_eq0; do 2!case: eqP => // ->. rewrite -has_count => /hasP[x s12x a_x]; pose a' := predD1 a x. have cnt_a' s: count a s = count_mem x s + count a' s. rewrite -count_predUI -[LHS]addn0 -(count_pred0 s). by congr (_ + _); apply: eq_count => y /=; case: eqP => // ->. rewrite !cnt_a' (eqnP (eq_cnt1 _ s12x)) (IHn a') // -ltnS. apply: leq_trans le_an. by rewrite ltnS cnt_a' -add1n leq_add2r -has_count has_pred1. Qed. Lemma perm_refl s : perm_eq s s. Proof. exact/permP. Qed. Hint Resolve perm_refl : core. Lemma perm_sym : symmetric perm_eq. Proof. by move=> s1 s2; apply/permP/permP=> eq_s12 a. Qed. Lemma perm_trans : transitive perm_eq. Proof. by move=> s2 s1 s3 /permP-eq12 /permP/(ftrans eq12)/permP. Qed. Notation perm_eql s1 s2 := (perm_eq s1 =1 perm_eq s2). Notation perm_eqr s1 s2 := (perm_eq^~ s1 =1 perm_eq^~ s2). Lemma permEl s1 s2 : perm_eql s1 s2 -> perm_eq s1 s2. Proof. by move->. Qed. Lemma permPl s1 s2 : reflect (perm_eql s1 s2) (perm_eq s1 s2). Proof. apply: (iffP idP) => [eq12 s3 | -> //]; apply/idP/idP; last exact: perm_trans. by rewrite -!(perm_sym s3) => /perm_trans; apply. Qed. Lemma permPr s1 s2 : reflect (perm_eqr s1 s2) (perm_eq s1 s2). Proof. by apply/(iffP idP) => [/permPl eq12 s3| <- //]; rewrite !(perm_sym s3) eq12. Qed. Lemma perm_catC s1 s2 : perm_eql (s1 ++ s2) (s2 ++ s1). Proof. by apply/permPl/permP=> a; rewrite !count_cat addnC. Qed. Lemma perm_cat2l s1 s2 s3 : perm_eq (s1 ++ s2) (s1 ++ s3) = perm_eq s2 s3. Proof. apply/permP/permP=> eq23 a; apply/eqP; by move/(_ a)/eqP: eq23; rewrite !count_cat eqn_add2l. Qed. Lemma perm_catl s t1 t2 : perm_eq t1 t2 -> perm_eql (s ++ t1) (s ++ t2). Proof. by move=> eq_t12; apply/permPl; rewrite perm_cat2l. Qed. Lemma perm_cons x s1 s2 : perm_eq (x :: s1) (x :: s2) = perm_eq s1 s2. Proof. exact: (perm_cat2l [::x]). Qed. Lemma perm_cat2r s1 s2 s3 : perm_eq (s2 ++ s1) (s3 ++ s1) = perm_eq s2 s3. Proof. by do 2!rewrite perm_sym perm_catC; apply: perm_cat2l. Qed. Lemma perm_catr s1 s2 t : perm_eq s1 s2 -> perm_eql (s1 ++ t) (s2 ++ t). Proof. by move=> eq_s12; apply/permPl; rewrite perm_cat2r. Qed. Lemma perm_cat s1 s2 t1 t2 : perm_eq s1 s2 -> perm_eq t1 t2 -> perm_eq (s1 ++ t1) (s2 ++ t2). Proof. by move=> /perm_catr-> /perm_catl->. Qed. Lemma perm_catAC s1 s2 s3 : perm_eql ((s1 ++ s2) ++ s3) ((s1 ++ s3) ++ s2). Proof. by apply/permPl; rewrite -!catA perm_cat2l perm_catC. Qed. Lemma perm_catCA s1 s2 s3 : perm_eql (s1 ++ s2 ++ s3) (s2 ++ s1 ++ s3). Proof. by apply/permPl; rewrite !catA perm_cat2r perm_catC. Qed. Lemma perm_catACA s1 s2 s3 s4 : perm_eql ((s1 ++ s2) ++ (s3 ++ s4)) ((s1 ++ s3) ++ (s2 ++ s4)). Proof. by apply/permPl; rewrite perm_catAC !catA perm_catAC. Qed. Lemma perm_rcons x s : perm_eql (rcons s x) (x :: s). Proof. by move=> /= s2; rewrite -cats1 perm_catC. Qed. Lemma perm_rot n s : perm_eql (rot n s) s. Proof. by move=> /= s2; rewrite perm_catC cat_take_drop. Qed. Lemma perm_rotr n s : perm_eql (rotr n s) s. Proof. exact: perm_rot. Qed. Lemma perm_rev s : perm_eql (rev s) s. Proof. by apply/permPl/permP=> i; rewrite count_rev. Qed. Lemma perm_filter s1 s2 a : perm_eq s1 s2 -> perm_eq (filter a s1) (filter a s2). Proof. by move/permP=> s12_count; apply/permP=> Q; rewrite !count_filter. Qed. Lemma perm_filterC a s : perm_eql (filter a s ++ filter (predC a) s) s. Proof. apply/permPl; elim: s => //= x s IHs. by case: (a x); last rewrite /= -cat1s perm_catCA; rewrite perm_cons. Qed. Lemma perm_size s1 s2 : perm_eq s1 s2 -> size s1 = size s2. Proof. by move/permP=> eq12; rewrite -!count_predT eq12. Qed. Lemma perm_mem s1 s2 : perm_eq s1 s2 -> s1 =i s2. Proof. by move/permP=> eq12 x; rewrite -!has_pred1 !has_count eq12. Qed. Lemma perm_nilP s : reflect (s = [::]) (perm_eq s [::]). Proof. by apply: (iffP idP) => [/perm_size/eqP/nilP | ->]. Qed. Lemma perm_consP x s t : reflect (exists i u, rot i t = x :: u /\ perm_eq u s) (perm_eq t (x :: s)). Proof. apply: (iffP idP) => [eq_txs | [i [u [Dt eq_us]]]]. have /rot_to[i u Dt]: x \in t by rewrite (perm_mem eq_txs) mem_head. by exists i, u; rewrite -(perm_cons x) -Dt perm_rot. by rewrite -(perm_rot i) Dt perm_cons. Qed. Lemma perm_has s1 s2 a : perm_eq s1 s2 -> has a s1 = has a s2. Proof. by move/perm_mem/eq_has_r. Qed. Lemma perm_all s1 s2 a : perm_eq s1 s2 -> all a s1 = all a s2. Proof. by move/perm_mem/eq_all_r. Qed. Lemma perm_small_eq s1 s2 : size s2 <= 1 -> perm_eq s1 s2 -> s1 = s2. Proof. move=> s2_le1 eqs12; move/perm_size: eqs12 s2_le1 (perm_mem eqs12). by case: s2 s1 => [|x []] // [|y []] // _ _ /(_ x); rewrite !inE eqxx => /eqP->. Qed. Lemma uniq_leq_size s1 s2 : uniq s1 -> {subset s1 <= s2} -> size s1 <= size s2. Proof. elim: s1 s2 => //= x s1 IHs s2 /andP[not_s1x Us1] /allP/=/andP[s2x /allP ss12]. have [i s3 def_s2] := rot_to s2x; rewrite -(size_rot i s2) def_s2. apply: IHs => // y s1y; have:= ss12 y s1y. by rewrite -(mem_rot i) def_s2 inE (negPf (memPn _ y s1y)). Qed. Lemma leq_size_uniq s1 s2 : uniq s1 -> {subset s1 <= s2} -> size s2 <= size s1 -> uniq s2. Proof. elim: s1 s2 => [[] | x s1 IHs s2] // Us1x; have /andP[not_s1x Us1] := Us1x. case/allP/andP=> /rot_to[i s3 def_s2] /allP ss12 le_s21. rewrite -(rot_uniq i) -(size_rot i) def_s2 /= in le_s21 *. have ss13 y (s1y : y \in s1): y \in s3. by have:= ss12 y s1y; rewrite -(mem_rot i) def_s2 inE (negPf (memPn _ y s1y)). rewrite IHs // andbT; apply: contraL _ le_s21 => s3x; rewrite -leqNgt. by apply/(uniq_leq_size Us1x)/allP; rewrite /= s3x; apply/allP. Qed. Lemma uniq_size_uniq s1 s2 : uniq s1 -> s1 =i s2 -> uniq s2 = (size s2 == size s1). Proof. move=> Us1 eqs12; apply/idP/idP=> [Us2 | /eqP eq_sz12]. by rewrite eqn_leq !uniq_leq_size // => y; rewrite eqs12. by apply: (leq_size_uniq Us1) => [y|]; rewrite (eqs12, eq_sz12). Qed. Lemma uniq_min_size s1 s2 : uniq s1 -> {subset s1 <= s2} -> size s2 <= size s1 -> (size s1 = size s2) * (s1 =i s2). Proof. move=> Us1 ss12 le_s21; have Us2: uniq s2 := leq_size_uniq Us1 ss12 le_s21. suffices: s1 =i s2 by split; first by apply/eqP; rewrite -uniq_size_uniq. move=> x; apply/idP/idP=> [/ss12// | s2x]; apply: contraLR le_s21 => not_s1x. rewrite -ltnNge (@uniq_leq_size (x :: s1)) /= ?not_s1x //. by apply/allP; rewrite /= s2x; apply/allP. Qed. Lemma eq_uniq s1 s2 : size s1 = size s2 -> s1 =i s2 -> uniq s1 = uniq s2. Proof. move=> eq_sz12 eq_s12. by apply/idP/idP=> Us; rewrite (uniq_size_uniq Us) ?eq_sz12 ?eqxx. Qed. Lemma perm_uniq s1 s2 : perm_eq s1 s2 -> uniq s1 = uniq s2. Proof. by move=> eq_s12; apply/eq_uniq; [apply/perm_size | apply/perm_mem]. Qed. Lemma uniq_perm s1 s2 : uniq s1 -> uniq s2 -> s1 =i s2 -> perm_eq s1 s2. Proof. move=> Us1 Us2 eq12; apply/allP=> x _; apply/eqP. by rewrite !count_uniq_mem ?eq12. Qed. Lemma perm_undup s1 s2 : s1 =i s2 -> perm_eq (undup s1) (undup s2). Proof. by move=> Es12; rewrite uniq_perm ?undup_uniq // => s; rewrite !mem_undup. Qed. Lemma count_mem_uniq s : (forall x, count_mem x s = (x \in s)) -> uniq s. Proof. move=> count1_s; have Uus := undup_uniq s. suffices: perm_eq s (undup s) by move/perm_uniq->. by apply/allP=> x _; apply/eqP; rewrite (count_uniq_mem x Uus) mem_undup. Qed. Lemma catCA_perm_ind P : (forall s1 s2 s3, P (s1 ++ s2 ++ s3) -> P (s2 ++ s1 ++ s3)) -> (forall s1 s2, perm_eq s1 s2 -> P s1 -> P s2). Proof. move=> PcatCA s1 s2 eq_s12; rewrite -[s1]cats0 -[s2]cats0. elim: s2 nil => [|x s2 IHs] s3 in s1 eq_s12 *. by case: s1 {eq_s12}(perm_size eq_s12). have /rot_to[i s' def_s1]: x \in s1 by rewrite (perm_mem eq_s12) mem_head. rewrite -(cat_take_drop i s1) -catA => /PcatCA. rewrite catA -/(rot i s1) def_s1 /= -cat1s => /PcatCA/IHs/PcatCA; apply. by rewrite -(perm_cons x) -def_s1 perm_rot. Qed. Lemma catCA_perm_subst R F : (forall s1 s2 s3, F (s1 ++ s2 ++ s3) = F (s2 ++ s1 ++ s3) :> R) -> (forall s1 s2, perm_eq s1 s2 -> F s1 = F s2). Proof. move=> FcatCA s1 s2 /catCA_perm_ind => ind_s12. by apply: (ind_s12 (eq _ \o F)) => //= *; rewrite FcatCA. Qed. End PermSeq. Notation perm_eql s1 s2 := (perm_eq s1 =1 perm_eq s2). Notation perm_eqr s1 s2 := (perm_eq^~ s1 =1 perm_eq^~ s2). Arguments permP {T s1 s2}. Arguments permPl {T s1 s2}. Arguments permPr {T s1 s2}. Prenex Implicits perm_eq. Hint Resolve perm_refl : core. Section RotrLemmas. Variables (n0 : nat) (T : Type) (T' : eqType). Implicit Types (x : T) (s : seq T). Lemma size_rotr s : size (rotr n0 s) = size s. Proof. by rewrite size_rot. Qed. Lemma mem_rotr (s : seq T') : rotr n0 s =i s. Proof. by move=> x; rewrite mem_rot. Qed. Lemma rotr_size_cat s1 s2 : rotr (size s2) (s1 ++ s2) = s2 ++ s1. Proof. by rewrite /rotr size_cat addnK rot_size_cat. Qed. Lemma rotr1_rcons x s : rotr 1 (rcons s x) = x :: s. Proof. by rewrite -rot1_cons rotK. Qed. Lemma has_rotr a s : has a (rotr n0 s) = has a s. Proof. by rewrite has_rot. Qed. Lemma rotr_uniq (s : seq T') : uniq (rotr n0 s) = uniq s. Proof. by rewrite rot_uniq. Qed. Lemma rotrK : cancel (@rotr T n0) (rot n0). Proof. move=> s; have [lt_n0s | ge_n0s] := ltnP n0 (size s). by rewrite -{1}(subKn (ltnW lt_n0s)) -{1}[size s]size_rotr; apply: rotK. by rewrite -[in RHS](rot_oversize ge_n0s) /rotr (eqnP ge_n0s) rot0. Qed. Lemma rotr_inj : injective (@rotr T n0). Proof. exact (can_inj rotrK). Qed. Lemma take_rev s : take n0 (rev s) = rev (drop (size s - n0) s). Proof. set m := _ - n0; rewrite -[s in LHS](cat_take_drop m) rev_cat take_cat. rewrite size_rev size_drop -minnE minnC leq_min ltnn /m. by have [_|/eqnP->] := ltnP; rewrite ?subnn take0 cats0. Qed. Lemma drop_rev s : drop n0 (rev s) = rev (take (size s - n0) s). Proof. set m := _ - n0; rewrite -[s in LHS](cat_take_drop m) rev_cat drop_cat. rewrite size_rev size_drop -minnE minnC leq_min ltnn /m. by have [_|/eqnP->] := ltnP; rewrite ?take0 // subnn drop0. Qed. Lemma rev_rotr s : rev (rotr n0 s) = rot n0 (rev s). Proof. by rewrite rev_cat -take_rev -drop_rev. Qed. Lemma rev_rot s : rev (rot n0 s) = rotr n0 (rev s). Proof. by apply: canLR revK _; rewrite rev_rotr revK. Qed. End RotrLemmas. Arguments rotrK n0 {T} s : rename. Arguments rotr_inj {n0 T} [s1 s2] eq_rotr_s12 : rename. Section RotCompLemmas. Variable T : Type. Implicit Type s : seq T. Lemma rotD m n s : m + n <= size s -> rot (m + n) s = rot m (rot n s). Proof. move=> sz_s; rewrite [LHS]/rot -[take _ s](cat_take_drop n). rewrite 5!(catA, =^~ rot_size_cat) !cat_take_drop. by rewrite size_drop !size_takel ?leq_addl ?addnK. Qed. Lemma rotS n s : n < size s -> rot n.+1 s = rot 1 (rot n s). Proof. exact: (@rotD 1). Qed. Lemma rot_add_mod m n s : n <= size s -> m <= size s -> rot m (rot n s) = rot (if m + n <= size s then m + n else m + n - size s) s. Proof. move=> Hn Hm; case: leqP => [/rotD // | /ltnW Hmn]; symmetry. by rewrite -{2}(rotK n s) /rotr -rotD size_rot addnBA ?subnK ?addnK. Qed. Lemma rot_minn n s : rot n s = rot (minn n (size s)) s. Proof. by case: (leqP n (size s)) => // /leqW ?; rewrite rot_size rot_oversize. Qed. Definition rot_add s n m (k := size s) (p := minn m k + minn n k) := locked (if p <= k then p else p - k). Lemma leq_rot_add n m s : rot_add s n m <= size s. Proof. by unlock rot_add; case: ifP; rewrite // leq_subLR leq_add // geq_minr. Qed. Lemma rot_addC n m s : rot_add s n m = rot_add s m n. Proof. by unlock rot_add; rewrite ![minn n _ + _]addnC. Qed. Lemma rot_rot_add n m s : rot m (rot n s) = rot (rot_add s n m) s. Proof. unlock rot_add. by rewrite (rot_minn n) (rot_minn m) rot_add_mod ?size_rot ?geq_minr. Qed. Lemma rot_rot m n s : rot m (rot n s) = rot n (rot m s). Proof. by rewrite rot_rot_add rot_addC -rot_rot_add. Qed. Lemma rot_rotr m n s : rot m (rotr n s) = rotr n (rot m s). Proof. by rewrite [RHS]/rotr size_rot rot_rot. Qed. Lemma rotr_rotr m n s : rotr m (rotr n s) = rotr n (rotr m s). Proof. by rewrite /rotr !size_rot rot_rot. Qed. End RotCompLemmas. Section Mask. Variables (n0 : nat) (T : Type). Implicit Types (m : bitseq) (s : seq T). Fixpoint mask m s {struct m} := match m, s with | b :: m', x :: s' => if b then x :: mask m' s' else mask m' s' | _, _ => [::] end. Lemma mask_false s n : mask (nseq n false) s = [::]. Proof. by elim: s n => [|x s IHs] [|n] /=. Qed. Lemma mask_true s n : size s <= n -> mask (nseq n true) s = s. Proof. by elim: s n => [|x s IHs] [|n] //= Hn; congr (_ :: _); apply: IHs. Qed. Lemma mask0 m : mask m [::] = [::]. Proof. by case: m. Qed. Lemma mask0s s : mask [::] s = [::]. Proof. by []. Qed. Lemma mask1 b x : mask [:: b] [:: x] = nseq b x. Proof. by case: b. Qed. Lemma mask_cons b m x s : mask (b :: m) (x :: s) = nseq b x ++ mask m s. Proof. by case: b. Qed. Lemma size_mask m s : size m = size s -> size (mask m s) = count id m. Proof. by move: m s; apply: seq_ind2 => // -[] x m s /= _ ->. Qed. Lemma mask_cat m1 m2 s1 s2 : size m1 = size s1 -> mask (m1 ++ m2) (s1 ++ s2) = mask m1 s1 ++ mask m2 s2. Proof. by move: m1 s1; apply: seq_ind2 => // -[] m1 x1 s1 /= _ ->. Qed. Lemma mask_rcons b m x s : size m = size s -> mask (rcons m b) (rcons s x) = mask m s ++ nseq b x. Proof. by move=> ms; rewrite -!cats1 mask_cat//; case: b. Qed. Lemma all_mask a m s : all a s -> all a (mask m s). Proof. by elim: s m => [|x s IHs] [|[] m]//= /andP[ax /IHs->]; rewrite ?ax. Qed. Lemma has_mask_cons a b m x s : has a (mask (b :: m) (x :: s)) = b && a x || has a (mask m s). Proof. by case: b. Qed. Lemma has_mask a m s : has a (mask m s) -> has a s. Proof. by apply/contraTT; rewrite -!all_predC; apply: all_mask. Qed. Lemma rev_mask m s : size m = size s -> rev (mask m s) = mask (rev m) (rev s). Proof. move: m s; apply: seq_ind2 => //= b x m s eq_size_sm IH. by case: b; rewrite !rev_cons mask_rcons ?IH ?size_rev// (cats1, cats0). Qed. Lemma mask_rot m s : size m = size s -> mask (rot n0 m) (rot n0 s) = rot (count id (take n0 m)) (mask m s). Proof. move=> Ems; rewrite mask_cat ?size_drop ?Ems // -rot_size_cat. by rewrite size_mask -?mask_cat ?size_take ?Ems // !cat_take_drop. Qed. Lemma resize_mask m s : {m1 | size m1 = size s & mask m s = mask m1 s}. Proof. exists (take (size s) m ++ nseq (size s - size m) false). by elim: s m => [|x s IHs] [|b m] //=; rewrite (size_nseq, IHs). by elim: s m => [|x s IHs] [|b m] //=; rewrite (mask_false, IHs). Qed. End Mask. Arguments mask _ !_ !_. Section EqMask. Variables (n0 : nat) (T : eqType). Implicit Types (s : seq T) (m : bitseq). Lemma mem_mask_cons x b m y s : (x \in mask (b :: m) (y :: s)) = b && (x == y) || (x \in mask m s). Proof. by case: b. Qed. Lemma mem_mask x m s : x \in mask m s -> x \in s. Proof. by rewrite -!has_pred1 => /has_mask. Qed. Lemma in_mask x m s : uniq s -> x \in mask m s = (x \in s) && nth false m (index x s). Proof. elim: s m => [|y s IHs] [|[] m]//= /andP[yNs ?]; rewrite ?in_cons ?IHs //=; by have [->|neq_xy] //= := eqVneq; rewrite ?andbF // (negPf yNs). Qed. Lemma mask_uniq s : uniq s -> forall m, uniq (mask m s). Proof. elim: s => [|x s IHs] Uxs [|b m] //=. case: b Uxs => //= /andP[s'x Us]; rewrite {}IHs // andbT. by apply: contra s'x; apply: mem_mask. Qed. Lemma mem_mask_rot m s : size m = size s -> mask (rot n0 m) (rot n0 s) =i mask m s. Proof. by move=> Ems x; rewrite mask_rot // mem_rot. Qed. End EqMask. Section Subseq. Variable T : eqType. Implicit Type s : seq T. Fixpoint subseq s1 s2 := if s2 is y :: s2' then if s1 is x :: s1' then subseq (if x == y then s1' else s1) s2' else true else s1 == [::]. Lemma sub0seq s : subseq [::] s. Proof. by case: s. Qed. Lemma subseq0 s : subseq s [::] = (s == [::]). Proof. by []. Qed. Lemma subseq_refl s : subseq s s. Proof. by elim: s => //= x s IHs; rewrite eqxx. Qed. Hint Resolve subseq_refl : core. Lemma subseqP s1 s2 : reflect (exists2 m, size m = size s2 & s1 = mask m s2) (subseq s1 s2). Proof. elim: s2 s1 => [|y s2 IHs2] [|x s1]. - by left; exists [::]. - by right=> -[m /eqP/nilP->]. - by left; exists (nseq (size s2).+1 false); rewrite ?size_nseq //= mask_false. apply: {IHs2}(iffP (IHs2 _)) => [] [m sz_m def_s1]. by exists ((x == y) :: m); rewrite /= ?sz_m // -def_s1; case: eqP => // ->. case: eqP => [_ | ne_xy]; last first. by case: m def_s1 sz_m => [|[] m] //; [case | move=> -> [<-]; exists m]. pose i := index true m; have def_m_i: take i m = nseq (size (take i m)) false. apply/all_pred1P; apply/(all_nthP true) => j. rewrite size_take ltnNge geq_min negb_or -ltnNge => /andP[lt_j_i _]. rewrite nth_take //= -negb_add addbF -addbT -negb_eqb. by rewrite [_ == _](before_find _ lt_j_i). have lt_i_m: i < size m. rewrite ltnNge; apply/negP=> le_m_i; rewrite take_oversize // in def_m_i. by rewrite def_m_i mask_false in def_s1. rewrite size_take lt_i_m in def_m_i. exists (take i m ++ drop i.+1 m). rewrite size_cat size_take size_drop lt_i_m. by rewrite sz_m in lt_i_m *; rewrite subnKC. rewrite {s1 def_s1}[s1](congr1 behead def_s1). rewrite -[s2](cat_take_drop i) -[m in LHS](cat_take_drop i) {}def_m_i -cat_cons. have sz_i_s2: size (take i s2) = i by apply: size_takel; rewrite sz_m in lt_i_m. rewrite lastI cat_rcons !mask_cat ?size_nseq ?size_belast ?mask_false //=. by rewrite (drop_nth true) // nth_index -?index_mem. Qed. Lemma mask_subseq m s : subseq (mask m s) s. Proof. by apply/subseqP; have [m1] := resize_mask m s; exists m1. Qed. Lemma subseq_trans : transitive subseq. Proof. move=> _ _ s /subseqP[m2 _ ->] /subseqP[m1 _ ->]. elim: s => [|x s IHs] in m2 m1 *; first by rewrite !mask0. case: m1 => [|[] m1]; first by rewrite mask0. case: m2 => [|[] m2] //; first by rewrite /= eqxx IHs. case/subseqP: (IHs m2 m1) => m sz_m def_s; apply/subseqP. by exists (false :: m); rewrite //= sz_m. case/subseqP: (IHs m2 m1) => m sz_m def_s; apply/subseqP. by exists (false :: m); rewrite //= sz_m. Qed. Lemma cat_subseq s1 s2 s3 s4 : subseq s1 s3 -> subseq s2 s4 -> subseq (s1 ++ s2) (s3 ++ s4). Proof. case/subseqP=> m1 sz_m1 -> /subseqP [m2 sz_m2 ->]; apply/subseqP. by exists (m1 ++ m2); rewrite ?size_cat ?mask_cat ?sz_m1 ?sz_m2. Qed. Lemma prefix_subseq s1 s2 : subseq s1 (s1 ++ s2). Proof. by rewrite -[s1 in subseq s1]cats0 cat_subseq ?sub0seq. Qed. Lemma suffix_subseq s1 s2 : subseq s2 (s1 ++ s2). Proof. exact: cat_subseq (sub0seq s1) _. Qed. Lemma take_subseq s i : subseq (take i s) s. Proof. by rewrite -[s in X in subseq _ X](cat_take_drop i) prefix_subseq. Qed. Lemma drop_subseq s i : subseq (drop i s) s. Proof. by rewrite -[s in X in subseq _ X](cat_take_drop i) suffix_subseq. Qed. Lemma mem_subseq s1 s2 : subseq s1 s2 -> {subset s1 <= s2}. Proof. by case/subseqP=> m _ -> x; apply: mem_mask. Qed. Lemma sub1seq x s : subseq [:: x] s = (x \in s). Proof. by elim: s => //= y s; rewrite inE; case: ifP; rewrite ?sub0seq. Qed. Lemma size_subseq s1 s2 : subseq s1 s2 -> size s1 <= size s2. Proof. by case/subseqP=> m sz_m ->; rewrite size_mask -sz_m ?count_size. Qed. Lemma size_subseq_leqif s1 s2 : subseq s1 s2 -> size s1 <= size s2 ?= iff (s1 == s2). Proof. move=> sub12; split; first exact: size_subseq. apply/idP/eqP=> [|-> //]; case/subseqP: sub12 => m sz_m ->{s1}. rewrite size_mask -sz_m // -all_count -(eq_all eqb_id). by move/(@all_pred1P _ true)->; rewrite sz_m mask_true. Qed. Lemma subseq_cons s x : subseq s (x :: s). Proof. exact: suffix_subseq [:: x] s. Qed. Lemma cons_subseq s1 s2 x : subseq (x :: s1) s2 -> subseq s1 s2. Proof. exact/subseq_trans/subseq_cons. Qed. Lemma subseq_rcons s x : subseq s (rcons s x). Proof. by rewrite -cats1 prefix_subseq. Qed. Lemma subseq_uniq s1 s2 : subseq s1 s2 -> uniq s2 -> uniq s1. Proof. by case/subseqP=> m _ -> Us2; apply: mask_uniq. Qed. Lemma take_uniq s n : uniq s -> uniq (take n s). Proof. exact/subseq_uniq/take_subseq. Qed. Lemma drop_uniq s n : uniq s -> uniq (drop n s). Proof. exact/subseq_uniq/drop_subseq. Qed. Lemma undup_subseq s : subseq (undup s) s. Proof. elim: s => //= x s; case: (_ \in _); last by rewrite eqxx. by case: (undup s) => //= y u; case: (_ == _) => //=; apply: cons_subseq. Qed. Lemma subseq_rev s1 s2 : subseq (rev s1) (rev s2) = subseq s1 s2. Proof. wlog suff W : s1 s2 / subseq s1 s2 -> subseq (rev s1) (rev s2). by apply/idP/idP => /W //; rewrite !revK. by case/subseqP => m size_m ->; rewrite rev_mask // mask_subseq. Qed. Lemma subseq_cat2l s s1 s2 : subseq (s ++ s1) (s ++ s2) = subseq s1 s2. Proof. by elim: s => // x s IHs; rewrite !cat_cons /= eqxx. Qed. Lemma subseq_cat2r s s1 s2 : subseq (s1 ++ s) (s2 ++ s) = subseq s1 s2. Proof. by rewrite -subseq_rev !rev_cat subseq_cat2l subseq_rev. Qed. Lemma subseq_rot p s n : subseq p s -> exists2 k, k <= n & subseq (rot k p) (rot n s). Proof. move=> /subseqP[m size_m ->]. exists (count id (take n m)); last by rewrite -mask_rot // mask_subseq. by rewrite (leq_trans (count_size _ _))// size_take; case: ltnP. Qed. End Subseq. Prenex Implicits subseq. Arguments subseqP {T s1 s2}. Hint Resolve subseq_refl : core. Section Rem. Variables (T : eqType) (x : T). Fixpoint rem s := if s is y :: t then (if y == x then t else y :: rem t) else s. Lemma rem_cons y s : rem (y :: s) = if y == x then s else y :: rem s. Proof. by []. Qed. Lemma remE s : rem s = take (index x s) s ++ drop (index x s).+1 s. Proof. by elim: s => //= y s ->; case: eqVneq; rewrite ?drop0. Qed. Lemma rem_id s : x \notin s -> rem s = s. Proof. by elim: s => //= y s IHs /norP[neq_yx /IHs->]; case: eqVneq neq_yx. Qed. Lemma perm_to_rem s : x \in s -> perm_eq s (x :: rem s). Proof. move=> xs; rewrite remE -[X in perm_eq X](cat_take_drop (index x s)). by rewrite drop_index// -cat1s perm_catCA cat1s. Qed. Lemma size_rem s : x \in s -> size (rem s) = (size s).-1. Proof. by move/perm_to_rem/perm_size->. Qed. Lemma rem_subseq s : subseq (rem s) s. Proof. elim: s => //= y s IHs; rewrite eq_sym. by case: ifP => _; [apply: subseq_cons | rewrite eqxx]. Qed. Lemma rem_uniq s : uniq s -> uniq (rem s). Proof. by apply: subseq_uniq; apply: rem_subseq. Qed. Lemma mem_rem s : {subset rem s <= s}. Proof. exact: mem_subseq (rem_subseq s). Qed. Lemma rem_filter s : uniq s -> rem s = filter (predC1 x) s. Proof. elim: s => //= y s IHs /andP[not_s_y /IHs->]. by case: eqP => //= <-; apply/esym/all_filterP; rewrite all_predC has_pred1. Qed. Lemma mem_rem_uniq s : uniq s -> rem s =i [predD1 s & x]. Proof. by move/rem_filter=> -> y; rewrite mem_filter. Qed. Lemma mem_rem_uniqF s : uniq s -> x \in rem s = false. Proof. by move/mem_rem_uniq->; rewrite inE eqxx. Qed. Lemma count_rem P s : count P (rem s) = count P s - (x \in s) && P x. Proof. have [/perm_to_rem/permP->|xNs]/= := boolP (x \in s); first by rewrite addKn. by rewrite subn0 rem_id. Qed. Lemma count_mem_rem y s : count_mem y (rem s) = count_mem y s - (x == y). Proof. rewrite count_rem; have []//= := boolP (x \in s). by case: eqP => // <- /count_memPn->. Qed. End Rem. Section Map. Variables (n0 : nat) (T1 : Type) (x1 : T1). Variables (T2 : Type) (x2 : T2) (f : T1 -> T2). Fixpoint map s := if s is x :: s' then f x :: map s' else [::]. Lemma map_cons x s : map (x :: s) = f x :: map s. Proof. by []. Qed. Lemma map_nseq x : map (nseq n0 x) = nseq n0 (f x). Proof. by elim: n0 => // *; congr (_ :: _). Qed. Lemma map_cat s1 s2 : map (s1 ++ s2) = map s1 ++ map s2. Proof. by elim: s1 => [|x s1 IHs] //=; rewrite IHs. Qed. Lemma size_map s : size (map s) = size s. Proof. by elim: s => //= x s ->. Qed. Lemma behead_map s : behead (map s) = map (behead s). Proof. by case: s. Qed. Lemma nth_map n s : n < size s -> nth x2 (map s) n = f (nth x1 s n). Proof. by elim: s n => [|x s IHs] []. Qed. Lemma map_rcons s x : map (rcons s x) = rcons (map s) (f x). Proof. by rewrite -!cats1 map_cat. Qed. Lemma last_map s x : last (f x) (map s) = f (last x s). Proof. by elim: s x => /=. Qed. Lemma belast_map s x : belast (f x) (map s) = map (belast x s). Proof. by elim: s x => //= y s IHs x; rewrite IHs. Qed. Lemma filter_map a s : filter a (map s) = map (filter (preim f a) s). Proof. by elim: s => //= x s IHs; rewrite (fun_if map) /= IHs. Qed. Lemma find_map a s : find a (map s) = find (preim f a) s. Proof. by elim: s => //= x s ->. Qed. Lemma has_map a s : has a (map s) = has (preim f a) s. Proof. by elim: s => //= x s ->. Qed. Lemma all_map a s : all a (map s) = all (preim f a) s. Proof. by elim: s => //= x s ->. Qed. Lemma count_map a s : count a (map s) = count (preim f a) s. Proof. by elim: s => //= x s ->. Qed. Lemma map_take s : map (take n0 s) = take n0 (map s). Proof. by elim: n0 s => [|n IHn] [|x s] //=; rewrite IHn. Qed. Lemma map_drop s : map (drop n0 s) = drop n0 (map s). Proof. by elim: n0 s => [|n IHn] [|x s] //=; rewrite IHn. Qed. Lemma map_rot s : map (rot n0 s) = rot n0 (map s). Proof. by rewrite /rot map_cat map_take map_drop. Qed. Lemma map_rotr s : map (rotr n0 s) = rotr n0 (map s). Proof. by apply: canRL (rotK n0) _; rewrite -map_rot rotrK. Qed. Lemma map_rev s : map (rev s) = rev (map s). Proof. by elim: s => //= x s IHs; rewrite !rev_cons -!cats1 map_cat IHs. Qed. Lemma map_mask m s : map (mask m s) = mask m (map s). Proof. by elim: m s => [|[|] m IHm] [|x p] //=; rewrite IHm. Qed. Lemma inj_map : injective f -> injective map. Proof. by move=> injf; elim=> [|y1 s1 IHs] [|y2 s2] //= [/injf-> /IHs->]. Qed. End Map. Notation "[ 'seq' E | i <- s ]" := (map (fun i => E) s) (at level 0, E at level 99, i ident, format "[ '[hv' 'seq' E '/ ' | i <- s ] ']'") : seq_scope. Notation "[ 'seq' E | i <- s & C ]" := [seq E | i <- [seq i <- s | C]] (at level 0, E at level 99, i ident, format "[ '[hv' 'seq' E '/ ' | i <- s '/ ' & C ] ']'") : seq_scope. Notation "[ 'seq' E | i : T <- s ]" := (map (fun i : T => E) s) (at level 0, E at level 99, i ident, only parsing) : seq_scope. Notation "[ 'seq' E | i : T <- s & C ]" := [seq E | i : T <- [seq i : T <- s | C]] (at level 0, E at level 99, i ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | i <- s ]" := (@map _ R (fun i => E) s) (at level 0, E at level 99, i ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | i <- s & C ]" := [seq E : R | i <- [seq i <- s | C]] (at level 0, E at level 99, i ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | i : T <- s ]" := (@map T R (fun i : T => E) s) (at level 0, E at level 99, i ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | i : T <- s & C ]" := [seq E : R | i : T <- [seq i : T <- s | C]] (at level 0, E at level 99, i ident, only parsing) : seq_scope. Lemma filter_mask T a (s : seq T) : filter a s = mask (map a s) s. Proof. by elim: s => //= x s <-; case: (a x). Qed. Lemma all_sigP T a (s : seq T) : all a s -> {s' : seq (sig a) | s = map sval s'}. Proof. elim: s => /= [_|x s ihs /andP [ax /ihs [s' ->]]]; first by exists [::]. by exists (exist a x ax :: s'). Qed. Section MiscMask. Lemma leq_count_mask T (P : {pred T}) m s : count P (mask m s) <= count P s. Proof. by elim: s m => [|x s IHs] [|[] m]//=; rewrite ?leq_add2l (leq_trans (IHs _)) ?leq_addl. Qed. Variable (T : eqType). Implicit Types (s : seq T) (m : bitseq). Lemma mask_filter s m : uniq s -> mask m s = [seq i <- s | i \in mask m s]. Proof. elim: m s => [|[] m ih] [|x s] //=. - by move=> _; elim: s. - case/andP => /negP x_notin_s /ih {1}->; rewrite inE eqxx /=; congr cons. by apply/eq_in_filter => ?; rewrite inE; case: eqP => // ->. - by case: ifP => [/mem_mask -> // | _ /andP [] _ /ih]. Qed. Lemma leq_count_subseq P s1 s2 : subseq s1 s2 -> count P s1 <= count P s2. Proof. by move=> /subseqP[m _ ->]; rewrite leq_count_mask. Qed. Lemma count_maskP s1 s2 : (forall x, count_mem x s1 <= count_mem x s2) <-> exists2 m : bitseq, size m = size s2 & perm_eq s1 (mask m s2). Proof. split=> [s1_le|[m _ /permP s1ms2 x]]; last by rewrite s1ms2 leq_count_mask. suff [m mP]: exists m, perm_eq s1 (mask m s2). by have [m' sm' eqm] := resize_mask m s2; exists m'; rewrite -?eqm. elim: s2 => [|x s2 IHs]//= in s1 s1_le *. by exists [::]; apply/allP => x _/=; rewrite eqn_leq s1_le. have [y|m s1s2] := IHs (rem x s1); first by rewrite count_mem_rem leq_subLR. exists ((x \in s1) :: m); have [|/rem_id<-//] := boolP (x \in s1). by move/perm_to_rem/permPl->; rewrite perm_cons. Qed. Lemma count_subseqP s1 s2 : (forall x, count_mem x s1 <= count_mem x s2) <-> exists2 s, subseq s s2 & perm_eq s1 s. Proof. rewrite count_maskP; split=> [[m _]|[_/subseqP[m sm ->]]]; last by exists m. by exists (mask m s2); rewrite ?mask_subseq. Qed. End MiscMask. Section FilterSubseq. Variable T : eqType. Implicit Types (s : seq T) (a : pred T). Lemma filter_subseq a s : subseq (filter a s) s. Proof. by apply/subseqP; exists (map a s); rewrite ?size_map ?filter_mask. Qed. Lemma subseq_filter s1 s2 a : subseq s1 (filter a s2) = all a s1 && subseq s1 s2. Proof. elim: s2 s1 => [|x s2 IHs] [|y s1] //=; rewrite ?andbF ?sub0seq //. by case a_x: (a x); rewrite /= !IHs /=; case: eqP => // ->; rewrite a_x. Qed. Lemma subseq_uniqP s1 s2 : uniq s2 -> reflect (s1 = filter (mem s1) s2) (subseq s1 s2). Proof. move=> uniq_s2; apply: (iffP idP) => [ss12 | ->]; last exact: filter_subseq. apply/eqP; rewrite -size_subseq_leqif ?subseq_filter ?(introT allP) //. apply/eqP/esym/perm_size. rewrite uniq_perm ?filter_uniq ?(subseq_uniq ss12) // => x. by rewrite mem_filter; apply: andb_idr; apply: (mem_subseq ss12). Qed. Lemma uniq_subseq_pivot x (s1 s2 s3 s4 : seq T) (s := s3 ++ x :: s4) : uniq s -> subseq (s1 ++ x :: s2) s = (subseq s1 s3 && subseq s2 s4). Proof. move=> uniq_s; apply/idP/idP => [sub_s'_s|/andP[? ?]]; last first. by rewrite cat_subseq //= eqxx. have uniq_s' := subseq_uniq sub_s'_s uniq_s. have/eqP {sub_s'_s uniq_s} := subseq_uniqP _ uniq_s sub_s'_s. rewrite !filter_cat /= mem_cat inE eqxx orbT /=. rewrite uniq_eqseq_pivotl // => /andP [/eqP -> /eqP ->]. by rewrite !filter_subseq. Qed. Lemma perm_to_subseq s1 s2 : subseq s1 s2 -> {s3 | perm_eq s2 (s1 ++ s3)}. Proof. elim Ds2: s2 s1 => [|y s2' IHs] [|x s1] //=; try by exists s2; rewrite Ds2. case: eqP => [-> | _] /IHs[s3 perm_s2] {IHs}. by exists s3; rewrite perm_cons. by exists (rcons s3 y); rewrite -cat_cons -perm_rcons -!cats1 catA perm_cat2r. Qed. Lemma subseq_rem x : {homo rem x : s1 s2 / @subseq T s1 s2}. Proof. move=> s1 s2; elim: s2 s1 => [|x2 s2 IHs2] [|x1 s1]; rewrite ?sub0seq //=. have [->|_] := eqVneq x1 x2; first by case: eqP => //= _ /IHs2; rewrite eqxx. move=> /IHs2/subseq_trans->//. by have [->|_] := eqVneq x x2; [apply: rem_subseq|apply: subseq_cons]. Qed. End FilterSubseq. Arguments subseq_uniqP [T s1 s2]. Section EqMap. Variables (n0 : nat) (T1 : eqType) (x1 : T1). Variables (T2 : eqType) (x2 : T2) (f : T1 -> T2). Implicit Type s : seq T1. Lemma map_f s x : x \in s -> f x \in map f s. Proof. by elim: s => //= y s IHs /predU1P[->|/IHs]; [apply: predU1l | apply: predU1r]. Qed. Lemma mapP s y : reflect (exists2 x, x \in s & y = f x) (y \in map f s). Proof. elim: s => [|x s IHs]; [by right; case | rewrite /= inE]. have [Dy | fx'y] := y =P f x; first by left; exists x; rewrite ?mem_head. by apply: (iffP IHs) => [[z]|[z /predU1P[->|]]]; exists z; do ?apply: predU1r. Qed. Lemma map_uniq s : uniq (map f s) -> uniq s. Proof. elim: s => //= x s IHs /andP[not_sfx /IHs->]; rewrite andbT. by apply: contra not_sfx => sx; apply/mapP; exists x. Qed. Lemma map_inj_in_uniq s : {in s &, injective f} -> uniq (map f s) = uniq s. Proof. elim: s => //= x s IHs //= injf; congr (~~ _ && _). apply/mapP/idP=> [[y sy /injf] | ]; last by exists x. by rewrite mem_head mem_behead // => ->. by apply: IHs => y z sy sz; apply: injf => //; apply: predU1r. Qed. Lemma map_subseq s1 s2 : subseq s1 s2 -> subseq (map f s1) (map f s2). Proof. case/subseqP=> m sz_m ->; apply/subseqP. by exists m; rewrite ?size_map ?map_mask. Qed. Lemma nth_index_map s x0 x : {in s &, injective f} -> x \in s -> nth x0 s (index (f x) (map f s)) = x. Proof. elim: s => //= y s IHs inj_f s_x; rewrite (inj_in_eq inj_f) ?mem_head //. move: s_x; rewrite inE; have [-> // | _] := eqVneq; apply: IHs. by apply: sub_in2 inj_f => z; apply: predU1r. Qed. Lemma perm_map s t : perm_eq s t -> perm_eq (map f s) (map f t). Proof. by move/permP=> Est; apply/permP=> a; rewrite !count_map Est. Qed. Hypothesis Hf : injective f. Lemma mem_map s x : (f x \in map f s) = (x \in s). Proof. by apply/mapP/idP=> [[y Hy /Hf->] //|]; exists x. Qed. Lemma index_map s x : index (f x) (map f s) = index x s. Proof. by rewrite /index; elim: s => //= y s IHs; rewrite (inj_eq Hf) IHs. Qed. Lemma map_inj_uniq s : uniq (map f s) = uniq s. Proof. by apply: map_inj_in_uniq; apply: in2W. Qed. Lemma perm_map_inj s t : perm_eq (map f s) (map f t) -> perm_eq s t. Proof. move/permP=> Est; apply/allP=> x _ /=. have Dx: pred1 x =1 preim f (pred1 (f x)) by move=> y /=; rewrite inj_eq. by rewrite !(eq_count Dx) -!count_map Est. Qed. End EqMap. Arguments mapP {T1 T2 f s y}. Lemma map_of_seq (T1 : eqType) T2 (s : seq T1) (fs : seq T2) (y0 : T2) : {f | uniq s -> size fs = size s -> map f s = fs}. Proof. exists (fun x => nth y0 fs (index x s)) => uAs eq_sz. apply/esym/(@eq_from_nth _ y0); rewrite ?size_map eq_sz // => i ltis. by have x0 : T1 by [case: (s) ltis]; rewrite (nth_map x0) // index_uniq. Qed. Section MapComp. Variable T1 T2 T3 : Type. Lemma map_id (s : seq T1) : map id s = s. Proof. by elim: s => //= x s ->. Qed. Lemma eq_map (f1 f2 : T1 -> T2) : f1 =1 f2 -> map f1 =1 map f2. Proof. by move=> Ef; elim=> //= x s ->; rewrite Ef. Qed. Lemma map_comp (f1 : T2 -> T3) (f2 : T1 -> T2) s : map (f1 \o f2) s = map f1 (map f2 s). Proof. by elim: s => //= x s ->. Qed. Lemma mapK (f1 : T1 -> T2) (f2 : T2 -> T1) : cancel f1 f2 -> cancel (map f1) (map f2). Proof. by move=> eq_f12; elim=> //= x s ->; rewrite eq_f12. Qed. End MapComp. Lemma eq_in_map (T1 : eqType) T2 (f1 f2 : T1 -> T2) (s : seq T1) : {in s, f1 =1 f2} <-> map f1 s = map f2 s. Proof. elim: s => //= x s IHs; split=> [eqf12 | [f12x /IHs eqf12]]; last first. by move=> y /predU1P[-> | /eqf12]. rewrite eqf12 ?mem_head //; congr (_ :: _). by apply/IHs=> y s_y; rewrite eqf12 // mem_behead. Qed. Lemma map_id_in (T : eqType) f (s : seq T) : {in s, f =1 id} -> map f s = s. Proof. by move/eq_in_map->; apply: map_id. Qed. (* Map a partial function *) Section Pmap. Variables (aT rT : Type) (f : aT -> option rT) (g : rT -> aT). Fixpoint pmap s := if s is x :: s' then let r := pmap s' in oapp (cons^~ r) r (f x) else [::]. Lemma map_pK : pcancel g f -> cancel (map g) pmap. Proof. by move=> gK; elim=> //= x s ->; rewrite gK. Qed. Lemma size_pmap s : size (pmap s) = count [eta f] s. Proof. by elim: s => //= x s <-; case: (f _). Qed. Lemma pmapS_filter s : map some (pmap s) = map f (filter [eta f] s). Proof. by elim: s => //= x s; case fx: (f x) => //= [u] <-; congr (_ :: _). Qed. Hypothesis fK : ocancel f g. Lemma pmap_filter s : map g (pmap s) = filter [eta f] s. Proof. by elim: s => //= x s <-; rewrite -{3}(fK x); case: (f _). Qed. Lemma pmap_cat s t : pmap (s ++ t) = pmap s ++ pmap t. Proof. by elim: s => //= x s ->; case/f: x. Qed. Lemma all_pmap (p : pred rT) s : all p (pmap s) = all [pred i | oapp p true (f i)] s. Proof. by elim: s => //= x s <-; case: f. Qed. End Pmap. Section EqPmap. Variables (aT rT : eqType) (f : aT -> option rT) (g : rT -> aT). Lemma eq_pmap (f1 f2 : aT -> option rT) : f1 =1 f2 -> pmap f1 =1 pmap f2. Proof. by move=> Ef; elim=> //= x s ->; rewrite Ef. Qed. Lemma mem_pmap s u : (u \in pmap f s) = (Some u \in map f s). Proof. by elim: s => //= x s IHs; rewrite in_cons -IHs; case: (f x). Qed. Hypothesis fK : ocancel f g. Lemma can2_mem_pmap : pcancel g f -> forall s u, (u \in pmap f s) = (g u \in s). Proof. by move=> gK s u; rewrite -(mem_map (pcan_inj gK)) pmap_filter // mem_filter gK. Qed. Lemma pmap_uniq s : uniq s -> uniq (pmap f s). Proof. move/(filter_uniq f); rewrite -(pmap_filter fK); exact: map_uniq. Qed. Lemma perm_pmap s t : perm_eq s t -> perm_eq (pmap f s) (pmap f t). Proof. move=> eq_st; apply/(perm_map_inj Some_inj); rewrite !pmapS_filter. exact/perm_map/perm_filter. Qed. End EqPmap. Section PmapSub. Variables (T : Type) (p : pred T) (sT : subType p). Lemma size_pmap_sub s : size (pmap (insub : T -> option sT) s) = count p s. Proof. by rewrite size_pmap (eq_count (isSome_insub _)). Qed. End PmapSub. Section EqPmapSub. Variables (T : eqType) (p : pred T) (sT : subType p). Let insT : T -> option sT := insub. Lemma mem_pmap_sub s u : (u \in pmap insT s) = (val u \in s). Proof. exact/(can2_mem_pmap (insubK _))/valK. Qed. Lemma pmap_sub_uniq s : uniq s -> uniq (pmap insT s). Proof. exact: (pmap_uniq (insubK _)). Qed. End EqPmapSub. (* Index sequence *) Fixpoint iota m n := if n is n'.+1 then m :: iota m.+1 n' else [::]. Lemma size_iota m n : size (iota m n) = n. Proof. by elim: n m => //= n IHn m; rewrite IHn. Qed. Lemma iotaD m n1 n2 : iota m (n1 + n2) = iota m n1 ++ iota (m + n1) n2. Proof. by elim: n1 m => [|n1 IHn1] m; rewrite ?addn0 // -addSnnS /= -IHn1. Qed. Lemma iotaDl m1 m2 n : iota (m1 + m2) n = map (addn m1) (iota m2 n). Proof. by elim: n m2 => //= n IHn m2; rewrite -addnS IHn. Qed. Lemma nth_iota p m n i : i < n -> nth p (iota m n) i = m + i. Proof. by move/subnKC <-; rewrite addSnnS iotaD nth_cat size_iota ltnn subnn. Qed. Lemma mem_iota m n i : (i \in iota m n) = (m <= i < m + n). Proof. elim: n m => [|n IHn] /= m; first by rewrite addn0 ltnNge andbN. by rewrite in_cons IHn addnS ltnS; case: ltngtP => // ->; rewrite leq_addr. Qed. Lemma iota_uniq m n : uniq (iota m n). Proof. by elim: n m => //= n IHn m; rewrite mem_iota ltnn /=. Qed. Lemma take_iota k m n : take k (iota m n) = iota m (minn k n). Proof. have [lt_k_n|le_n_k] := ltnP. by elim: k n lt_k_n m => [|k IHk] [|n] //= H m; rewrite IHk. by apply: take_oversize; rewrite size_iota. Qed. Lemma drop_iota k m n : drop k (iota m n) = iota (m + k) (n - k). Proof. by elim: k m n => [|k IHk] m [|n] //=; rewrite ?addn0 // IHk addnS subSS. Qed. (* Making a sequence of a specific length, using indexes to compute items. *) Section MakeSeq. Variables (T : Type) (x0 : T). Definition mkseq f n : seq T := map f (iota 0 n). Lemma size_mkseq f n : size (mkseq f n) = n. Proof. by rewrite size_map size_iota. Qed. Lemma eq_mkseq f g : f =1 g -> mkseq f =1 mkseq g. Proof. by move=> Efg n; apply: eq_map Efg _. Qed. Lemma nth_mkseq f n i : i < n -> nth x0 (mkseq f n) i = f i. Proof. by move=> Hi; rewrite (nth_map 0) ?nth_iota ?size_iota. Qed. Lemma mkseq_nth s : mkseq (nth x0 s) (size s) = s. Proof. by apply: (@eq_from_nth _ x0); rewrite size_mkseq // => i Hi; rewrite nth_mkseq. Qed. Variant mkseq_spec s : seq T -> Type := | MapIota n f : s = mkseq f n -> mkseq_spec s (mkseq f n). Lemma mkseqP s : mkseq_spec s s. Proof. by rewrite -[s]mkseq_nth; constructor. Qed. End MakeSeq. Section MakeEqSeq. Variable T : eqType. Lemma mkseq_uniq (f : nat -> T) n : injective f -> uniq (mkseq f n). Proof. by move/map_inj_uniq->; apply: iota_uniq. Qed. Lemma perm_iotaP {s t : seq T} x0 (It := iota 0 (size t)) : reflect (exists2 Is, perm_eq Is It & s = map (nth x0 t) Is) (perm_eq s t). Proof. apply: (iffP idP) => [Est | [Is eqIst ->]]; last first. by rewrite -{2}[t](mkseq_nth x0) perm_map. elim: t => [|x t IHt] in s It Est *. by rewrite (perm_small_eq _ Est) //; exists [::]. have /rot_to[k s1 Ds]: x \in s by rewrite (perm_mem Est) mem_head. have [|Is1 eqIst1 Ds1] := IHt s1; first by rewrite -(perm_cons x) -Ds perm_rot. exists (rotr k (0 :: map succn Is1)). by rewrite perm_rot /It /= perm_cons (iotaDl 1) perm_map. by rewrite map_rotr /= -map_comp -(@eq_map _ _ (nth x0 t)) // -Ds1 -Ds rotK. Qed. End MakeEqSeq. Arguments perm_iotaP {T s t}. Section FoldRight. Variables (T : Type) (R : Type) (f : T -> R -> R) (z0 : R). Fixpoint foldr s := if s is x :: s' then f x (foldr s') else z0. End FoldRight. Section FoldRightComp. Variables (T1 T2 : Type) (h : T1 -> T2). Variables (R : Type) (f : T2 -> R -> R) (z0 : R). Lemma foldr_cat s1 s2 : foldr f z0 (s1 ++ s2) = foldr f (foldr f z0 s2) s1. Proof. by elim: s1 => //= x s1 ->. Qed. Lemma foldr_rcons s x : foldr f z0 (rcons s x) = foldr f (f x z0) s. Proof. by rewrite -cats1 foldr_cat. Qed. Lemma foldr_map s : foldr f z0 (map h s) = foldr (fun x z => f (h x) z) z0 s. Proof. by elim: s => //= x s ->. Qed. End FoldRightComp. (* Quick characterization of the null sequence. *) Definition sumn := foldr addn 0. Lemma sumn_nseq x n : sumn (nseq n x) = x * n. Proof. by rewrite mulnC; elim: n => //= n ->. Qed. Lemma sumn_cat s1 s2 : sumn (s1 ++ s2) = sumn s1 + sumn s2. Proof. by elim: s1 => //= x s1 ->; rewrite addnA. Qed. Lemma sumn_count T (a : pred T) s : sumn [seq a i : nat | i <- s] = count a s. Proof. by elim: s => //= s0 s /= ->. Qed. Lemma sumn_rcons s n : sumn (rcons s n) = sumn s + n. Proof. by rewrite -cats1 sumn_cat /= addn0. Qed. Lemma perm_sumn s1 s2 : perm_eq s1 s2 -> sumn s1 = sumn s2. Proof. by apply/catCA_perm_subst: s1 s2 => s1 s2 s3; rewrite !sumn_cat addnCA. Qed. Lemma sumn_rot s n : sumn (rot n s) = sumn s. Proof. by apply/perm_sumn; rewrite perm_rot. Qed. Lemma sumn_rev s : sumn (rev s) = sumn s. Proof. by apply/perm_sumn; rewrite perm_rev. Qed. Lemma natnseq0P s : reflect (s = nseq (size s) 0) (sumn s == 0). Proof. apply: (iffP idP) => [|->]; last by rewrite sumn_nseq. by elim: s => //= x s IHs; rewrite addn_eq0 => /andP[/eqP-> /IHs <-]. Qed. Section FoldLeft. Variables (T R : Type) (f : R -> T -> R). Fixpoint foldl z s := if s is x :: s' then foldl (f z x) s' else z. Lemma foldl_rev z s : foldl z (rev s) = foldr (fun x z => f z x) z s. Proof. by elim/last_ind: s z => // s x IHs z; rewrite rev_rcons -cats1 foldr_cat -IHs. Qed. Lemma foldl_cat z s1 s2 : foldl z (s1 ++ s2) = foldl (foldl z s1) s2. Proof. by rewrite -(revK (s1 ++ s2)) foldl_rev rev_cat foldr_cat -!foldl_rev !revK. Qed. Lemma foldl_rcons z s x : foldl z (rcons s x) = f (foldl z s) x. Proof. by rewrite -cats1 foldl_cat. Qed. End FoldLeft. Section Scan. Variables (T1 : Type) (x1 : T1) (T2 : Type) (x2 : T2). Variables (f : T1 -> T1 -> T2) (g : T1 -> T2 -> T1). Fixpoint pairmap x s := if s is y :: s' then f x y :: pairmap y s' else [::]. Lemma size_pairmap x s : size (pairmap x s) = size s. Proof. by elim: s x => //= y s IHs x; rewrite IHs. Qed. Lemma pairmap_cat x s1 s2 : pairmap x (s1 ++ s2) = pairmap x s1 ++ pairmap (last x s1) s2. Proof. by elim: s1 x => //= y s1 IHs1 x; rewrite IHs1. Qed. Lemma nth_pairmap s n : n < size s -> forall x, nth x2 (pairmap x s) n = f (nth x1 (x :: s) n) (nth x1 s n). Proof. by elim: s n => [|y s IHs] [|n] //= Hn x; apply: IHs. Qed. Fixpoint scanl x s := if s is y :: s' then let x' := g x y in x' :: scanl x' s' else [::]. Lemma size_scanl x s : size (scanl x s) = size s. Proof. by elim: s x => //= y s IHs x; rewrite IHs. Qed. Lemma scanl_cat x s1 s2 : scanl x (s1 ++ s2) = scanl x s1 ++ scanl (foldl g x s1) s2. Proof. by elim: s1 x => //= y s1 IHs1 x; rewrite IHs1. Qed. Lemma scanl_rcons x s1 y : scanl x (rcons s1 y) = rcons (scanl x s1) (foldl g x (rcons s1 y)). Proof. by rewrite -!cats1 scanl_cat foldl_cat. Qed. Lemma nth_cons_scanl s n : n <= size s -> forall x, nth x1 (x :: scanl x s) n = foldl g x (take n s). Proof. by elim: s n => [|y s IHs] [|n] Hn x //=; rewrite IHs. Qed. Lemma nth_scanl s n : n < size s -> forall x, nth x1 (scanl x s) n = foldl g x (take n.+1 s). Proof. by move=> n_lt x; rewrite -nth_cons_scanl. Qed. Lemma scanlK : (forall x, cancel (g x) (f x)) -> forall x, cancel (scanl x) (pairmap x). Proof. by move=> Hfg x s; elim: s x => //= y s IHs x; rewrite Hfg IHs. Qed. Lemma pairmapK : (forall x, cancel (f x) (g x)) -> forall x, cancel (pairmap x) (scanl x). Proof. by move=> Hgf x s; elim: s x => //= y s IHs x; rewrite Hgf IHs. Qed. End Scan. Prenex Implicits mask map pmap foldr foldl scanl pairmap. Section Zip. Variables (S T : Type) (r : S -> T -> bool). Fixpoint zip (s : seq S) (t : seq T) {struct t} := match s, t with | x :: s', y :: t' => (x, y) :: zip s' t' | _, _ => [::] end. Definition unzip1 := map (@fst S T). Definition unzip2 := map (@snd S T). Fixpoint all2 s t := match s, t with | [::], [::] => true | x :: s, y :: t => r x y && all2 s t | _, _ => false end. Lemma zip_unzip s : zip (unzip1 s) (unzip2 s) = s. Proof. by elim: s => [|[x y] s /= ->]. Qed. Lemma unzip1_zip s t : size s <= size t -> unzip1 (zip s t) = s. Proof. by elim: s t => [|x s IHs] [|y t] //= le_s_t; rewrite IHs. Qed. Lemma unzip2_zip s t : size t <= size s -> unzip2 (zip s t) = t. Proof. by elim: s t => [|x s IHs] [|y t] //= le_t_s; rewrite IHs. Qed. Lemma size1_zip s t : size s <= size t -> size (zip s t) = size s. Proof. by elim: s t => [|x s IHs] [|y t] //= Hs; rewrite IHs. Qed. Lemma size2_zip s t : size t <= size s -> size (zip s t) = size t. Proof. by elim: s t => [|x s IHs] [|y t] //= Hs; rewrite IHs. Qed. Lemma size_zip s t : size (zip s t) = minn (size s) (size t). Proof. by elim: s t => [|x s IHs] [|t2 t] //=; rewrite IHs minnSS. Qed. Lemma zip_cat s1 s2 t1 t2 : size s1 = size t1 -> zip (s1 ++ s2) (t1 ++ t2) = zip s1 t1 ++ zip s2 t2. Proof. by move: s1 t1; apply: seq_ind2 => //= x y s1 t1 _ ->. Qed. Lemma nth_zip x y s t i : size s = size t -> nth (x, y) (zip s t) i = (nth x s i, nth y t i). Proof. by elim: i s t => [|i IHi] [|y1 s1] [|y2 t] //= [/IHi->]. Qed. Lemma nth_zip_cond p s t i : nth p (zip s t) i = (if i < size (zip s t) then (nth p.1 s i, nth p.2 t i) else p). Proof. rewrite size_zip ltnNge geq_min. by elim: s t i => [|x s IHs] [|y t] [|i] //=; rewrite ?orbT -?IHs. Qed. Lemma zip_rcons s t x y : size s = size t -> zip (rcons s x) (rcons t y) = rcons (zip s t) (x, y). Proof. by move=> eq_sz; rewrite -!cats1 zip_cat //= eq_sz. Qed. Lemma rev_zip s t : size s = size t -> rev (zip s t) = zip (rev s) (rev t). Proof. move: s t; apply: seq_ind2 => //= x y s t eq_sz IHs. by rewrite !rev_cons IHs zip_rcons ?size_rev. Qed. Lemma all2E s t : all2 s t = (size s == size t) && all [pred xy | r xy.1 xy.2] (zip s t). Proof. by elim: s t => [|x s IHs] [|y t] //=; rewrite IHs andbCA. Qed. End Zip. Prenex Implicits zip unzip1 unzip2 all2. Section Flatten. Variable T : Type. Implicit Types (s : seq T) (ss : seq (seq T)). Definition flatten := foldr cat (Nil T). Definition shape := map (@size T). Fixpoint reshape sh s := if sh is n :: sh' then take n s :: reshape sh' (drop n s) else [::]. Definition flatten_index sh r c := sumn (take r sh) + c. Definition reshape_index sh i := find (pred1 0) (scanl subn i.+1 sh). Definition reshape_offset sh i := i - sumn (take (reshape_index sh i) sh). Lemma size_flatten ss : size (flatten ss) = sumn (shape ss). Proof. by elim: ss => //= s ss <-; rewrite size_cat. Qed. Lemma flatten_cat ss1 ss2 : flatten (ss1 ++ ss2) = flatten ss1 ++ flatten ss2. Proof. by elim: ss1 => //= s ss1 ->; rewrite catA. Qed. Lemma size_reshape sh s : size (reshape sh s) = size sh. Proof. by elim: sh s => //= s0 sh IHsh s; rewrite IHsh. Qed. Lemma nth_reshape (sh : seq nat) l n : nth [::] (reshape sh l) n = take (nth 0 sh n) (drop (sumn (take n sh)) l). Proof. elim: n sh l => [| n IHn] [| sh0 sh] l; rewrite ?take0 ?drop0 //=. by rewrite addnC -drop_drop; apply: IHn. Qed. Lemma flattenK ss : reshape (shape ss) (flatten ss) = ss. Proof. by elim: ss => //= s ss IHss; rewrite take_size_cat ?drop_size_cat ?IHss. Qed. Lemma reshapeKr sh s : size s <= sumn sh -> flatten (reshape sh s) = s. Proof. elim: sh s => [[]|n sh IHsh] //= s sz_s; rewrite IHsh ?cat_take_drop //. by rewrite size_drop leq_subLR. Qed. Lemma reshapeKl sh s : size s >= sumn sh -> shape (reshape sh s) = sh. Proof. elim: sh s => [[]|n sh IHsh] //= s sz_s. rewrite size_takel; last exact: leq_trans (leq_addr _ _) sz_s. by rewrite IHsh // -(leq_add2l n) size_drop -maxnE leq_max sz_s orbT. Qed. Lemma flatten_rcons ss s : flatten (rcons ss s) = flatten ss ++ s. Proof. by rewrite -cats1 flatten_cat /= cats0. Qed. Lemma flatten_seq1 s : flatten [seq [:: x] | x <- s] = s. Proof. by elim: s => //= s0 s ->. Qed. Lemma count_flatten ss P : count P (flatten ss) = sumn [seq count P x | x <- ss]. Proof. by elim: ss => //= s ss IHss; rewrite count_cat IHss. Qed. Lemma filter_flatten ss (P : pred T) : filter P (flatten ss) = flatten [seq filter P i | i <- ss]. Proof. by elim: ss => // s ss /= <-; apply: filter_cat. Qed. Lemma rev_flatten ss : rev (flatten ss) = flatten (rev (map rev ss)). Proof. by elim: ss => //= s ss IHss; rewrite rev_cons flatten_rcons -IHss rev_cat. Qed. Lemma nth_shape ss i : nth 0 (shape ss) i = size (nth [::] ss i). Proof. rewrite /shape; case: (ltnP i (size ss)) => Hi; first exact: nth_map. by rewrite !nth_default // size_map. Qed. Lemma shape_rev ss : shape (rev ss) = rev (shape ss). Proof. exact: map_rev. Qed. Lemma eq_from_flatten_shape ss1 ss2 : flatten ss1 = flatten ss2 -> shape ss1 = shape ss2 -> ss1 = ss2. Proof. by move=> Eflat Esh; rewrite -[LHS]flattenK Eflat Esh flattenK. Qed. Lemma rev_reshape sh s : size s = sumn sh -> rev (reshape sh s) = map rev (reshape (rev sh) (rev s)). Proof. move=> sz_s; apply/(canLR revK)/eq_from_flatten_shape. rewrite reshapeKr ?sz_s // -rev_flatten reshapeKr ?revK //. by rewrite size_rev sumn_rev sz_s. transitivity (rev (shape (reshape (rev sh) (rev s)))). by rewrite !reshapeKl ?revK ?size_rev ?sz_s ?sumn_rev. rewrite shape_rev; congr (rev _); rewrite -[RHS]map_comp. by under eq_map do rewrite /= size_rev. Qed. Lemma reshape_rcons s sh n (m := sumn sh) : m + n = size s -> reshape (rcons sh n) s = rcons (reshape sh (take m s)) (drop m s). Proof. move=> Dmn; apply/(can_inj revK); rewrite rev_reshape ?rev_rcons ?sumn_rcons //. rewrite /= take_rev drop_rev -Dmn addnK revK -rev_reshape //. by rewrite size_takel // -Dmn leq_addr. Qed. Lemma flatten_indexP sh r c : c < nth 0 sh r -> flatten_index sh r c < sumn sh. Proof. move=> lt_c_sh; rewrite -[sh in sumn sh](cat_take_drop r) sumn_cat ltn_add2l. suffices lt_r_sh: r < size sh by rewrite (drop_nth 0 lt_r_sh) ltn_addr. by case: ltnP => // le_sh_r; rewrite nth_default in lt_c_sh. Qed. Lemma reshape_indexP sh i : i < sumn sh -> reshape_index sh i < size sh. Proof. rewrite /reshape_index; elim: sh => //= n sh IHsh in i *; rewrite subn_eq0. by have [// | le_n_i] := ltnP i n; rewrite -leq_subLR subSn // => /IHsh. Qed. Lemma reshape_offsetP sh i : i < sumn sh -> reshape_offset sh i < nth 0 sh (reshape_index sh i). Proof. rewrite /reshape_offset /reshape_index; elim: sh => //= n sh IHsh in i *. rewrite subn_eq0; have [| le_n_i] := ltnP i n; first by rewrite subn0. by rewrite -leq_subLR /= subnDA subSn // => /IHsh. Qed. Lemma reshape_indexK sh i : flatten_index sh (reshape_index sh i) (reshape_offset sh i) = i. Proof. rewrite /reshape_offset /reshape_index /flatten_index -subSKn. elim: sh => //= n sh IHsh in i *; rewrite subn_eq0; have [//|le_n_i] := ltnP. by rewrite /= subnDA subSn // -addnA IHsh subnKC. Qed. Lemma flatten_indexKl sh r c : c < nth 0 sh r -> reshape_index sh (flatten_index sh r c) = r. Proof. rewrite /reshape_index /flatten_index. elim: sh r => [|n sh IHsh] [|r] //= lt_c_sh; first by rewrite ifT. by rewrite -addnA -addnS addKn IHsh. Qed. Lemma flatten_indexKr sh r c : c < nth 0 sh r -> reshape_offset sh (flatten_index sh r c) = c. Proof. rewrite /reshape_offset /reshape_index /flatten_index. elim: sh r => [|n sh IHsh] [|r] //= lt_c_sh; first by rewrite ifT ?subn0. by rewrite -addnA -addnS addKn /= subnDl IHsh. Qed. Lemma nth_flatten x0 ss i (r := reshape_index (shape ss) i) : nth x0 (flatten ss) i = nth x0 (nth [::] ss r) (reshape_offset (shape ss) i). Proof. rewrite /reshape_offset -subSKn {}/r /reshape_index. elim: ss => //= s ss IHss in i *; rewrite subn_eq0 nth_cat. by have [//|le_s_i] := ltnP; rewrite subnDA subSn /=. Qed. Lemma reshape_leq sh i1 i2 (r1 := reshape_index sh i1) (c1 := reshape_offset sh i1) (r2 := reshape_index sh i2) (c2 := reshape_offset sh i2) : (i1 <= i2) = ((r1 < r2) || ((r1 == r2) && (c1 <= c2))). Proof. rewrite {}/r1 {}/c1 {}/r2 {}/c2 /reshape_offset /reshape_index. elim: sh => [|s0 s IHs] /= in i1 i2 *; rewrite ?subn0 ?subn_eq0 //. have [[] i1s0 [] i2s0] := (ltnP i1 s0, ltnP i2 s0); first by rewrite !subn0. - by apply: leq_trans i2s0; apply/ltnW. - by apply/negP => /(leq_trans i1s0); rewrite leqNgt i2s0. by rewrite !subSn // !eqSS !ltnS !subnDA -IHs leq_subLR subnKC. Qed. End Flatten. Prenex Implicits flatten shape reshape. Lemma map_flatten S T (f : T -> S) ss : map f (flatten ss) = flatten (map (map f) ss). Proof. by elim: ss => // s ss /= <-; apply: map_cat. Qed. Lemma flatten_map1 (S T : Type) (f : S -> T) s : flatten [seq [:: f x] | x <- s] = map f s. Proof. by elim: s => //= s0 s ->. Qed. Lemma undup_flatten_nseq n (T : eqType) (s : seq T) : 0 < n -> undup (flatten (nseq n s)) = undup s. Proof. elim: n => [|[|n]/= IHn]//= _; rewrite ?cats0// undup_cat {}IHn//. rewrite (@eq_in_filter _ _ pred0) ?filter_pred0// => x. by rewrite mem_undup mem_cat => ->. Qed. Lemma sumn_flatten (ss : seq (seq nat)) : sumn (flatten ss) = sumn (map sumn ss). Proof. by elim: ss => // s ss /= <-; apply: sumn_cat. Qed. Lemma map_reshape T S (f : T -> S) sh s : map (map f) (reshape sh s) = reshape sh (map f s). Proof. by elim: sh s => //= sh0 sh IHsh s; rewrite map_take IHsh map_drop. Qed. Section EqFlatten. Variables S T : eqType. Lemma flattenP (A : seq (seq T)) x : reflect (exists2 s, s \in A & x \in s) (x \in flatten A). Proof. elim: A => /= [|s A /iffP IH_A]; [by right; case | rewrite mem_cat]. have [s_x|s'x] := @idP (x \in s); first by left; exists s; rewrite ?mem_head. by apply: IH_A => [[t] | [t /predU1P[->|]]]; exists t; rewrite // mem_behead. Qed. Arguments flattenP {A x}. Lemma flatten_mapP (A : S -> seq T) s y : reflect (exists2 x, x \in s & y \in A x) (y \in flatten (map A s)). Proof. apply: (iffP flattenP) => [[_ /mapP[x sx ->]] | [x sx]] Axy; first by exists x. by exists (A x); rewrite ?map_f. Qed. Lemma perm_flatten (ss1 ss2 : seq (seq T)) : perm_eq ss1 ss2 -> perm_eq (flatten ss1) (flatten ss2). Proof. move=> eq_ss; apply/permP=> a; apply/catCA_perm_subst: ss1 ss2 eq_ss. by move=> ss1 ss2 ss3; rewrite !flatten_cat !count_cat addnCA. Qed. End EqFlatten. Arguments flattenP {T A x}. Arguments flatten_mapP {S T A s y}. Notation "[ 'seq' E | x <- s , y <- t ]" := (flatten [seq [seq E | y <- t] | x <- s]) (at level 0, E at level 99, x ident, y ident, format "[ '[hv' 'seq' E '/ ' | x <- s , '/ ' y <- t ] ']'") : seq_scope. Notation "[ 'seq' E | x : S <- s , y : T <- t ]" := (flatten [seq [seq E | y : T <- t] | x : S <- s]) (at level 0, E at level 99, x ident, y ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | x : S <- s , y : T <- t ]" := (flatten [seq [seq E : R | y : T <- t] | x : S <- s]) (at level 0, E at level 99, x ident, y ident, only parsing) : seq_scope. Notation "[ 'seq' E : R | x <- s , y <- t ]" := (flatten [seq [seq E : R | y <- t] | x <- s]) (at level 0, E at level 99, x ident, y ident, only parsing) : seq_scope. Section AllPairsDep. Variables (S S' : Type) (T T' : S -> Type) (R : Type). Implicit Type f : forall x, T x -> R. Definition allpairs_dep f s t := [seq f x y | x <- s, y <- t x]. Lemma size_allpairs_dep f s t : size [seq f x y | x <- s, y <- t x] = sumn [seq size (t x) | x <- s]. Proof. by elim: s => //= x s IHs; rewrite size_cat size_map IHs. Qed. Lemma allpairs0l f t : [seq f x y | x <- [::], y <- t x] = [::]. Proof. by []. Qed. Lemma allpairs0r f s : [seq f x y | x <- s, y <- [::]] = [::]. Proof. by elim: s. Qed. Lemma allpairs1l f x t : [seq f x y | x <- [:: x], y <- t x] = [seq f x y | y <- t x]. Proof. exact: cats0. Qed. Lemma allpairs1r f s y : [seq f x y | x <- s, y <- [:: y x]] = [seq f x (y x) | x <- s]. Proof. exact: flatten_map1. Qed. Lemma allpairs_cons f x s t : [seq f x y | x <- x :: s, y <- t x] = [seq f x y | y <- t x] ++ [seq f x y | x <- s, y <- t x]. Proof. by []. Qed. Lemma eq_allpairs (f1 f2 : forall x, T x -> R) s t : (forall x, f1 x =1 f2 x) -> [seq f1 x y | x <- s, y <- t x] = [seq f2 x y | x <- s, y <- t x]. Proof. by move=> eq_f; under eq_map do under eq_map do rewrite eq_f. Qed. Lemma eq_allpairsr (f : forall x, T x -> R) s t1 t2 : (forall x, t1 x = t2 x) -> [seq f x y | x <- s, y <- t1 x] = [seq f x y | x <- s, y <- t2 x]. Proof. by move=> eq_t; under eq_map do rewrite eq_t. Qed. Lemma allpairs_cat f s1 s2 t : [seq f x y | x <- s1 ++ s2, y <- t x] = [seq f x y | x <- s1, y <- t x] ++ [seq f x y | x <- s2, y <- t x]. Proof. by rewrite map_cat flatten_cat. Qed. Lemma allpairs_rcons f x s t : [seq f x y | x <- rcons s x, y <- t x] = [seq f x y | x <- s, y <- t x] ++ [seq f x y | y <- t x]. Proof. by rewrite -cats1 allpairs_cat allpairs1l. Qed. Lemma allpairs_mapl f (g : S' -> S) s t : [seq f x y | x <- map g s, y <- t x] = [seq f (g x) y | x <- s, y <- t (g x)]. Proof. by rewrite -map_comp. Qed. Lemma allpairs_mapr f (g : forall x, T' x -> T x) s t : [seq f x y | x <- s, y <- map (g x) (t x)] = [seq f x (g x y) | x <- s, y <- t x]. Proof. by under eq_map do rewrite -map_comp. Qed. End AllPairsDep. Arguments allpairs_dep {S T R} f s t /. Lemma map_allpairs S T R R' (g : R' -> R) f s t : map g [seq f x y | x : S <- s, y : T x <- t x] = [seq g (f x y) | x <- s, y <- t x]. Proof. by rewrite map_flatten allpairs_mapl allpairs_mapr. Qed. Section AllPairsNonDep. Variables (S T R : Type) (f : S -> T -> R). Implicit Types (s : seq S) (t : seq T). Definition allpairs s t := [seq f x y | x <- s, y <- t]. Lemma size_allpairs s t : size [seq f x y | x <- s, y <- t] = size s * size t. Proof. by elim: s => //= x s IHs; rewrite size_cat size_map IHs. Qed. End AllPairsNonDep. Arguments allpairs {S T R} f s t /. Section EqAllPairsDep. Variables (S : eqType) (T : S -> eqType). Implicit Types (R : eqType) (s : seq S) (t : forall x, seq (T x)). Lemma allpairsPdep R (f : forall x, T x -> R) s t (z : R) : reflect (exists x y, [/\ x \in s, y \in t x & z = f x y]) (z \in [seq f x y | x <- s, y <- t x]). Proof. apply: (iffP flatten_mapP); first by case=> x sx /mapP[y ty ->]; exists x, y. by case=> x [y [sx ty ->]]; exists x; last apply: map_f. Qed. Variable R : eqType. Implicit Type f : forall x, T x -> R. Lemma allpairs_f_dep f s t x y : x \in s -> y \in t x -> f x y \in [seq f x y | x <- s, y <- t x]. Proof. by move=> sx ty; apply/allpairsPdep; exists x, y. Qed. Lemma eq_in_allpairs_dep f1 f2 s t : {in s, forall x, {in t x, f1 x =1 f2 x}} <-> [seq f1 x y : R | x <- s, y <- t x] = [seq f2 x y | x <- s, y <- t x]. Proof. split=> [eq_f | eq_fst x s_x]. by congr flatten; apply/eq_in_map=> x s_x; apply/eq_in_map/eq_f. apply/eq_in_map; apply/eq_in_map: x s_x; apply/eq_from_flatten_shape => //. by rewrite /shape -!map_comp; apply/eq_map=> x /=; rewrite !size_map. Qed. Lemma mem_allpairs_dep f s1 t1 s2 t2 : s1 =i s2 -> {in s1, forall x, t1 x =i t2 x} -> [seq f x y | x <- s1, y <- t1 x] =i [seq f x y | x <- s2, y <- t2 x]. Proof. move=> eq_s eq_t z; apply/allpairsPdep/allpairsPdep=> -[x [y [sx ty ->]]]; by exists x, y; rewrite -eq_s in sx *; rewrite eq_t in ty *. Qed. Lemma allpairs_uniq_dep f s t (st := [seq Tagged T y | x <- s, y <- t x]) : let g (p : {x : S & T x}) : R := f (tag p) (tagged p) in uniq s -> {in s, forall x, uniq (t x)} -> {in st &, injective g} -> uniq [seq f x y | x <- s, y <- t x]. Proof. move=> g Us Ut; rewrite -(map_allpairs g (existT T)) => /map_inj_in_uniq->{f g}. elim: s Us => //= x s IHs /andP[s'x Us] in st Ut *; rewrite {st}cat_uniq. rewrite {}IHs {Us}// ?andbT => [|x1 s_s1]; last exact/Ut/mem_behead. have injT: injective (existT T x) by move=> y z /eqP; rewrite eq_Tagged => /eqP. rewrite (map_inj_in_uniq (in2W injT)) {injT}Ut ?mem_head // has_sym has_map. by apply: contra s'x => /hasP[y _ /allpairsPdep[z [_ [? _ /(congr1 tag)/=->]]]]. Qed. End EqAllPairsDep. Arguments allpairsPdep {S T R f s t z}. Section MemAllPairs. Variables (S : Type) (T : S -> Type) (R : eqType). Implicit Types (f : forall x, T x -> R) (s : seq S). Lemma perm_allpairs_catr f s t1 t2 : perm_eql [seq f x y | x <- s, y <- t1 x ++ t2 x] ([seq f x y | x <- s, y <- t1 x] ++ [seq f x y | x <- s, y <- t2 x]). Proof. apply/permPl; rewrite perm_sym; elim: s => //= x s ihs. by rewrite perm_catACA perm_cat ?map_cat. Qed. Lemma mem_allpairs_catr f s y0 t : [seq f x y | x <- s, y <- y0 x ++ t x] =i [seq f x y | x <- s, y <- y0 x] ++ [seq f x y | x <- s, y <- t x]. Proof. exact/perm_mem/permPl/perm_allpairs_catr. Qed. Lemma perm_allpairs_consr f s y0 t : perm_eql [seq f x y | x <- s, y <- y0 x :: t x] ([seq f x (y0 x) | x <- s] ++ [seq f x y | x <- s, y <- t x]). Proof. by apply/permPl; rewrite (perm_allpairs_catr _ _ (fun=> [:: _])) allpairs1r. Qed. Lemma mem_allpairs_consr f s t y0 : [seq f x y | x <- s, y <- y0 x :: t x] =i [seq f x (y0 x) | x <- s] ++ [seq f x y | x <- s, y <- t x]. Proof. exact/perm_mem/permPl/perm_allpairs_consr. Qed. Lemma allpairs_rconsr f s y0 t : perm_eql [seq f x y | x <- s, y <- rcons (t x) (y0 x)] ([seq f x y | x <- s, y <- t x] ++ [seq f x (y0 x) | x <- s]). Proof. apply/permPl; rewrite -(eq_allpairsr _ _ (fun=> cats1 _ _)). by rewrite perm_allpairs_catr allpairs1r. Qed. Lemma mem_allpairs_rconsr f s t y0 : [seq f x y | x <- s, y <- rcons (t x) (y0 x)] =i ([seq f x y | x <- s, y <- t x] ++ [seq f x (y0 x) | x <- s]). Proof. exact/perm_mem/permPl/allpairs_rconsr. Qed. End MemAllPairs. Lemma all_allpairsP (S : eqType) (T : S -> eqType) (R : Type) (p : pred R) (f : forall x : S, T x -> R) (s : seq S) (t : forall x : S, seq (T x)) : reflect (forall (x : S) (y : T x), x \in s -> y \in t x -> p (f x y)) (all p [seq f x y | x <- s, y <- t x]). Proof. elim: s => [|x s IHs]; first by constructor. rewrite /= all_cat all_map /preim. apply/(iffP andP)=> [[/allP /= ? ? x' y x'_in_xs]|p_xs_t]. by move: x'_in_xs y; rewrite inE => /predU1P [-> //|? ?]; exact: IHs. split; first by apply/allP => ?; exact/p_xs_t/mem_head. by apply/IHs => x' y x'_in_s; apply: p_xs_t; rewrite inE x'_in_s orbT. Qed. Arguments all_allpairsP {S T R p f s t}. Section EqAllPairs. Variables S T R : eqType. Implicit Types (f : S -> T -> R) (s : seq S) (t : seq T). Lemma allpairsP f s t (z : R) : reflect (exists p, [/\ p.1 \in s, p.2 \in t & z = f p.1 p.2]) (z \in [seq f x y | x <- s, y <- t]). Proof. by apply: (iffP allpairsPdep) => [[x[y]]|[[x y]]]; [exists (x, y)|exists x, y]. Qed. Lemma allpairs_f f s t x y : x \in s -> y \in t -> f x y \in [seq f x y | x <- s, y <- t]. Proof. exact: allpairs_f_dep. Qed. Lemma eq_in_allpairs f1 f2 s t : {in s & t, f1 =2 f2} <-> [seq f1 x y : R | x <- s, y <- t] = [seq f2 x y | x <- s, y <- t]. Proof. split=> [eq_f | /eq_in_allpairs_dep-eq_f x y /eq_f/(_ y)//]. by apply/eq_in_allpairs_dep=> x /eq_f. Qed. Lemma mem_allpairs f s1 t1 s2 t2 : s1 =i s2 -> t1 =i t2 -> [seq f x y | x <- s1, y <- t1] =i [seq f x y | x <- s2, y <- t2]. Proof. by move=> eq_s eq_t; apply: mem_allpairs_dep. Qed. Lemma allpairs_uniq f s t (st := [seq (x, y) | x <- s, y <- t]) : uniq s -> uniq t -> {in st &, injective (prod_curry f)} -> uniq [seq f x y | x <- s, y <- t]. Proof. move=> Us Ut inj_f; rewrite -(map_allpairs (prod_curry f) (@pair S T)) -/st. rewrite map_inj_in_uniq // allpairs_uniq_dep {Us Ut st inj_f}//. by apply: in2W => -[x1 y1] [x2 y2] /= [-> ->]. Qed. End EqAllPairs. Arguments allpairsP {S T R f s t z}. Arguments perm_nilP {T s}. Arguments perm_consP {T x s t}. Section AllRel. Variables (T S : Type) (r : T -> S -> bool). Implicit Types (x : T) (y : S) (xs : seq T) (ys : seq S). Definition allrel xs ys := all [pred x | all (r x) ys] xs. Lemma allrel0l ys : allrel [::] ys. Proof. by []. Qed. Lemma allrel0r xs : allrel xs [::]. Proof. by elim: xs. Qed. Lemma allrel_consl x xs ys : allrel (x :: xs) ys = all (r x) ys && allrel xs ys. Proof. by []. Qed. Lemma allrel_consr xs y ys : allrel xs (y :: ys) = all (r^~ y) xs && allrel xs ys. Proof. exact: all_predI. Qed. Lemma allrel_cons2 x y xs ys : allrel (x :: xs) (y :: ys) = [&& r x y, all (r x) ys, all (r^~ y) xs & allrel xs ys]. Proof. by rewrite /= allrel_consr -andbA. Qed. Lemma allrel1l x ys : allrel [:: x] ys = all (r x) ys. Proof. exact: andbT. Qed. Lemma allrel1r xs y : allrel xs [:: y] = all (r^~ y) xs. Proof. by rewrite allrel_consr allrel0r andbT. Qed. Lemma allrel_catl xs xs' ys : allrel (xs ++ xs') ys = allrel xs ys && allrel xs' ys. Proof. exact: all_cat. Qed. Lemma allrel_catr xs ys ys' : allrel xs (ys ++ ys') = allrel xs ys && allrel xs ys'. Proof. elim: ys => /= [|y ys ihys]; first by rewrite allrel0r. by rewrite !allrel_consr ihys andbA. Qed. Lemma allrel_allpairsE xs ys : allrel xs ys = all id [seq r x y | x <- xs, y <- ys]. Proof. by elim: xs => //= x xs ->; rewrite all_cat all_map. Qed. End AllRel. Arguments allrel {T S} r xs ys : simpl never. Arguments allrel0l {T S} r ys. Arguments allrel0r {T S} r xs. Arguments allrel_consl {T S} r x xs ys. Arguments allrel_consr {T S} r xs y ys. Arguments allrel1l {T S} r x ys. Arguments allrel1r {T S} r xs y. Arguments allrel_catl {T S} r xs xs' ys. Arguments allrel_catr {T S} r xs ys ys'. Arguments allrel_allpairsE {T S} r xs ys. Notation all2rel r xs := (allrel r xs xs). Lemma eq_in_allrel {T S : Type} (P : {pred T}) (Q : {pred S}) r r' : {in P & Q, r =2 r'} -> forall xs ys, all P xs -> all Q ys -> allrel r xs ys = allrel r' xs ys. Proof. move=> rr' + ys; elim=> //= x xs IH /andP [Px Pxs] Qys. congr andb => /=; last exact: IH. by elim: ys Qys {IH} => //= y ys IH /andP [Qy Qys]; rewrite rr' // IH. Qed. Lemma eq_allrel {T S : Type} (r r': T -> S -> bool) : r =2 r' -> allrel r =2 allrel r'. Proof. by move=> rr' xs ys; apply/eq_in_allrel/all_predT/all_predT. Qed. Lemma allrelC {T S : Type} (r : T -> S -> bool) xs ys : allrel r xs ys = allrel (fun y => r^~ y) ys xs. Proof. by elim: xs => [|x xs ih]; [elim: ys | rewrite allrel_consr -ih]. Qed. Lemma allrel_mapl {T T' S : Type} (f : T' -> T) (r : T -> S -> bool) xs ys : allrel r (map f xs) ys = allrel (fun x => r (f x)) xs ys. Proof. exact: all_map. Qed. Lemma allrel_mapr {T S S' : Type} (f : S' -> S) (r : T -> S -> bool) xs ys : allrel r xs (map f ys) = allrel (fun x y => r x (f y)) xs ys. Proof. by rewrite allrelC allrel_mapl allrelC. Qed. Lemma allrelP {T S : eqType} {r : T -> S -> bool} {xs ys} : reflect {in xs & ys, forall x y, r x y} (allrel r xs ys). Proof. by rewrite allrel_allpairsE; exact: all_allpairsP. Qed. Section All2Rel. Variable (T : nonPropType) (r : rel T). Implicit Types (x y z : T) (xs : seq T). Hypothesis (rsym : symmetric r). Lemma all2rel1 x : all2rel r [:: x] = r x x. Proof. by rewrite /allrel /= !andbT. Qed. Lemma all2rel2 x y : all2rel r [:: x; y] = r x x && r y y && r x y. Proof. by rewrite /allrel /= rsym; do 3 case: r. Qed. Lemma all2rel_cons x xs : all2rel r (x :: xs) = [&& r x x, all (r x) xs & all2rel r xs]. Proof. rewrite allrel_cons2; congr andb; rewrite andbA -all_predI; congr andb. by elim: xs => //= y xs ->; rewrite rsym andbb. Qed. End All2Rel. Section Permutations. Variable T : eqType. Implicit Types (x : T) (s t : seq T) (bs : seq (T * nat)) (acc : seq (seq T)). Fixpoint incr_tally bs x := if bs isn't b :: bs then [:: (x, 1)] else if x == b.1 then (x, b.2.+1) :: bs else b :: incr_tally bs x. Definition tally s := foldl incr_tally [::] s. Definition wf_tally := [qualify a bs : seq (T * nat) | uniq (unzip1 bs) && (0 \notin unzip2 bs)]. Definition tally_seq bs := flatten [seq nseq b.2 b.1 | b <- bs]. Local Notation tseq := tally_seq. Lemma size_tally_seq bs : size (tally_seq bs) = sumn (unzip2 bs). Proof. by rewrite size_flatten /shape -map_comp; under eq_map do rewrite /= size_nseq. Qed. Lemma tally_seqK : {in wf_tally, cancel tally_seq tally}. Proof. move=> bs /andP[]; elim: bs => [|[x [|n]] bs IHbs] //= /andP[bs'x Ubs] bs'0. rewrite inE /tseq /tally /= -[n.+1]addn1 in bs'0 *. elim: n 1 => /= [|n IHn] m; last by rewrite eqxx IHn addnS. rewrite -{}[in RHS]IHbs {Ubs bs'0}// /tally /tally_seq add0n. elim: bs bs'x [::] => [|[y n] bs IHbs] //=; rewrite inE => /norP[y'x bs'x]. by elim: n => [|n IHn] bs1 /=; [rewrite IHbs | rewrite eq_sym ifN // IHn]. Qed. Lemma incr_tallyP x : {homo incr_tally^~ x : bs / bs \in wf_tally}. Proof. move=> bs /andP[]; rewrite unfold_in. elim: bs => [|[y [|n]] bs IHbs] //= /andP[bs'y Ubs]; rewrite inE /= => bs'0. have [<- | y'x] /= := eqVneq y; first by rewrite bs'y Ubs. rewrite -andbA {}IHbs {Ubs bs'0}// andbT. elim: bs bs'y => [|b bs IHbs] /=; rewrite inE ?y'x // => /norP[b'y bs'y]. by case: ifP => _; rewrite /= inE negb_or ?y'x // b'y IHbs. Qed. Lemma tallyP s : tally s \is a wf_tally. Proof. rewrite /tally; set bs := [::]; have: bs \in wf_tally by []. by elim: s bs => //= x s IHs bs /(incr_tallyP x)/IHs. Qed. Lemma tallyK s : perm_eq (tally_seq (tally s)) s. Proof. rewrite -[s in perm_eq _ s]cats0 -[nil]/(tseq [::]) /tally. elim: s [::] => //= x s IHs bs; rewrite {IHs}(permPl (IHs _)). rewrite perm_sym -cat1s perm_catCA {s}perm_cat2l. elim: bs => //= b bs IHbs; case: eqP => [-> | _] //=. by rewrite -cat1s perm_catCA perm_cat2l. Qed. Lemma tallyEl s : perm_eq (unzip1 (tally s)) (undup s). Proof. have /andP[Ubs bs'0] := tallyP s; set bs := tally s in Ubs bs'0 *. rewrite uniq_perm ?undup_uniq {Ubs}// => x. rewrite mem_undup -(perm_mem (tallyK s)) -/bs. elim: bs => [|[y [|m]] bs IHbs] //= in bs'0 *. by rewrite inE IHbs // mem_cat mem_nseq. Qed. Lemma tallyE s : perm_eq (tally s) [seq (x, count_mem x s) | x <- undup s]. Proof. have /andP[Ubs _] := tallyP s; pose b := [fun s x => (x, count_mem x (tseq s))]. suffices /permPl->: perm_eq (tally s) (map (b (tally s)) (unzip1 (tally s))). congr perm_eq: (perm_map (b (tally s)) (tallyEl s)). by under eq_map do rewrite /= (permP (tallyK s)). elim: (tally s) Ubs => [|[x m] bs IH] //= /andP[bs'x /IH-IHbs {IH}]. rewrite /tseq /= -/(tseq _) count_cat count_nseq /= eqxx mul1n. rewrite (count_memPn _) ?addn0 ?perm_cons; last first. apply: contra bs'x; elim: {b IHbs}bs => //= b bs IHbs. by rewrite mem_cat mem_nseq inE andbC; case: (_ == _). congr perm_eq: IHbs; apply/eq_in_map=> y bs_y; congr (y, _). by rewrite count_cat count_nseq /= (negPf (memPnC bs'x y bs_y)). Qed. Lemma perm_tally s1 s2 : perm_eq s1 s2 -> perm_eq (tally s1) (tally s2). Proof. move=> eq_s12; apply: (@perm_trans _ [seq (x, count_mem x s2) | x <- undup s1]). by congr perm_eq: (tallyE s1); under eq_map do rewrite (permP eq_s12). by rewrite (permPr (tallyE s2)); apply/perm_map/perm_undup/(perm_mem eq_s12). Qed. Lemma perm_tally_seq bs1 bs2 : perm_eq bs1 bs2 -> perm_eq (tally_seq bs1) (tally_seq bs2). Proof. by move=> Ebs12; rewrite perm_flatten ?perm_map. Qed. Local Notation perm_tseq := perm_tally_seq. Lemma perm_count_undup s : perm_eq (flatten [seq nseq (count_mem x s) x | x <- undup s]) s. Proof. by rewrite -(permPr (tallyK s)) (permPr (perm_tseq (tallyE s))) /tseq -map_comp. Qed. Local Fixpoint cons_perms_ perms_rec (s : seq T) bs bs2 acc := if bs isn't b :: bs1 then acc else if b isn't (x, m.+1) then cons_perms_ perms_rec s bs1 bs2 acc else let acc_xs := perms_rec (x :: s) ((x, m) :: bs1 ++ bs2) acc in cons_perms_ perms_rec s bs1 (b :: bs2) acc_xs. Local Fixpoint perms_rec n s bs acc := if n isn't n.+1 then s :: acc else cons_perms_ (perms_rec n) s bs [::] acc. Local Notation cons_perms n := (cons_perms_ (perms_rec n) [::]). Definition permutations s := perms_rec (size s) [::] (tally s) [::]. Let permsP s : exists n bs, [/\ permutations s = perms_rec n [::] bs [::], size (tseq bs) == n, perm_eq (tseq bs) s & uniq (unzip1 bs)]. Proof. have /andP[Ubs _] := tallyP s; exists (size s), (tally s). by rewrite (perm_size (tallyK s)) tallyK. Qed. Local Notation bsCA := (permEl (perm_catCA _ [:: _] _)). Let cons_permsE : forall n x bs bs1 bs2, let cp := cons_perms n bs bs2 in let perms s := perms_rec n s bs1 [::] in cp (perms [:: x]) = cp [::] ++ [seq rcons t x | t <- perms [::]]. Proof. pose is_acc f := forall acc, f acc = f [::] ++ acc. (* f is accumulating. *) have cpE: forall f & forall s bs, is_acc (f s bs), is_acc (cons_perms_ f _ _ _). move=> s bs bs2 f fE acc; elim: bs => [|[x [|m]] bs IHbs] //= in s bs2 acc *. by rewrite fE IHbs catA -IHbs. have prE: is_acc (perms_rec _ _ _) by elim=> //= n IHn s bs; apply: cpE. pose has_suffix f := forall s : seq T, f s = [seq t ++ s | t <- f [::]]. suffices prEs n bs: has_suffix (fun s => perms_rec n s bs [::]). move=> n x bs bs1 bs2 /=; rewrite cpE // prEs. by under eq_map do rewrite cats1. elim: n bs => //= n IHn bs s; elim: bs [::] => [|[x [|m]] bs IHbs] //= bs1. rewrite cpE // IHbs IHn [in RHS]cpE // [in RHS]IHn map_cat -map_comp. by congr (_ ++ _); apply: eq_map => t /=; rewrite -catA. Qed. Lemma mem_permutations s t : (t \in permutations s) = perm_eq t s. Proof. have{s} [n [bs [-> Dn /permPr<- _]]] := permsP s. elim: n => [|n IHn] /= in t bs Dn *. by rewrite inE (nilP Dn); apply/eqP/perm_nilP. rewrite -[bs in tseq bs]cats0 in Dn *; have x0 : T by case: (tseq _) Dn. rewrite -[RHS](@andb_idl (last x0 t \in tseq bs)); last first. case/lastP: t {IHn} => [|t x] Dt; first by rewrite -(perm_size Dt) in Dn. by rewrite -[bs]cats0 -(perm_mem Dt) last_rcons mem_rcons mem_head. elim: bs [::] => [|[x [|m]] bs IHbs] //= bs2 in Dn *. rewrite cons_permsE -!cat_cons !mem_cat (mem_nseq m.+1) orbC andb_orl. rewrite {}IHbs ?(perm_size (perm_tseq bsCA)) //= (permPr (perm_tseq bsCA)). congr (_ || _); apply/mapP/andP=> [[t1 Dt1 ->] | [/eqP]]. by rewrite last_rcons perm_rcons perm_cons IHn in Dt1 *. case/lastP: t => [_ /perm_size//|t y]; rewrite last_rcons perm_rcons => ->. by rewrite perm_cons; exists t; rewrite ?IHn. Qed. Lemma permutations_uniq s : uniq (permutations s). Proof. have{s} [n [bs [-> Dn _ Ubs]]] := permsP s. elim: n => //= n IHn in bs Dn Ubs *; rewrite -[bs]cats0 /unzip1 in Dn Ubs. elim: bs [::] => [|[x [|m]] bs IHbs] //= bs2 in Dn Ubs *. by case/andP: Ubs => _ /IHbs->. rewrite /= cons_permsE cat_uniq has_sym andbCA andbC. rewrite {}IHbs; first 1 last; first by rewrite (perm_size (perm_tseq bsCA)). by rewrite (perm_uniq (perm_map _ bsCA)). rewrite (map_inj_uniq (rcons_injl x)) {}IHn {Dn}//=. have: x \notin unzip1 bs by apply: contraL Ubs; rewrite map_cat mem_cat => ->. move: {bs2 m Ubs}(perms_rec n _ _ _) (_ :: bs2) => ts. elim: bs => [|[y [|m]] bs IHbs] //=; rewrite inE => bs2 /norP[x'y /IHbs//]. rewrite cons_permsE has_cat negb_or has_map => ->. by apply/hasPn=> t _; apply: contra x'y => /mapP[t1 _ /rcons_inj[_ ->]]. Qed. Notation perms := permutations. Lemma permutationsE s : 0 < size s -> perm_eq (perms s) [seq x :: t | x <- undup s, t <- perms (rem x s)]. Proof. move=> nt_s; apply/uniq_perm=> [||t]; first exact: permutations_uniq. apply/allpairs_uniq_dep=> [|x _|]; rewrite ?undup_uniq ?permutations_uniq //. by case=> [_ _] [x t] _ _ [-> ->]. rewrite mem_permutations; apply/idP/allpairsPdep=> [Dt | [x [t1 []]]]. rewrite -(perm_size Dt) in nt_s; case: t nt_s => // x t _ in Dt *. have s_x: x \in s by rewrite -(perm_mem Dt) mem_head. exists x, t; rewrite mem_undup mem_permutations; split=> //. by rewrite -(perm_cons x) (permPl Dt) perm_to_rem. rewrite mem_undup mem_permutations -(perm_cons x) => s_x Dt1 ->. by rewrite (permPl Dt1) perm_sym perm_to_rem. Qed. Lemma permutationsErot x s (le_x := fun t => iota 0 (index x t + 1)) : perm_eq (perms (x :: s)) [seq rot i (x :: t) | t <- perms s, i <- le_x t]. Proof. have take'x t i: i <= index x t -> i <= size t /\ x \notin take i t. move=> le_i_x; have le_i_t: i <= size t := leq_trans le_i_x (index_size x t). case: (nthP x) => // -[j lt_j_i /eqP]; rewrite size_takel // in lt_j_i. by rewrite nth_take // [_ == _](before_find x (leq_trans lt_j_i le_i_x)). pose xrot t i := rot i (x :: t); pose xrotV t := index x (rev (rot 1 t)). have xrotK t: {in le_x t, cancel (xrot t) xrotV}. move=> i; rewrite mem_iota addn1 /xrotV => /take'x[le_i_t ti'x]. rewrite -rotD ?rev_cat //= rev_cons cat_rcons index_cat mem_rev size_rev. by rewrite ifN // size_takel //= eqxx addn0. apply/uniq_perm=> [||t]; first exact: permutations_uniq. apply/allpairs_uniq_dep=> [|t _|]; rewrite ?permutations_uniq ?iota_uniq //. move=> _ _ /allpairsPdep[t [i [_ ? ->]]] /allpairsPdep[u [j [_ ? ->]]] Etu. have Eij: i = j by rewrite -(xrotK t i) // /xrot Etu xrotK. by move: Etu; rewrite Eij => /rot_inj[->]. rewrite mem_permutations; apply/esym; apply/allpairsPdep/idP=> [[u [i]] | Dt]. rewrite mem_permutations => -[Du _ /(canLR (rotK i))]; rewrite /rotr. by set j := (j in rot j _) => Dt; apply/perm_consP; exists j, u. pose r := rev (rot 1 t); pose i := index x r; pose u := rev (take i r). have r_x: x \in r by rewrite mem_rev mem_rot (perm_mem Dt) mem_head. have [v Duv]: {v | rot i (x :: u ++ v) = t}; first exists (rev (drop i.+1 r)). rewrite -rev_cat -rev_rcons -rot1_cons -cat_cons -(nth_index x r_x). by rewrite -drop_nth ?index_mem // rot_rot !rev_rot revK rotK rotrK. exists (u ++ v), i; rewrite mem_permutations -(perm_cons x) -(perm_rot i) Duv. rewrite mem_iota addn1 ltnS /= index_cat mem_rev size_rev. by have /take'x[le_i_t ti'x] := leqnn i; rewrite ifN ?size_takel ?leq_addr. Qed. Lemma size_permutations s : uniq s -> size (permutations s) = (size s)`!. Proof. move Dn: (size s) => n Us; elim: n s => [[]|n IHn s] //= in Dn Us *. rewrite (perm_size (permutationsE _)) ?Dn // undup_id // factS -Dn. rewrite -(size_iota 0 n`!) -(size_allpairs (fun=>id)) !size_allpairs_dep. by apply/congr1/eq_in_map=> x sx; rewrite size_iota IHn ?size_rem ?Dn ?rem_uniq. Qed. Lemma permutations_all_uniq s : uniq s -> all uniq (permutations s). Proof. by move=> Us; apply/allP=> t; rewrite mem_permutations => /perm_uniq->. Qed. Lemma perm_permutations s t : perm_eq s t -> perm_eq (permutations s) (permutations t). Proof. move=> Est; apply/uniq_perm; try exact: permutations_uniq. by move=> u; rewrite !mem_permutations (permPr Est). Qed. End Permutations. Section AllIff. (* The Following Are Equivalent *) (* We introduce a specific conjunction, used to chain the consecutive *) (* items in a circular list of implications *) Inductive all_iff_and (P Q : Prop) : Prop := AllIffConj of P & Q. Definition all_iff (P0 : Prop) (Ps : seq Prop) : Prop := let fix loop (P : Prop) (Qs : seq Prop) : Prop := if Qs is Q :: Qs then all_iff_and (P -> Q) (loop Q Qs) else P -> P0 in loop P0 Ps. Lemma all_iffLR P0 Ps : all_iff P0 Ps -> forall m n, nth P0 (P0 :: Ps) m -> nth P0 (P0 :: Ps) n. Proof. move=> iffPs; have PsS n: nth P0 Ps n -> nth P0 Ps n.+1. elim: n P0 Ps iffPs => [|n IHn] P0 [|P [|Q Ps]] //= [iP0P] //; first by case. by rewrite nth_nil. by case=> iPQ iffPs; apply: IHn; split=> // /iP0P. have{PsS} lePs: {homo nth P0 Ps : m n / m <= n >-> (m -> n)}. by move=> m n /subnK<-; elim: {n}(n - m) => // n IHn /IHn; apply: PsS. move=> m n P_m; have{m P_m} hP0: P0. case: m P_m => //= m /(lePs m _ (leq_maxl m (size Ps))). by rewrite nth_default ?leq_maxr. case: n =>// n; apply: lePs 0 n (leq0n n) _. by case: Ps iffPs hP0 => // P Ps []. Qed. Lemma all_iffP P0 Ps : all_iff P0 Ps -> forall m n, nth P0 (P0 :: Ps) m <-> nth P0 (P0 :: Ps) n. Proof. by move=> /all_iffLR-iffPs m n; split => /iffPs. Qed. End AllIff. Arguments all_iffLR {P0 Ps}. Arguments all_iffP {P0 Ps}. Coercion all_iffP : all_iff >-> Funclass. (* This means "the following are all equivalent: P0, ... Pn" *) Notation "[ '<->' P0 ; P1 ; .. ; Pn ]" := (all_iff P0 (@cons Prop P1 (.. (@cons Prop Pn nil) ..))) : form_scope. Ltac tfae := do !apply: AllIffConj. (* Temporary backward compatibility. *) Notation take_addn := (deprecate take_addn takeD _) (only parsing). Notation rot_addn := (deprecate rot_addn rotD _) (only parsing). Notation nseq_addn := (deprecate nseq_addn nseqD _) (only parsing). Notation perm_eq_rev := (deprecate perm_eq_rev perm_rev _) (only parsing). Notation perm_eq_flatten := (deprecate perm_eq_flatten perm_flatten _ _ _) (only parsing). Notation perm_eq_all := (deprecate perm_eq_all perm_all _ _ _) (only parsing). Notation perm_eq_small := (deprecate perm_eq_small perm_small_eq _ _ _) (only parsing). Notation perm_eq_nilP := (deprecate perm_eq_nilP perm_nilP) (only parsing). Notation perm_eq_consP := (deprecate perm_eq_consP perm_consP) (only parsing). Notation leq_size_perm := ((fun T s1 s2 Us1 ss12 les21 => let: (Esz12, Es12) := deprecate leq_size_perm uniq_min_size T s1 s2 Us1 ss12 les21 in conj Es12 Esz12) _ _ _) (only parsing). Notation uniq_perm_eq := (deprecate uniq_perm_eq uniq_perm _ _ _) (only parsing). Notation perm_eq_iotaP := (deprecate perm_eq_iotaP perm_iotaP) (only parsing). Notation perm_undup_count := (deprecate perm_undup_count perm_count_undup _ _) (only parsing). (* TODO: restore when Coq 8.10 is no longer supported *) (* #[deprecated(since="mathcomp 1.13.0", note="Use iotaD instead.")] *) Notation iota_add := iotaD (only parsing). Notation iota_addl := (deprecate iota_addl iotaDl) (only parsing). Notation allpairs_catr := (deprecate allpairs_catr mem_allpairs_catr _ _ _) (only parsing). Notation allpairs_consr := (deprecate allpairs_consr mem_allpairs_consr _ _ _) (only parsing). Notation perm_allpairs_rconsr := (deprecate perm_allpairs_rconsr allpairs_rconsr _ _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrAC.v000066400000000000000000000251621375767750300223240ustar00rootroot00000000000000Require Import BinPos BinNat. From mathcomp Require Import ssreflect ssrbool ssrfun ssrnat eqtype seq bigop. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (************************************************************************) (* Small Scale Rewriting using Associatity and Commutativity *) (* *) (* Rewriting with AC (not modulo AC), using a small scale command. *) (* Replaces opA, opC, opAC, opCA, ... and any combinations of them *) (* *) (* Usage : *) (* rewrite [pattern](AC patternshape reordering) *) (* rewrite [pattern](ACl reordering) *) (* rewrite [pattern](ACof reordering reordering) *) (* rewrite [pattern]op.[AC patternshape reordering] *) (* rewrite [pattern]op.[ACl reordering] *) (* rewrite [pattern]op.[ACof reordering reordering] *) (* *) (* - if op is specified, the rule is specialized to op *) (* otherwise, the head symbol is a generic comm_law *) (* and the rewrite might be less efficient *) (* NOTE because of a bug in Coq's notations coq/coq#8190 *) (* op must not contain any hole. *) (* *%R.[AC p s] currently does not work because of that *) (* (@GRing.mul R).[AC p s] must be used instead *) (* *) (* - pattern is optional, as usual, but must be used to select the *) (* appropriate operator in case of ambiguity such an operator must *) (* have a canonical Monoid.com_law structure *) (* (additions, multiplications, conjuction and disjunction do) *) (* *) (* - patternshape is expressed using the syntax *) (* p := n | p * p' *) (* where "*" is purely formal *) (* and n > 0 is number of left associated symbols *) (* examples of pattern shapes: *) (* + 4 represents (n * m * p * q) *) (* + (1*2) represents (n * (m * p)) *) (* *) (* - reordering is expressed using the syntax *) (* s := n | s * s' *) (* where "*" is purely formal and n > 0 is the position in the LHS *) (* positions start at 1 ! *) (* *) (* If the ACl variant is used, the patternshape defaults to the *) (* pattern fully associated to the left i.e. n i.e (x * y * ...) *) (* *) (* Examples of reorderings: *) (* - ACl ((1*2)*3) is the identity (and will fail with error message) *) (* - opAC == op.[ACl (1*3)*2] == op.[AC 3 ((1*3)*2)] *) (* - opCA == op.[AC (2*1) (1*2*3)] *) (* - opACA == op.[AC (2*2) ((1*3)*(2*4))] *) (* - rewrite opAC -opA == rewrite op.[ACl 1*(3*2)] *) (* ... *) (************************************************************************) Declare Scope AC_scope. Delimit Scope AC_scope with AC. Definition change_type ty ty' (x : ty) (strategy : ty = ty') : ty' := ecast ty ty strategy x. Notation simplrefl := (ltac: (simpl; reflexivity)) (only parsing). Notation cbvrefl := (ltac: (cbv; reflexivity)) (only parsing). Notation vmrefl := (ltac: (vm_compute; reflexivity)) (only parsing). Module AC. Canonical positive_eqType := EqType positive (EqMixin (fun _ _ => equivP idP (Pos.eqb_eq _ _))). (* Should be replaced by (EqMixin Pos.eqb_spec) for coq >= 8.7 *) Inductive syntax := Leaf of positive | Op of syntax & syntax. Coercion serial := (fix loop (acc : seq positive) (s : syntax) := match s with | Leaf n => n :: acc | Op s s' => (loop^~ s (loop^~ s' acc)) end) [::]. Lemma serial_Op s1 s2 : Op s1 s2 = s1 ++ s2 :> seq _. Proof. rewrite /serial; set loop := (X in X [::]); rewrite -/loop. elim: s1 (loop [::] s2) => [n|s11 IHs1 s12 IHs2] //= l. by rewrite IHs1 [in RHS]IHs1 IHs2 catA. Qed. Definition Leaf_of_nat n := Leaf ((pos_of_nat n n) - 1)%positive. Module Import Syntax. Bind Scope AC_scope with syntax. Coercion Leaf : positive >-> syntax. Coercion Leaf_of_nat : nat >-> syntax. Notation "1" := 1%positive : AC_scope. Notation "x * y" := (Op x%AC y%AC) : AC_scope. End Syntax. Definition pattern (s : syntax) := ((fix loop n s := match s with | Leaf 1%positive => (Leaf n, Pos.succ n) | Leaf m => Pos.iter (fun oi => (Op oi.1 (Leaf oi.2), Pos.succ oi.2)) (Leaf n, Pos.succ n) (m - 1)%positive | Op s s' => let: (p, n') := loop n s in let: (p', n'') := loop n' s' in (Op p p', n'') end) 1%positive s).1. Section eval. Variables (T : Type) (idx : T) (op : T -> T -> T). Inductive env := Empty | ENode of T & env & env. Definition pos := fix loop (e : env) p {struct e} := match e, p with | ENode t _ _, 1%positive => t | ENode t e _, (p~0)%positive => loop e p | ENode t _ e, (p~1)%positive => loop e p | _, _ => idx end. Definition set_pos (f : T -> T) := fix loop e p {struct p} := match e, p with | ENode t e e', 1%positive => ENode (f t) e e' | ENode t e e', (p~0)%positive => ENode t (loop e p) e' | ENode t e e', (p~1)%positive => ENode t e (loop e' p) | Empty, 1%positive => ENode (f idx) Empty Empty | Empty, (p~0)%positive => ENode idx (loop Empty p) Empty | Empty, (p~1)%positive => ENode idx Empty (loop Empty p) end. Lemma pos_set_pos (f : T -> T) e (p p' : positive) : pos (set_pos f e p) p' = if p == p' then f (pos e p) else pos e p'. Proof. by elim: p e p' => [p IHp|p IHp|] [|???] [?|?|]//=; rewrite IHp. Qed. Fixpoint unzip z (e : env) : env := match z with | [::] => e | (x, inl e') :: z' => unzip z' (ENode x e' e) | (x, inr e') :: z' => unzip z' (ENode x e e') end. Definition set_pos_trec (f : T -> T) := fix loop z e p {struct p} := match e, p with | ENode t e e', 1%positive => unzip z (ENode (f t) e e') | ENode t e e', (p~0)%positive => loop ((t, inr e') :: z) e p | ENode t e e', (p~1)%positive => loop ((t, inl e) :: z) e' p | Empty, 1%positive => unzip z (ENode (f idx) Empty Empty) | Empty, (p~0)%positive => loop ((idx, (inr Empty)) :: z) Empty p | Empty, (p~1)%positive => loop ((idx, (inl Empty)) :: z) Empty p end. Lemma set_pos_trecE f z e p : set_pos_trec f z e p = unzip z (set_pos f e p). Proof. by elim: p e z => [p IHp|p IHp|] [|???] [|[??]?] //=; rewrite ?IHp. Qed. Definition eval (e : env) := fix loop (s : syntax) := match s with | Leaf n => pos e n | Op s s' => op (loop s) (loop s') end. End eval. Arguments Empty {T}. Definition content := (fix loop (acc : env N) s := match s with | Leaf n => set_pos_trec 0%num N.succ [::] acc n | Op s s' => loop (loop acc s') s end) Empty. Lemma count_memE x (t : syntax) : count_mem x t = pos 0%num (content t) x. Proof. rewrite /content; set loop := (X in X Empty); rewrite -/loop. rewrite -[LHS]addn0; have <- : pos 0%num Empty x = 0 :> nat by elim: x. elim: t Empty => [n|s IHs s' IHs'] e //=; last first. by rewrite serial_Op count_cat -addnA IHs' IHs. rewrite ?addn0 set_pos_trecE pos_set_pos; case: (altP eqP) => [->|] //=. by rewrite -N.add_1_l nat_of_add_bin //=. Qed. Definition cforall N T : env N -> (env T -> Type) -> Type := env_rect (@^~ Empty) (fun _ e IHe e' IHe' R => forall x, IHe (fun xe => IHe' (R \o ENode x xe))). Lemma cforallP N T R : (forall e : env T, R e) -> forall (e : env N), cforall e R. Proof. move=> Re e; elim: e R Re => [|? e /= IHe e' IHe' ?? x] //=. by apply: IHe => ?; apply: IHe' => /=. Qed. Section eq_eval. Variables (T : Type) (idx : T) (op : Monoid.com_law idx). Lemma proof (p s : syntax) : content p = content s -> forall env, eval idx op env p = eval idx op env s. Proof. suff evalE env t : eval idx op env t = \big[op/idx]_(i <- t) (pos idx env i). move=> cps e; rewrite !evalE; apply: perm_big. by apply/allP => x _ /=; rewrite !count_memE cps. elim: t => //= [n|t -> t' ->]; last by rewrite serial_Op big_cat. by rewrite big_cons big_nil Monoid.mulm1. Qed. Definition direct p s ps := cforallP (@proof p s ps) (content p). End eq_eval. Module Exports. Export AC.Syntax. End Exports. End AC. Export AC.Exports. Notation AC_check_pattern := (ltac: (match goal with |- AC.content ?pat = AC.content ?ord => let pat' := fresh "pat" in let pat' := eval compute in pat in tryif unify pat' ord then fail 1 "AC: equality between" pat "and" ord "is trivial, cannot progress" else tryif vm_compute; reflexivity then idtac else fail 2 "AC: mismatch between shape" pat "=" pat' "and reordering" ord | |- ?G => fail 3 "AC: no pattern to check" G end)) (only parsing). Notation opACof law p s := ((fun T idx op assoc lid rid comm => (change_type (@AC.direct T idx (@Monoid.ComLaw _ _ (@Monoid.Law _ idx op assoc lid rid) comm) p%AC s%AC AC_check_pattern) cbvrefl)) _ _ law (Monoid.mulmA _) (Monoid.mul1m _) (Monoid.mulm1 _) (Monoid.mulmC _)) (only parsing). Notation opAC op p s := (opACof op (AC.pattern p%AC) s%AC) (only parsing). Notation opACl op s := (opAC op (AC.Leaf_of_nat (size (AC.serial s%AC))) s%AC) (only parsing). Notation "op .[ 'ACof' p s ]" := (opACof op p s) (at level 2, p at level 1, left associativity, only parsing). Notation "op .[ 'AC' p s ]" := (opAC op p s) (at level 2, p at level 1, left associativity, only parsing). Notation "op .[ 'ACl' s ]" := (opACl op s) (at level 2, left associativity, only parsing). Notation AC_strategy := (ltac: (cbv -[Monoid.com_operator Monoid.operator]; reflexivity)) (only parsing). Notation ACof p s := (change_type (@AC.direct _ _ _ p%AC s%AC AC_check_pattern) AC_strategy) (only parsing). Notation AC p s := (ACof (AC.pattern p%AC) s%AC) (only parsing). Notation ACl s := (AC (AC.Leaf_of_nat (size (AC.serial s%AC))) s%AC) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrbool.v000066400000000000000000000347401375767750300227760ustar00rootroot00000000000000From mathcomp Require Import ssreflect ssrfun. From Coq Require Export ssrbool. (******************************************************************************) (* Local additions: *) (* {pred T} == a type convertible to pred T but that presents the *) (* pred_sort coercion class. *) (* PredType toP == the predType structure for toP : A -> pred T. *) (* relpre f r == the preimage of r by f, simplifying to r (f x) (f y). *) (* --> These will become part of the core SSReflect library with Coq 8.11. *) (* This file also anticipates a v8.11 change in the definition of simpl_pred *) (* to T -> simpl_pred T. This change ensures that inE expands the definition *) (* of r : simpl_rel along with the \in, when rewriting in y \in r x. *) (* *) (* This file also anticipates v8.13 additions as well as a generalization in *) (* the statments of `homoRL_in`, `homoLR_in`, `homo_mono_in`, `monoLR_in`, *) (* monoRL_in, and can_mono_in. *) (******************************************************************************) (******************) (* v8.11 addtions *) (******************) Notation "{ 'pred' T }" := (pred_sort (predPredType T)) (at level 0, format "{ 'pred' T }") : type_scope. Lemma simpl_pred_sortE T (p : pred T) : (SimplPred p : {pred T}) =1 p. Proof. by []. Qed. Definition inE := (inE, simpl_pred_sortE). Definition PredType : forall T pT, (pT -> pred T) -> predType T. exact PredType || exact mkPredType. Defined. Arguments PredType [T pT] toP. Definition simpl_rel T := T -> simpl_pred T. Definition SimplRel {T} (r : rel T) : simpl_rel T := fun x => SimplPred (r x). Coercion rel_of_simpl_rel T (sr : simpl_rel T) : rel T := sr. Arguments rel_of_simpl_rel {T} sr x / y : rename. (* Required to avoid an incompatible format warning with coq-8.12 *) Reserved Notation "[ 'rel' x y : T | E ]" (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y : T | '/ ' E ] ']'"). Notation "[ 'rel' x y | E ]" := (SimplRel (fun x y => E%B)) (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y | '/ ' E ] ']'") : fun_scope. Notation "[ 'rel' x y : T | E ]" := (SimplRel (fun x y : T => E%B)) (only parsing) : fun_scope. Notation "[ 'rel' x y 'in' A & B | E ]" := [rel x y | (x \in A) && (y \in B) && E] (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y 'in' A & B | '/ ' E ] ']'") : fun_scope. Notation "[ 'rel' x y 'in' A & B ]" := [rel x y | (x \in A) && (y \in B)] (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y 'in' A & B ] ']'") : fun_scope. Notation "[ 'rel' x y 'in' A | E ]" := [rel x y in A & A | E] (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y 'in' A | '/ ' E ] ']'") : fun_scope. Notation "[ 'rel' x y 'in' A ]" := [rel x y in A & A] (at level 0, x ident, y ident, format "'[hv' [ 'rel' x y 'in' A ] ']'") : fun_scope. Notation xrelpre := (fun f (r : rel _) x y => r (f x) (f y)). Definition relpre {T rT} (f : T -> rT) (r : rel rT) := [rel x y | r (f x) (f y)]. (******************) (* v8.13 addtions *) (******************) Section HomoMonoMorphismFlip. Variables (aT rT : Type) (aR : rel aT) (rR : rel rT) (f : aT -> rT). Variable (aD aD' : {pred aT}). Lemma homo_sym : {homo f : x y / aR x y >-> rR x y} -> {homo f : y x / aR x y >-> rR x y}. Proof. by move=> fR y x; apply: fR. Qed. Lemma mono_sym : {mono f : x y / aR x y >-> rR x y} -> {mono f : y x / aR x y >-> rR x y}. Proof. by move=> fR y x; apply: fR. Qed. Lemma homo_sym_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in aD &, {homo f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma mono_sym_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in aD &, {mono f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma homo_sym_in11 : {in aD & aD', {homo f : x y / aR x y >-> rR x y}} -> {in aD' & aD, {homo f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma mono_sym_in11 : {in aD & aD', {mono f : x y / aR x y >-> rR x y}} -> {in aD' & aD, {mono f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. End HomoMonoMorphismFlip. Arguments homo_sym {aT rT} [aR rR f]. Arguments mono_sym {aT rT} [aR rR f]. Arguments homo_sym_in {aT rT} [aR rR f aD]. Arguments mono_sym_in {aT rT} [aR rR f aD]. Arguments homo_sym_in11 {aT rT} [aR rR f aD aD']. Arguments mono_sym_in11 {aT rT} [aR rR f aD aD']. (******************) (* v8.14 addtions *) (******************) Section LocalGlobal. Local Notation "{ 'all1' P }" := (forall x, P x : Prop) (at level 0). Local Notation "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0). Variables T1 T2 T3 : predArgType. Variables (D1 : {pred T1}) (D2 : {pred T2}). Variables (f : T1 -> T2) (h : T3). Variable Q1 : (T1 -> T2) -> T1 -> Prop. Variable Q1l : (T1 -> T2) -> T3 -> T1 -> Prop. Variable Q2 : (T1 -> T2) -> T1 -> T1 -> Prop. Let allQ1 f'' := {all1 Q1 f''}. Let allQ1l f'' h' := {all1 Q1l f'' h'}. Let allQ2 f'' := {all2 Q2 f''}. Lemma in_on1P : {in D1, {on D2, allQ1 f}} <-> {in [pred x in D1 | f x \in D2], allQ1 f}. Proof. split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP. by move=> ? ?; apply: Q1f; apply/andP. Qed. Lemma in_on1lP : {in D1, {on D2, allQ1l f & h}} <-> {in [pred x in D1 | f x \in D2], allQ1l f h}. Proof. split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP. by move=> ? ?; apply: Q1f; apply/andP. Qed. Lemma in_on2P : {in D1 &, {on D2 &, allQ2 f}} <-> {in [pred x in D1 | f x \in D2] &, allQ2 f}. Proof. split => allf x y; have := allf x y; rewrite !inE => Q2f. by move=> /andP[? ?] /andP[? ?]; apply: Q2f. by move=> ? ? ? ?; apply: Q2f; apply/andP. Qed. Lemma on1W_in : {in D1, allQ1 f} -> {in D1, {on D2, allQ1 f}}. Proof. by move=> D1f ? /D1f. Qed. Lemma on1lW_in : {in D1, allQ1l f h} -> {in D1, {on D2, allQ1l f & h}}. Proof. by move=> D1f ? /D1f. Qed. Lemma on2W_in : {in D1 &, allQ2 f} -> {in D1 &, {on D2 &, allQ2 f}}. Proof. by move=> D1f ? ? ? ? ? ?; apply: D1f. Qed. Lemma in_on1W : allQ1 f -> {in D1, {on D2, allQ1 f}}. Proof. by move=> allf ? ? ?; apply: allf. Qed. Lemma in_on1lW : allQ1l f h -> {in D1, {on D2, allQ1l f & h}}. Proof. by move=> allf ? ? ?; apply: allf. Qed. Lemma in_on2W : allQ2 f -> {in D1 &, {on D2 &, allQ2 f}}. Proof. by move=> allf ? ? ? ? ? ?; apply: allf. Qed. Lemma on1S : (forall x, f x \in D2) -> {on D2, allQ1 f} -> allQ1 f. Proof. by move=> ? fD1 ?; apply: fD1. Qed. Lemma on1lS : (forall x, f x \in D2) -> {on D2, allQ1l f & h} -> allQ1l f h. Proof. by move=> ? fD1 ?; apply: fD1. Qed. Lemma on2S : (forall x, f x \in D2) -> {on D2 &, allQ2 f} -> allQ2 f. Proof. by move=> ? fD1 ? ?; apply: fD1. Qed. Lemma on1S_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1, {on D2, allQ1 f}} -> {in D1, allQ1 f}. Proof. by move=> fD fD1 ? ?; apply/fD1/fD. Qed. Lemma on1lS_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1, {on D2, allQ1l f & h}} -> {in D1, allQ1l f h}. Proof. by move=> fD fD1 ? ?; apply/fD1/fD. Qed. Lemma on2S_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1 &, {on D2 &, allQ2 f}} -> {in D1 &, allQ2 f}. Proof. by move=> fD fD1 ? ? ? ?; apply: fD1 => //; apply: fD. Qed. Lemma in_on1S : (forall x, f x \in D2) -> {in T1, {on D2, allQ1 f}} -> allQ1 f. Proof. by move=> fD2 fD1 ?; apply: fD1. Qed. Lemma in_on1lS : (forall x, f x \in D2) -> {in T1, {on D2, allQ1l f & h}} -> allQ1l f h. Proof. by move=> fD2 fD1 ?; apply: fD1. Qed. Lemma in_on2S : (forall x, f x \in D2) -> {in T1 &, {on D2 &, allQ2 f}} -> allQ2 f. Proof. by move=> fD2 fD1 ? ?; apply: fD1. Qed. End LocalGlobal. Arguments in_on1P {T1 T2 D1 D2 f Q1}. Arguments in_on1lP {T1 T2 T3 D1 D2 f h Q1l}. Arguments in_on2P {T1 T2 D1 D2 f Q2}. Arguments on1W_in {T1 T2 D1} D2 {f Q1}. Arguments on1lW_in {T1 T2 T3 D1} D2 {f h Q1l}. Arguments on2W_in {T1 T2 D1} D2 {f Q2}. Arguments in_on1W {T1 T2} D1 D2 {f Q1}. Arguments in_on1lW {T1 T2 T3} D1 D2 {f h Q1l}. Arguments in_on2W {T1 T2} D1 D2 {f Q2}. Arguments on1S {T1 T2} D2 {f Q1}. Arguments on1lS {T1 T2 T3} D2 {f h Q1l}. Arguments on2S {T1 T2} D2 {f Q2}. Arguments on1S_in {T1 T2 D1} D2 {f Q1}. Arguments on1lS_in {T1 T2 T3 D1} D2 {f h Q1l}. Arguments on2S_in {T1 T2 D1} D2 {f Q2}. Arguments in_on1S {T1 T2} D2 {f Q1}. Arguments in_on1lS {T1 T2 T3} D2 {f h Q1l}. Arguments in_on2S {T1 T2} D2 {f Q2}. (******************) (* v8.13 addtions *) (******************) Section CancelOn. Variables (aT rT : predArgType) (aD : {pred aT}) (rD : {pred rT}). Variables (f : aT -> rT) (g : rT -> aT). Lemma onW_can : cancel g f -> {on aD, cancel g & f}. Proof. exact: on1lW. Qed. Lemma onW_can_in : {in rD, cancel g f} -> {in rD, {on aD, cancel g & f}}. Proof. exact: on1lW_in. Qed. Lemma in_onW_can : cancel g f -> {in rD, {on aD, cancel g & f}}. Proof. exact: in_on1lW. Qed. Lemma onS_can : (forall x, g x \in aD) -> {on aD, cancel g & f} -> cancel g f. Proof. exact: on1lS. Qed. Lemma onS_can_in : {homo g : x / x \in rD >-> x \in aD} -> {in rD, {on aD, cancel g & f}} -> {in rD, cancel g f}. Proof. exact: on1lS_in. Qed. Lemma in_onS_can : (forall x, g x \in aD) -> {in rT, {on aD, cancel g & f}} -> cancel g f. Proof. exact: in_on1lS. Qed. End CancelOn. Arguments onW_can {aT rT} aD {f g}. Arguments onW_can_in {aT rT} aD {rD f g}. Arguments in_onW_can {aT rT} aD rD {f g}. Arguments onS_can {aT rT} aD {f g}. Arguments onS_can_in {aT rT} aD {rD f g}. Arguments in_onS_can {aT rT} aD {f g}. Section MonoHomoMorphismTheory_in. Variables (aT rT : predArgType) (aD : {pred aT}) (rD : {pred rT}). Variables (f : aT -> rT) (g : rT -> aT) (aR : rel aT) (rR : rel rT). Hypothesis fgK : {in rD, {on aD, cancel g & f}}. Hypothesis mem_g : {homo g : x / x \in rD >-> x \in aD}. Lemma homoRL_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in rD & aD, forall x y, aR (g x) y -> rR x (f y)}. Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed. Lemma homoLR_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in aD & rD, forall x y, aR x (g y) -> rR (f x) y}. Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed. Lemma homo_mono_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in rD &, {homo g : x y / rR x y >-> aR x y}} -> {in rD &, {mono g : x y / rR x y >-> aR x y}}. Proof. move=> mf mg x y hx hy; case: (boolP (rR _ _))=> [/mg //|]; first exact. by apply: contraNF=> /mf; rewrite !fgK ?mem_g//; apply. Qed. Lemma monoLR_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in aD & rD, forall x y, rR (f x) y = aR x (g y)}. Proof. by move=> mf x y hx hy; rewrite -{1}[y]fgK ?mem_g// mf ?mem_g. Qed. Lemma monoRL_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in rD & aD, forall x y, rR x (f y) = aR (g x) y}. Proof. by move=> mf x y hx hy; rewrite -{1}[x]fgK ?mem_g// mf ?mem_g. Qed. Lemma can_mono_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in rD &, {mono g : x y / rR x y >-> aR x y}}. Proof. by move=> mf x y hx hy; rewrite -mf ?mem_g// !fgK ?mem_g. Qed. End MonoHomoMorphismTheory_in. Arguments homoRL_in {aT rT aD rD f g aR rR}. Arguments homoLR_in {aT rT aD rD f g aR rR}. Arguments homo_mono_in {aT rT aD rD f g aR rR}. Arguments monoLR_in {aT rT aD rD f g aR rR}. Arguments monoRL_in {aT rT aD rD f g aR rR}. Arguments can_mono_in {aT rT aD rD f g aR rR}. Section inj_can_sym_in_on. Variables (aT rT : predArgType) (aD : {pred aT}) (rD : {pred rT}). Variables (f : aT -> rT) (g : rT -> aT). Lemma inj_can_sym_in_on : {homo f : x / x \in aD >-> x \in rD} -> {in aD, {on rD, cancel f & g}} -> {in rD &, {on aD &, injective g}} -> {in rD, {on aD, cancel g & f}}. Proof. by move=> fD fK gI x x_rD gx_aD; apply: gI; rewrite ?inE ?fK ?fD. Qed. Lemma inj_can_sym_on : {in aD, cancel f g} -> {on aD &, injective g} -> {on aD, cancel g & f}. Proof. by move=> fK gI x gx_aD; apply: gI; rewrite ?inE ?fK. Qed. Lemma inj_can_sym_in : {homo f \o g : x / x \in rD} -> {on rD, cancel f & g} -> {in rD &, injective g} -> {in rD, cancel g f}. Proof. by move=> fgD fK gI x x_rD; apply: gI; rewrite ?fK ?fgD. Qed. End inj_can_sym_in_on. Arguments inj_can_sym_in_on {aT rT aD rD f g}. Arguments inj_can_sym_on {aT rT aD f g}. Arguments inj_can_sym_in {aT rT rD f g}. (* additional contra lemmas involving [P,Q : Prop] *) Section Contra. Implicit Types (P Q : Prop) (b : bool). Lemma contra_not P Q : (Q -> P) -> (~ P -> ~ Q). Proof. by auto. Qed. Lemma contraPnot P Q : (Q -> ~ P) -> (P -> ~ Q). Proof. by auto. Qed. Lemma contraTnot b P : (P -> ~~ b) -> (b -> ~ P). Proof. by case: b; auto. Qed. Lemma contraNnot P b : (P -> b) -> (~~ b -> ~ P). Proof. rewrite -{1}[b]negbK; exact: contraTnot. Qed. Lemma contraPT P b : (~~ b -> ~ P) -> P -> b. Proof. by case: b => //= /(_ isT) nP /nP. Qed. Lemma contra_notT P b : (~~ b -> P) -> ~ P -> b. Proof. by case: b => //= /(_ isT) HP /(_ HP). Qed. Lemma contra_notN P b : (b -> P) -> ~ P -> ~~ b. Proof. rewrite -{1}[b]negbK; exact: contra_notT. Qed. Lemma contraPN P b : (b -> ~ P) -> (P -> ~~ b). Proof. by case: b => //=; move/(_ isT) => HP /HP. Qed. Lemma contraFnot P b : (P -> b) -> b = false -> ~ P. Proof. by case: b => //; auto. Qed. Lemma contraPF P b : (b -> ~ P) -> P -> b = false. Proof. by case: b => // /(_ isT). Qed. Lemma contra_notF P b : (b -> P) -> ~ P -> b = false. Proof. by case: b => // /(_ isT). Qed. End Contra. (******************) (* v8.14 addtions *) (******************) Section in_sig. Local Notation "{ 'all1' P }" := (forall x, P x : Prop) (at level 0). Local Notation "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0). Local Notation "{ 'all3' P }" := (forall x y z, P x y z : Prop) (at level 0). Variables T1 T2 T3 : Type. Variables (D1 : {pred T1}) (D2 : {pred T2}) (D3 : {pred T3}). Variable P1 : T1 -> Prop. Variable P2 : T1 -> T2 -> Prop. Variable P3 : T1 -> T2 -> T3 -> Prop. Lemma in1_sig : {in D1, {all1 P1}} -> forall x : sig D1, P1 (sval x). Proof. by move=> DP [x Dx]; have := DP _ Dx. Qed. Lemma in2_sig : {in D1 & D2, {all2 P2}} -> forall (x : sig D1) (y : sig D2), P2 (sval x) (sval y). Proof. by move=> DP [x Dx] [y Dy]; have := DP _ _ Dx Dy. Qed. Lemma in3_sig : {in D1 & D2 & D3, {all3 P3}} -> forall (x : sig D1) (y : sig D2) (z : sig D3), P3 (sval x) (sval y) (sval z). Proof. by move=> DP [x Dx] [y Dy] [z Dz]; have := DP _ _ _ Dx Dy Dz. Qed. End in_sig. Arguments in1_sig {T1 D1 P1}. Arguments in2_sig {T1 T2 D1 D2 P2}. Arguments in3_sig {T1 T2 T3 D1 D2 D3 P3}. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssreflect.v000066400000000000000000000140641375767750300233020ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From Coq Require Export ssreflect. Global Set SsrOldRewriteGoalsOrder. Global Set Asymmetric Patterns. Global Set Bullet Behavior "None". (******************************************************************************) (* Local additions: *) (* nonPropType == an interface for non-Prop Types: a nonPropType coerces *) (* to a Type, and only types that do _not_ have sort *) (* Prop are canonical nonPropType instances. This is *) (* useful for applied views. *) (* --> This will become standard with the Coq v8.11 SSReflect core library. *) (* deprecate old new == new, but warning that old is deprecated and new *) (* should be used instead. *) (* --> Usage: Notation old := (deprecate old new) (only parsing). *) (* --> Caveat: deprecate old new only inherits new's maximal implicits; *) (* on-demand implicits should be added after : (deprecate old new _). *) (* --> Caveat 2: if premises or conclusions need to be adjusted, of for *) (* non-prenex implicits, use the idiom: *) (* Notation old := ((fun a1 a2 ... => deprecate old new a1 a2 ...) *) (* _ _ ... _) (only printing). *) (* where all the implicit a_i's occur first, and correspond to the *) (* trailing _'s, making sure deprecate old new is fully applied and *) (* there are _no implicits_ inside the (fun .. => ..) expression. This *) (* is to avoid triggering a bug in SSReflect elaboration that is *) (* triggered by such evars under binders. *) (* Import Deprecation.Silent :: turn off deprecation warning messages. *) (* Import Deprecation.Reject :: raise an error instead of only warning. *) (* *) (* Intro pattern ltac views: *) (* - top of the stack actions: *) (* => /[apply] := => hyp {}/hyp *) (* => /[swap] := => x y; move: y x *) (* (also swap and perserves let bindings) *) (* => /[dup] := => x; have copy := x; move: copy x *) (* (also copies and preserves let bindings) *) (******************************************************************************) Module NonPropType. Structure call_of (condition : unit) (result : bool) := Call {callee : Type}. Definition maybeProp (T : Type) := tt. Definition call T := Call (maybeProp T) false T. Structure test_of (result : bool) := Test {condition :> unit}. Definition test_Prop (P : Prop) := Test true (maybeProp P). Definition test_negative := Test false tt. Structure type := Check {result : bool; test : test_of result; frame : call_of test result}. Definition check result test frame := @Check result test frame. Module Exports. Canonical call. Canonical test_Prop. Canonical test_negative. Canonical check. Notation nonPropType := type. Coercion callee : call_of >-> Sortclass. Coercion frame : type >-> call_of. Notation notProp T := (@check false test_negative (call T)). End Exports. End NonPropType. Export NonPropType.Exports. Module Deprecation. Definition hidden (T : Type) := T. Definition exposed (T : Type) & unit -> unit -> unit := T. Definition hide T u (v : exposed T u) : hidden T := v. Ltac warn old_id new_id := idtac "Warning:" old_id "is deprecated; use" new_id "instead". Ltac stop old_id new_id := fail 1 "Error:" old_id "is deprecated; use" new_id "instead". Structure hinted := Hint {statement; hint : statement}. Ltac check cond := let test := constr:(hint _ : cond) in idtac. Variant reject := Reject. Definition reject_hint := Hint reject Reject. Module Reject. Canonical reject_hint. End Reject. Variant silent := Silent. Definition silent_hint := Hint silent Silent. Module Silent. Canonical silent_hint. End Silent. Ltac flag old_id new_id := first [check reject; stop old_id new_id | check silent | warn old_id new_id]. Module Exports. Arguments hide {T} u v /. Coercion hide : exposed >-> hidden. Notation deprecate old_id new_id := (hide (fun old_id new_id => ltac:(flag old_id new_id; exact tt)) new_id) (only parsing). End Exports. End Deprecation. Export Deprecation.Exports. Module Export ipat. Notation "'[' 'apply' ']'" := (ltac:(let f := fresh "_top_" in move=> f {}/f)) (at level 0, only parsing) : ssripat_scope. (* we try to preserve the naming by matching the names from the goal *) (* we do move to perform a hnf before trying to match *) Notation "'[' 'swap' ']'" := (ltac:(move; let x := lazymatch goal with | |- forall (x : _), _ => fresh x | |- let x := _ in _ => fresh x | _ => fresh "_top_" end in intro x; move; let y := lazymatch goal with | |- forall (y : _), _ => fresh y | |- let y := _ in _ => fresh y | _ => fresh "_top_" end in intro y; revert x; revert y)) (at level 0, only parsing) : ssripat_scope. (* we try to preserve the naming by matching the names from the goal *) (* we do move to perform a hnf before trying to match *) Notation "'[' 'dup' ']'" := (ltac:(move; lazymatch goal with | |- forall (x : _), _ => let x := fresh x in intro x; let copy := fresh x in have copy := x; revert x; revert copy | |- let x := _ in _ => let x := fresh x in intro x; let copy := fresh x in pose copy := x; do [unfold x in (value of copy)]; revert x; revert copy | |- _ => let x := fresh "_top_" in move=> x; let copy := fresh "_top" in have copy := x; revert x; revert copy end)) (at level 0, only parsing) : ssripat_scope. End ipat. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrfun.v000066400000000000000000000021211375767750300226170ustar00rootroot00000000000000From mathcomp Require Import ssreflect. From Coq Require Export ssrfun. From mathcomp Require Export ssrnotations. (******************************************************************************) (* Local additions: *) (* void == a notation for the Empty_set type of the standard library. *) (* of_void T == the canonical injection void -> T. *) (******************************************************************************) Lemma Some_inj {T : nonPropType} : injective (@Some T). Proof. by move=> x y []. Qed. Notation void := Empty_set. Definition of_void T (x : void) : T := match x with end. Lemma of_voidK T : pcancel (of_void T) [fun _ => None]. Proof. by case. Qed. Lemma inj_compr A B C (f : B -> A) (h : C -> B) : injective (f \o h) -> injective h. Proof. by move=> fh_inj x y /(congr1 f) /fh_inj. Qed. Definition injective2 (rT aT1 aT2 : Type) (f : aT1 -> aT2 -> rT) := forall (x1 x2 : aT1) (y1 y2 : aT2), f x1 y1 = f x2 y2 -> (x1 = x2) * (y1 = y2). Arguments injective2 [rT aT1 aT2] f. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrmatching.v000066400000000000000000000000451375767750300236240ustar00rootroot00000000000000From Coq Require Export ssrmatching. math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrnat.v000066400000000000000000002263711375767750300226300ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype. Require Import BinNat. Require BinPos Ndec. Require Export Ring. (******************************************************************************) (* A version of arithmetic on nat (natural numbers) that is better suited to *) (* small scale reflection than the Coq Arith library. It contains an *) (* extensive equational theory (including, e.g., the AGM inequality), as well *) (* as support for the ring tactic, and congruence tactics. *) (* The following operations and notations are provided: *) (* *) (* successor and predecessor *) (* n.+1, n.+2, n.+3, n.+4 and n.-1, n.-2 *) (* this frees the names "S" and "pred" *) (* *) (* basic arithmetic *) (* m + n, m - n, m * n *) (* Important: m - n denotes TRUNCATED subtraction: m - n = 0 if m <= n. *) (* The definitions use the nosimpl tag to prevent undesirable computation *) (* computation during simplification, but remain compatible with the ones *) (* provided in the Coq.Init.Peano prelude. *) (* For computation, a module NatTrec rebinds all arithmetic notations *) (* to less convenient but also less inefficient tail-recursive functions; *) (* the auxiliary functions used by these versions are flagged with %Nrec. *) (* Also, there is support for input and output of large nat values. *) (* Num 3 082 241 inputs the number 3082241 *) (* [Num of n] outputs the value n *) (* There are coercions num >-> BinNat.N >-> nat; ssrnat rebinds the scope *) (* delimiter for BinNat.N to %num, as it uses the shorter %N for its own *) (* notations (Peano notations are flagged with %coq_nat). *) (* *) (* doubling, halving, and parity *) (* n.*2, n./2, odd n, uphalf n, with uphalf n = n.+1./2 *) (* bool coerces to nat so we can write, e.g., n = odd n + n./2.*2. *) (* *) (* iteration *) (* iter n f x0 == f ( .. (f x0)) *) (* iteri n g x0 == g n.-1 (g ... (g 0 x0)) *) (* iterop n op x x0 == op x (... op x x) (n x's) or x0 if n = 0 *) (* *) (* exponentiation, factorial *) (* m ^ n, n`! *) (* m ^ 1 is convertible to m, and m ^ 2 to m * m *) (* *) (* comparison *) (* m <= n, m < n, m >= n, m > n, m == n, m <= n <= p, etc., *) (* comparisons are BOOLEAN operators, and m == n is the generic eqType *) (* operation. *) (* Most compatibility lemmas are stated as boolean equalities; this keeps *) (* the size of the library down. All the inequalities refer to the same *) (* constant "leq"; in particular m < n is identical to m.+1 <= n. *) (* *) (* conditionally strict inequality `leqif' *) (* m <= n ?= iff condition == (m <= n) and ((m == n) = condition) *) (* This is actually a pair of boolean equalities, so rewriting with an *) (* `leqif' lemma can affect several kinds of comparison. The transitivity *) (* lemma for leqif aggregates the conditions, allowing for arguments of *) (* the form ``m <= n <= p <= m, so equality holds throughout''. *) (* *) (* maximum and minimum *) (* maxn m n, minn m n *) (* Note that maxn m n = m + (n - m), due to the truncating subtraction. *) (* Absolute difference (linear distance) between nats is defined in the int *) (* library (in the int.IntDist sublibrary), with the syntax `|m - n|. The *) (* '-' in this notation is the signed integer difference. *) (* *) (* countable choice *) (* ex_minn : forall P : pred nat, (exists n, P n) -> nat *) (* This returns the smallest n such that P n holds. *) (* ex_maxn : forall (P : pred nat) m, *) (* (exists n, P n) -> (forall n, P n -> n <= m) -> nat *) (* This returns the largest n such that P n holds (given an explicit upper *) (* bound). *) (* *) (* This file adds the following suffix conventions to those documented in *) (* ssrbool.v and eqtype.v: *) (* A (infix) -- conjunction, as in *) (* ltn_neqAle : (m < n) = (m != n) && (m <= n). *) (* B -- subtraction, as in subBn : (m - n) - p = m - (n + p). *) (* D -- addition, as in mulnDl : (m + n) * p = m * p + n * p. *) (* M -- multiplication, as in expnMn : (m * n) ^ p = m ^ p * n ^ p. *) (* p (prefix) -- positive, as in *) (* eqn_pmul2l : m > 0 -> (m * n1 == m * n2) = (n1 == n2). *) (* P -- greater than 1, as in *) (* ltn_Pmull : 1 < n -> 0 < m -> m < n * m. *) (* S -- successor, as in addSn : n.+1 + m = (n + m).+1. *) (* V (infix) -- disjunction, as in *) (* leq_eqVlt : (m <= n) = (m == n) || (m < n). *) (* X - exponentiation, as in lognX : logn p (m ^ n) = logn p m * n in *) (* file prime.v (the suffix is not used in this file). *) (* Suffixes that abbreviate operations (D, B, M and X) are used to abbreviate *) (* second-rank operations in equational lemma names that describe left-hand *) (* sides (e.g., mulnDl); they are not used to abbreviate the main operation *) (* of relational lemmas (e.g., leq_add2l). *) (* For the asymmetrical exponentiation operator expn (m ^ n) a right suffix *) (* indicates an operation on the exponent, e.g., expnM : m ^ (n1 * n2) = ...; *) (* a trailing "n" is used to indicate the left operand, e.g., *) (* expnMn : (m1 * m2) ^ n = ... The operands of other operators are selected *) (* using the l/r suffixes. *) (******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope coq_nat_scope. Declare Scope nat_rec_scope. (* Disable Coq prelude hints to improve proof script robustness. *) Remove Hints plus_n_O plus_n_Sm mult_n_O mult_n_Sm : core. (* Declare legacy Arith operators in new scope. *) Delimit Scope coq_nat_scope with coq_nat. Notation "m + n" := (plus m n) : coq_nat_scope. Notation "m - n" := (minus m n) : coq_nat_scope. Notation "m * n" := (mult m n) : coq_nat_scope. Notation "m <= n" := (le m n) : coq_nat_scope. Notation "m < n" := (lt m n) : coq_nat_scope. Notation "m >= n" := (ge m n) : coq_nat_scope. Notation "m > n" := (gt m n) : coq_nat_scope. (* Rebind scope delimiters, reserving a scope for the "recursive", *) (* i.e., unprotected version of operators. *) Delimit Scope N_scope with num. Delimit Scope nat_scope with N. Delimit Scope nat_rec_scope with Nrec. (* Postfix notation for the successor and predecessor functions. *) (* SSreflect uses "pred" for the generic predicate type, and S as *) (* a local bound variable. *) Notation succn := Datatypes.S. Notation predn := Peano.pred. Notation "n .+1" := (succn n) (at level 2, left associativity, format "n .+1") : nat_scope. Notation "n .+2" := n.+1.+1 (at level 2, left associativity, format "n .+2") : nat_scope. Notation "n .+3" := n.+2.+1 (at level 2, left associativity, format "n .+3") : nat_scope. Notation "n .+4" := n.+2.+2 (at level 2, left associativity, format "n .+4") : nat_scope. Notation "n .-1" := (predn n) (at level 2, left associativity, format "n .-1") : nat_scope. Notation "n .-2" := n.-1.-1 (at level 2, left associativity, format "n .-2") : nat_scope. Lemma succnK : cancel succn predn. Proof. by []. Qed. Lemma succn_inj : injective succn. Proof. by move=> n m []. Qed. (* Predeclare postfix doubling/halving operators. *) Reserved Notation "n .*2" (at level 2, format "n .*2"). Reserved Notation "n ./2" (at level 2, format "n ./2"). (* Canonical comparison and eqType for nat. *) Fixpoint eqn m n {struct m} := match m, n with | 0, 0 => true | m'.+1, n'.+1 => eqn m' n' | _, _ => false end. Lemma eqnP : Equality.axiom eqn. Proof. move=> n m; apply: (iffP idP) => [|<-]; last by elim n. by elim: n m => [|n IHn] [|m] //= /IHn->. Qed. Canonical nat_eqMixin := EqMixin eqnP. Canonical nat_eqType := Eval hnf in EqType nat nat_eqMixin. Arguments eqn !m !n. Arguments eqnP {x y}. Lemma eqnE : eqn = eq_op. Proof. by []. Qed. Lemma eqSS m n : (m.+1 == n.+1) = (m == n). Proof. by []. Qed. Lemma nat_irrelevance (x y : nat) (E E' : x = y) : E = E'. Proof. exact: eq_irrelevance. Qed. (* Protected addition, with a more systematic set of lemmas. *) Definition addn_rec := plus. Notation "m + n" := (addn_rec m n) : nat_rec_scope. Definition addn := nosimpl addn_rec. Notation "m + n" := (addn m n) : nat_scope. Lemma addnE : addn = addn_rec. Proof. by []. Qed. Lemma plusE : plus = addn. Proof. by []. Qed. Lemma add0n : left_id 0 addn. Proof. by []. Qed. Lemma addSn m n : m.+1 + n = (m + n).+1. Proof. by []. Qed. Lemma add1n n : 1 + n = n.+1. Proof. by []. Qed. Lemma addn0 : right_id 0 addn. Proof. by move=> n; apply/eqP; elim: n. Qed. Lemma addnS m n : m + n.+1 = (m + n).+1. Proof. by apply/eqP; elim: m. Qed. Lemma addSnnS m n : m.+1 + n = m + n.+1. Proof. by rewrite addnS. Qed. Lemma addnCA : left_commutative addn. Proof. by move=> m n p; elim: m => //= m; rewrite addnS => <-. Qed. Lemma addnC : commutative addn. Proof. by move=> m n; rewrite -[n in LHS]addn0 addnCA addn0. Qed. Lemma addn1 n : n + 1 = n.+1. Proof. by rewrite addnC. Qed. Lemma addnA : associative addn. Proof. by move=> m n p; rewrite (addnC n) addnCA addnC. Qed. Lemma addnAC : right_commutative addn. Proof. by move=> m n p; rewrite -!addnA (addnC n). Qed. Lemma addnCAC m n p : m + n + p = p + n + m. Proof. by rewrite addnC addnA addnAC. Qed. Lemma addnACl m n p: m + n + p = n + (p + m). Proof. by rewrite (addnC m) addnC addnCA. Qed. Lemma addnACA : interchange addn addn. Proof. by move=> m n p q; rewrite -!addnA (addnCA n). Qed. Lemma addn_eq0 m n : (m + n == 0) = (m == 0) && (n == 0). Proof. by case: m; case: n. Qed. Lemma eqn_add2l p m n : (p + m == p + n) = (m == n). Proof. by elim: p. Qed. Lemma eqn_add2r p m n : (m + p == n + p) = (m == n). Proof. by rewrite -!(addnC p) eqn_add2l. Qed. Lemma addnI : right_injective addn. Proof. by move=> p m n Heq; apply: eqP; rewrite -(eqn_add2l p) Heq eqxx. Qed. Lemma addIn : left_injective addn. Proof. move=> p m n; rewrite -!(addnC p); apply addnI. Qed. Lemma addn2 m : m + 2 = m.+2. Proof. by rewrite addnC. Qed. Lemma add2n m : 2 + m = m.+2. Proof. by []. Qed. Lemma addn3 m : m + 3 = m.+3. Proof. by rewrite addnC. Qed. Lemma add3n m : 3 + m = m.+3. Proof. by []. Qed. Lemma addn4 m : m + 4 = m.+4. Proof. by rewrite addnC. Qed. Lemma add4n m : 4 + m = m.+4. Proof. by []. Qed. (* Protected, structurally decreasing subtraction, and basic lemmas. *) (* Further properties depend on ordering conditions. *) Definition subn_rec := minus. Arguments subn_rec : simpl nomatch. Notation "m - n" := (subn_rec m n) : nat_rec_scope. Definition subn := nosimpl subn_rec. Notation "m - n" := (subn m n) : nat_scope. Lemma subnE : subn = subn_rec. Proof. by []. Qed. Lemma minusE : minus = subn. Proof. by []. Qed. Lemma sub0n : left_zero 0 subn. Proof. by []. Qed. Lemma subn0 : right_id 0 subn. Proof. by case. Qed. Lemma subnn : self_inverse 0 subn. Proof. by elim. Qed. Lemma subSS n m : m.+1 - n.+1 = m - n. Proof. by []. Qed. Lemma subn1 n : n - 1 = n.-1. Proof. by case: n => [|[]]. Qed. Lemma subn2 n : (n - 2)%N = n.-2. Proof. by case: n => [|[|[]]]. Qed. Lemma subnDl p m n : (p + m) - (p + n) = m - n. Proof. by elim: p. Qed. Lemma subnDr p m n : (m + p) - (n + p) = m - n. Proof. by rewrite -!(addnC p) subnDl. Qed. Lemma addnK n : cancel (addn^~ n) (subn^~ n). Proof. by move=> m; rewrite (subnDr n m 0) subn0. Qed. Lemma addKn n : cancel (addn n) (subn^~ n). Proof. by move=> m; rewrite addnC addnK. Qed. Lemma subSnn n : n.+1 - n = 1. Proof. exact (addnK n 1). Qed. Lemma subnDA m n p : n - (m + p) = (n - m) - p. Proof. by elim: m n => [|m IHm] []. Qed. Lemma subnAC : right_commutative subn. Proof. by move=> m n p; rewrite -!subnDA addnC. Qed. Lemma subnS m n : m - n.+1 = (m - n).-1. Proof. by rewrite -addn1 subnDA subn1. Qed. Lemma subSKn m n : (m.+1 - n).-1 = m - n. Proof. by rewrite -subnS. Qed. (* Integer ordering, and its interaction with the other operations. *) Definition leq m n := m - n == 0. Notation "m <= n" := (leq m n) : nat_scope. Notation "m < n" := (m.+1 <= n) : nat_scope. Notation "m >= n" := (n <= m) (only parsing) : nat_scope. Notation "m > n" := (n < m) (only parsing) : nat_scope. (* For sorting, etc. *) Definition geq := [rel m n | m >= n]. Definition ltn := [rel m n | m < n]. Definition gtn := [rel m n | m > n]. Notation "m <= n <= p" := ((m <= n) && (n <= p)) : nat_scope. Notation "m < n <= p" := ((m < n) && (n <= p)) : nat_scope. Notation "m <= n < p" := ((m <= n) && (n < p)) : nat_scope. Notation "m < n < p" := ((m < n) && (n < p)) : nat_scope. Lemma ltnS m n : (m < n.+1) = (m <= n). Proof. by []. Qed. Lemma leq0n n : 0 <= n. Proof. by []. Qed. Lemma ltn0Sn n : 0 < n.+1. Proof. by []. Qed. Lemma ltn0 n : n < 0 = false. Proof. by []. Qed. Lemma leqnn n : n <= n. Proof. by elim: n. Qed. Hint Resolve leqnn : core. Lemma ltnSn n : n < n.+1. Proof. by []. Qed. Lemma eq_leq m n : m = n -> m <= n. Proof. by move->. Qed. Lemma leqnSn n : n <= n.+1. Proof. by elim: n. Qed. Hint Resolve leqnSn : core. Lemma leq_pred n : n.-1 <= n. Proof. by case: n => /=. Qed. Lemma leqSpred n : n <= n.-1.+1. Proof. by case: n => /=. Qed. Lemma ltn_predL n : (n.-1 < n) = (0 < n). Proof. by case: n => [//|n]; rewrite ltnSn. Qed. Lemma ltn_predRL m n : (m < n.-1) = (m.+1 < n). Proof. by case: n => [//|n]; rewrite succnK. Qed. Lemma ltn_predK m n : m < n -> n.-1.+1 = n. Proof. by case: n. Qed. Lemma prednK n : 0 < n -> n.-1.+1 = n. Proof. exact: ltn_predK. Qed. Lemma leqNgt m n : (m <= n) = ~~ (n < m). Proof. by elim: m n => [|m IHm] []. Qed. Lemma ltnNge m n : (m < n) = ~~ (n <= m). Proof. by rewrite leqNgt. Qed. Lemma ltnn n : n < n = false. Proof. by rewrite ltnNge leqnn. Qed. Lemma leqn0 n : (n <= 0) = (n == 0). Proof. by case: n. Qed. Lemma lt0n n : (0 < n) = (n != 0). Proof. by case: n. Qed. Lemma lt0n_neq0 n : 0 < n -> n != 0. Proof. by case: n. Qed. Lemma eqn0Ngt n : (n == 0) = ~~ (n > 0). Proof. by case: n. Qed. Lemma neq0_lt0n n : (n == 0) = false -> 0 < n. Proof. by case: n. Qed. Hint Resolve lt0n_neq0 neq0_lt0n : core. Lemma eqn_leq m n : (m == n) = (m <= n <= m). Proof. by elim: m n => [|m IHm] []. Qed. Lemma anti_leq : antisymmetric leq. Proof. by move=> m n; rewrite -eqn_leq => /eqP. Qed. Lemma neq_ltn m n : (m != n) = (m < n) || (n < m). Proof. by rewrite eqn_leq negb_and orbC -!ltnNge. Qed. Lemma gtn_eqF m n : m < n -> n == m = false. Proof. by rewrite eqn_leq (leqNgt n) => ->. Qed. Lemma ltn_eqF m n : m < n -> m == n = false. Proof. by move/gtn_eqF; rewrite eq_sym. Qed. Lemma ltn_geF m n : m < n -> m >= n = false. Proof. by rewrite (leqNgt n) => ->. Qed. Lemma leq_gtF m n : m <= n -> m > n = false. Proof. by rewrite (ltnNge n) => ->. Qed. Lemma leq_eqVlt m n : (m <= n) = (m == n) || (m < n). Proof. by elim: m n => [|m IHm] []. Qed. Lemma ltn_neqAle m n : (m < n) = (m != n) && (m <= n). Proof. by rewrite ltnNge leq_eqVlt negb_or -leqNgt eq_sym. Qed. Lemma leq_trans n m p : m <= n -> n <= p -> m <= p. Proof. by elim: n m p => [|i IHn] [|m] [|p] //; apply: IHn m p. Qed. Lemma leq_ltn_trans n m p : m <= n -> n < p -> m < p. Proof. by move=> Hmn; apply: leq_trans. Qed. Lemma ltnW m n : m < n -> m <= n. Proof. exact: leq_trans. Qed. Hint Resolve ltnW : core. Lemma leqW m n : m <= n -> m <= n.+1. Proof. by move=> le_mn; apply: ltnW. Qed. Lemma ltn_trans n m p : m < n -> n < p -> m < p. Proof. by move=> lt_mn /ltnW; apply: leq_trans. Qed. Lemma leq_total m n : (m <= n) || (m >= n). Proof. by rewrite -implyNb -ltnNge; apply/implyP; apply: ltnW. Qed. (* Helper lemmas to support generalized induction over a nat measure. *) (* The idiom for a proof by induction over a measure Mxy : nat involving *) (* variables x, y, ... (e.g., size x + size y) is *) (* have [n leMn] := ubnP Mxy; elim: n => // n IHn in x y ... leMn ... *. *) (* after which the current goal (possibly modified by generalizations in the *) (* in ... part) can be proven with the extra context assumptions *) (* n : nat *) (* IHn : forall x y ..., Mxy < n -> ... -> the_initial_goal *) (* leMn : Mxy < n.+1 *) (* This is preferable to the legacy idiom relying on numerical occurrence *) (* selection, which is fragile if there can be multiple occurrences of x, y, *) (* ... in the measure expression Mxy (e.g., in #|y| with x : finType and *) (* y : {set x}). *) (* The leMn statement is convertible to Mxy <= n; if it is necessary to *) (* have _exactly_ leMn : Mxy <= n, the ltnSE helper lemma may be used as *) (* follows *) (* have [n] := ubnP Mxy; elim: n => // n IHn in x y ... * => /ltnSE-leMn. *) (* We also provide alternative helper lemmas for proofs where the upper *) (* bound appears in the goal, and we assume nonstrict (in)equality. *) (* In either case the proof will have to dispatch an Mxy = 0 case. *) (* have [n defM] := ubnPleq Mxy; elim: n => [|n IHn] in x y ... defM ... *. *) (* yields two subgoals, in which Mxy has been replaced by 0 and n.+1, *) (* with the extra assumption defM : Mxy <= 0 / Mxy <= n.+1, respectively. *) (* The second goal also has the inductive assumption *) (* IHn : forall x y ..., Mxy <= n -> ... -> the_initial_goal[n / Mxy]. *) (* Using ubnPgeq or ubnPeq instead of ubnPleq yields assumptions with *) (* Mxy >= 0/n.+1 or Mxy == 0/n.+1 instead of Mxy <= 0/n.+1, respectively. *) (* These introduce a different kind of induction; for example ubnPgeq M lets *) (* us remember that n < M throughout the induction. *) (* Finally, the ltn_ind lemma provides a generalized induction view for a *) (* property of a single integer (i.e., the case Mxy := x). *) Lemma ubnP m : {n | m < n}. Proof. by exists m.+1. Qed. Lemma ltnSE m n : m < n.+1 -> m <= n. Proof. by []. Qed. Variant ubn_leq_spec m : nat -> Type := UbnLeq n of m <= n : ubn_leq_spec m n. Variant ubn_geq_spec m : nat -> Type := UbnGeq n of m >= n : ubn_geq_spec m n. Variant ubn_eq_spec m : nat -> Type := UbnEq n of m == n : ubn_eq_spec m n. Lemma ubnPleq m : ubn_leq_spec m m. Proof. by []. Qed. Lemma ubnPgeq m : ubn_geq_spec m m. Proof. by []. Qed. Lemma ubnPeq m : ubn_eq_spec m m. Proof. by []. Qed. Lemma ltn_ind P : (forall n, (forall m, m < n -> P m) -> P n) -> forall n, P n. Proof. move=> accP M; have [n leMn] := ubnP M; elim: n => // n IHn in M leMn *. by apply/accP=> p /leq_trans/(_ leMn)/IHn. Qed. (* Link to the legacy comparison predicates. *) Lemma leP m n : reflect (m <= n)%coq_nat (m <= n). Proof. apply: (iffP idP); last by elim: n / => // n _ /leq_trans->. elim: n => [|n IHn]; first by case: m. by rewrite leq_eqVlt ltnS => /predU1P[<- // | /IHn]; right. Qed. Arguments leP {m n}. Lemma le_irrelevance m n le_mn1 le_mn2 : le_mn1 = le_mn2 :> (m <= n)%coq_nat. Proof. elim/ltn_ind: n => n IHn in le_mn1 le_mn2 *; set n1 := n in le_mn1 *. pose def_n : n = n1 := erefl n; transitivity (eq_ind _ _ le_mn2 _ def_n) => //. case: n1 / le_mn1 le_mn2 => [|n1 le_mn1] {n}[|n le_mn2] in (def_n) IHn *. - by rewrite [def_n]eq_axiomK. - by case/leP/idPn: (le_mn2); rewrite -def_n ltnn. - by case/leP/idPn: (le_mn1); rewrite def_n ltnn. case: def_n (def_n) => <-{n1} def_n in le_mn1 *. by rewrite [def_n]eq_axiomK /=; congr le_S; apply: IHn. Qed. Lemma ltP m n : reflect (m < n)%coq_nat (m < n). Proof. exact leP. Qed. Arguments ltP {m n}. Lemma lt_irrelevance m n lt_mn1 lt_mn2 : lt_mn1 = lt_mn2 :> (m < n)%coq_nat. Proof. exact: (@le_irrelevance m.+1). Qed. (* Monotonicity lemmas *) Lemma leq_add2l p m n : (p + m <= p + n) = (m <= n). Proof. by elim: p. Qed. Lemma ltn_add2l p m n : (p + m < p + n) = (m < n). Proof. by rewrite -addnS; apply: leq_add2l. Qed. Lemma leq_add2r p m n : (m + p <= n + p) = (m <= n). Proof. by rewrite -!(addnC p); apply: leq_add2l. Qed. Lemma ltn_add2r p m n : (m + p < n + p) = (m < n). Proof. exact: leq_add2r p m.+1 n. Qed. Lemma leq_add m1 m2 n1 n2 : m1 <= n1 -> m2 <= n2 -> m1 + m2 <= n1 + n2. Proof. by move=> le_mn1 le_mn2; rewrite (@leq_trans (m1 + n2)) ?leq_add2l ?leq_add2r. Qed. Lemma leq_addl m n : n <= m + n. Proof. exact: (leq_add2r n 0). Qed. Lemma leq_addr m n : n <= n + m. Proof. by rewrite addnC leq_addl. Qed. Lemma ltn_addl m n p : m < n -> m < p + n. Proof. by move/leq_trans=> -> //; apply: leq_addl. Qed. Lemma ltn_addr m n p : m < n -> m < n + p. Proof. by move/leq_trans=> -> //; apply: leq_addr. Qed. Lemma addn_gt0 m n : (0 < m + n) = (0 < m) || (0 < n). Proof. by rewrite !lt0n -negb_and addn_eq0. Qed. Lemma subn_gt0 m n : (0 < n - m) = (m < n). Proof. by elim: m n => [|m IHm] [|n] //; apply: IHm n. Qed. Lemma subn_eq0 m n : (m - n == 0) = (m <= n). Proof. by []. Qed. Lemma leq_subLR m n p : (m - n <= p) = (m <= n + p). Proof. by rewrite -subn_eq0 -subnDA. Qed. Lemma leq_subr m n : n - m <= n. Proof. by rewrite leq_subLR leq_addl. Qed. Lemma ltn_subrR m n : (n < n - m) = false. Proof. by rewrite ltnNge leq_subr. Qed. Lemma leq_subrR m n : (n <= n - m) = (m == 0) || (n == 0). Proof. by case: m n => [|m] [|n]; rewrite ?subn0 ?leqnn ?ltn_subrR. Qed. Lemma ltn_subrL m n : (n - m < n) = (0 < m) && (0 < n). Proof. by rewrite ltnNge leq_subrR negb_or !lt0n. Qed. Lemma subnKC m n : m <= n -> m + (n - m) = n. Proof. by elim: m n => [|m IHm] [|n] // /(IHm n) {2}<-. Qed. Lemma addnBn m n : m + (n - m) = m - n + n. Proof. by elim: m n => [|m IHm] [|n] //; rewrite addSn addnS IHm. Qed. Lemma subnK m n : m <= n -> (n - m) + m = n. Proof. by rewrite addnC; apply: subnKC. Qed. Lemma addnBA m n p : p <= n -> m + (n - p) = m + n - p. Proof. by move=> le_pn; rewrite -[in RHS](subnK le_pn) addnA addnK. Qed. Lemma addnBAC m n p : n <= m -> m - n + p = m + p - n. Proof. by move=> le_nm; rewrite addnC addnBA // addnC. Qed. Lemma addnBCA m n p : p <= m -> p <= n -> m + (n - p) = n + (m - p). Proof. by move=> le_pm le_pn; rewrite !addnBA // addnC. Qed. Lemma addnABC m n p : p <= m -> p <= n -> m + (n - p) = m - p + n. Proof. by move=> le_pm le_pn; rewrite addnBA // addnBAC. Qed. Lemma subnBA m n p : p <= n -> m - (n - p) = m + p - n. Proof. by move=> le_pn; rewrite -[in RHS](subnK le_pn) subnDr. Qed. Lemma subnA m n p : p <= n -> n <= m -> m - (n - p) = m - n + p. Proof. by move=> le_pn lr_nm; rewrite addnBAC // subnBA. Qed. Lemma subKn m n : m <= n -> n - (n - m) = m. Proof. by move/subnBA->; rewrite addKn. Qed. Lemma subSn m n : m <= n -> n.+1 - m = (n - m).+1. Proof. by rewrite -add1n => /addnBA <-. Qed. Lemma subnSK m n : m < n -> (n - m.+1).+1 = n - m. Proof. by move/subSn. Qed. Lemma predn_sub m n : (m - n).-1 = (m.-1 - n). Proof. by case: m => // m; rewrite subSKn. Qed. Lemma leq_sub2r p m n : m <= n -> m - p <= n - p. Proof. by move=> le_mn; rewrite leq_subLR (leq_trans le_mn) // -leq_subLR. Qed. Lemma leq_sub2l p m n : m <= n -> p - n <= p - m. Proof. rewrite -(leq_add2r (p - m)) leq_subLR. by apply: leq_trans; rewrite -leq_subLR. Qed. Lemma leq_sub m1 m2 n1 n2 : m1 <= m2 -> n2 <= n1 -> m1 - n1 <= m2 - n2. Proof. by move/(leq_sub2r n1)=> le_m12 /(leq_sub2l m2); apply: leq_trans. Qed. Lemma ltn_sub2r p m n : p < n -> m < n -> m - p < n - p. Proof. by move/subnSK <-; apply: (@leq_sub2r p.+1). Qed. Lemma ltn_sub2l p m n : m < p -> m < n -> p - n < p - m. Proof. by move/subnSK <-; apply: leq_sub2l. Qed. Lemma ltn_subRL m n p : (n < p - m) = (m + n < p). Proof. by rewrite !ltnNge leq_subLR. Qed. Lemma leq_psubRL m n p : 0 < n -> (n <= p - m) = (m + n <= p). Proof. by move=> /prednK<-; rewrite ltn_subRL addnS. Qed. Lemma ltn_psubLR m n p : 0 < p -> (m - n < p) = (m < n + p). Proof. by move=> /prednK<-; rewrite ltnS leq_subLR addnS. Qed. Lemma leq_subRL m n p : m <= p -> (n <= p - m) = (m + n <= p). Proof. by move=> /subnKC{2}<-; rewrite leq_add2l. Qed. Lemma ltn_subLR m n p : n <= m -> (m - n < p) = (m < n + p). Proof. by move=> /subnKC{2}<-; rewrite ltn_add2l. Qed. Lemma leq_subCl m n p : (m - n <= p) = (m - p <= n). Proof. by rewrite !leq_subLR // addnC. Qed. Lemma ltn_subCr m n p : (p < m - n) = (n < m - p). Proof. by rewrite !ltn_subRL // addnC. Qed. Lemma leq_psubCr m n p : 0 < p -> 0 < n -> (p <= m - n) = (n <= m - p). Proof. by move=> p_gt0 n_gt0; rewrite !leq_psubRL // addnC. Qed. Lemma ltn_psubCl m n p : 0 < p -> 0 < n -> (m - n < p) = (m - p < n). Proof. by move=> p_gt0 n_gt0; rewrite !ltn_psubLR // addnC. Qed. Lemma leq_subCr m n p : n <= m -> p <= m -> (p <= m - n) = (n <= m - p). Proof. by move=> np pm; rewrite !leq_subRL // addnC. Qed. Lemma ltn_subCl m n p : n <= m -> p <= m -> (m - n < p) = (m - p < n). Proof. by move=> nm pm; rewrite !ltn_subLR // addnC. Qed. (* Max and min. *) Definition maxn m n := if m < n then n else m. Definition minn m n := if m < n then m else n. Lemma max0n : left_id 0 maxn. Proof. by case. Qed. Lemma maxn0 : right_id 0 maxn. Proof. by []. Qed. Lemma maxnC : commutative maxn. Proof. by rewrite /maxn; elim=> [|m ih] [] // n; rewrite !ltnS -!fun_if ih. Qed. Lemma maxnE m n : maxn m n = m + (n - m). Proof. rewrite /maxn; elim: m n => [|m ih] [|n]; rewrite ?addn0 //. by rewrite ltnS subSS addSn -ih; case: leq. Qed. Lemma maxnAC : right_commutative maxn. Proof. by move=> m n p; rewrite !maxnE -!addnA !subnDA -!maxnE maxnC. Qed. Lemma maxnA : associative maxn. Proof. by move=> m n p; rewrite !(maxnC m) maxnAC. Qed. Lemma maxnCA : left_commutative maxn. Proof. by move=> m n p; rewrite !maxnA (maxnC m). Qed. Lemma maxnACA : interchange maxn maxn. Proof. by move=> m n p q; rewrite -!maxnA (maxnCA n). Qed. Lemma maxn_idPl {m n} : reflect (maxn m n = m) (m >= n). Proof. by rewrite -subn_eq0 -(eqn_add2l m) addn0 -maxnE; apply: eqP. Qed. Lemma maxn_idPr {m n} : reflect (maxn m n = n) (m <= n). Proof. by rewrite maxnC; apply: maxn_idPl. Qed. Lemma maxnn : idempotent maxn. Proof. by move=> n; apply/maxn_idPl. Qed. Lemma leq_max m n1 n2 : (m <= maxn n1 n2) = (m <= n1) || (m <= n2). Proof. without loss le_n21: n1 n2 / n2 <= n1. by case/orP: (leq_total n2 n1) => le_n12; last rewrite maxnC orbC; apply. by rewrite (maxn_idPl le_n21) orb_idr // => /leq_trans->. Qed. Lemma leq_maxl m n : m <= maxn m n. Proof. by rewrite leq_max leqnn. Qed. Lemma leq_maxr m n : n <= maxn m n. Proof. by rewrite maxnC leq_maxl. Qed. Lemma gtn_max m n1 n2 : (m > maxn n1 n2) = (m > n1) && (m > n2). Proof. by rewrite !ltnNge leq_max negb_or. Qed. Lemma geq_max m n1 n2 : (m >= maxn n1 n2) = (m >= n1) && (m >= n2). Proof. by rewrite -ltnS gtn_max. Qed. Lemma maxnSS m n : maxn m.+1 n.+1 = (maxn m n).+1. Proof. by rewrite !maxnE. Qed. Lemma addn_maxl : left_distributive addn maxn. Proof. by move=> m1 m2 n; rewrite !maxnE subnDr addnAC. Qed. Lemma addn_maxr : right_distributive addn maxn. Proof. by move=> m n1 n2; rewrite !(addnC m) addn_maxl. Qed. Lemma subn_maxl : left_distributive subn maxn. Proof. move=> m n p; apply/eqP. rewrite eqn_leq !geq_max !leq_sub2r leq_max ?leqnn ?andbT ?orbT // /maxn. by case: (_ < _); rewrite leqnn // orbT. Qed. Lemma min0n : left_zero 0 minn. Proof. by case. Qed. Lemma minn0 : right_zero 0 minn. Proof. by []. Qed. Lemma minnC : commutative minn. Proof. by rewrite /minn; elim=> [|m ih] [] // n; rewrite !ltnS -!fun_if ih. Qed. Lemma addn_min_max m n : minn m n + maxn m n = m + n. Proof. by rewrite /minn /maxn; case: (m < n) => //; exact: addnC. Qed. Lemma minnE m n : minn m n = m - (m - n). Proof. by rewrite -(subnDl n) -maxnE -addn_min_max addnK minnC. Qed. Lemma minnAC : right_commutative minn. Proof. by move=> m n p; rewrite !minnE -subnDA subnAC -maxnE maxnC maxnE subnAC subnDA. Qed. Lemma minnA : associative minn. Proof. by move=> m n p; rewrite minnC minnAC (minnC n). Qed. Lemma minnCA : left_commutative minn. Proof. by move=> m n p; rewrite !minnA (minnC n). Qed. Lemma minnACA : interchange minn minn. Proof. by move=> m n p q; rewrite -!minnA (minnCA n). Qed. Lemma minn_idPl {m n} : reflect (minn m n = m) (m <= n). Proof. rewrite (sameP maxn_idPr eqP) -(eqn_add2l m) eq_sym -addn_min_max eqn_add2r. exact: eqP. Qed. Lemma minn_idPr {m n} : reflect (minn m n = n) (m >= n). Proof. by rewrite minnC; apply: minn_idPl. Qed. Lemma minnn : idempotent minn. Proof. by move=> n; apply/minn_idPl. Qed. Lemma leq_min m n1 n2 : (m <= minn n1 n2) = (m <= n1) && (m <= n2). Proof. wlog le_n21: n1 n2 / n2 <= n1. by case/orP: (leq_total n2 n1) => ?; last rewrite minnC andbC; apply. rewrite /minn ltnNge le_n21 /=; case le_m_n1: (m <= n1) => //=. apply/contraFF: le_m_n1 => /leq_trans; exact. Qed. Lemma gtn_min m n1 n2 : (m > minn n1 n2) = (m > n1) || (m > n2). Proof. by rewrite !ltnNge leq_min negb_and. Qed. Lemma geq_min m n1 n2 : (m >= minn n1 n2) = (m >= n1) || (m >= n2). Proof. by rewrite -ltnS gtn_min. Qed. Lemma geq_minl m n : minn m n <= m. Proof. by rewrite geq_min leqnn. Qed. Lemma geq_minr m n : minn m n <= n. Proof. by rewrite minnC geq_minl. Qed. Lemma addn_minr : right_distributive addn minn. Proof. by move=> m1 m2 n; rewrite !minnE subnDl addnBA ?leq_subr. Qed. Lemma addn_minl : left_distributive addn minn. Proof. by move=> m1 m2 n; rewrite -!(addnC n) addn_minr. Qed. Lemma subn_minl : left_distributive subn minn. Proof. move=> m n p; apply/eqP. rewrite eqn_leq !leq_min !leq_sub2r geq_min ?leqnn ?orbT //= /minn. by case: (_ < _); rewrite leqnn // orbT. Qed. Lemma minnSS m n : minn m.+1 n.+1 = (minn m n).+1. Proof. by rewrite -(addn_minr 1). Qed. (* Quasi-cancellation (really, absorption) lemmas *) Lemma maxnK m n : minn (maxn m n) m = m. Proof. exact/minn_idPr/leq_maxl. Qed. Lemma maxKn m n : minn n (maxn m n) = n. Proof. exact/minn_idPl/leq_maxr. Qed. Lemma minnK m n : maxn (minn m n) m = m. Proof. exact/maxn_idPr/geq_minl. Qed. Lemma minKn m n : maxn n (minn m n) = n. Proof. exact/maxn_idPl/geq_minr. Qed. (* Distributivity. *) Lemma maxn_minl : left_distributive maxn minn. Proof. move=> m1 m2 n; wlog le_m21: m1 m2 / m2 <= m1. move=> IH; case/orP: (leq_total m2 m1) => /IH //. by rewrite minnC [in R in _ = R]minnC. rewrite (minn_idPr le_m21); apply/esym/minn_idPr. by rewrite geq_max leq_maxr leq_max le_m21. Qed. Lemma maxn_minr : right_distributive maxn minn. Proof. by move=> m n1 n2; rewrite !(maxnC m) maxn_minl. Qed. Lemma minn_maxl : left_distributive minn maxn. Proof. by move=> m1 m2 n; rewrite maxn_minr !maxn_minl -minnA maxnn (maxnC _ n) !maxnK. Qed. Lemma minn_maxr : right_distributive minn maxn. Proof. by move=> m n1 n2; rewrite !(minnC m) minn_maxl. Qed. (* Comparison predicates. *) Variant leq_xor_gtn m n : nat -> nat -> nat -> nat -> bool -> bool -> Set := | LeqNotGtn of m <= n : leq_xor_gtn m n m m n n true false | GtnNotLeq of n < m : leq_xor_gtn m n n n m m false true. Lemma leqP m n : leq_xor_gtn m n (minn n m) (minn m n) (maxn n m) (maxn m n) (m <= n) (n < m). Proof. rewrite (minnC m) /minn (maxnC m) /maxn ltnNge. by case le_mn: (m <= n); constructor; rewrite //= ltnNge le_mn. Qed. Variant ltn_xor_geq m n : nat -> nat -> nat -> nat -> bool -> bool -> Set := | LtnNotGeq of m < n : ltn_xor_geq m n m m n n false true | GeqNotLtn of n <= m : ltn_xor_geq m n n n m m true false. Lemma ltnP m n : ltn_xor_geq m n (minn n m) (minn m n) (maxn n m) (maxn m n) (n <= m) (m < n). Proof. by case: leqP; constructor. Qed. Variant eqn0_xor_gt0 n : bool -> bool -> Set := | Eq0NotPos of n = 0 : eqn0_xor_gt0 n true false | PosNotEq0 of n > 0 : eqn0_xor_gt0 n false true. Lemma posnP n : eqn0_xor_gt0 n (n == 0) (0 < n). Proof. by case: n; constructor. Qed. Variant compare_nat m n : nat -> nat -> nat -> nat -> bool -> bool -> bool -> bool -> bool -> bool -> Set := | CompareNatLt of m < n : compare_nat m n m m n n false false false true false true | CompareNatGt of m > n : compare_nat m n n n m m false false true false true false | CompareNatEq of m = n : compare_nat m n m m m m true true true true false false. Lemma ltngtP m n : compare_nat m n (minn n m) (minn m n) (maxn n m) (maxn m n) (n == m) (m == n) (n <= m) (m <= n) (n < m) (m < n). Proof. rewrite !ltn_neqAle [_ == n]eq_sym; have [mn|] := ltnP m n. by rewrite ltnW // gtn_eqF //; constructor. rewrite leq_eqVlt; case: ltnP; rewrite ?(orbT, orbF) => //= lt_nm eq_nm. by rewrite ltn_eqF //; constructor. by rewrite eq_nm (eqP eq_nm); constructor. Qed. (* Eliminating the idiom for structurally decreasing compare and subtract. *) Lemma subn_if_gt T m n F (E : T) : (if m.+1 - n is m'.+1 then F m' else E) = (if n <= m then F (m - n) else E). Proof. by have [le_nm|/eqnP-> //] := leqP; rewrite -{1}(subnK le_nm) -addSn addnK. Qed. (* Getting a concrete value from an abstract existence proof. *) Section ExMinn. Variable P : pred nat. Hypothesis exP : exists n, P n. Inductive acc_nat i : Prop := AccNat0 of P i | AccNatS of acc_nat i.+1. Lemma find_ex_minn : {m | P m & forall n, P n -> n >= m}. Proof. have: forall n, P n -> n >= 0 by []. have: acc_nat 0. case exP => n; rewrite -(addn0 n); elim: n 0 => [|n IHn] j; first by left. by rewrite addSnnS; right; apply: IHn. move: 0; fix find_ex_minn 2 => m IHm m_lb; case Pm: (P m); first by exists m. apply: find_ex_minn m.+1 _ _ => [|n Pn]; first by case: IHm; rewrite ?Pm. by rewrite ltn_neqAle m_lb //; case: eqP Pm => // -> /idP[]. Qed. Definition ex_minn := s2val find_ex_minn. Inductive ex_minn_spec : nat -> Type := ExMinnSpec m of P m & (forall n, P n -> n >= m) : ex_minn_spec m. Lemma ex_minnP : ex_minn_spec ex_minn. Proof. by rewrite /ex_minn; case: find_ex_minn. Qed. End ExMinn. Section ExMaxn. Variables (P : pred nat) (m : nat). Hypotheses (exP : exists i, P i) (ubP : forall i, P i -> i <= m). Lemma ex_maxn_subproof : exists i, P (m - i). Proof. by case: exP => i Pi; exists (m - i); rewrite subKn ?ubP. Qed. Definition ex_maxn := m - ex_minn ex_maxn_subproof. Variant ex_maxn_spec : nat -> Type := ExMaxnSpec i of P i & (forall j, P j -> j <= i) : ex_maxn_spec i. Lemma ex_maxnP : ex_maxn_spec ex_maxn. Proof. rewrite /ex_maxn; case: ex_minnP => i Pmi min_i; split=> // j Pj. have le_i_mj: i <= m - j by rewrite min_i // subKn // ubP. rewrite -subn_eq0 subnBA ?(leq_trans le_i_mj) ?leq_subr //. by rewrite addnC -subnBA ?ubP. Qed. End ExMaxn. Lemma eq_ex_minn P Q exP exQ : P =1 Q -> @ex_minn P exP = @ex_minn Q exQ. Proof. move=> eqPQ; case: ex_minnP => m1 Pm1 m1_lb; case: ex_minnP => m2 Pm2 m2_lb. by apply/eqP; rewrite eqn_leq m1_lb (m2_lb, eqPQ) // -eqPQ. Qed. Lemma eq_ex_maxn (P Q : pred nat) m n exP ubP exQ ubQ : P =1 Q -> @ex_maxn P m exP ubP = @ex_maxn Q n exQ ubQ. Proof. move=> eqPQ; case: ex_maxnP => i Pi max_i; case: ex_maxnP => j Pj max_j. by apply/eqP; rewrite eqn_leq max_i ?eqPQ // max_j -?eqPQ. Qed. Section Iteration. Variable T : Type. Implicit Types m n : nat. Implicit Types x y : T. Implicit Types S : {pred T}. Definition iter n f x := let fix loop m := if m is i.+1 then f (loop i) else x in loop n. Definition iteri n f x := let fix loop m := if m is i.+1 then f i (loop i) else x in loop n. Definition iterop n op x := let f i y := if i is 0 then x else op x y in iteri n f. Lemma iterSr n f x : iter n.+1 f x = iter n f (f x). Proof. by elim: n => //= n <-. Qed. Lemma iterS n f x : iter n.+1 f x = f (iter n f x). Proof. by []. Qed. Lemma iterD n m f x : iter (n + m) f x = iter n f (iter m f x). Proof. by elim: n => //= n ->. Qed. Lemma iteriS n f x : iteri n.+1 f x = f n (iteri n f x). Proof. by []. Qed. Lemma iteropS idx n op x : iterop n.+1 op x idx = iter n (op x) x. Proof. by elim: n => //= n ->. Qed. Lemma eq_iter f f' : f =1 f' -> forall n, iter n f =1 iter n f'. Proof. by move=> eq_f n x; elim: n => //= n ->; rewrite eq_f. Qed. Lemma iter_fix n f x : f x = x -> iter n f x = x. Proof. by move=> fixf; elim: n => //= n ->. Qed. Lemma eq_iteri f f' : f =2 f' -> forall n, iteri n f =1 iteri n f'. Proof. by move=> eq_f n x; elim: n => //= n ->; rewrite eq_f. Qed. Lemma eq_iterop n op op' : op =2 op' -> iterop n op =2 iterop n op'. Proof. by move=> eq_op x; apply: eq_iteri; case. Qed. Lemma iter_in f S i : {homo f : x / x \in S} -> {homo iter i f : x / x \in S}. Proof. by move=> f_in x xS; elim: i => [|i /f_in]. Qed. End Iteration. Lemma iter_succn m n : iter n succn m = m + n. Proof. by rewrite addnC; elim: n => //= n ->. Qed. Lemma iter_succn_0 n : iter n succn 0 = n. Proof. exact: iter_succn. Qed. Lemma iter_predn m n : iter n predn m = m - n. Proof. by elim: n m => /= [|n IHn] m; rewrite ?subn0 // IHn subnS. Qed. (* Multiplication. *) Definition muln_rec := mult. Notation "m * n" := (muln_rec m n) : nat_rec_scope. Definition muln := nosimpl muln_rec. Notation "m * n" := (muln m n) : nat_scope. Lemma multE : mult = muln. Proof. by []. Qed. Lemma mulnE : muln = muln_rec. Proof. by []. Qed. Lemma mul0n : left_zero 0 muln. Proof. by []. Qed. Lemma muln0 : right_zero 0 muln. Proof. by elim. Qed. Lemma mul1n : left_id 1 muln. Proof. exact: addn0. Qed. Lemma mulSn m n : m.+1 * n = n + m * n. Proof. by []. Qed. Lemma mulSnr m n : m.+1 * n = m * n + n. Proof. exact: addnC. Qed. Lemma mulnS m n : m * n.+1 = m + m * n. Proof. by elim: m => // m; rewrite !mulSn !addSn addnCA => ->. Qed. Lemma mulnSr m n : m * n.+1 = m * n + m. Proof. by rewrite addnC mulnS. Qed. Lemma iter_addn m n p : iter n (addn m) p = m * n + p. Proof. by elim: n => /= [|n ->]; rewrite ?muln0 // mulnS addnA. Qed. Lemma iter_addn_0 m n : iter n (addn m) 0 = m * n. Proof. by rewrite iter_addn addn0. Qed. Lemma muln1 : right_id 1 muln. Proof. by move=> n; rewrite mulnSr muln0. Qed. Lemma mulnC : commutative muln. Proof. by move=> m n; elim: m => [|m]; rewrite (muln0, mulnS) // mulSn => ->. Qed. Lemma mulnDl : left_distributive muln addn. Proof. by move=> m1 m2 n; elim: m1 => //= m1 IHm; rewrite -addnA -IHm. Qed. Lemma mulnDr : right_distributive muln addn. Proof. by move=> m n1 n2; rewrite !(mulnC m) mulnDl. Qed. Lemma mulnBl : left_distributive muln subn. Proof. move=> m n [|p]; first by rewrite !muln0. by elim: m n => // [m IHm] [|n] //; rewrite mulSn subnDl -IHm. Qed. Lemma mulnBr : right_distributive muln subn. Proof. by move=> m n p; rewrite !(mulnC m) mulnBl. Qed. Lemma mulnA : associative muln. Proof. by move=> m n p; elim: m => //= m; rewrite mulSn mulnDl => ->. Qed. Lemma mulnCA : left_commutative muln. Proof. by move=> m n1 n2; rewrite !mulnA (mulnC m). Qed. Lemma mulnAC : right_commutative muln. Proof. by move=> m n p; rewrite -!mulnA (mulnC n). Qed. Lemma mulnACA : interchange muln muln. Proof. by move=> m n p q; rewrite -!mulnA (mulnCA n). Qed. Lemma muln_eq0 m n : (m * n == 0) = (m == 0) || (n == 0). Proof. by case: m n => // m [|n] //=; rewrite muln0. Qed. Lemma muln_eq1 m n : (m * n == 1) = (m == 1) && (n == 1). Proof. by case: m n => [|[|m]] [|[|n]] //; rewrite muln0. Qed. Lemma muln_gt0 m n : (0 < m * n) = (0 < m) && (0 < n). Proof. by case: m n => // m [|n] //=; rewrite muln0. Qed. Lemma leq_pmull m n : n > 0 -> m <= n * m. Proof. by move/prednK <-; apply: leq_addr. Qed. Lemma leq_pmulr m n : n > 0 -> m <= m * n. Proof. by move/leq_pmull; rewrite mulnC. Qed. Lemma leq_mul2l m n1 n2 : (m * n1 <= m * n2) = (m == 0) || (n1 <= n2). Proof. by rewrite [LHS]/leq -mulnBr muln_eq0. Qed. Lemma leq_mul2r m n1 n2 : (n1 * m <= n2 * m) = (m == 0) || (n1 <= n2). Proof. by rewrite -!(mulnC m) leq_mul2l. Qed. Lemma leq_mul m1 m2 n1 n2 : m1 <= n1 -> m2 <= n2 -> m1 * m2 <= n1 * n2. Proof. move=> le_mn1 le_mn2; apply (@leq_trans (m1 * n2)). by rewrite leq_mul2l le_mn2 orbT. by rewrite leq_mul2r le_mn1 orbT. Qed. Lemma eqn_mul2l m n1 n2 : (m * n1 == m * n2) = (m == 0) || (n1 == n2). Proof. by rewrite eqn_leq !leq_mul2l -orb_andr -eqn_leq. Qed. Lemma eqn_mul2r m n1 n2 : (n1 * m == n2 * m) = (m == 0) || (n1 == n2). Proof. by rewrite eqn_leq !leq_mul2r -orb_andr -eqn_leq. Qed. Lemma leq_pmul2l m n1 n2 : 0 < m -> (m * n1 <= m * n2) = (n1 <= n2). Proof. by move/prednK=> <-; rewrite leq_mul2l. Qed. Arguments leq_pmul2l [m n1 n2]. Lemma leq_pmul2r m n1 n2 : 0 < m -> (n1 * m <= n2 * m) = (n1 <= n2). Proof. by move/prednK <-; rewrite leq_mul2r. Qed. Arguments leq_pmul2r [m n1 n2]. Lemma eqn_pmul2l m n1 n2 : 0 < m -> (m * n1 == m * n2) = (n1 == n2). Proof. by move/prednK <-; rewrite eqn_mul2l. Qed. Arguments eqn_pmul2l [m n1 n2]. Lemma eqn_pmul2r m n1 n2 : 0 < m -> (n1 * m == n2 * m) = (n1 == n2). Proof. by move/prednK <-; rewrite eqn_mul2r. Qed. Arguments eqn_pmul2r [m n1 n2]. Lemma ltn_mul2l m n1 n2 : (m * n1 < m * n2) = (0 < m) && (n1 < n2). Proof. by rewrite lt0n !ltnNge leq_mul2l negb_or. Qed. Lemma ltn_mul2r m n1 n2 : (n1 * m < n2 * m) = (0 < m) && (n1 < n2). Proof. by rewrite lt0n !ltnNge leq_mul2r negb_or. Qed. Lemma ltn_pmul2l m n1 n2 : 0 < m -> (m * n1 < m * n2) = (n1 < n2). Proof. by move/prednK <-; rewrite ltn_mul2l. Qed. Arguments ltn_pmul2l [m n1 n2]. Lemma ltn_pmul2r m n1 n2 : 0 < m -> (n1 * m < n2 * m) = (n1 < n2). Proof. by move/prednK <-; rewrite ltn_mul2r. Qed. Arguments ltn_pmul2r [m n1 n2]. Lemma ltn_Pmull m n : 1 < n -> 0 < m -> m < n * m. Proof. by move=> lt1n m_gt0; rewrite -[m in m < _]mul1n ltn_pmul2r. Qed. Lemma ltn_Pmulr m n : 1 < n -> 0 < m -> m < m * n. Proof. by move=> lt1n m_gt0; rewrite mulnC ltn_Pmull. Qed. Lemma ltn_mul m1 m2 n1 n2 : m1 < n1 -> m2 < n2 -> m1 * m2 < n1 * n2. Proof. move=> lt_mn1 lt_mn2; apply (@leq_ltn_trans (m1 * n2)). by rewrite leq_mul2l orbC ltnW. by rewrite ltn_pmul2r // (leq_trans _ lt_mn2). Qed. Lemma maxnMr : right_distributive muln maxn. Proof. by case=> // m n1 n2; rewrite /maxn (fun_if (muln _)) ltn_pmul2l. Qed. Lemma maxnMl : left_distributive muln maxn. Proof. by move=> m1 m2 n; rewrite -!(mulnC n) maxnMr. Qed. Lemma minnMr : right_distributive muln minn. Proof. by case=> // m n1 n2; rewrite /minn (fun_if (muln _)) ltn_pmul2l. Qed. Lemma minnMl : left_distributive muln minn. Proof. by move=> m1 m2 n; rewrite -!(mulnC n) minnMr. Qed. Lemma iterM (T : Type) (n m : nat) (f : T -> T) : iter (n * m) f =1 iter n (iter m f). Proof. by move=> x; elim: n => //= n <-; rewrite mulSn iterD. Qed. (* Exponentiation. *) Definition expn_rec m n := iterop n muln m 1. Notation "m ^ n" := (expn_rec m n) : nat_rec_scope. Definition expn := nosimpl expn_rec. Notation "m ^ n" := (expn m n) : nat_scope. Lemma expnE : expn = expn_rec. Proof. by []. Qed. Lemma expn0 m : m ^ 0 = 1. Proof. by []. Qed. Lemma expn1 m : m ^ 1 = m. Proof. by []. Qed. Lemma expnS m n : m ^ n.+1 = m * m ^ n. Proof. by case: n; rewrite ?muln1. Qed. Lemma expnSr m n : m ^ n.+1 = m ^ n * m. Proof. by rewrite mulnC expnS. Qed. Lemma iter_muln m n p : iter n (muln m) p = m ^ n * p. Proof. by elim: n => /= [|n ->]; rewrite ?mul1n // expnS mulnA. Qed. Lemma iter_muln_1 m n : iter n (muln m) 1 = m ^ n. Proof. by rewrite iter_muln muln1. Qed. Lemma exp0n n : 0 < n -> 0 ^ n = 0. Proof. by case: n => [|[]]. Qed. Lemma exp1n n : 1 ^ n = 1. Proof. by elim: n => // n; rewrite expnS mul1n. Qed. Lemma expnD m n1 n2 : m ^ (n1 + n2) = m ^ n1 * m ^ n2. Proof. by elim: n1 => [|n1 IHn]; rewrite !(mul1n, expnS) // IHn mulnA. Qed. Lemma expnMn m1 m2 n : (m1 * m2) ^ n = m1 ^ n * m2 ^ n. Proof. by elim: n => // n IHn; rewrite !expnS IHn -!mulnA (mulnCA m2). Qed. Lemma expnM m n1 n2 : m ^ (n1 * n2) = (m ^ n1) ^ n2. Proof. elim: n1 => [|n1 IHn]; first by rewrite exp1n. by rewrite expnD expnS expnMn IHn. Qed. Lemma expnAC m n1 n2 : (m ^ n1) ^ n2 = (m ^ n2) ^ n1. Proof. by rewrite -!expnM mulnC. Qed. Lemma expn_gt0 m n : (0 < m ^ n) = (0 < m) || (n == 0). Proof. by case: m => [|m]; elim: n => //= n IHn; rewrite expnS // addn_gt0 IHn. Qed. Lemma expn_eq0 m e : (m ^ e == 0) = (m == 0) && (e > 0). Proof. by rewrite !eqn0Ngt expn_gt0 negb_or -lt0n. Qed. Lemma ltn_expl m n : 1 < m -> n < m ^ n. Proof. move=> m_gt1; elim: n => //= n; rewrite -(leq_pmul2l (ltnW m_gt1)) expnS. by apply: leq_trans; apply: ltn_Pmull. Qed. Lemma leq_exp2l m n1 n2 : 1 < m -> (m ^ n1 <= m ^ n2) = (n1 <= n2). Proof. move=> m_gt1; elim: n1 n2 => [|n1 IHn] [|n2] //; last 1 first. - by rewrite !expnS leq_pmul2l ?IHn // ltnW. - by rewrite expn_gt0 ltnW. by rewrite leqNgt (leq_trans m_gt1) // expnS leq_pmulr // expn_gt0 ltnW. Qed. Lemma ltn_exp2l m n1 n2 : 1 < m -> (m ^ n1 < m ^ n2) = (n1 < n2). Proof. by move=> m_gt1; rewrite !ltnNge leq_exp2l. Qed. Lemma eqn_exp2l m n1 n2 : 1 < m -> (m ^ n1 == m ^ n2) = (n1 == n2). Proof. by move=> m_gt1; rewrite !eqn_leq !leq_exp2l. Qed. Lemma expnI m : 1 < m -> injective (expn m). Proof. by move=> m_gt1 e1 e2 /eqP; rewrite eqn_exp2l // => /eqP. Qed. Lemma leq_pexp2l m n1 n2 : 0 < m -> n1 <= n2 -> m ^ n1 <= m ^ n2. Proof. by case: m => [|[|m]] // _; [rewrite !exp1n | rewrite leq_exp2l]. Qed. Lemma ltn_pexp2l m n1 n2 : 0 < m -> m ^ n1 < m ^ n2 -> n1 < n2. Proof. by case: m => [|[|m]] // _; [rewrite !exp1n | rewrite ltn_exp2l]. Qed. Lemma ltn_exp2r m n e : e > 0 -> (m ^ e < n ^ e) = (m < n). Proof. move=> e_gt0; apply/idP/idP=> [|ltmn]. rewrite !ltnNge; apply: contra => lemn. by elim: e {e_gt0} => // e IHe; rewrite !expnS leq_mul. by elim: e e_gt0 => // [[|e] IHe] _; rewrite ?expn1 // ltn_mul // IHe. Qed. Lemma leq_exp2r m n e : e > 0 -> (m ^ e <= n ^ e) = (m <= n). Proof. by move=> e_gt0; rewrite leqNgt ltn_exp2r // -leqNgt. Qed. Lemma eqn_exp2r m n e : e > 0 -> (m ^ e == n ^ e) = (m == n). Proof. by move=> e_gt0; rewrite !eqn_leq !leq_exp2r. Qed. Lemma expIn e : e > 0 -> injective (expn^~ e). Proof. by move=> e_gt1 m n /eqP; rewrite eqn_exp2r // => /eqP. Qed. Lemma iterX (T : Type) (n m : nat) (f : T -> T) : iter (n ^ m) f =1 iter m (iter n) f. Proof. elim: m => //= m ihm x; rewrite expnS iterM; exact/eq_iter. Qed. (* Factorial. *) Fixpoint fact_rec n := if n is n'.+1 then n * fact_rec n' else 1. Definition factorial := nosimpl fact_rec. Notation "n `!" := (factorial n) (at level 2, format "n `!") : nat_scope. Lemma factE : factorial = fact_rec. Proof. by []. Qed. Lemma fact0 : 0`! = 1. Proof. by []. Qed. Lemma factS n : (n.+1)`! = n.+1 * n`!. Proof. by []. Qed. Lemma fact_gt0 n : n`! > 0. Proof. by elim: n => //= n IHn; rewrite muln_gt0. Qed. (* Parity and bits. *) Coercion nat_of_bool (b : bool) := if b then 1 else 0. Lemma leq_b1 (b : bool) : b <= 1. Proof. by case: b. Qed. Lemma addn_negb (b : bool) : ~~ b + b = 1. Proof. by case: b. Qed. Lemma eqb0 (b : bool) : (b == 0 :> nat) = ~~ b. Proof. by case: b. Qed. Lemma eqb1 (b : bool) : (b == 1 :> nat) = b. Proof. by case: b. Qed. Lemma lt0b (b : bool) : (b > 0) = b. Proof. by case: b. Qed. Lemma sub1b (b : bool) : 1 - b = ~~ b. Proof. by case: b. Qed. Lemma mulnb (b1 b2 : bool) : b1 * b2 = b1 && b2. Proof. by case: b1; case: b2. Qed. Lemma mulnbl (b : bool) n : b * n = (if b then n else 0). Proof. by case: b; rewrite ?mul1n. Qed. Lemma mulnbr (b : bool) n : n * b = (if b then n else 0). Proof. by rewrite mulnC mulnbl. Qed. Fixpoint odd n := if n is n'.+1 then ~~ odd n' else false. Lemma oddS n : odd n.+1 = ~~ odd n. Proof. by []. Qed. Lemma oddb (b : bool) : odd b = b. Proof. by case: b. Qed. Lemma oddD m n : odd (m + n) = odd m (+) odd n. Proof. by elim: m => [|m IHn] //=; rewrite -addTb IHn addbA addTb. Qed. Lemma oddB m n : n <= m -> odd (m - n) = odd m (+) odd n. Proof. by move=> le_nm; apply: (@canRL bool) (addbK _) _; rewrite -oddD subnK. Qed. Lemma oddN i m : odd m = false -> i <= m -> odd (m - i) = odd i. Proof. by move=> oddm /oddB ->; rewrite oddm. Qed. Lemma oddM m n : odd (m * n) = odd m && odd n. Proof. by elim: m => //= m IHm; rewrite oddD -addTb andb_addl -IHm. Qed. Lemma oddX m n : odd (m ^ n) = (n == 0) || odd m. Proof. by elim: n => // n IHn; rewrite expnS oddM {}IHn orbC; case odd. Qed. (* Doubling. *) Fixpoint double_rec n := if n is n'.+1 then n'.*2%Nrec.+2 else 0 where "n .*2" := (double_rec n) : nat_rec_scope. Definition double := nosimpl double_rec. Notation "n .*2" := (double n) : nat_scope. Lemma doubleE : double = double_rec. Proof. by []. Qed. Lemma double0 : 0.*2 = 0. Proof. by []. Qed. Lemma doubleS n : n.+1.*2 = n.*2.+2. Proof. by []. Qed. Lemma addnn n : n + n = n.*2. Proof. by apply: eqP; elim: n => // n IHn; rewrite addnS. Qed. Lemma mul2n m : 2 * m = m.*2. Proof. by rewrite mulSn mul1n addnn. Qed. Lemma muln2 m : m * 2 = m.*2. Proof. by rewrite mulnC mul2n. Qed. Lemma doubleD m n : (m + n).*2 = m.*2 + n.*2. Proof. by rewrite -!mul2n mulnDr. Qed. Lemma doubleB m n : (m - n).*2 = m.*2 - n.*2. Proof. by elim: m n => [|m IHm] []. Qed. Lemma leq_double m n : (m.*2 <= n.*2) = (m <= n). Proof. by rewrite /leq -doubleB; case (m - n). Qed. Lemma ltn_double m n : (m.*2 < n.*2) = (m < n). Proof. by rewrite 2!ltnNge leq_double. Qed. Lemma ltn_Sdouble m n : (m.*2.+1 < n.*2) = (m < n). Proof. by rewrite -doubleS leq_double. Qed. Lemma leq_Sdouble m n : (m.*2 <= n.*2.+1) = (m <= n). Proof. by rewrite leqNgt ltn_Sdouble -leqNgt. Qed. Lemma odd_double n : odd n.*2 = false. Proof. by rewrite -addnn oddD addbb. Qed. Lemma double_gt0 n : (0 < n.*2) = (0 < n). Proof. by case: n. Qed. Lemma double_eq0 n : (n.*2 == 0) = (n == 0). Proof. by case: n. Qed. Lemma doubleMl m n : (m * n).*2 = m.*2 * n. Proof. by rewrite -!mul2n mulnA. Qed. Lemma doubleMr m n : (m * n).*2 = m * n.*2. Proof. by rewrite -!muln2 mulnA. Qed. (* Halving. *) Fixpoint half (n : nat) : nat := if n is n'.+1 then uphalf n' else n with uphalf (n : nat) : nat := if n is n'.+1 then n'./2.+1 else n where "n ./2" := (half n) : nat_scope. Lemma doubleK : cancel double half. Proof. by elim=> //= n ->. Qed. Definition half_double := doubleK. Definition double_inj := can_inj doubleK. Lemma uphalf_double n : uphalf n.*2 = n. Proof. by elim: n => //= n ->. Qed. Lemma uphalf_half n : uphalf n = odd n + n./2. Proof. by elim: n => //= n ->; rewrite addnA addn_negb. Qed. Lemma odd_double_half n : odd n + n./2.*2 = n. Proof. by elim: n => //= n {3}<-; rewrite uphalf_half doubleD; case (odd n). Qed. Lemma half_bit_double n (b : bool) : (b + n.*2)./2 = n. Proof. by case: b; rewrite /= (half_double, uphalf_double). Qed. Lemma halfD m n : (m + n)./2 = (odd m && odd n) + (m./2 + n./2). Proof. rewrite -[n in LHS]odd_double_half addnCA. rewrite -[m in LHS]odd_double_half -addnA -doubleD. by do 2!case: odd; rewrite /= ?add0n ?half_double ?uphalf_double. Qed. Lemma half_leq m n : m <= n -> m./2 <= n./2. Proof. by move/subnK <-; rewrite halfD addnA leq_addl. Qed. Lemma half_gt0 n : (0 < n./2) = (1 < n). Proof. by case: n => [|[]]. Qed. Lemma odd_geq m n : odd n -> (m <= n) = (m./2.*2 <= n). Proof. move=> odd_n; rewrite -[m in LHS]odd_double_half -[n]odd_double_half odd_n. by case: (odd m); rewrite // leq_Sdouble ltnS leq_double. Qed. Lemma odd_ltn m n : odd n -> (n < m) = (n < m./2.*2). Proof. by move=> odd_n; rewrite !ltnNge odd_geq. Qed. Lemma odd_gt0 n : odd n -> n > 0. Proof. by case: n. Qed. Lemma odd_gt2 n : odd n -> n > 1 -> n > 2. Proof. by move=> odd_n n_gt1; rewrite odd_geq. Qed. (* Squares and square identities. *) Lemma mulnn m : m * m = m ^ 2. Proof. by rewrite !expnS muln1. Qed. Lemma sqrnD m n : (m + n) ^ 2 = m ^ 2 + n ^ 2 + 2 * (m * n). Proof. rewrite -!mulnn mul2n mulnDr !mulnDl (mulnC n) -!addnA. by congr (_ + _); rewrite addnA addnn addnC. Qed. Lemma sqrnB m n : n <= m -> (m - n) ^ 2 = m ^ 2 + n ^ 2 - 2 * (m * n). Proof. move/subnK <-; rewrite addnK sqrnD -addnA -addnACA -addnA. by rewrite addnn -mul2n -mulnDr -mulnDl addnK. Qed. Lemma sqrnD_sub m n : n <= m -> (m + n) ^ 2 - 4 * (m * n) = (m - n) ^ 2. Proof. move=> le_nm; rewrite -[4]/(2 * 2) -mulnA mul2n -addnn subnDA. by rewrite sqrnD addnK sqrnB. Qed. Lemma subn_sqr m n : m ^ 2 - n ^ 2 = (m - n) * (m + n). Proof. by rewrite mulnBl !mulnDr addnC (mulnC m) subnDl. Qed. Lemma ltn_sqr m n : (m ^ 2 < n ^ 2) = (m < n). Proof. by rewrite ltn_exp2r. Qed. Lemma leq_sqr m n : (m ^ 2 <= n ^ 2) = (m <= n). Proof. by rewrite leq_exp2r. Qed. Lemma sqrn_gt0 n : (0 < n ^ 2) = (0 < n). Proof. exact: (ltn_sqr 0). Qed. Lemma eqn_sqr m n : (m ^ 2 == n ^ 2) = (m == n). Proof. by rewrite eqn_exp2r. Qed. Lemma sqrn_inj : injective (expn ^~ 2). Proof. exact: expIn. Qed. (* Almost strict inequality: an inequality that is strict unless some *) (* specific condition holds, such as the Cauchy-Schwartz or the AGM *) (* inequality (we only prove the order-2 AGM here; the general one *) (* requires sequences). *) (* We formalize the concept as a rewrite multirule, that can be used *) (* both to rewrite the non-strict inequality to true, and the equality *) (* to the specific condition (for strict inequalities use the ltn_neqAle *) (* lemma); in addition, the conditional equality also coerces to a *) (* non-strict one. *) Definition leqif m n C := ((m <= n) * ((m == n) = C))%type. Notation "m <= n ?= 'iff' C" := (leqif m n C) : nat_scope. Coercion leq_of_leqif m n C (H : m <= n ?= iff C) := H.1 : m <= n. Lemma leqifP m n C : reflect (m <= n ?= iff C) (if C then m == n else m < n). Proof. rewrite ltn_neqAle; apply: (iffP idP) => [|lte]; last by rewrite !lte; case C. by case C => [/eqP-> | /andP[/negPf]]; split=> //; apply: eqxx. Qed. Lemma leqif_refl m C : reflect (m <= m ?= iff C) C. Proof. by apply: (iffP idP) => [-> | <-] //; split; rewrite ?eqxx. Qed. Lemma leqif_trans m1 m2 m3 C12 C23 : m1 <= m2 ?= iff C12 -> m2 <= m3 ?= iff C23 -> m1 <= m3 ?= iff C12 && C23. Proof. move=> ltm12 ltm23; apply/leqifP; rewrite -ltm12. have [->|eqm12] := eqVneq; first by rewrite ltn_neqAle !ltm23 andbT; case C23. by rewrite (@leq_trans m2) ?ltm23 // ltn_neqAle eqm12 ltm12. Qed. Lemma mono_leqif f : {mono f : m n / m <= n} -> forall m n C, (f m <= f n ?= iff C) = (m <= n ?= iff C). Proof. by move=> f_mono m n C; rewrite /leqif !eqn_leq !f_mono. Qed. Lemma leqif_geq m n : m <= n -> m <= n ?= iff (m >= n). Proof. by move=> lemn; split=> //; rewrite eqn_leq lemn. Qed. Lemma leqif_eq m n : m <= n -> m <= n ?= iff (m == n). Proof. by []. Qed. Lemma geq_leqif a b C : a <= b ?= iff C -> (b <= a) = C. Proof. by case=> le_ab; rewrite eqn_leq le_ab. Qed. Lemma ltn_leqif a b C : a <= b ?= iff C -> (a < b) = ~~ C. Proof. by move=> le_ab; rewrite ltnNge (geq_leqif le_ab). Qed. Lemma ltnNleqif x y C : x <= y ?= iff ~~ C -> (x < y) = C. Proof. by move=> /ltn_leqif; rewrite negbK. Qed. Lemma eq_leqif x y C : x <= y ?= iff C -> (x == y) = C. Proof. by move=> /leqifP; case: C ltngtP => [] []. Qed. Lemma eqTleqif x y C : x <= y ?= iff C -> C -> x = y. Proof. by move=> /eq_leqif<-/eqP. Qed. Lemma leqif_add m1 n1 C1 m2 n2 C2 : m1 <= n1 ?= iff C1 -> m2 <= n2 ?= iff C2 -> m1 + m2 <= n1 + n2 ?= iff C1 && C2. Proof. rewrite -(mono_leqif (leq_add2r m2)) -(mono_leqif (leq_add2l n1) m2). exact: leqif_trans. Qed. Lemma leqif_mul m1 n1 C1 m2 n2 C2 : m1 <= n1 ?= iff C1 -> m2 <= n2 ?= iff C2 -> m1 * m2 <= n1 * n2 ?= iff (n1 * n2 == 0) || (C1 && C2). Proof. case: n1 => [|n1] le1; first by case: m1 le1 => [|m1] [_ <-] //. case: n2 m2 => [|n2] [|m2] /=; try by case=> // _ <-; rewrite !muln0 ?andbF. have /leq_pmul2l-/mono_leqif<-: 0 < n1.+1 by []. by apply: leqif_trans; have /leq_pmul2r-/mono_leqif->: 0 < m2.+1. Qed. Lemma nat_Cauchy m n : 2 * (m * n) <= m ^ 2 + n ^ 2 ?= iff (m == n). Proof. without loss le_nm: m n / n <= m. by have [?|/ltnW ?] := leqP n m; last rewrite eq_sym addnC (mulnC m); apply. apply/leqifP; have [-> | ne_mn] := eqVneq; first by rewrite addnn mul2n. by rewrite -subn_gt0 -sqrnB // sqrn_gt0 subn_gt0 ltn_neqAle eq_sym ne_mn. Qed. Lemma nat_AGM2 m n : 4 * (m * n) <= (m + n) ^ 2 ?= iff (m == n). Proof. rewrite -[4]/(2 * 2) -mulnA mul2n -addnn sqrnD; apply/leqifP. by rewrite ltn_add2r eqn_add2r ltn_neqAle !nat_Cauchy; case: eqVneq. Qed. Section ContraLeq. Implicit Types (b : bool) (m n : nat) (P : Prop). Lemma contraTleq b m n : (n < m -> ~~ b) -> (b -> m <= n). Proof. by rewrite ltnNge; apply: contraTT. Qed. Lemma contraTltn b m n : (n <= m -> ~~ b) -> (b -> m < n). Proof. by rewrite ltnNge; apply: contraTN. Qed. Lemma contraPleq P m n : (n < m -> ~ P) -> (P -> m <= n). Proof. by rewrite ltnNge; apply: contraPT. Qed. Lemma contraPltn P m n : (n <= m -> ~ P) -> (P -> m < n). Proof. by rewrite ltnNge; apply: contraPN. Qed. Lemma contraNleq b m n : (n < m -> b) -> (~~ b -> m <= n). Proof. by rewrite ltnNge; apply: contraNT. Qed. Lemma contraNltn b m n : (n <= m -> b) -> (~~ b -> m < n). Proof. by rewrite ltnNge; apply: contraNN. Qed. Lemma contra_not_leq P m n : (n < m -> P) -> (~ P -> m <= n). Proof. by rewrite ltnNge; apply: contra_notT. Qed. Lemma contra_not_ltn P m n : (n <= m -> P) -> (~ P -> m < n). Proof. by rewrite ltnNge; apply: contra_notN. Qed. Lemma contraFleq b m n : (n < m -> b) -> (b = false -> m <= n). Proof. by rewrite ltnNge; apply: contraFT. Qed. Lemma contraFltn b m n : (n <= m -> b) -> (b = false -> m < n). Proof. by rewrite ltnNge; apply: contraFN. Qed. Lemma contra_leqT b m n : (~~ b -> m < n) -> (n <= m -> b). Proof. by rewrite ltnNge; apply: contraTT. Qed. Lemma contra_ltnT b m n : (~~ b -> m <= n) -> (n < m -> b). Proof. by rewrite ltnNge; apply: contraNT. Qed. Lemma contra_leqN b m n : (b -> m < n) -> (n <= m -> ~~ b). Proof. by rewrite ltnNge; apply: contraTN. Qed. Lemma contra_ltnN b m n : (b -> m <= n) -> (n < m -> ~~ b). Proof. by rewrite ltnNge; apply: contraNN. Qed. Lemma contra_leq_not P m n : (P -> m < n) -> (n <= m -> ~ P). Proof. by rewrite ltnNge; apply: contraTnot. Qed. Lemma contra_ltn_not P m n : (P -> m <= n) -> (n < m -> ~ P). Proof. by rewrite ltnNge; apply: contraNnot. Qed. Lemma contra_leqF b m n : (b -> m < n) -> (n <= m -> b = false). Proof. by rewrite ltnNge; apply: contraTF. Qed. Lemma contra_ltnF b m n : (b -> m <= n) -> (n < m -> b = false). Proof. by rewrite ltnNge; apply: contraNF. Qed. Lemma contra_leq m n p q : (q < p -> n < m) -> (m <= n -> p <= q). Proof. by rewrite !ltnNge; apply: contraTT. Qed. Lemma contra_leq_ltn m n p q : (q <= p -> n < m) -> (m <= n -> p < q). Proof. by rewrite !ltnNge; apply: contraTN. Qed. Lemma contra_ltn_leq m n p q : (q < p -> n <= m) -> (m < n -> p <= q). Proof. by rewrite !ltnNge; apply: contraNT. Qed. Lemma contra_ltn m n p q : (q <= p -> n <= m) -> (m < n -> p < q). Proof. by rewrite !ltnNge; apply: contraNN. Qed. End ContraLeq. Section Monotonicity. Variable T : Type. Lemma homo_ltn_in (D : {pred nat}) (f : nat -> T) (r : T -> T -> Prop) : (forall y x z, r x y -> r y z -> r x z) -> {in D &, forall i j k, i < k < j -> k \in D} -> {in D, forall i, i.+1 \in D -> r (f i) (f i.+1)} -> {in D &, {homo f : i j / i < j >-> r i j}}. Proof. move=> r_trans Dcx r_incr i j iD jD lt_ij; move: (lt_ij) (jD) => /subnKC<-. elim: (_ - _) => [|k ihk]; first by rewrite addn0 => Dsi; apply: r_incr. move=> DSiSk [: DSik]; apply: (r_trans _ _ _ (ihk _)); rewrite ?addnS. by abstract: DSik; apply: (Dcx _ _ iD DSiSk); rewrite ltn_addr ?addnS /=. by apply: r_incr; rewrite -?addnS. Qed. Lemma homo_ltn (f : nat -> T) (r : T -> T -> Prop) : (forall y x z, r x y -> r y z -> r x z) -> (forall i, r (f i) (f i.+1)) -> {homo f : i j / i < j >-> r i j}. Proof. by move=> /(@homo_ltn_in predT f) fr fS i j; apply: fr. Qed. Lemma homo_leq_in (D : {pred nat}) (f : nat -> T) (r : T -> T -> Prop) : (forall x, r x x) -> (forall y x z, r x y -> r y z -> r x z) -> {in D &, forall i j k, i < k < j -> k \in D} -> {in D, forall i, i.+1 \in D -> r (f i) (f i.+1)} -> {in D &, {homo f : i j / i <= j >-> r i j}}. Proof. move=> r_refl r_trans Dcx /(homo_ltn_in r_trans Dcx) lt_r i j iD jD. case: ltngtP => [? _||->] //; exact: lt_r. Qed. Lemma homo_leq (f : nat -> T) (r : T -> T -> Prop) : (forall x, r x x) -> (forall y x z, r x y -> r y z -> r x z) -> (forall i, r (f i) (f i.+1)) -> {homo f : i j / i <= j >-> r i j}. Proof. by move=> rrefl /(@homo_leq_in predT f r) fr fS i j; apply: fr. Qed. Section NatToNat. Variable (f : nat -> nat). (****************************************************************************) (* This listing of "Let"s factor out the required premises for the *) (* subsequent lemmas, putting them in the context so that "done" solves the *) (* goals quickly *) (****************************************************************************) Let ltn_neqAle := ltn_neqAle. Let gtn_neqAge x y : (y < x) = (x != y) && (y <= x). Proof. by rewrite ltn_neqAle eq_sym. Qed. Let anti_leq := anti_leq. Let anti_geq : antisymmetric geq. Proof. by move=> m n /=; rewrite andbC => /anti_leq. Qed. Let leq_total := leq_total. Lemma ltnW_homo : {homo f : m n / m < n} -> {homo f : m n / m <= n}. Proof. exact: homoW. Qed. Lemma inj_homo_ltn : injective f -> {homo f : m n / m <= n} -> {homo f : m n / m < n}. Proof. exact: inj_homo. Qed. Lemma ltnW_nhomo : {homo f : m n /~ m < n} -> {homo f : m n /~ m <= n}. Proof. exact: homoW. Qed. Lemma inj_nhomo_ltn : injective f -> {homo f : m n /~ m <= n} -> {homo f : m n /~ m < n}. Proof. exact: inj_homo. Qed. Lemma incn_inj : {mono f : m n / m <= n} -> injective f. Proof. exact: mono_inj. Qed. Lemma decn_inj : {mono f : m n /~ m <= n} -> injective f. Proof. exact: mono_inj. Qed. Lemma leqW_mono : {mono f : m n / m <= n} -> {mono f : m n / m < n}. Proof. exact: anti_mono. Qed. Lemma leqW_nmono : {mono f : m n /~ m <= n} -> {mono f : m n /~ m < n}. Proof. exact: anti_mono. Qed. Lemma leq_mono : {homo f : m n / m < n} -> {mono f : m n / m <= n}. Proof. exact: total_homo_mono. Qed. Lemma leq_nmono : {homo f : m n /~ m < n} -> {mono f : m n /~ m <= n}. Proof. exact: total_homo_mono. Qed. Variables (D D' : {pred nat}). Lemma ltnW_homo_in : {in D & D', {homo f : m n / m < n}} -> {in D & D', {homo f : m n / m <= n}}. Proof. exact: homoW_in. Qed. Lemma ltnW_nhomo_in : {in D & D', {homo f : m n /~ m < n}} -> {in D & D', {homo f : m n /~ m <= n}}. Proof. exact: homoW_in. Qed. Lemma inj_homo_ltn_in : {in D & D', injective f} -> {in D & D', {homo f : m n / m <= n}} -> {in D & D', {homo f : m n / m < n}}. Proof. exact: inj_homo_in. Qed. Lemma inj_nhomo_ltn_in : {in D & D', injective f} -> {in D & D', {homo f : m n /~ m <= n}} -> {in D & D', {homo f : m n /~ m < n}}. Proof. exact: inj_homo_in. Qed. Lemma incn_inj_in : {in D &, {mono f : m n / m <= n}} -> {in D &, injective f}. Proof. exact: mono_inj_in. Qed. Lemma decn_inj_in : {in D &, {mono f : m n /~ m <= n}} -> {in D &, injective f}. Proof. exact: mono_inj_in. Qed. Lemma leqW_mono_in : {in D &, {mono f : m n / m <= n}} -> {in D &, {mono f : m n / m < n}}. Proof. exact: anti_mono_in. Qed. Lemma leqW_nmono_in : {in D &, {mono f : m n /~ m <= n}} -> {in D &, {mono f : m n /~ m < n}}. Proof. exact: anti_mono_in. Qed. Lemma leq_mono_in : {in D &, {homo f : m n / m < n}} -> {in D &, {mono f : m n / m <= n}}. Proof. exact: total_homo_mono_in. Qed. Lemma leq_nmono_in : {in D &, {homo f : m n /~ m < n}} -> {in D &, {mono f : m n /~ m <= n}}. Proof. exact: total_homo_mono_in. Qed. End NatToNat. End Monotonicity. (* Support for larger integers. The normal definitions of +, - and even *) (* IO are unsuitable for Peano integers larger than 2000 or so because *) (* they are not tail-recursive. We provide a workaround module, along *) (* with a rewrite multirule to change the tailrec operators to the *) (* normal ones. We handle IO via the NatBin module, but provide our *) (* own (more efficient) conversion functions. *) Module NatTrec. (* Usage: *) (* Import NatTrec. *) (* in section defining functions, rebinds all *) (* non-tail recursive operators. *) (* rewrite !trecE. *) (* in the correctness proof, restores operators *) Fixpoint add m n := if m is m'.+1 then m' + n.+1 else n where "n + m" := (add n m) : nat_scope. Fixpoint add_mul m n s := if m is m'.+1 then add_mul m' n (n + s) else s. Definition mul m n := if m is m'.+1 then add_mul m' n n else 0. Notation "n * m" := (mul n m) : nat_scope. Fixpoint mul_exp m n p := if n is n'.+1 then mul_exp m n' (m * p) else p. Definition exp m n := if n is n'.+1 then mul_exp m n' m else 1. Notation "n ^ m" := (exp n m) : nat_scope. Local Notation oddn := odd. Fixpoint odd n := if n is n'.+2 then odd n' else eqn n 1. Local Notation doublen := double. Definition double n := if n is n'.+1 then n' + n.+1 else 0. Notation "n .*2" := (double n) : nat_scope. Lemma addE : add =2 addn. Proof. by elim=> //= n IHn m; rewrite IHn addSnnS. Qed. Lemma doubleE : double =1 doublen. Proof. by case=> // n; rewrite -addnn -addE. Qed. Lemma add_mulE n m s : add_mul n m s = addn (muln n m) s. Proof. by elim: n => //= n IHn in m s *; rewrite IHn addE addnCA addnA. Qed. Lemma mulE : mul =2 muln. Proof. by case=> //= n m; rewrite add_mulE addnC. Qed. Lemma mul_expE m n p : mul_exp m n p = muln (expn m n) p. Proof. by elim: n => [|n IHn] in p *; rewrite ?mul1n //= expnS IHn mulE mulnCA mulnA. Qed. Lemma expE : exp =2 expn. Proof. by move=> m [|n] //=; rewrite mul_expE expnS mulnC. Qed. Lemma oddE : odd =1 oddn. Proof. move=> n; rewrite -[n in LHS]odd_double_half addnC. by elim: n./2 => //=; case (oddn n). Qed. Definition trecE := (addE, (doubleE, oddE), (mulE, add_mulE, (expE, mul_expE))). End NatTrec. Notation natTrecE := NatTrec.trecE. Lemma eq_binP : Equality.axiom N.eqb. Proof. move=> p q; apply: (iffP idP) => [|<-]; last by case: p => //; elim. by case: q; case: p => //; elim=> [p IHp|p IHp|] [q|q|] //= /IHp [->]. Qed. Canonical bin_nat_eqMixin := EqMixin eq_binP. Canonical bin_nat_eqType := Eval hnf in EqType N bin_nat_eqMixin. Arguments N.eqb !n !m. Section NumberInterpretation. Import BinPos. Section Trec. Import NatTrec. Fixpoint nat_of_pos p0 := match p0 with | xO p => (nat_of_pos p).*2 | xI p => (nat_of_pos p).*2.+1 | xH => 1 end. End Trec. Local Coercion nat_of_pos : positive >-> nat. Coercion nat_of_bin b := if b is Npos p then p : nat else 0. Fixpoint pos_of_nat n0 m0 := match n0, m0 with | n.+1, m.+2 => pos_of_nat n m | n.+1, 1 => xO (pos_of_nat n n) | n.+1, 0 => xI (pos_of_nat n n) | 0, _ => xH end. Definition bin_of_nat n0 := if n0 is n.+1 then Npos (pos_of_nat n n) else 0%num. Lemma bin_of_natK : cancel bin_of_nat nat_of_bin. Proof. have sub2nn n : n.*2 - n = n by rewrite -addnn addKn. case=> //= n; rewrite -[n in RHS]sub2nn. by elim: n {2 4}n => // m IHm [|[|n]] //=; rewrite IHm // natTrecE sub2nn. Qed. Lemma nat_of_binK : cancel nat_of_bin bin_of_nat. Proof. case=> //=; elim=> //= p; case: (nat_of_pos p) => //= n [<-]. by rewrite natTrecE !addnS {2}addnn; elim: {1 3}n. by rewrite natTrecE addnS /= addnS {2}addnn; elim: {1 3}n. Qed. Lemma nat_of_succ_pos p : Pos.succ p = p.+1 :> nat. Proof. by elim: p => //= p ->; rewrite !natTrecE. Qed. Lemma nat_of_add_pos p q : (p + q)%positive = p + q :> nat. Proof. apply: @fst _ (Pplus_carry p q = (p + q).+1 :> nat) _. elim: p q => [p IHp|p IHp|] [q|q|] //=; rewrite !natTrecE //; by rewrite ?IHp ?nat_of_succ_pos ?(doubleS, doubleD, addn1, addnS). Qed. Lemma nat_of_mul_pos p q : (p * q)%positive = p * q :> nat. Proof. elim: p => [p IHp|p IHp|] /=; rewrite ?mul1n //; by rewrite ?nat_of_add_pos /= !natTrecE IHp doubleMl. Qed. Lemma nat_of_add_bin b1 b2 : (b1 + b2)%num = b1 + b2 :> nat. Proof. by case: b1 b2 => [|p] [|q]; rewrite ?addn0 //= nat_of_add_pos. Qed. Lemma nat_of_mul_bin b1 b2 : (b1 * b2)%num = b1 * b2 :> nat. Proof. by case: b1 b2 => [|p] [|q]; rewrite ?muln0 //= nat_of_mul_pos. Qed. Lemma nat_of_exp_bin n (b : N) : n ^ b = pow_N 1 muln n b. Proof. by case: b; last (elim=> //= p <-; rewrite natTrecE mulnn -expnM muln2 ?expnS). Qed. End NumberInterpretation. (* Big(ger) nat IO; usage: *) (* Num 1 072 399 *) (* to create large numbers for test cases *) (* Eval compute in [Num of some expression] *) (* to display the result of an expression that *) (* returns a larger integer. *) Record number : Type := Num {bin_of_number :> N}. Definition extend_number (nn : number) m := Num (nn * 1000 + bin_of_nat m). Coercion extend_number : number >-> Funclass. Canonical number_subType := [newType for bin_of_number]. Definition number_eqMixin := Eval hnf in [eqMixin of number by <:]. Canonical number_eqType := Eval hnf in EqType number number_eqMixin. Notation "[ 'Num' 'of' e ]" := (Num (bin_of_nat e)) (at level 0, format "[ 'Num' 'of' e ]") : nat_scope. (* Interface to ring/ring_simplify tactics *) Lemma nat_semi_ring : semi_ring_theory 0 1 addn muln (@eq _). Proof. exact: mk_srt add0n addnC addnA mul1n mul0n mulnC mulnA mulnDl. Qed. Lemma nat_semi_morph : semi_morph 0 1 addn muln (@eq _) 0%num 1%num Nplus Nmult pred1 nat_of_bin. Proof. by move: nat_of_add_bin nat_of_mul_bin; split=> //= m n /eqP ->. Qed. Lemma nat_power_theory : power_theory 1 muln (@eq _) nat_of_bin expn. Proof. by split; apply: nat_of_exp_bin. Qed. (* Interface to the ring tactic machinery. *) Fixpoint pop_succn e := if e is e'.+1 then fun n => pop_succn e' n.+1 else id. Ltac pop_succn e := eval lazy beta iota delta [pop_succn] in (pop_succn e 1). Ltac nat_litteral e := match pop_succn e with | ?n.+1 => constr: (bin_of_nat n) | _ => NotConstant end. Ltac succn_to_add := match goal with | |- context G [?e.+1] => let x := fresh "NatLit0" in match pop_succn e with | ?n.+1 => pose x := n.+1; let G' := context G [x] in change G' | _ ?e' ?n => pose x := n; let G' := context G [x + e'] in change G' end; succn_to_add; rewrite {}/x | _ => idtac end. Add Ring nat_ring_ssr : nat_semi_ring (morphism nat_semi_morph, constants [nat_litteral], preprocess [succn_to_add], power_tac nat_power_theory [nat_litteral]). (* A congruence tactic, similar to the boolean one, along with an .+1/+ *) (* normalization tactic. *) Ltac nat_norm := succn_to_add; rewrite ?add0n ?addn0 -?addnA ?(addSn, addnS, add0n, addn0). Ltac nat_congr := first [ apply: (congr1 succn _) | apply: (congr1 predn _) | apply: (congr1 (addn _) _) | apply: (congr1 (subn _) _) | apply: (congr1 (addn^~ _) _) | match goal with |- (?X1 + ?X2 = ?X3) => symmetry; rewrite -1?(addnC X1) -?(addnCA X1); apply: (congr1 (addn X1) _); symmetry end ]. Module mc_1_10. Variant leq_xor_gtn m n : bool -> bool -> Set := | LeqNotGtn of m <= n : leq_xor_gtn m n true false | GtnNotLeq of n < m : leq_xor_gtn m n false true. Lemma leqP m n : leq_xor_gtn m n (m <= n) (n < m). Proof. by case: leqP; constructor. Qed. Variant ltn_xor_geq m n : bool -> bool -> Set := | LtnNotGeq of m < n : ltn_xor_geq m n false true | GeqNotLtn of n <= m : ltn_xor_geq m n true false. Lemma ltnP m n : ltn_xor_geq m n (n <= m) (m < n). Proof. by case: ltnP; constructor. Qed. Variant eqn0_xor_gt0 n : bool -> bool -> Set := | Eq0NotPos of n = 0 : eqn0_xor_gt0 n true false | PosNotEq0 of n > 0 : eqn0_xor_gt0 n false true. Lemma posnP n : eqn0_xor_gt0 n (n == 0) (0 < n). Proof. by case: n; constructor. Qed. Variant compare_nat m n : bool -> bool -> bool -> bool -> bool -> bool -> Set := | CompareNatLt of m < n : compare_nat m n false false false true false true | CompareNatGt of m > n : compare_nat m n false false true false true false | CompareNatEq of m = n : compare_nat m n true true true true false false. Lemma ltngtP m n : compare_nat m n (n == m) (m == n) (n <= m) (m <= n) (n < m) (m < n). Proof. by case: ltngtP; constructor. Qed. End mc_1_10. (* Temporary backward compatibility. *) Notation odd_add := (deprecate odd_add oddD _) (only parsing). Notation odd_sub := (deprecate odd_sub oddB _) (only parsing). Notation "@ 'homo_inj_lt'" := (deprecate homo_inj_lt inj_homo_ltn) (at level 10, only parsing) : fun_scope. Notation homo_inj_lt := (@homo_inj_lt _) (only parsing). Notation "@ 'homo_inj_lt_in'" := (deprecate homo_inj_lt_in inj_homo_ltn_in) (at level 10, only parsing) : fun_scope. Notation homo_inj_lt_in := (@homo_inj_lt_in _ _ _) (only parsing). Notation "@ 'incr_inj'" := (deprecate incr_inj incn_inj) (at level 10, only parsing) : fun_scope. Notation incr_inj := (@incr_inj _) (only parsing). Notation "@ 'incr_inj_in'" := (deprecate incr_inj_in incn_inj_in) (at level 10, only parsing) : fun_scope. Notation incr_inj_in := (@incr_inj_in _ _) (only parsing). Notation "@ 'decr_inj'" := (deprecate decr_inj decn_inj) (at level 10, only parsing) : fun_scope. Notation decr_inj := (@decr_inj _) (only parsing). Notation "@ 'decr_inj_in'" := (deprecate decr_inj_in decn_inj_in) (at level 10, only parsing) : fun_scope. Notation decr_inj_in := (@decr_inj_in _ _) (only parsing). Notation "@ 'iter_add'" := (deprecate iter_add iterD) (at level 10, only parsing) : fun_scope. Notation "@ 'odd_opp'" := (deprecate odd_opp oddN) (at level 10, only parsing) : fun_scope. Notation "@ 'sqrn_sub'" := (deprecate sqrn_sub sqrnB) (at level 10, only parsing) : fun_scope. Notation iter_add := (@iterD _) (only parsing). Notation maxn_mulr := (deprecate maxn_mulr maxnMr) (only parsing). Notation maxn_mull := (deprecate maxn_mull maxnMl) (only parsing). Notation minn_mulr := (deprecate minn_mulr minnMr) (only parsing). Notation minn_mull := (deprecate minn_mull minnMl) (only parsing). Notation odd_opp := (@odd_opp _ _) (only parsing). Notation odd_mul := (deprecate odd_mul oddM) (only parsing). Notation odd_exp := (deprecate odd_exp oddX) (only parsing). Notation sqrn_sub := (@sqrn_sub _ _) (only parsing). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/ssrnotations.v000066400000000000000000000142001375767750300240460ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) (******************************************************************************) (* - Reserved notation for various arithmetic and algebraic operations: *) (* e.[a1, ..., a_n] evaluation (e.g., polynomials). *) (* e`_i indexing (number list, integer pi-part). *) (* x^-1 inverse (group, field). *) (* x *+ n, x *- n integer multiplier (modules and rings). *) (* x ^+ n, x ^- n integer exponent (groups and rings). *) (* x *: A, A :* x external product (scaling/module product in rings, *) (* left/right cosets in groups). *) (* A :&: B intersection (of sets, groups, subspaces, ...). *) (* A :|: B, a |: B union, union with a singleton (of sets). *) (* A :\: B, A :\ b relative complement (of sets, subspaces, ...). *) (* <>, <[a]> generated group/subspace, generated cycle/line. *) (* 'C[x], 'C_A[x] point centralisers (in groups and F-algebras). *) (* 'C(A), 'C_B(A) centralisers (in groups and matrix and F_algebras). *) (* 'Z(A) centers (in groups and matrix and F-algebras). *) (* m %/ d, m %% d Euclidean division and remainder (nat, polynomials). *) (* d %| m Euclidean divisibility (nat, polynomial). *) (* m = n %[mod d] equality mod d (also defined for <>, ==, and !=). *) (* e^`(n) nth formal derivative (groups, polynomials). *) (* e^`() simple formal derivative (polynomials only). *) (* `|x| norm, absolute value, distance (rings, int, nat). *) (* x <= y ?= iff C x is less than y, and equal iff C holds (nat, rings). *) (* x <= y :> T, etc cast comparison (rings, all comparison operators). *) (* [rec a1, ..., an] standard shorthand for hidden recursor (see prime.v). *) (* The interpretation of these notations is not defined here, but the *) (* declarations help maintain consistency across the library. *) (******************************************************************************) (* Reserved notation for evaluation *) Reserved Notation "e .[ x ]" (at level 2, left associativity, format "e .[ x ]"). Reserved Notation "e .[ x1 , x2 , .. , xn ]" (at level 2, left associativity, format "e '[ ' .[ x1 , '/' x2 , '/' .. , '/' xn ] ']'"). (* Reserved notation for subscripting and superscripting *) Reserved Notation "s `_ i" (at level 3, i at level 2, left associativity, format "s `_ i"). Reserved Notation "x ^-1" (at level 3, left associativity, format "x ^-1"). (* Reserved notation for integer multipliers and exponents *) Reserved Notation "x *+ n" (at level 40, left associativity). Reserved Notation "x *- n" (at level 40, left associativity). Reserved Notation "x ^+ n" (at level 29, left associativity). Reserved Notation "x ^- n" (at level 29, left associativity). (* Reserved notation for external multiplication. *) Reserved Notation "x *: A" (at level 40). Reserved Notation "A :* x" (at level 40). (* Reserved notation for set-theoretic operations. *) Reserved Notation "A :&: B" (at level 48, left associativity). Reserved Notation "A :|: B" (at level 52, left associativity). Reserved Notation "a |: A" (at level 52, left associativity). Reserved Notation "A :\: B" (at level 50, left associativity). Reserved Notation "A :\ b" (at level 50, left associativity). (* Reserved notation for generated structures *) Reserved Notation "<< A >>" (at level 0, format "<< A >>"). Reserved Notation "<[ a ] >" (at level 0, format "<[ a ] >"). (* Reserved notation for the order of an element (group, polynomial, etc) *) Reserved Notation "#[ x ]" (at level 0, format "#[ x ]"). (* Reserved notation for centralisers and centers. *) Reserved Notation "''C' [ x ]" (at level 8, format "''C' [ x ]"). Reserved Notation "''C_' A [ x ]" (at level 8, A at level 2, format "''C_' A [ x ]"). Reserved Notation "''C' ( A )" (at level 8, format "''C' ( A )"). Reserved Notation "''C_' B ( A )" (at level 8, B at level 2, format "''C_' B ( A )"). Reserved Notation "''Z' ( A )" (at level 8, format "''Z' ( A )"). (* Compatibility with group action centraliser notation. *) Reserved Notation "''C_' ( A ) [ x ]" (at level 8). Reserved Notation "''C_' ( B ) ( A )" (at level 8). (* Reserved notation for Euclidean division and divisibility. *) Reserved Notation "m %/ d" (at level 40, no associativity). Reserved Notation "m %% d" (at level 40, no associativity). Reserved Notation "m %| d" (at level 70, no associativity). Reserved Notation "m = n %[mod d ]" (at level 70, n at next level, format "'[hv ' m '/' = n '/' %[mod d ] ']'"). Reserved Notation "m == n %[mod d ]" (at level 70, n at next level, format "'[hv ' m '/' == n '/' %[mod d ] ']'"). Reserved Notation "m <> n %[mod d ]" (at level 70, n at next level, format "'[hv ' m '/' <> n '/' %[mod d ] ']'"). Reserved Notation "m != n %[mod d ]" (at level 70, n at next level, format "'[hv ' m '/' != n '/' %[mod d ] ']'"). (* Reserved notation for derivatives. *) Reserved Notation "a ^` ()" (at level 8, format "a ^` ()"). Reserved Notation "a ^` ( n )" (at level 8, format "a ^` ( n )"). (* Reserved notation for absolute value. *) Reserved Notation "`| x |" (at level 0, x at level 99, format "`| x |"). (* Reserved notation for conditional comparison *) Reserved Notation "x <= y ?= 'iff' c" (at level 70, y, c at next level, format "x '[hv' <= y '/' ?= 'iff' c ']'"). (* Reserved notation for cast comparison. *) Reserved Notation "x <= y :> T" (at level 70, y at next level). Reserved Notation "x >= y :> T" (at level 70, y at next level). Reserved Notation "x < y :> T" (at level 70, y at next level). Reserved Notation "x > y :> T" (at level 70, y at next level). Reserved Notation "x <= y ?= 'iff' c :> T" (at level 70, y, c at next level, format "x '[hv' <= y '/' ?= 'iff' c :> T ']'"). math-comp-mathcomp-1.12.0/mathcomp/ssreflect/tuple.v000066400000000000000000000371131375767750300224410ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat. From mathcomp Require Import seq choice fintype. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (******************************************************************************) (* Tuples, i.e., sequences with a fixed (known) length. We define: *) (* n.-tuple T == the type of n-tuples of elements of type T. *) (* [tuple of s] == the tuple whose underlying sequence (value) is s. *) (* The size of s must be known: specifically, Coq must *) (* be able to infer a Canonical tuple projecting on s. *) (* in_tuple s == the (size s).-tuple with value s. *) (* [tuple] == the empty tuple. *) (* [tuple x1; ..; xn] == the explicit n.-tuple . *) (* [tuple E | i < n] == the n.-tuple with general term E (i : 'I_n is bound *) (* in E). *) (* tcast Emn t == the m.-tuple t cast as an n.-tuple using Emn : m = n.*) (* As n.-tuple T coerces to seq t, all seq operations (size, nth, ...) can be *) (* applied to t : n.-tuple T; we provide a few specialized instances when *) (* avoids the need for a default value. *) (* tsize t == the size of t (the n in n.-tuple T) *) (* tnth t i == the i'th component of t, where i : 'I_n. *) (* [tnth t i] == the i'th component of t, where i : nat and i < n *) (* is convertible to true. *) (* thead t == the first element of t, when n is m.+1 for some m. *) (* Most seq constructors (cons, behead, cat, rcons, belast, take, drop, rot, *) (* map, ...) can be used to build tuples via the [tuple of s] construct. *) (* Tuples are actually a subType of seq, and inherit all combinatorial *) (* structures, including the finType structure. *) (* Some useful lemmas and definitions: *) (* tuple0 : [tuple] is the only 0.-tuple *) (* tupleP : elimination view for n.+1.-tuple *) (* ord_tuple n : the n.-tuple of all i : 'I_n *) (******************************************************************************) Section Def. Variables (n : nat) (T : Type). Structure tuple_of : Type := Tuple {tval :> seq T; _ : size tval == n}. Canonical tuple_subType := Eval hnf in [subType for tval]. Implicit Type t : tuple_of. Definition tsize of tuple_of := n. Lemma size_tuple t : size t = n. Proof. exact: (eqP (valP t)). Qed. Lemma tnth_default t : 'I_n -> T. Proof. by rewrite -(size_tuple t); case: (tval t) => [|//] []. Qed. Definition tnth t i := nth (tnth_default t i) t i. Lemma tnth_nth x t i : tnth t i = nth x t i. Proof. by apply: set_nth_default; rewrite size_tuple. Qed. Lemma map_tnth_enum t : map (tnth t) (enum 'I_n) = t. Proof. case def_t: {-}(val t) => [|x0 t']. by rewrite [enum _]size0nil // -cardE card_ord -(size_tuple t) def_t. apply: (@eq_from_nth _ x0) => [|i]; rewrite size_map. by rewrite -cardE size_tuple card_ord. move=> lt_i_e; have lt_i_n: i < n by rewrite -cardE card_ord in lt_i_e. by rewrite (nth_map (Ordinal lt_i_n)) // (tnth_nth x0) nth_enum_ord. Qed. Lemma eq_from_tnth t1 t2 : tnth t1 =1 tnth t2 -> t1 = t2. Proof. by move/eq_map=> eq_t; apply: val_inj; rewrite /= -!map_tnth_enum eq_t. Qed. Definition tuple t mkT : tuple_of := mkT (let: Tuple _ tP := t return size t == n in tP). Lemma tupleE t : tuple (fun sP => @Tuple t sP) = t. Proof. by case: t. Qed. End Def. Notation "n .-tuple" := (tuple_of n) (at level 2, format "n .-tuple") : type_scope. Notation "{ 'tuple' n 'of' T }" := (n.-tuple T : predArgType) (at level 0, only parsing) : form_scope. Notation "[ 'tuple' 'of' s ]" := (tuple (fun sP => @Tuple _ _ s sP)) (at level 0, format "[ 'tuple' 'of' s ]") : form_scope. Notation "[ 'tnth' t i ]" := (tnth t (@Ordinal (tsize t) i (erefl true))) (at level 0, t, i at level 8, format "[ 'tnth' t i ]") : form_scope. Canonical nil_tuple T := Tuple (isT : @size T [::] == 0). Canonical cons_tuple n T x (t : n.-tuple T) := Tuple (valP t : size (x :: t) == n.+1). Notation "[ 'tuple' x1 ; .. ; xn ]" := [tuple of x1 :: .. [:: xn] ..] (at level 0, format "[ 'tuple' '[' x1 ; '/' .. ; '/' xn ']' ]") : form_scope. Notation "[ 'tuple' ]" := [tuple of [::]] (at level 0, format "[ 'tuple' ]") : form_scope. Section CastTuple. Variable T : Type. Definition in_tuple (s : seq T) := Tuple (eqxx (size s)). Definition tcast m n (eq_mn : m = n) t := let: erefl in _ = n := eq_mn return n.-tuple T in t. Lemma tcastE m n (eq_mn : m = n) t i : tnth (tcast eq_mn t) i = tnth t (cast_ord (esym eq_mn) i). Proof. by case: n / eq_mn in i *; rewrite cast_ord_id. Qed. Lemma tcast_id n (eq_nn : n = n) t : tcast eq_nn t = t. Proof. by rewrite (eq_axiomK eq_nn). Qed. Lemma tcastK m n (eq_mn : m = n) : cancel (tcast eq_mn) (tcast (esym eq_mn)). Proof. by case: n / eq_mn. Qed. Lemma tcastKV m n (eq_mn : m = n) : cancel (tcast (esym eq_mn)) (tcast eq_mn). Proof. by case: n / eq_mn. Qed. Lemma tcast_trans m n p (eq_mn : m = n) (eq_np : n = p) t: tcast (etrans eq_mn eq_np) t = tcast eq_np (tcast eq_mn t). Proof. by case: n / eq_mn eq_np; case: p /. Qed. Lemma tvalK n (t : n.-tuple T) : in_tuple t = tcast (esym (size_tuple t)) t. Proof. by apply: val_inj => /=; case: _ / (esym _). Qed. Lemma in_tupleE s : in_tuple s = s :> seq T. Proof. by []. Qed. End CastTuple. Section SeqTuple. Variables (n m : nat) (T U rT : Type). Implicit Type t : n.-tuple T. Lemma rcons_tupleP t x : size (rcons t x) == n.+1. Proof. by rewrite size_rcons size_tuple. Qed. Canonical rcons_tuple t x := Tuple (rcons_tupleP t x). Lemma nseq_tupleP x : @size T (nseq n x) == n. Proof. by rewrite size_nseq. Qed. Canonical nseq_tuple x := Tuple (nseq_tupleP x). Lemma iota_tupleP : size (iota m n) == n. Proof. by rewrite size_iota. Qed. Canonical iota_tuple := Tuple iota_tupleP. Lemma behead_tupleP t : size (behead t) == n.-1. Proof. by rewrite size_behead size_tuple. Qed. Canonical behead_tuple t := Tuple (behead_tupleP t). Lemma belast_tupleP x t : size (belast x t) == n. Proof. by rewrite size_belast size_tuple. Qed. Canonical belast_tuple x t := Tuple (belast_tupleP x t). Lemma cat_tupleP t (u : m.-tuple T) : size (t ++ u) == n + m. Proof. by rewrite size_cat !size_tuple. Qed. Canonical cat_tuple t u := Tuple (cat_tupleP t u). Lemma take_tupleP t : size (take m t) == minn m n. Proof. by rewrite size_take size_tuple eqxx. Qed. Canonical take_tuple t := Tuple (take_tupleP t). Lemma drop_tupleP t : size (drop m t) == n - m. Proof. by rewrite size_drop size_tuple. Qed. Canonical drop_tuple t := Tuple (drop_tupleP t). Lemma rev_tupleP t : size (rev t) == n. Proof. by rewrite size_rev size_tuple. Qed. Canonical rev_tuple t := Tuple (rev_tupleP t). Lemma rot_tupleP t : size (rot m t) == n. Proof. by rewrite size_rot size_tuple. Qed. Canonical rot_tuple t := Tuple (rot_tupleP t). Lemma rotr_tupleP t : size (rotr m t) == n. Proof. by rewrite size_rotr size_tuple. Qed. Canonical rotr_tuple t := Tuple (rotr_tupleP t). Lemma map_tupleP f t : @size rT (map f t) == n. Proof. by rewrite size_map size_tuple. Qed. Canonical map_tuple f t := Tuple (map_tupleP f t). Lemma scanl_tupleP f x t : @size rT (scanl f x t) == n. Proof. by rewrite size_scanl size_tuple. Qed. Canonical scanl_tuple f x t := Tuple (scanl_tupleP f x t). Lemma pairmap_tupleP f x t : @size rT (pairmap f x t) == n. Proof. by rewrite size_pairmap size_tuple. Qed. Canonical pairmap_tuple f x t := Tuple (pairmap_tupleP f x t). Lemma zip_tupleP t (u : n.-tuple U) : size (zip t u) == n. Proof. by rewrite size1_zip !size_tuple. Qed. Canonical zip_tuple t u := Tuple (zip_tupleP t u). Lemma allpairs_tupleP f t (u : m.-tuple U) : @size rT (allpairs f t u) == n * m. Proof. by rewrite size_allpairs !size_tuple. Qed. Canonical allpairs_tuple f t u := Tuple (allpairs_tupleP f t u). Definition thead (u : n.+1.-tuple T) := tnth u ord0. Lemma tnth0 x t : tnth [tuple of x :: t] ord0 = x. Proof. by []. Qed. Lemma tnthS x t i : tnth [tuple of x :: t] (lift ord0 i) = tnth t i. Proof. by rewrite (tnth_nth (tnth_default t i)). Qed. Lemma theadE x t : thead [tuple of x :: t] = x. Proof. by []. Qed. Lemma tuple0 : all_equal_to ([tuple] : 0.-tuple T). Proof. by move=> t; apply: val_inj; case: t => [[]]. Qed. Variant tuple1_spec : n.+1.-tuple T -> Type := Tuple1spec x t : tuple1_spec [tuple of x :: t]. Lemma tupleP u : tuple1_spec u. Proof. case: u => [[|x s] //= sz_s]; pose t := @Tuple n _ s sz_s. by rewrite (_ : Tuple _ = [tuple of x :: t]) //; apply: val_inj. Qed. Lemma tnth_map f t i : tnth [tuple of map f t] i = f (tnth t i) :> rT. Proof. by apply: nth_map; rewrite size_tuple. Qed. Lemma tnth_nseq x i : tnth [tuple of nseq n x] i = x. Proof. by rewrite !(tnth_nth (tnth_default (nseq_tuple x) i)) nth_nseq ltn_ord. Qed. End SeqTuple. Lemma tnth_behead n T (t : n.+1.-tuple T) i : tnth [tuple of behead t] i = tnth t (inord i.+1). Proof. by case/tupleP: t => x t; rewrite !(tnth_nth x) inordK ?ltnS. Qed. Lemma tuple_eta n T (t : n.+1.-tuple T) : t = [tuple of thead t :: behead t]. Proof. by case/tupleP: t => x t; apply: val_inj. Qed. Section TupleQuantifiers. Variables (n : nat) (T : Type). Implicit Types (a : pred T) (t : n.-tuple T). Lemma forallb_tnth a t : [forall i, a (tnth t i)] = all a t. Proof. apply: negb_inj; rewrite -has_predC -has_map negb_forall. apply/existsP/(has_nthP true) => [[i a_t_i] | [i lt_i_n a_t_i]]. by exists i; rewrite ?size_tuple // -tnth_nth tnth_map. rewrite size_tuple in lt_i_n; exists (Ordinal lt_i_n). by rewrite -tnth_map (tnth_nth true). Qed. Lemma existsb_tnth a t : [exists i, a (tnth t i)] = has a t. Proof. by apply: negb_inj; rewrite negb_exists -all_predC -forallb_tnth. Qed. Lemma all_tnthP a t : reflect (forall i, a (tnth t i)) (all a t). Proof. by rewrite -forallb_tnth; apply: forallP. Qed. Lemma has_tnthP a t : reflect (exists i, a (tnth t i)) (has a t). Proof. by rewrite -existsb_tnth; apply: existsP. Qed. End TupleQuantifiers. Arguments all_tnthP {n T a t}. Arguments has_tnthP {n T a t}. Section EqTuple. Variables (n : nat) (T : eqType). Definition tuple_eqMixin := Eval hnf in [eqMixin of n.-tuple T by <:]. Canonical tuple_eqType := Eval hnf in EqType (n.-tuple T) tuple_eqMixin. Canonical tuple_predType := PredType (pred_of_seq : n.-tuple T -> pred T). Lemma eqEtuple (t1 t2 : n.-tuple T) : (t1 == t2) = [forall i, tnth t1 i == tnth t2 i]. Proof. by apply/eqP/'forall_eqP => [->|/eq_from_tnth]. Qed. Lemma memtE (t : n.-tuple T) : mem t = mem (tval t). Proof. by []. Qed. Lemma mem_tnth i (t : n.-tuple T) : tnth t i \in t. Proof. by rewrite mem_nth ?size_tuple. Qed. Lemma memt_nth x0 (t : n.-tuple T) i : i < n -> nth x0 t i \in t. Proof. by move=> i_lt_n; rewrite mem_nth ?size_tuple. Qed. Lemma tnthP (t : n.-tuple T) x : reflect (exists i, x = tnth t i) (x \in t). Proof. apply: (iffP idP) => [/(nthP x)[i ltin <-] | [i ->]]; last exact: mem_tnth. by rewrite size_tuple in ltin; exists (Ordinal ltin); rewrite (tnth_nth x). Qed. Lemma seq_tnthP (s : seq T) x : x \in s -> {i | x = tnth (in_tuple s) i}. Proof. move=> s_x; pose i := index x s; have lt_i: i < size s by rewrite index_mem. by exists (Ordinal lt_i); rewrite (tnth_nth x) nth_index. Qed. End EqTuple. Definition tuple_choiceMixin n (T : choiceType) := [choiceMixin of n.-tuple T by <:]. Canonical tuple_choiceType n (T : choiceType) := Eval hnf in ChoiceType (n.-tuple T) (tuple_choiceMixin n T). Definition tuple_countMixin n (T : countType) := [countMixin of n.-tuple T by <:]. Canonical tuple_countType n (T : countType) := Eval hnf in CountType (n.-tuple T) (tuple_countMixin n T). Canonical tuple_subCountType n (T : countType) := Eval hnf in [subCountType of n.-tuple T]. Module Type FinTupleSig. Section FinTupleSig. Variables (n : nat) (T : finType). Parameter enum : seq (n.-tuple T). Axiom enumP : Finite.axiom enum. Axiom size_enum : size enum = #|T| ^ n. End FinTupleSig. End FinTupleSig. Module FinTuple : FinTupleSig. Section FinTuple. Variables (n : nat) (T : finType). Definition enum : seq (n.-tuple T) := let extend e := flatten (codom (fun x => map (cons x) e)) in pmap insub (iter n extend [::[::]]). Lemma enumP : Finite.axiom enum. Proof. case=> /= t t_n; rewrite -(count_map _ (pred1 t)) (pmap_filter (insubK _)). rewrite count_filter -(@eq_count _ (pred1 t)) => [|s /=]; last first. by rewrite isSome_insub; case: eqP=> // ->. elim: n t t_n => [|m IHm] [|x t] //= {}/IHm; move: (iter m _ _) => em IHm. transitivity (x \in T : nat); rewrite // -mem_enum codomE. elim: (fintype.enum T) (enum_uniq T) => //= y e IHe /andP[/negPf ney]. rewrite count_cat count_map inE /preim /= [in LHS]/eq_op /= eq_sym => /IHe->. by case: eqP => [->|_]; rewrite ?(ney, count_pred0, IHm). Qed. Lemma size_enum : size enum = #|T| ^ n. Proof. rewrite /= cardE size_pmap_sub; elim: n => //= m IHm. rewrite expnS /codom /image_mem; elim: {2 3}(fintype.enum T) => //= x e IHe. by rewrite count_cat {}IHe count_map IHm. Qed. End FinTuple. End FinTuple. Section UseFinTuple. Variables (n : nat) (T : finType). (* tuple_finMixin could, in principle, be made Canonical to allow for folding *) (* Finite.enum of a finite tuple type (see comments around eqE in eqtype.v), *) (* but in practice it will not work because the mixin_enum projector *) (* has been buried under an opaque alias, to avoid some performance issues *) (* during type inference. *) Definition tuple_finMixin := Eval hnf in FinMixin (@FinTuple.enumP n T). Canonical tuple_finType := Eval hnf in FinType (n.-tuple T) tuple_finMixin. Canonical tuple_subFinType := Eval hnf in [subFinType of n.-tuple T]. Lemma card_tuple : #|{:n.-tuple T}| = #|T| ^ n. Proof. by rewrite [#|_|]cardT enumT unlock FinTuple.size_enum. Qed. Lemma enum_tupleP (A : {pred T}) : size (enum A) == #|A|. Proof. by rewrite -cardE. Qed. Canonical enum_tuple A := Tuple (enum_tupleP A). Definition ord_tuple : n.-tuple 'I_n := Tuple (introT eqP (size_enum_ord n)). Lemma val_ord_tuple : val ord_tuple = enum 'I_n. Proof. by []. Qed. Lemma tuple_map_ord U (t : n.-tuple U) : t = [tuple of map (tnth t) ord_tuple]. Proof. by apply: val_inj => /=; rewrite map_tnth_enum. Qed. Lemma tnth_ord_tuple i : tnth ord_tuple i = i. Proof. apply: val_inj; rewrite (tnth_nth i) -(nth_map _ 0) ?size_tuple //. by rewrite /= enumT unlock val_ord_enum nth_iota. Qed. Section ImageTuple. Variables (T' : Type) (f : T -> T') (A : {pred T}). Canonical image_tuple : #|A|.-tuple T' := [tuple of image f A]. Canonical codom_tuple : #|T|.-tuple T' := [tuple of codom f]. End ImageTuple. Section MkTuple. Variables (T' : Type) (f : 'I_n -> T'). Definition mktuple := map_tuple f ord_tuple. Lemma tnth_mktuple i : tnth mktuple i = f i. Proof. by rewrite tnth_map tnth_ord_tuple. Qed. Lemma nth_mktuple x0 (i : 'I_n) : nth x0 mktuple i = f i. Proof. by rewrite -tnth_nth tnth_mktuple. Qed. End MkTuple. Lemma eq_mktuple T' (f1 f2 : 'I_n -> T') : f1 =1 f2 -> mktuple f1 = mktuple f2. Proof. by move=> eq_f; apply eq_from_tnth=> i; rewrite !tnth_map eq_f. Qed. End UseFinTuple. Notation "[ 'tuple' F | i < n ]" := (mktuple (fun i : 'I_n => F)) (at level 0, i at level 0, format "[ '[hv' 'tuple' F '/' | i < n ] ']'") : form_scope. Arguments eq_mktuple {n T'} [f1] f2 eq_f12. math-comp-mathcomp-1.12.0/mathcomp/test_suite/000077500000000000000000000000001375767750300213125ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/test_suite/imset2_finset.v000066400000000000000000000002231375767750300242510ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Check @imset2_pair. math-comp-mathcomp-1.12.0/mathcomp/test_suite/imset2_finset.v.out000066400000000000000000000001751375767750300250650ustar00rootroot00000000000000imset2_pair : forall (aT aT2 : finType) (A : {set aT}) (B : {set aT2}), [set (x, y) | x in A, y in B] = setX A B math-comp-mathcomp-1.12.0/mathcomp/test_suite/imset2_gproduct.v000066400000000000000000000003121375767750300246070ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect all_fingroup. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GroupScope. Open Scope group_scope. Check @ker_sdprodm. math-comp-mathcomp-1.12.0/mathcomp/test_suite/imset2_gproduct.v.out000066400000000000000000000004531375767750300254230ustar00rootroot00000000000000ker_sdprodm : forall (gT rT : finGroupType) (H K G : {group gT}) (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}) (eqHK_G : H ><| K = G) (actf : {in H & K, morph_act 'J 'J fH fK}), 'ker (sdprodm eqHK_G actf) = [set a * b^-1 | a in H, b in K & fH a == fK b] math-comp-mathcomp-1.12.0/mathcomp/test_suite/output.v000066400000000000000000000002621375767750300230410ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect all_algebra all_field all_character all_fingroup all_solvable. Open Scope group_scope. Check @cyclic_pgroup_Aut_structure.math-comp-mathcomp-1.12.0/mathcomp/test_suite/output.v.out000066400000000000000000000037661375767750300236630ustar00rootroot00000000000000cyclic_pgroup_Aut_structure : forall (gT : finGroupType) (p : nat) (G : {group gT}), p.-group G -> cyclic G -> G != 1 -> let q := #|G| in let n := (logn p q).-1 in let A := Aut G in let P := 'O_p(A) in let F := 'O_p^'(A) in exists m : {perm gT} -> 'Z_q, [/\ [/\ {in A & G, forall (a : {perm gT}) (x : gT), x ^+ m a = a x}, m 1 = 1%R /\ {in A &, {morph m : a b / a * b >-> (a * b)%R}}, {in A &, injective m} /\ [seq m x | x in A] =i GRing.unit, forall k : nat, {in A, {morph m : a / a ^+ k >-> (a ^+ k)%R}} & {in A, {morph m : a / a^-1 >-> (a^-1)%R}}], [/\ abelian A, cyclic F, #|F| = p.-1 & [faithful F, on 'Ohm_1(G) | [Aut G]]] & if n == 0 then A = F else exists t : perm_for_finType gT, [/\ t \in A, #[t] = 2, m t = (-1)%R & if odd p then [/\ cyclic A /\ cyclic P, exists s : perm_for_finType gT, [/\ s \in A, #[s] = (p ^ n)%N, m s = (p.+1%:R)%R & P = <[s]>] & exists s0 : perm_for_finType gT, [/\ s0 \in A, #[s0] = p, m s0 = ((p ^ n).+1%:R)%R & 'Ohm_1(P) = <[s0]>]] else if n == 1 then A = <[t]> else exists s : perm_for_finType gT, [/\ s \in A, #[s] = (2 ^ n.-1)%N, m s = (5%:R)%R, <[s]> \x <[t]> = A & exists s0 : perm_for_finType gT, [/\ s0 \in A, #[s0] = 2, m s0 = ((2 ^ n).+1%:R)%R, m (s0 * t) = ((2 ^ n).-1%:R)%R & 'Ohm_1(<[s]>) = <[s0]>]]]] math-comp-mathcomp-1.12.0/mathcomp/test_suite/output.v.out.8.7000077700000000000000000000000001375767750300270272output.v.out.8.9ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/test_suite/output.v.out.8.8000077700000000000000000000000001375767750300270302output.v.out.8.9ustar00rootroot00000000000000math-comp-mathcomp-1.12.0/mathcomp/test_suite/output.v.out.8.9000066400000000000000000000040101375767750300241570ustar00rootroot00000000000000cyclic_pgroup_Aut_structure : forall (gT : finGroupType) (p : nat) (G : {group gT}), p.-group G -> cyclic G -> G != 1 -> let q := #|G| in let n := (logn p q).-1 in let A := Aut G in let P := 'O_p(A) in let F := 'O_p^'(A) in exists m : {perm gT} -> 'Z_q, [/\ [/\ {in A & G, forall (a : {perm gT}) (x : gT), x ^+ m a = a x}, m 1 = 1%R /\ {in A &, {morph m : a b / a * b >-> (a * b)%R}}, {in A &, injective m} /\ [seq m x | x in A] =i GRing.unit, forall k : nat, {in A, {morph m : a / a ^+ k >-> (a ^+ k)%R}} & {in A, {morph m : a / a^-1 >-> (a^-1)%R}}], [/\ abelian A, cyclic F, #|F| = p.-1 & [faithful F, on 'Ohm_1(G) | [Aut G]]] & if n == 0 then A = F else exists t : perm_for_finType gT, [/\ t \in A, #[t] = 2, m t = (-1)%R & if odd p then [/\ cyclic A /\ cyclic P, exists s : perm_for_finType gT, [/\ s \in A, #[s] = (p ^ n)%N, m s = (p.+1%:R)%R & P = <[s]>] & exists s0 : perm_for_finType gT, [/\ s0 \in A, #[s0] = p, m s0 = ((p ^ n).+1%:R)%R & 'Ohm_1(P) = <[s0]>]] else if n == 1 then A = <[t]> else exists s : perm_for_finType gT, [/\ s \in A, #[s] = (2 ^ n.-1)%N, m s = (5%:R)%R, <[s]> \x <[t]> = A & exists s0 : perm_for_finType gT, [/\ s0 \in A, #[s0] = 2, m s0 = ((2 ^ n).+1%:R)%R, m (s0 * t) = ((2 ^ n).-1%:R)%R & 'Ohm_1(<[s]>) = <[s0]>]]]] math-comp-mathcomp-1.12.0/mathcomp/test_suite/test_guard.v000066400000000000000000000022141375767750300236410ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Inductive tree := Node { children : seq tree }. Inductive ptree (T : Type) := singleton of T | branch of list (ptree T). (* has *) Fixpoint tree_has (T : Type) (p : pred T) (t : ptree T) : bool := match t with | singleton x => p x | branch ts => has (tree_has p) ts end. (* all *) Fixpoint tree_all (T : Type) (p : pred T) (t : ptree T) : bool := match t with | singleton x => p x | branch ts => all (tree_all p) ts end. (* map *) Fixpoint traverse_id (t : tree) : tree := Node (map traverse_id (children t)). (* foldr *) Fixpoint tree_foldr (T R : Type) (f : T -> R -> R) (z : R) (t : ptree T) : R := match t with | singleton x => f x z | branch ts => foldr (fun t z' => tree_foldr f z' t) z ts end. (* foldl *) Fixpoint tree_foldl (T R : Type) (f : R -> T -> R) (z : R) (t : ptree T) : R := match t with | singleton x => f z x | branch ts => foldl (tree_foldl f) z ts end. (* all2 *) Fixpoint eq_tree (x y : tree) {struct x} : bool := all2 eq_tree (children x) (children y). math-comp-mathcomp-1.12.0/mathcomp/test_suite/test_intro_rw.v000066400000000000000000000022321375767750300244020ustar00rootroot00000000000000From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Lemma test_dup1 : forall n : nat, odd n. Proof. move=> /[dup] m n; suff: odd n by []. Abort. Lemma test_dup2 : let n := 1 in False. Proof. move=> /[dup] m n; have : m = n := erefl. Abort. Lemma test_swap1 : forall (n : nat) (b : bool), odd n = b. Proof. move=> /[swap] b n; suff: odd n = b by []. Abort. Lemma test_swap1 : let n := 1 in let b := true in False. Proof. move=> /[swap] b n; have : odd n = b := erefl. Abort. Lemma test_apply A B : forall (f : A -> B) (a : A), False. Proof. move=> /[apply] b. Check (b : B). Abort. Lemma test_swap_plus P Q : P -> Q -> False. Proof. move=> + /[dup] q. suff: P -> Q -> False by []. Abort. Lemma test_dup_plus2 P : P -> let x := 0 in False. Proof. move=> + /[dup] y. suff: P -> let x := 0 in False by []. Abort. Lemma test_swap_plus P Q R : P -> Q -> R -> False. Proof. move=> + /[swap]. suff: P -> R -> Q -> False by []. Abort. Lemma test_swap_plus2 P : P -> let x := 0 in let y := 1 in False. Proof. move=> + /[swap]. suff: P -> let y := 1 in let x := 0 in False by []. Abort. math-comp-mathcomp-1.12.0/mathcomp/test_suite/test_regular_conv.v000066400000000000000000000026561375767750300252370ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect all_algebra all_field. Section regular. Import GRing. Let eq_ringType_of_regular_lalgType (R : ringType) := erefl : regular_lalgType R = Ring.Pack (Ring.class R) :> ringType. Let eq_ringType_of_regular_algType (R : comRingType) := erefl : regular_algType R = Ring.Pack (Ring.class R) :> ringType. Let eq_comRingType_of_regular_comAlgType (R : comRingType) := erefl : regular_comAlgType R = ComRing.Pack (ComRing.class R) :> ringType. Let eq_unitRingType_of_regular_unitAlgType (R : comUnitRingType) := erefl : regular_unitAlgType R = UnitRing.Pack (UnitRing.class R) :> unitRingType. (* The following assertion fails if the class records are not primitive *) (* because the [comUnitAlgType _ of _] packager inserts an eta-expansion on *) (* the class. *) Let eq_comUnitRingType_of_regular_comUnitAlgType (R : comUnitRingType) := erefl : regular_comUnitAlgType R = ComUnitRing.Pack (ComUnitRing.class R) :> comUnitRingType. Let eq_unitRingType_of_regular_FalgType (R : comUnitRingType) := erefl : regular_FalgType R = UnitRing.Pack (UnitRing.class R) :> unitRingType. (* The following assertion also fails if the class records are not primitive. *) Let eq_fieldType_of_regular_fieldExtType (K : fieldType) := erefl : regular_fieldExtType K = Field.Pack (Field.class K) :> fieldType. End regular. math-comp-mathcomp-1.12.0/mathcomp/test_suite/test_ssrAC.v000066400000000000000000000150351375767750300235570ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg. Section Tests. Lemma test_orb (a b c d : bool) : (a || b) || (c || d) = (a || c) || (b || d). Proof. time by rewrite orbACA. Restart. Proof. time by rewrite (AC (2*2) ((1*3)*(2*4))). Restart. Proof. time by rewrite orb.[AC (2*2) ((1*3)*(2*4))]. Qed. Lemma test_addn (a b c d : nat) : a + b + c + d = a + c + b + d. Proof. time by rewrite -addnA addnAC addnA addnAC. Restart. Proof. time by rewrite (ACl (1*3*2*4)). Restart. Proof. time by rewrite addn.[ACl 1*3*2*4]. Qed. Lemma test_addr (R : comRingType) (a b c d : R) : (a + b + c + d = a + c + b + d)%R. Proof. time by rewrite -GRing.addrA GRing.addrAC GRing.addrA GRing.addrAC. Restart. Proof. time by rewrite (ACl (1*3*2*4)). Restart. Proof. time by rewrite (@GRing.add R).[ACl 1*3*2*4]. Qed. Local Open Scope ring_scope. Import GRing.Theory. Lemma test_mulr (R : comRingType) (x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 : R) (x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 : R) : (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) = (x0 * x2 * x4 * x9) * (x1 * x3 * x5 * x7) * x6 * x8 * (x10 * x12 * x14 * x19) * (x11 * x13 * x15 * x17) * x16 * x18 * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9)* (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) *(x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) * (x10 * x11) * (x12 * x13) * (x14 * x15) * (x16 * x17 * x18 * x19) * (x0 * x1) * (x2 * x3) * (x4 * x5) * (x6 * x7 * x8 * x9) . Proof. pose s := ((2 * 4 * 9 * 1 * 3 * 5 * 7 * 6 * 8 * 20 * 21 * 22 * 23) * 25 * 26 * 27 * 28 * (29 * 30 * 31) * 32 * 33 * 34 * 35 * 36 * 37 * 38 * 39 * 40 * 41 * (10 * 12 * 14 * 19 * 11 * 13 * 15 * 17 * 16 * 18 * 24) * (42 * 43 * 44 * 45 * 46 * 47 * 48 * 49) * 50 * 52 * 53 * 54 * 55 * 56 * 57 * 58 * 59 * 51* 60 * 62 * 63 * 64 * 65 * 66 * 67 * 68 * 69 * 61* 70 * 72 * 73 * 74 * 75 * 76 * 77 * 78 * 79 * 71 * 80 * 82 * 83 * 84 * 85 * 86 * 87 * 88 * 89 * 81* 90 * 92 * 93 * 94 * 95 * 96 * 97 * 98 * 99 * 91 * 100 * ((102 * 104 * 109 * 101 * 103 * 105 * 107 * 106 * 108 * 120 * 121 * 122 * 123) * 125 * 126 * 127 * 128 * (129 * 130 * 131) * 132 * 133 * 134 * 135 * 136 * 137 * 138 * 139 * 140 * 141 * (110 * 112 * 114 * 119 * 111 * 113 * 115 * 117 * 116 * 118 * 124) * (142 * 143 * 144 * 145 * 146 * 147 * 148 * 149) * 150 * 152 * 153 * 154 * 155 * 156 * 157 * 158 * 159 * 151* 160 * 162 * 163 * 164 * 165 * 166 * 167 * 168 * 169 * 161* 170 * 172 * 173 * 174 * 175 * 176 * 177 * 178 * 179 * 171 * 180 * 182 * 183 * 184 * 185 * 186 * 187 * 188 * 189 * 181* 190 * 192 * 193 * 194 * 195 * 196 * 197 * 198 * 199 * 191) )%AC. time have := (@GRing.mul R).[ACl s]. time rewrite (@GRing.mul R).[ACl s]. Abort. End Tests.math-comp-mathcomp-1.12.0/package.nix000066400000000000000000000000221375767750300174170ustar00rootroot00000000000000"mathcomp.single"