pax_global_header00006660000000000000000000000064147243276100014520gustar00rootroot0000000000000052 comment=84f104d6fd8b36cc2fedadc4c308d549c2b14da2 multinomials-2.3.0/000077500000000000000000000000001472432761000142375ustar00rootroot00000000000000multinomials-2.3.0/.github/000077500000000000000000000000001472432761000155775ustar00rootroot00000000000000multinomials-2.3.0/.github/workflows/000077500000000000000000000000001472432761000176345ustar00rootroot00000000000000multinomials-2.3.0/.github/workflows/ci.yml000066400000000000000000000075321472432761000207610ustar00rootroot00000000000000name: Docker CI on: [push, pull_request] jobs: build: runs-on: ubuntu-20.04 strategy: matrix: image: - mathcomp/mathcomp:2.0.0-coq-8.16 - mathcomp/mathcomp:2.0.0-coq-8.17 - mathcomp/mathcomp:2.0.0-coq-8.18 - mathcomp/mathcomp:2.1.0-coq-8.16 - mathcomp/mathcomp:2.1.0-coq-8.17 - mathcomp/mathcomp:2.1.0-coq-8.18 - mathcomp/mathcomp:2.2.0-coq-8.16 - mathcomp/mathcomp:2.2.0-coq-8.17 - mathcomp/mathcomp:2.2.0-coq-8.18 - mathcomp/mathcomp:2.2.0-coq-8.19 - mathcomp/mathcomp:2.2.0-coq-8.20 - mathcomp/mathcomp:2.2.0-coq-dev - mathcomp/mathcomp:2.3.0-coq-8.18 - mathcomp/mathcomp:2.3.0-coq-8.19 - mathcomp/mathcomp:2.3.0-coq-8.20 - mathcomp/mathcomp:2.3.0-coq-dev - mathcomp/mathcomp-dev:coq-8.18 - mathcomp/mathcomp-dev:coq-8.19 - mathcomp/mathcomp-dev:coq-8.20 - mathcomp/mathcomp-dev:coq-dev fail-fast: false steps: - uses: actions/checkout@v2 - uses: coq-community/docker-coq-action@v1 env: LIBRARY_NAME: 'mathcomp.multinomials' ROOT_THEORIES: 'mpoly monalg' with: opam_file: 'coq-mathcomp-multinomials.opam' custom_image: ${{ matrix.image }} export: 'LIBRARY_NAME ROOT_THEORIES' # Note: these native-compiler tests are generic, # thanks to env variables & the configure script after_script: | startGroup "Print native_compiler status" coqc -config coq_version() { coqc --version | grep version | \ sed -e 's/^.*version \([-0-9a-z.+~]\+\)\( .*\)\?$/\1/' } le_version() { [ "$(printf '%s\n' "$1" "$2" | sort -V -u | tail -n1)" = "$2" ] } coq_native_compiler_default() { coqc -config | grep -q 'COQ_NATIVE_COMPILER_DEFAULT=yes' } coqv=$(coq_version) coq_native_compiler_default && echo native-compiler coq_native=$(opam var coq-native:installed) endGroup if [ "$coq_native" = "true" ] && le_version "8.13.0" "$coqv"; then startGroup "Workaround permission issue" sudo chown -R coq:coq . # <--(§) endGroup startGroup "Check native_compiler on a test file" printf '%s\n' "From $LIBRARY_NAME Require Import $ROOT_THEORIES." > test.v if le_version "8.14" "$coqv"; then debug=(-d native-compiler) else debug=(-debug) fi coqc "${debug[@]}" -native-compiler yes test.v > stdout.txt || ret=$? cat stdout.txt ( exit "${ret:-0}" ) endGroup # in practice, we get ret=0 even if deps were not native-compiled # but the logs are useful...(*), so we keep this first test group # and add another test group which is less verbose, but stricter. startGroup "Check installation of .coq-native/ files" set -o pipefail # fail noisily if ever 'find' gives 'No such file or directory' num=$(find "$(coqc -where)/user-contrib/${LIBRARY_NAME//\.//}" -type d -name ".coq-native" | wc -l) [ "$num" -gt 0 ] endGroup fi - name: Revert permissions # to avoid a warning at cleanup time if: ${{ always() }} run: sudo chown -R 1001:116 . # <--(§) #(§)=> https://github.com/coq-community/docker-coq-action#permissions #(*)=> Cannot find native compiler file /home/coq/.opam/4.07.1/lib/coq/user-contrib/mathcomp.multinomials/.coq-native/Nmathcomp.multinomials_ssrcomplements.cmxs multinomials-2.3.0/.gitignore000066400000000000000000000000241472432761000162230ustar00rootroot00000000000000/attic/ /_build/ *~ multinomials-2.3.0/LICENSE000066400000000000000000000516231472432761000152530ustar00rootroot00000000000000CeCILL-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. multinomials-2.3.0/Makefile000066400000000000000000000016571472432761000157100ustar00rootroot00000000000000# KNOWNTARGETS will not be passed along to CoqMakefile KNOWNTARGETS := Makefile.coq # KNOWNFILES will not get implicit targets from the final rule, and so # depending on them won't invoke the submake # Warning: These files get declared as PHONY, so any targets depending # on them always get rebuilt KNOWNFILES := Makefile _CoqProject .DEFAULT_GOAL := invoke-coqmakefile Makefile.coq: Makefile _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq invoke-coqmakefile: Makefile.coq $(MAKE) --no-print-directory -f Makefile.coq $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) .PHONY: invoke-coqmakefile $(KNOWNFILES) #################################################################### ## Your targets here ## #################################################################### # This should be the last rule, to handle any targets not declared above %: invoke-coqmakefile @true multinomials-2.3.0/README.md000066400000000000000000000025471472432761000155260ustar00rootroot00000000000000A Multivariate polynomial Library for the Mathematical Components Library ======================================================================== This library provides a library for monomial algebra,for multivariate polynomials over ring structures and an extended theory for polynomials whose coefficients range over commutative rings and integral domains. Building and installation instructions ------------------------------------------------------------------------ The easiest way to install the latest released version this library is via [OPAM](https://opam.ocaml.org/doc/Install.html): ```shell opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-mathcomp-multinomials ``` If you want to install it manually, do: ``` shell git clone https://github.com/math-comp/multinomials.git cd multinomials make # or make -j make install ``` Authors ======================================================================== "Pierre-Yves Strub" \ Contributors: - [Florent Hivert](https://www.lri.fr/~hivert/) - [Laurent Thery](https://www-sop.inria.fr/marelle/personnel/Laurent.Thery/moi.html) This library is also the result of discussions with: - Sophie Bernard - [Cyril Cohen](http://www.cyrilcohen.fr/) - [Laurence Rideau](http://www-sop.inria.fr/members/Laurence.Rideau/) multinomials-2.3.0/_CoqProject000066400000000000000000000003751472432761000163770ustar00rootroot00000000000000src/freeg.v src/monalg.v src/mpoly.v src/ssrcomplements.v src/xfinmap.v -R src mathcomp.multinomials -arg -w -arg -ambiguous-paths -arg -w -arg -notation-overridden -arg -w -arg -redundant-canonical-projection -arg -w -arg -projection-no-head-constant multinomials-2.3.0/coq-mathcomp-multinomials.opam000066400000000000000000000016031472432761000222200ustar00rootroot00000000000000opam-version: "2.0" maintainer: "pierre-yves@strub.nu" homepage: "https://github.com/math-comp/multinomials" bug-reports: "https://github.com/math-comp/multinomials/issues" dev-repo: "git+https://github.com/math-comp/multinomials.git" license: "CECILL-B" authors: ["Pierre-Yves Strub"] build: [make "-j%{jobs}%"] install: [make "install"] depends: [ "coq" {(>= "8.16" & < "8.21~") | = "dev"} "coq-mathcomp-ssreflect" {(>= "2.0" & < "2.4~") | = "dev"} "coq-mathcomp-algebra" "coq-mathcomp-bigenough" {(>= "1.0" & < "1.1~") | = "dev"} "coq-mathcomp-finmap" {(>= "2.0" & < "2.2~") | = "dev"} ] tags: [ "keyword:multinomials" "keyword:monoid algebra" "category:Mathematics/Algebra/Multinomials" "category:Mathematics/Algebra/Monoid algebra" "logpath:mathcomp.multinomials" ] synopsis: "A Multivariate polynomial Library for the Mathematical Components Library" multinomials-2.3.0/src/000077500000000000000000000000001472432761000150265ustar00rootroot00000000000000multinomials-2.3.0/src/freeg.v000066400000000000000000001271561472432761000163210ustar00rootroot00000000000000(* -------------------------------------------------------------------- * (c) Copyright 2011--2012 Microsoft Corporation and Inria. * (c) Copyright 2012--2014 Inria. * (c) Copyright 2012--2015 IMDEA Software Institute. * * You may distribute this file under the terms of the CeCILL-B license * -------------------------------------------------------------------- *) (***********************************************************************) (* {freeg K / G} = the free abelian group generated by a finite set of *) (* elements of keys K and the group G. *) (* *) (* In the following, assume that g is of the form \sum_k a_k * k *) (* *) (* dom g = the support of g (i.e. [seq k | a_k != 0]) *) (* [freeg S] = builds an element of {freeg K / G} *) (* from a sequence seq (G * K) *) (* fglift f g = applies f to the keys (i.e. \sum_k a_k * f k) *) (* coeff k g = the coefficient of k in g (i.e. a_k) *) (* <> = [freeg [:: a, p]] (the element a * k) *) (* <> = [freeg [:: 1, p]] (the element k) *) (* deg g = \sum a_k (provided that a_k : int) *) (***********************************************************************) (* -------------------------------------------------------------------- *) From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. From mathcomp Require Import fintype bigop order generic_quotient. From mathcomp Require Import ssralg ssrnum ssrint. Import Order.Theory GRing.Theory Num.Theory. Local Open Scope ring_scope. Local Open Scope quotient_scope. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (* -------------------------------------------------------------------- *) Local Notation simpm := Monoid.simpm. (* -------------------------------------------------------------------- *) Reserved Notation "{ 'freeg' K / G }" (at level 0, K, G at level 2, format "{ 'freeg' K / G }"). Reserved Notation "{ 'freeg' K }" (at level 0, K at level 2, format "{ 'freeg' K }"). Reserved Notation "[ 'freeg' S ]" (at level 0, S at level 2, format "[ 'freeg' S ]"). Reserved Notation "<< z *p k >>" (at level 0, format "<< z *p k >>"). Reserved Notation "<< k >>" (at level 0, format "<< k >>"). (* -------------------------------------------------------------------- *) Module FreegDefs. Section Defs. Context (G : zmodType) (K : choiceType). Definition reduced (D : seq (G * K)) := uniq [seq zx.2 | zx <- D] && all [pred zx | zx.1 != 0] D. Lemma reduced_uniq D : reduced D -> uniq [seq zx.2 | zx <- D]. Proof. by case/andP. Qed. Record prefreeg : Type := mkPrefreeg { seq_of_prefreeg : seq (G * K); _ : reduced seq_of_prefreeg }. Local Coercion seq_of_prefreeg : prefreeg >-> seq. Lemma prefreeg_reduced (D : prefreeg) : reduced D. Proof. by case: D. Qed. Lemma prefreeg_uniq (D : prefreeg) : uniq [seq zx.2 | zx <- D]. Proof. exact/reduced_uniq/prefreeg_reduced. Qed. #[export] HB.instance Definition _ := [isSub for seq_of_prefreeg]. #[export] HB.instance Definition _ := [Choice of prefreeg by <:]. End Defs. Arguments mkPrefreeg [G K]. Section Quotient. Context (G : zmodType) (K : choiceType). Local Coercion seq_of_prefreeg : prefreeg >-> seq. Definition equiv (D1 D2 : prefreeg G K) := perm_eq D1 D2. Lemma equiv_refl : reflexive equiv. Proof. exact: perm_refl. Qed. Lemma equiv_sym : symmetric equiv. Proof. exact: perm_sym. Qed. Lemma equiv_trans : transitive equiv. Proof. exact: perm_trans. Qed. Canonical prefreeg_equiv := EquivRel equiv equiv_refl equiv_sym equiv_trans. Canonical prefreeg_equiv_direct := defaultEncModRel equiv. Definition type := {eq_quot equiv}. Definition type_of of phant G & phant K := type. Notation "{ 'freeg' K / G }" := (type_of (Phant G) (Phant K)). #[export] HB.instance Definition _ := Quotient.on type. #[export] HB.instance Definition _ := Choice.on type. #[export] HB.instance Definition _ : EqQuotient _ equiv type := EqQuotient.on type. #[export] HB.instance Definition _ := Quotient.on {freeg K / G}. #[export] HB.instance Definition _ := Choice.on {freeg K / G}. #[export] HB.instance Definition _ : EqQuotient _ equiv {freeg K / G} := EqQuotient.on {freeg K / G}. End Quotient. Module Exports. Coercion seq_of_prefreeg : prefreeg >-> seq. Canonical prefreeg_equiv. Canonical prefreeg_equiv_direct. HB.reexport. Notation prefreeg := prefreeg. Notation fgequiv := equiv. Notation mkPrefreeg := mkPrefreeg. Notation reduced := reduced. Notation "{ 'freeg' T / G }" := (type_of (Phant G) (Phant T)). Notation "{ 'freeg' T }" := (type_of (Phant int) (Phant T)). Identity Coercion type_freeg_of : type_of >-> type. End Exports. End FreegDefs. Export FreegDefs.Exports. (* -------------------------------------------------------------------- *) Section FreegTheory. Section MkFreeg. Context (G : zmodType) (K : choiceType). Implicit Types (rD : prefreeg G K) (D : {freeg K / G}) (s : seq (G * K)). Implicit Types (z k : G) (x y : K). Local Notation freeg := {freeg K / G}. Lemma perm_eq_fgrepr rD : perm_eq (repr (\pi_freeg rD)) rD. Proof. by rewrite -/(fgequiv _ _); apply/eqmodP; rewrite reprK. Qed. Lemma reduced_uniq s : reduced s -> uniq [seq zx.2 | zx <- s]. Proof. by case/andP. Qed. Lemma prefreeg_reduced rD : reduced rD. Proof. by case: rD. Qed. Lemma prefreeg_uniq rD : uniq [seq zx.2 | zx <- rD]. Proof. exact/reduced_uniq/prefreeg_reduced. Qed. Fixpoint augment s z x := if s is ((z', x') as d) :: s then if x == x' then (z + z', x) :: s else d :: augment s z x else [:: (z, x)]. Definition reduce s := filter [pred zx | zx.1 != 0] (foldr (fun zx s => augment s zx.1 zx.2) [::] s). Definition predom s: seq K := [seq v.2 | v <- s]. Definition dom D := [seq zx.2 | zx <- repr D]. Lemma uniq_dom D : uniq (dom D). Proof. by rewrite /dom; case: repr => /= {}D /andP[]. Qed. Lemma reduced_cons zx s : reduced (zx :: s) = [&& zx.1 != 0, zx.2 \notin predom s & reduced s]. Proof. by rewrite /reduced /= andbACA [RHS]andbCA [RHS]andbA. Qed. Lemma mem_augment s z x y : x != y -> y \notin (predom s) -> y \notin predom (augment s z x). Proof. move=> neq_xy; elim: s => [_|[z' x'] s IHs] /=. by rewrite mem_seq1 eq_sym. rewrite in_cons => /norP[neq_yx' Hys]. have [->|neq_xx'] /= := eqVneq x x'. by rewrite in_cons negb_or neq_yx'. by rewrite in_cons negb_or neq_yx' IHs. Qed. Lemma uniq_predom_augment s z x : uniq (predom s) -> uniq (predom (augment s z x)). Proof. elim: s => [|[z' x'] s IHs] //=. by case: eqVneq => [->|neq_xx'] //= /andP [/mem_augment ->]. Qed. Lemma uniq_predom_reduce s : uniq (predom (reduce s)). Proof. rewrite /reduce; set s' := (foldr _ _ _). apply: (subseq_uniq (s2 := predom s')). exact/map_subseq/filter_subseq. by rewrite {}/s'; elim: s=> [|[z x] s IHs] //=; exact: uniq_predom_augment. Qed. Lemma reduced_reduce s : reduced (reduce s). Proof. rewrite /reduced uniq_predom_reduce /=. by apply/allP=> zx; rewrite mem_filter=> /andP []. Qed. Lemma outdom_augmentE s k x : x \notin predom s -> augment s k x = rcons s (k, x). Proof. elim: s=> [//|[k' x'] s IHs] /=; rewrite in_cons. by case/norP=> /negbTE -> /IHs ->. Qed. Lemma reduce_reduced s : reduced s -> reduce s = rev s. Proof. move=> rs; rewrite /reduce; set S := foldr _ _ _. have ->: S = rev s; rewrite {}/S. elim: s rs => [//|[k x] s IHs]; rewrite reduced_cons /=. case/and3P=> nz_k x_notin_s rs; rewrite IHs //. rewrite rev_cons outdom_augmentE //; move: x_notin_s. by rewrite /predom map_rev mem_rev. rewrite (eq_in_filter (a2 := predT)) ?filter_predT //. by move=> kx; rewrite mem_rev /=; case/andP: rs => _ /allP /(_ kx). Qed. Lemma reduceK s : reduced s -> perm_eq (reduce s) s. Proof. by move/reduce_reduced=> ->; rewrite perm_rev. Qed. Definition Prefreeg s := mkPrefreeg (reduce s) (reduced_reduce s). Lemma PrefreegK rD : Prefreeg rD = rD %[mod_eq (@fgequiv G K)]. Proof. exact/eqmodP/reduceK/prefreeg_reduced. Qed. Definition Freeg := lift_embed {freeg K / G} Prefreeg. Canonical to_freeg_pi_morph := PiEmbed Freeg. End MkFreeg. Local Notation "[ 'freeg' S ]" := (Freeg S). Local Notation "<< z *g p >>" := [freeg [:: (z, p)]]. Local Notation "<< p >>" := [freeg [:: (1, p)]]. (* ------------------------------------------------------------------ *) Section ZLift. Context (R : ringType) (M : lmodType R) (K : choiceType) (f : K -> M). Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)). Implicit Types (z k : R) (x y : K). Definition prelift s : M := \sum_(x <- s) x.1 *: f x.2. Definition prefreeg_opp s := [seq (-xz.1, xz.2) | xz <- s]. Lemma prelift_nil : prelift [::] = 0. Proof. exact: big_nil. Qed. Lemma prelift_cons s k x : prelift ((k, x) :: s) = k *: f x + prelift s. Proof. exact: big_cons. Qed. Lemma prelift_cat s1 s2 : prelift (s1 ++ s2) = prelift s1 + prelift s2. Proof. exact: big_cat. Qed. Lemma prelift_opp s : prelift (prefreeg_opp s) = - prelift s. Proof. by rewrite [LHS]big_map -sumrN; apply: eq_bigr => i _; rewrite scaleNr. Qed. Lemma prelift_seq1 k x : prelift [:: (k, x)] = k *: f x. Proof. exact: big_seq1. Qed. Lemma prelift_perm_eq s1 s2 : perm_eq s1 s2 -> prelift s1 = prelift s2. Proof. exact: perm_big. Qed. Lemma prelift_augment s k x : prelift (augment s k x) = k *: f x + prelift s. Proof. elim: s => [|[k' x'] s IHs] //=. by rewrite prelift_seq1 prelift_nil addr0. have [->|ne_xx'] := eqVneq x x'. by rewrite !prelift_cons scalerDl addrA. by rewrite !prelift_cons IHs addrCA. Qed. Lemma prelift_reduce s : prelift (reduce s) = prelift s. Proof. rewrite /reduce; set S := foldr _ _ _; set rD := filter _ _. have ->: prelift rD = prelift S; rewrite {}/rD. elim: S => [//|[k x] S IHS] /=; have [->|nz_k] := eqVneq k 0. by rewrite /= prelift_cons scale0r add0r. by rewrite !prelift_cons IHS. rewrite {}/S; elim: s => [//|[k x] s IHs]. by rewrite prelift_cons /= prelift_augment IHs. Qed. Lemma prelift_repr rD : prelift (repr (\pi_{freeg K / R} rD)) = prelift rD. Proof. by rewrite (prelift_perm_eq (perm_eq_fgrepr _)). Qed. Definition lift (rD : prefreeg _ _) := prelift rD. Definition fglift := lift_fun1 {freeg K / R} lift. Lemma pi_fglift : {mono \pi_{freeg K / R} : D / lift D >-> fglift D}. Proof. by case=> [s reds]; unlock fglift; exact/prelift_perm_eq/perm_eq_fgrepr. Qed. Canonical pi_fglift_morph := PiMono1 pi_fglift. Lemma fglift_Freeg s : fglift [freeg s] = prelift s. Proof. unlock Freeg; unlock fglift; rewrite ?piE /lift. rewrite (prelift_perm_eq (perm_eq_fgrepr _)) /=. exact: prelift_reduce. Qed. Lemma liftU k x : fglift << k *g x >> = k *: f x. Proof. by rewrite fglift_Freeg prelift_seq1. Qed. End ZLift. (* -------------------------------------------------------------------- *) Context (R : ringType) (K : choiceType). Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)). Implicit Types (z k : R) (x y : K). Definition coeff x D : R := fglift (fun y => (y == x)%:R : R^o) D. Lemma coeffU k x y : coeff y << k *g x >> = k * (x == y)%:R. Proof. by rewrite /coeff liftU. Qed. Definition precoeff x s : R := \sum_(kx <- s | kx.2 == x) kx.1. Lemma precoeffE x : precoeff x =1 prelift (fun y => (y == x)%:R : R^o). Proof. move=> s; rewrite [RHS](bigID [pred kx | kx.2 == x]) /= addrC big1. by rewrite add0r; apply: eq_bigr => i /eqP ->; rewrite eqxx [_ *: _]mulr1. by move=> i /negbTE ->; rewrite scaler0. Qed. Lemma precoeff_nil x : precoeff x [::] = 0. Proof. exact: big_nil. Qed. Lemma precoeff_cons x s y k : precoeff x ((k, y) :: s) = (y == x)%:R * k + precoeff x s. Proof. by rewrite [LHS]big_cons /=; case: eqP; rewrite !simpm. Qed. Lemma precoeff_cat x s1 s2 : precoeff x (s1 ++ s2) = precoeff x s1 + precoeff x s2. Proof. by rewrite !precoeffE prelift_cat. Qed. Lemma precoeff_opp x s : precoeff x (prefreeg_opp s) = - precoeff x s. Proof. by rewrite !precoeffE prelift_opp. Qed. Lemma precoeff_perm_eq x s1 s2 : perm_eq s1 s2 -> precoeff x s1 = precoeff x s2. Proof. by rewrite !precoeffE => /prelift_perm_eq ->. Qed. Lemma precoeff_repr x rD : precoeff x (repr (\pi_{freeg K / R} rD)) = precoeff x rD. Proof. by rewrite !precoeffE prelift_repr. Qed. Lemma precoeff_reduce x s : precoeff x (reduce s) = precoeff x s. Proof. by rewrite !precoeffE prelift_reduce. Qed. Lemma precoeff_outdom x s : x \notin predom s -> precoeff x s = 0. Proof. move=> x_notin_s; rewrite /precoeff big_seq_cond big_pred0 //; case => k z. by apply/contraNF: x_notin_s => /andP[+ /eqP<-]; apply: map_f. Qed. Lemma reduced_mem s k x : reduced s -> ((k, x) \in s) = (precoeff x s == k) && (k != 0). Proof. elim: s => [|[k' x'] s IHs] /=. by rewrite in_nil precoeff_nil eq_sym andbN. rewrite reduced_cons in_cons precoeff_cons. case/and3P=> [/= nz_k' x'Ns /IHs ->]; rewrite eqE /=. case: (eqVneq x' x) x'Ns => [-> xNs|nz_x's]. rewrite andbT mul1r precoeff_outdom // addr0. by have [->|_] //= := eqVneq k k'; case: eqVneq. by rewrite andbF mul0r add0r. Qed. Lemma coeff_Freeg x s : coeff x [freeg s] = precoeff x s. Proof. by rewrite /coeff fglift_Freeg precoeffE. Qed. Lemma freegequivP s1 s2 (hs1 : reduced s1) (hs2 : reduced s2) : reflect (precoeff^~ s1 =1 precoeff^~ s2) (fgequiv (mkPrefreeg s1 hs1) (mkPrefreeg s2 hs2)). Proof. apply: (iffP idP); rewrite /fgequiv /=. by move=> H k; apply: precoeff_perm_eq. move=> H; apply: uniq_perm. - by move/reduced_uniq/map_uniq: hs1. - by move/reduced_uniq/map_uniq: hs2. by move=> [z k]; rewrite !reduced_mem // H. Qed. Lemma fgequivP rD1 rD2 : reflect (precoeff^~ rD1 =1 precoeff^~ rD2) (fgequiv rD1 rD2). Proof. by case: rD1 rD2 => [s1 HD1] [s2 HD2]; apply/freegequivP. Qed. Lemma freeg_eqP D1 D2 : reflect (coeff^~ D1 =1 coeff^~ D2) (D1 == D2). Proof. apply: (iffP idP) => [/eqP -> //|]. elim/quotW: D1 => D1; elim/quotW: D2 => D2. move=> eqc; rewrite eqmodE; apply/fgequivP=> k. by move: (eqc k); rewrite /coeff !piE !precoeffE. Qed. Lemma perm_eq_Freeg s1 s2 : perm_eq s1 s2 -> [freeg s1] = [freeg s2]. Proof. move=> peq; apply/eqP/freeg_eqP=> k. by rewrite !coeff_Freeg; apply: precoeff_perm_eq. Qed. Lemma freeg_repr D : [freeg (repr D)] = D. Proof. apply/eqP/freeg_eqP=> k. by rewrite coeff_Freeg precoeffE /coeff; unlock fglift. Qed. Lemma Freeg_dom D : [freeg [seq (coeff x D, x) | x <- dom D]] = D. Proof. apply/esym/eqP/freeg_eqP=> k. rewrite -{1 2}[D]freeg_repr !coeff_Freeg /dom. case: (repr D)=> {}D rD /=; rewrite -map_comp map_id_in //. move=> [z x]; rewrite reduced_mem // => /andP [/eqP <- _]. by rewrite /= coeff_Freeg. Qed. (* -------------------------------------------------------------------- *) Lemma precoeff_uniqE s x : uniq (predom s) -> precoeff x s = [seq v.1 | v <- s]`_(index x (predom s)). Proof. elim: s => [|[z y s ih]]; first by rewrite precoeff_nil nth_nil. rewrite precoeff_cons /= => /andP [x_notin_s /ih ->]. have [->|ne_yx] := eqVneq x y; last by rewrite mul0r add0r. by rewrite mul1r /= nth_default ?addr0 // memNindex //= !size_map. Qed. Lemma precoeff_mem_uniqE s kz : uniq (predom s) -> kz \in s -> precoeff kz.2 s = kz.1. Proof. move=> uniq_dom_s kz_in_s; have uniq_s := map_uniq uniq_dom_s. rewrite precoeff_uniqE // (nth_map kz); last first. by rewrite -(size_map (@snd _ _)) index_mem map_f. rewrite nth_index_map // => {kz kz_in_s} kz1 kz2 kz1_in_s kz2_in_s eq. apply/eqP. rewrite -[kz1](nth_index kz1 (s := s)) // -[kz2](nth_index kz1 (s := s)) //. rewrite nth_uniq ?index_mem // -(nth_uniq kz1.2 (s := predom s)) //; try by rewrite size_map index_mem. by rewrite !(nth_map kz1) ?index_mem // !nth_index // eq eqxx. Qed. Lemma mem_dom D x : (x \in dom D) = (coeff x D != 0). Proof. elim/quotW: D; case=> D rD. rewrite /dom (perm_mem (perm_map _ (perm_eq_fgrepr _))) /=. unlock coeff; rewrite !piE /lift /= -precoeffE. case/andP: rD => uniqD /allP /= rD; rewrite precoeff_uniqE //. apply/idP/idP; last apply: contra_neqT; move=> x_in_D; last first. by rewrite nth_default // memNindex // !size_map. rewrite (nth_map (0, x)); last first. by rewrite -(size_map (@snd _ _)) index_mem x_in_D. by apply/rD/mem_nth; rewrite -(size_map (@snd _ _)) index_mem. Qed. Lemma coeff_outdom D x : x \notin dom D -> coeff x D = 0. Proof. by rewrite mem_dom negbK => /eqP. Qed. End FreegTheory. Notation "[ 'freeg' S ]" := (Freeg S). Notation "<< z *g p >>" := [freeg [:: (z, p)]]. Notation "<< p >>" := [freeg [:: (1, p)]]. (* -------------------------------------------------------------------- *) Module FreegZmodType. Section Defs. Context (R : ringType) (K : choiceType). Implicit Types (rD : prefreeg R K) (D : {freeg K / R}) (s : seq (R * K)). Implicit Types (z k : R) (x y : K). Local Notation zero := [freeg [::]]. Lemma reprfg0 : repr zero = Prefreeg [::] :> prefreeg R K. Proof. by apply/eqP; rewrite !piE eqE; apply/eqP/perm_small_eq/perm_eq_fgrepr. Qed. Definition fgadd_r rD1 rD2 := Prefreeg (rD1 ++ rD2). Definition fgadd := lift_op2 {freeg K / R} fgadd_r. Lemma pi_fgadd : {morph \pi : D1 D2 / fgadd_r D1 D2 >-> fgadd D1 D2}. Proof. case=> [D1 redD1] [D2 redD2]; unlock fgadd; rewrite ?piE. apply/eqmodP/freegequivP => k /=. by rewrite !precoeff_reduce !precoeff_cat !precoeff_repr. Qed. Canonical pi_fgadd_morph := PiMorph2 pi_fgadd. Definition fgopp_r rD := Prefreeg (prefreeg_opp rD). Definition fgopp := lift_op1 {freeg K / R} fgopp_r. Lemma pi_fgopp : {morph \pi : D / fgopp_r D >-> fgopp D}. Proof. case=> [D redD]; unlock fgopp; rewrite ?piE. apply/eqmodP/freegequivP => k /=. by rewrite !precoeff_reduce !precoeff_opp !precoeff_repr. Qed. Canonical pi_fgopp_morph := PiMorph1 pi_fgopp. Lemma addmA : associative fgadd. Proof. elim/quotW=> [D1]; elim/quotW=> [D2]; elim/quotW=> [D3]. unlock fgadd; rewrite ?piE; apply/eqmodP/freegequivP => k /=. by rewrite !(precoeff_reduce, precoeff_cat, precoeff_repr) addrA. Qed. Lemma addmC : commutative fgadd. Proof. elim/quotW=> [D1]; elim/quotW=> [D2]. unlock fgadd; rewrite ?piE; apply/eqmodP/freegequivP => k /=. by rewrite !(precoeff_reduce, precoeff_cat, precoeff_repr) addrC. Qed. Lemma addm0 : left_id zero fgadd. Proof. elim/quotW=> [[D redD]]; unlock fgadd; rewrite !(reprfg0, piE). apply/eqmodP/freegequivP=> /= k. by rewrite precoeff_reduce precoeff_repr. Qed. Lemma addmN : left_inverse zero fgopp fgadd. Proof. elim/quotW=> [[D redD]]; unlock fgadd fgopp; rewrite !(reprfg0, piE). apply/eqmodP/freegequivP=> /= k. set rw := (precoeff_reduce, precoeff_repr, precoeff_cat , precoeff_opp , precoeff_repr , precoeff_nil ). by rewrite !rw /= addrC subrr. Qed. #[export] HB.instance Definition _ := GRing.isZmodule.Build {freeg K / R} addmA addmC addm0 addmN. End Defs. Module Exports. Canonical pi_fgadd_morph. Canonical pi_fgopp_morph. HB.reexport. End Exports. End FreegZmodType. Import FreegZmodType. Export FreegZmodType.Exports. (* -------------------------------------------------------------------- *) Section FreegZmodTypeTheory. Context (R : ringType) (K : choiceType). Implicit Types (x y z : K) (k : R) (D: {freeg K / R}). Local Notation coeff := (@coeff R K). (* -------------------------------------------------------------------- *) Section Lift. Context (M : lmodType R) (f : K -> M). Lemma lift_is_additive : additive (fglift f). Proof. elim/quotW=> [[D1 /= H1]]; elim/quotW=> [[D2 /= H2]]. unlock fglift; rewrite ?piE [_ + _]piE /lift /=. rewrite !prelift_repr /fgadd_r /fgopp_r /=. by rewrite !(prelift_reduce, prelift_cat, prelift_opp). Qed. End Lift. (* -------------------------------------------------------------------- *) Lemma coeff_is_additive x : additive (coeff x). Proof. exact: lift_is_additive R^o _. Qed. #[export] HB.instance Definition _ x := GRing.isAdditive.Build {freeg K / R} R (coeff x) (coeff_is_additive x). Lemma coeff0 z : coeff z 0 = 0 . Proof. exact: raddf0. Qed. Lemma coeffN z : {morph coeff z: x / - x} . Proof. exact: raddfN. Qed. Lemma coeffD z : {morph coeff z: x y / x + y}. Proof. exact: raddfD. Qed. Lemma coeffB z : {morph coeff z: x y / x - y}. Proof. exact: raddfB. Qed. Lemma coeffMn z n : {morph coeff z: x / x *+ n} . Proof. exact: raddfMn. Qed. Lemma coeffMNn z n : {morph coeff z: x / x *- n} . Proof. exact: raddfMNn. Qed. (* ------------------------------------------------------------------ *) Lemma dom0 : dom (0 : {freeg K / R}) = [::] :> seq K. Proof. apply/perm_small_eq/uniq_perm => //; first exact: uniq_dom. by move=> z; rewrite mem_dom coeff0 eqxx. Qed. (* ------------------------------------------------------------------ *) Lemma dom_eq0 (D : {freeg K / R}) : (dom D == [::]) = (D == 0). Proof. apply/eqP/idP => [z_domD|/eqP ->]; last exact: dom0. by apply/freeg_eqP => z; rewrite coeff0 coeff_outdom // z_domD in_nil. Qed. (* ------------------------------------------------------------------ *) Lemma domU (c : R) (x : K) : c != 0 -> dom << c *g x >> = [:: x]. Proof. move=> nz_c; apply/perm_small_eq/uniq_perm => //; first exact: uniq_dom. move=> y; rewrite mem_dom coeffU mem_seq1. by case: (eqVneq x); rewrite /= ?(mulr0, mulr1, eqxx). Qed. (* -------------------------------------------------------------------*) Lemma domU1 z : dom (<< z >> : {freeg K / R}) = [:: z]. Proof. by rewrite domU ?oner_eq0. Qed. (* -------------------------------------------------------------------*) Lemma domN D : dom (-D) =i dom D. Proof. by move=> z; rewrite !mem_dom coeffN oppr_eq0. Qed. Lemma domN_perm_eq D : perm_eq (dom (- D)) (dom D). Proof. by apply: uniq_perm; rewrite ?uniq_dom //; apply: domN. Qed. (* ------------------------------------------------------------------ *) Lemma domD_perm_eq D1 D2 : [predI (dom D1) & (dom D2)] =1 pred0 -> perm_eq (dom (D1 + D2)) (dom D1 ++ dom D2). Proof. move=> D12_nI; apply/uniq_perm; first exact: uniq_dom. rewrite cat_uniq !uniq_dom andbT; apply/hasPn => p p_in_D2. by move: (D12_nI p); rewrite /= p_in_D2 andbT => /negbT. move=> p; move: (D12_nI p); rewrite /= mem_cat !mem_dom coeffD. have [->|nz_D1p] /= := eqVneq (coeff p D1) 0; first by rewrite add0r. by move=> /negbFE /eqP ->; rewrite addr0. Qed. Lemma domD D1 D2 x : [predI (dom D1) & (dom D2)] =1 pred0 -> (x \in dom (D1 + D2)) = (x \in dom D1) || (x \in dom D2). Proof. by move/domD_perm_eq/perm_mem/(_ x); rewrite mem_cat. Qed. (* ------------------------------------------------------------------ *) Lemma domD_subset D1 D2 : {subset dom (D1 + D2) <= dom D1 ++ dom D2}. Proof. move=> z; rewrite mem_cat !mem_dom coeffD. have nz_sum (x1 x2 : R): x1 + x2 != 0 -> (x1 != 0) || (x2 != 0). by have [->|] := eqVneq x1 0; first by rewrite add0r. by move=> /nz_sum /orP [] ->; rewrite ?orbT. Qed. (* ------------------------------------------------------------------ *) Lemma dom_sum_subset (I : Type) (r : seq I) (F : I -> {freeg K / R}) (P : pred I) : {subset dom (\sum_(i <- r | P i) F i) <= flatten [seq dom (F i) | i <- r & P i]}. Proof. move=> p; elim: r => [|r rs IH]; first by rewrite big_nil dom0. rewrite big_cons; case Pr: (P r); last by move/IH=> /=; rewrite Pr. move/domD_subset; rewrite mem_cat /= Pr => /orP[|/IH]. + by rewrite map_cons /= mem_cat=> ->. + by rewrite map_cons /= mem_cat=> ->; rewrite orbT. Qed. (* ------------------------------------------------------------------ *) Lemma domB D1 D2 : {subset dom (D1 - D2) <= (dom D1) ++ (dom D2)}. Proof. by move=> z /domD_subset; rewrite !mem_cat domN. Qed. (* ------------------------------------------------------------------ *) Lemma freegUD k1 k2 x : << k1 *g x >> + << k2 *g x >> = << (k1 + k2) *g x >>. Proof. by apply/eqP/freeg_eqP=> z; rewrite coeffD !coeffU -mulrDl. Qed. Lemma freegUN k x : - << k *g x >> = << -k *g x >>. Proof. by apply/eqP/freeg_eqP=> z; rewrite coeffN !coeffU mulNr. Qed. Lemma freegUB k1 k2 x : << k1 *g x >> - << k2 *g x >> = << (k1-k2) *g x >>. Proof. by rewrite freegUN freegUD. Qed. Lemma freegU0 x : << 0 *g x >> = 0 :> {freeg K / R}. Proof. by apply/eqP/freeg_eqP=> y; rewrite coeffU coeff0 mul0r. Qed. Lemma freegU_eq0 k x : (<< k *g x >> == 0) = (k == 0). Proof. apply/eqP/eqP => [/(congr1 (coeff x))|->]; last by rewrite freegU0. by rewrite coeff0 coeffU eqxx mulr1. Qed. (* -------------------------------------------------------------------- *) Lemma freeg_muln k n (S : K) : << k *g S >> *+ n = << (k *+ n) *g S >>. Proof. elim: n => [|n ih]. + by rewrite !mulr0n freegU0. + by rewrite !mulrS ih freegUD. Qed. Lemma freegU_muln n (S : K) : << S >> *+ n = << n%:R *g S >> :> {freeg K / R}. Proof. by rewrite freeg_muln. Qed. Lemma freeg_mulz k (m : int) (S : K) : << k *g S >> *~ m = << k *~ m *g S >>. Proof. case: m=> [n|n]. + by rewrite -pmulrn freeg_muln. + by rewrite NegzE -nmulrn freeg_muln mulrNz freegUN. Qed. Lemma freegU_mulz (m : int) (S : K) : << S >> *~ m = << m%:~R *g S >> :> {freeg K / R}. Proof. by rewrite freeg_mulz. Qed. (* -------------------------------------------------------------------- *) Lemma freeg_nil : [freeg [::]] = 0 :> {freeg K / R}. Proof. exact/eqP/freeg_eqP. Qed. Lemma freeg_cat (s1 s2 : seq (R * K)) : [freeg s1 ++ s2] = [freeg s1] + [freeg s2]. Proof. by apply/eqP/freeg_eqP => k; rewrite coeffD !coeff_Freeg precoeff_cat. Qed. (* -------------------------------------------------------------------- *) Definition fgenum D : seq (R * K) := repr D. Lemma Freeg_enum D : Freeg (fgenum D) = D. Proof. elim/quotW: D; case=> D rD /=; unlock Freeg. exact/eqmodP/perm_trans/perm_eq_fgrepr/reduceK/prefreeg_reduced. Qed. Lemma perm_eq_fgenum (s : seq (R * K)) (rD : reduced s) : perm_eq (fgenum (\pi_{freeg K / R} (mkPrefreeg s rD))) s. Proof. exact: perm_eq_fgrepr. Qed. (* -------------------------------------------------------------------- *) Lemma freeg_sumE D : \sum_(z <- dom D) << (coeff z D) *g z >> = D. Proof. apply/eqP/freeg_eqP=> x /=; rewrite raddf_sum /=. case x_in_dom: (x \in dom D); last rewrite coeff_outdom ?x_in_dom //. + rewrite (bigD1_seq x) ?uniq_dom //= big1 ?addr0. * by rewrite coeffU eqxx mulr1. * by move=> z ne_z_x; rewrite coeffU (negbTE ne_z_x) mulr0. + rewrite big_seq big1 // => z z_notin_dom; rewrite coeffU. have ->: (z == x)%:R = 0 :> R; last by rewrite mulr0. by case: (z =P x)=> //= eq_zx; rewrite eq_zx x_in_dom in z_notin_dom. Qed. End FreegZmodTypeTheory. (* -------------------------------------------------------------------- *) Section FreeglModType. Context (R : ringType) (K : choiceType). Implicit Types (x y z : K) (c k : R) (D: {freeg K / R}). Local Notation coeff := (@coeff R K). Definition fgscale c D := \sum_(x <- dom D) << c * (coeff x D) *g x >>. Local Notation "c *:F D" := (fgscale c D) (at level 40, left associativity). Lemma coeff_fgscale c D x : coeff x (c *:F D) = c * (coeff x D). Proof. rewrite -{2}[D]freeg_sumE /fgscale !raddf_sum /=. by rewrite mulr_sumr; apply/eq_bigr=> i _; rewrite !coeffU mulrA. Qed. Lemma fgscaleA c1 c2 D : c1 *:F (c2 *:F D) = (c1 * c2) *:F D. Proof. by apply/eqP/freeg_eqP=> x; rewrite !coeff_fgscale mulrA. Qed. Lemma fgscale1r D : 1 *:F D = D. Proof. by apply/eqP/freeg_eqP=> x; rewrite !coeff_fgscale mul1r. Qed. Lemma fgscaleDr c D1 D2 : c *:F (D1 + D2) = c *:F D1 + c *:F D2. Proof. by apply/eqP/freeg_eqP=> x; rewrite !(coeffD, coeff_fgscale) mulrDr. Qed. Lemma fgscaleDl D c1 c2 : (c1 + c2) *:F D = c1 *:F D + c2 *:F D. Proof. by apply/eqP/freeg_eqP=> x; rewrite !(coeffD, coeff_fgscale) mulrDl. Qed. HB.instance Definition _ := GRing.Zmodule_isLmodule.Build R {freeg K / R} fgscaleA fgscale1r fgscaleDr fgscaleDl. End FreeglModType. (* -------------------------------------------------------------------- *) Section FreeglModTheory. Context (R : ringType) (K : choiceType). Implicit Types (x y z : K) (c k : R) (D : {freeg K / R}). Local Notation coeff := (@coeff R K). Lemma coeffZ c D x : coeff x (c *: D) = c * coeff x D. Proof. by rewrite coeff_fgscale. Qed. Lemma domZ_subset c D : {subset dom (c *: D) <= dom D}. Proof. move=> x; rewrite !mem_dom coeffZ. by case: (coeff _ _ =P 0)=> // ->; rewrite mulr0 eqxx. Qed. End FreeglModTheory. (* -------------------------------------------------------------------- *) Section FreeglModTheoryId. Context (R : idomainType) (K : choiceType). Implicit Types (x y z : K) (c k : R) (D: {freeg K / R}). Local Notation coeff := (@coeff R K). Lemma domZ c D : c != 0 -> dom (c *: D) =i dom D. Proof. by move=> nz_c x; rewrite !mem_dom coeffZ mulf_eq0 negb_or nz_c. Qed. End FreeglModTheoryId. (* -------------------------------------------------------------------- *) Section Deg. Context (K : choiceType). (* -------------------------------------------------------------------- *) Definition deg (D : {freeg K / int}) : int := fglift (fun _ => (1%:Z : int^o)) D. Lemma degU k z : deg << k *g z >> = k. Proof. by rewrite /deg liftU /GRing.scale /= mulr1. Qed. Definition predeg (D : seq (int * K)) := \sum_(kx <- D) kx.1. Lemma deg_is_additive: additive deg. Proof. exact: (@lift_is_additive _ K int^o). Qed. #[export] HB.instance Definition _ := GRing.isAdditive.Build {freeg K / int} int deg deg_is_additive. Lemma deg0 : deg 0 = 0 . Proof. exact: raddf0. Qed. Lemma degN : {morph deg: x / - x} . Proof. exact: raddfN. Qed. Lemma degD : {morph deg: x y / x + y}. Proof. exact: raddfD. Qed. Lemma degB : {morph deg: x y / x - y}. Proof. exact: raddfB. Qed. Lemma degMn n : {morph deg: x / x *+ n} . Proof. exact: raddfMn. Qed. Lemma degMNn n : {morph deg: x / x *- n} . Proof. exact: raddfMNn. Qed. Lemma predegE : predeg =1 prelift (fun _ => 1%:Z : int^o). Proof. move=> D; rewrite /predeg /prelift; apply: eq_bigr. by move=> i _; rewrite /GRing.scale /= mulr1. Qed. Lemma predeg_nil : predeg [::] = 0. Proof. by rewrite /predeg big_nil. Qed. Lemma predeg_cons D k x : predeg ((k, x) :: D) = k + predeg D. Proof. by rewrite /predeg big_cons. Qed. Lemma predeg_cat D1 D2 : predeg (D1 ++ D2) = predeg D1 + predeg D2. Proof. by rewrite !predegE prelift_cat. Qed. Lemma predeg_opp D : predeg (prefreeg_opp D) = - predeg D. Proof. by rewrite !predegE prelift_opp. Qed. Lemma predeg_perm_eq D1 D2 : perm_eq D1 D2 -> predeg D1 = predeg D2. Proof. by rewrite !predegE => /prelift_perm_eq ->. Qed. Lemma predeg_repr D : predeg (repr (\pi_{freeg K / int} D)) = predeg D. Proof. by rewrite !predegE prelift_repr. Qed. Lemma predeg_reduce D : predeg (reduce D) = predeg D. Proof. by rewrite !predegE prelift_reduce. Qed. End Deg. (* -------------------------------------------------------------------- *) Reserved Notation "D1 <=g D2" (at level 50, no associativity). Section FreegCmp. Context (G : numDomainType) (K : choiceType). Definition fgle (D1 D2 : {freeg K / G}) := all [pred z | coeff z D1 <= coeff z D2] (dom D1 ++ dom D2). Local Notation "D1 <=g D2" := (fgle D1 D2). Lemma fgleP D1 D2 : reflect (forall z, coeff z D1 <= coeff z D2) (D1 <=g D2). Proof. apply: (iffP allP); last by move=> H z _; apply: H. move=> lec z; case z_in_dom: (z \in (dom D1 ++ dom D2)). exact: lec. move: z_in_dom; rewrite mem_cat; case/norP=> zD1 zD2. by rewrite !coeff_outdom // lexx. Qed. Lemma fgposP D : reflect (forall z, 0 <= coeff z D) (0 <=g D). Proof. apply: (iffP idP). + by move=> posD z; move/fgleP/(_ z): posD; rewrite coeff0. + by move=> posD; apply/fgleP=> z; rewrite coeff0. Qed. Lemma fgledd D : D <=g D. Proof. by apply/fgleP=> z; rewrite lexx. Qed. Lemma fgle_trans : transitive fgle. Proof. move=> D2 D1 D3 le12 le23; apply/fgleP=> z. by rewrite (@le_trans _ _ (coeff z D2)) //; apply/fgleP. Qed. End FreegCmp. Local Notation "D1 <=g D2" := (fgle D1 D2). (* -------------------------------------------------------------------- *) Section FreegCmpDom. Context (K : choiceType). Lemma dompDl (D1 D2 : {freeg K}) : 0 <=g D1 -> 0 <=g D2 -> dom (D1 + D2) =i dom D1 ++ dom D2. Proof. move=> pos_D1 pos_D2 z; rewrite mem_cat !mem_dom coeffD. by rewrite paddr_eq0; first 1 [rewrite negb_and] || apply/fgposP. Qed. End FreegCmpDom. (* -------------------------------------------------------------------- *) Section FreegMap. Context (G : ringType) (K : choiceType) (P : pred K) (f : G -> G). Implicit Types (D : {freeg K / G}). Definition fgmap D := \sum_(z <- dom D | P z) << f (coeff z D) *g z >>. Lemma fgmap_coeffE (D : {freeg K / G}) z : z \in dom D -> coeff z (fgmap D) = f (coeff z D) *+ P z. Proof. move=> zD; rewrite /fgmap raddf_sum /= -big_filter; case Pz: (P z). + rewrite (bigD1_seq z) ?(filter_uniq, uniq_dom) //=; last first. by rewrite mem_filter Pz. rewrite coeffU eqxx mulr1 big1 ?addr0 //. by move=> z' ne_z'z; rewrite coeffU (negbTE ne_z'z) mulr0. + rewrite big_seq big1 ?mulr0 //. move=> z' z'PD; rewrite coeffU; have/negbTE->: z' != z. apply/eqP=> /(congr1 (fun x => x \in filter P (dom D))). by rewrite z'PD mem_filter Pz. by rewrite mulr0. Qed. Lemma fgmap_dom D : {subset dom (fgmap D) <= filter P (dom D)}. Proof. move=> z; rewrite mem_dom mem_filter andbC. case zD: (z \in (dom D)) => /=. + rewrite fgmap_coeffE //; case: (P _)=> //=. by rewrite mulr0n eqxx. + rewrite /fgmap raddf_sum /= big_seq_cond big1 ?eqxx //. move=> z' /andP [z'D _]; rewrite coeffU. have/negbTE->: z' != z; last by rewrite mulr0. apply/eqP=> /(congr1 (fun x => x \in dom D)). by rewrite zD z'D. Qed. Lemma fgmap_f0_coeffE (D : {freeg K / G}) z : f 0 = 0 -> coeff z (fgmap D) = f (coeff z D) *+ P z. Proof. move=> z_f0; case zD: (z \in dom D). by rewrite fgmap_coeffE. rewrite !coeff_outdom ?z_f0 ?zD ?mul0rn //. by apply/negP=> /fgmap_dom; rewrite mem_filter zD andbF. Qed. End FreegMap. (* -------------------------------------------------------------------- *) Section FreegNorm. Variable (G : numDomainType) (K : choiceType). Implicit Types (D : {freeg K / G}). Definition fgnorm D : {freeg K / G} := fgmap xpredT Num.norm D. Lemma fgnormE D : fgnorm D = \sum_(z <- dom D) << `|coeff z D| *g z >>. Proof. by []. Qed. Lemma coeff_fgnormE D z : coeff z (fgnorm D) = `|coeff z D|. Proof. by rewrite fgmap_f0_coeffE ?mulr1n // normr0. Qed. End FreegNorm. (* -------------------------------------------------------------------- *) Section FreegPosDecomp. Variable (G : realDomainType) (K : choiceType). Implicit Types (D : {freeg K / G}). Definition fgpos D: {freeg K / G} := fgmap [pred z | coeff z D >= 0] Num.norm D. Definition fgneg D: {freeg K / G} := fgmap [pred z | coeff z D <= 0] Num.norm D. Lemma fgposE D : fgpos D = \sum_(z <- dom D | coeff z D >= 0) << `|coeff z D| *g z >>. Proof. by []. Qed. Lemma fgnegE D : fgneg D = \sum_(z <- dom D | coeff z D <= 0) << `|coeff z D| *g z >>. Proof. by []. Qed. Lemma fgposN D : fgpos (- D) = fgneg D. Proof. apply/eqP/freeg_eqP=> z. by rewrite !fgmap_f0_coeffE ?normr0 //= !coeffN oppr_ge0 normrN. Qed. Lemma fgpos_le0 D : 0 <=g fgpos D. Proof. by apply/fgleP=> z; rewrite coeff0 fgmap_f0_coeffE ?normr0 // mulrn_wge0. Qed. Lemma fgneg_le0 D : 0 <=g fgneg D. Proof. by rewrite -fgposN fgpos_le0. Qed. Lemma coeff_fgposE D k : coeff k (fgpos D) = Num.max 0 (coeff k D). Proof. by rewrite fgmap_f0_coeffE ?normr0 //=; case: ger0P. Qed. Lemma coeff_fgnegE D k : coeff k (fgneg D) = - Num.min 0 (coeff k D). Proof. by rewrite -fgposN coeff_fgposE coeffN -{1}[0]oppr0 -oppr_min. Qed. Lemma fgpos_dom D : {subset dom (fgpos D) <= dom D}. Proof. by move=> x /fgmap_dom; rewrite mem_filter => /andP []. Qed. Lemma fgneg_dom D : {subset dom (fgneg D) <= dom D}. Proof. by move=> k; rewrite -fgposN => /fgpos_dom; rewrite domN. Qed. Lemma fg_decomp D : D = fgpos D - fgneg D. Proof. apply/eqP/freeg_eqP=> k; rewrite coeffB. by rewrite coeff_fgposE coeff_fgnegE opprK addr_max_min add0r. Qed. Lemma fgnorm_decomp D : fgnorm D = fgpos D + fgneg D. Proof. apply/eqP/freeg_eqP=> k. rewrite coeffD coeff_fgnormE coeff_fgposE coeff_fgnegE. by case: ger0P; rewrite (sub0r, subr0). Qed. End FreegPosDecomp. (* -------------------------------------------------------------------- *) Section PosFreegDeg. Context (K : choiceType). Lemma fgpos_eq0P (D : {freeg K}) : 0 <=g D -> deg D = 0 -> D = 0. Proof. move=> posD; rewrite -{1}[D]freeg_sumE raddf_sum /=. rewrite (eq_bigr (fun z => coeff z D)); last first. by move=> i _; rewrite degU. move/eqP; rewrite psumr_eq0; last by move=> i _; apply/fgposP. move/allP=> zD; apply/eqP; apply/freeg_eqP=> z; rewrite coeff0. case z_in_D: (z \in dom D); last first. by rewrite coeff_outdom // z_in_D. exact/eqP/zD. Qed. Lemma fgneg_eq0P (D : {freeg K}) : D <=g 0 -> deg D = 0 -> D = 0. Proof. move=> negD deg_eq0; apply/eqP; rewrite -oppr_eq0; apply/eqP. apply/fgpos_eq0P; last by apply/eqP; rewrite degN oppr_eq0 deg_eq0. apply/fgposP=> z; rewrite coeffN oppr_ge0. by move/fgleP: negD => /(_ z); rewrite coeff0. Qed. Lemma deg1pos (D : {freeg K}) : 0 <=g D -> deg D = 1 -> exists x, D = << x >>. Proof. move=> D_ge0 degD_eq1; have: D != 0. by case: (D =P 0) degD_eq1 => [->|//]; rewrite deg0. rewrite -dom_eq0; case DE: (dom D) => [//|p ps] _. rewrite -[D]addr0 -(subrr <

>) addrA addrAC. have: coeff p D != 0. by move: (mem_dom D p); rewrite DE in_cons eqxx. rewrite neq_lt ltNge; have/fgposP/(_ p) := D_ge0 => ->/=. move=> coeffpD_gt0; have: 0 <=g (D - <

>). apply/fgposP=> q; rewrite coeffB coeffU mul1r. case: (p =P q) =>[<-/=|]; last first. by move=> _; rewrite subr0; apply/fgposP. by rewrite subr_ge0. move/fgpos_eq0P=> ->; first by rewrite add0r; exists p. by rewrite degB degU degD_eq1 subrr. Qed. Lemma deg1neg (D : {freeg K}) : D <=g 0 -> deg D = -1 -> exists x, D = - << x >>. Proof. move=> D_le0 degD_eqN1; case: (@deg1pos (-D)). + apply/fgleP=> p; rewrite coeffN coeff0 oppr_ge0. by move/fgleP/(_ p): D_le0; rewrite coeff0. + by rewrite degN degD_eqN1 opprK. + by move=> p /eqP; rewrite eqr_oppLR => /eqP->; exists p. Qed. End PosFreegDeg. (* -------------------------------------------------------------------- *) Section FreegIndDom. Context (R : ringType) (K : choiceType) (F : pred K). Context (P : {freeg K / R} -> Type). Implicit Types (D : {freeg K / R}). Context (H0 : forall D, [predI dom D & [predC F]] =1 pred0 -> P D). Context (HS : forall k x D, x \notin dom D -> k != 0 -> ~~ (F x) -> P D -> P (<< k *g x >> + D)). Lemma freeg_rect_dom D: P D. Proof. rewrite -[D]freeg_sumE (bigID F) /=; set DR := \sum_(_ <- _ | _) _. have: [predI dom DR & [predC F]] =1 pred0. move=> p /=; rewrite !inE; apply/negP=> /andP []. rewrite /DR => /dom_sum_subset /flattenP. case=> [ps /mapP [q]]; rewrite mem_filter => /andP []. move=> Rq q_in_D ->; rewrite domU ?mem_seq1; last first. by rewrite -(mem_dom D q). by move/eqP=> ->; move: Rq; rewrite /in_mem /= => ->. move: DR => DR domDR; rewrite addrC -big_filter. set ps := [seq _ <- _ | _]; move: (perm_refl ps). rewrite {1}/ps; move: ps (D) => {D}; elim => [|p ps IH] D. + by move=> _; rewrite big_nil add0r; apply: H0. + move=> DE; move: (perm_mem DE p); rewrite !inE eqxx /=. have /=: uniq (p :: ps). by move/perm_uniq: DE; rewrite filter_uniq // uniq_dom. case/andP=> p_notin_ps uniq_ps; rewrite mem_filter=> /andP [NRp p_in_D]. rewrite big_cons -addrA; apply: HS => //; first 1 last. * by move: p_in_D; rewrite mem_dom. * pose D' := D - << coeff p D *g p >>. have coeffD' q: coeff q D' = coeff q D * (p != q)%:R. rewrite {}/D' coeffB coeffU; case: (p =P q). - by move=> ->; rewrite !(mulr1, mulr0) subrr. - by move/eqP=> ne_pq; rewrite !(mulr1, mulr0) subr0. have: perm_eq (dom D) (p :: dom D'). apply: uniq_perm; rewrite /= ?uniq_dom ?andbT //. - by rewrite mem_dom coeffD' eqxx mulr0 eqxx. move=> q; rewrite in_cons !mem_dom coeffD' [q == _]eq_sym. case: (p =P q); rewrite !(mulr0, mulr1) //=. by move=> <-; move: p_in_D; rewrite mem_dom. move/perm_filter=> /(_ [pred q | ~~ (F q)]) /=. rewrite NRp; rewrite perm_sym; move/perm_trans => /(_ _ DE). rewrite perm_cons => domD'; rewrite big_seq. rewrite (eq_bigr (fun q => << coeff q D' *g q >>)); last first. move=> q q_in_ps; rewrite /D' coeffB coeffU; case: (p =P q). - by move=> eq_pq; move: p_notin_ps; rewrite eq_pq q_in_ps. - by move=> _; rewrite mulr0 subr0. by rewrite -big_seq; apply: IH. * apply/negP=> /domD_subset; rewrite mem_cat; case/orP; last first. by move=> p_in_DR; move/(_ p): domDR; rewrite !inE NRp p_in_DR. move/dom_sum_subset; rewrite filter_predT => /flattenP [qs]. move/mapP => [q q_in_ps ->]; rewrite domU; last first. move/perm_mem/(_ q): DE; rewrite !inE q_in_ps orbT. by rewrite mem_filter => /andP [_]; rewrite mem_dom. rewrite mem_seq1 => /eqP pq_eq; move: p_notin_ps. by rewrite pq_eq q_in_ps. Qed. End FreegIndDom. Lemma freeg_ind_dom (R : ringType) (K : choiceType) (F : pred K): forall (P : {freeg K / R} -> Prop), (forall D : {freeg K / R}, [predI dom (G:=R) (K:=K) D & [predC F]] =1 pred0 -> P D) -> (forall (k : R) (x : K) (D : {freeg K / R}), x \notin dom (G:=R) (K:=K) D -> k != 0 -> ~~ F x -> P D -> P (<< k *g x >> + D)) -> forall D : {freeg K / R}, P D. Proof. by move=> P; apply/(@freeg_rect_dom R K F P). Qed. (* -------------------------------------------------------------------- *) Section FreegIndDom0. Context (R : ringType) (K : choiceType) (P : {freeg K / R} -> Type). Context (H0 : P 0). Context (HS : forall k x D, x \notin dom D -> k != 0 -> P D -> P (<< k *g x >> + D)). Lemma freeg_rect_dom0 D: P D. Proof. apply: (@freeg_rect_dom _ _ xpred0) => [{}D|k x {}D]. move=> domD; congr P: H0; apply/esym/eqP; rewrite -dom_eq0. by case: (dom D) domD => [//|p ps] /(_ p); rewrite !inE eqxx. by move=> ? ? _; apply: HS. Qed. End FreegIndDom0. Lemma freeg_ind_dom0 (R : ringType) (K : choiceType): forall (P : {freeg K / R} -> Prop), P 0 -> (forall (k : R) (x : K) (D : {freeg K / R}), x \notin dom (G:=R) (K:=K) D -> k != 0 -> P D -> P (<< k *g x >> + D)) -> forall D : {freeg K / R}, P D. Proof. by move=> P; apply/(@freeg_rect_dom0 R K P). Qed. multinomials-2.3.0/src/monalg.v000066400000000000000000001464311472432761000165030ustar00rootroot00000000000000(* -------------------------------------------------------------------- * (c) Copyright 2014--2015 IMDEA Software Institute. * * You may distribute this file under the terms of the CeCILL-B license * -------------------------------------------------------------------- *) (* -------------------------------------------------------------------- *) From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat. From mathcomp Require Import seq path choice finset fintype finfun. From mathcomp Require Import tuple bigop ssralg ssrint ssrnum. Require Import xfinmap. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory Num.Theory BigEnoughFSet. Local Open Scope fset. Local Open Scope fmap. Local Open Scope ring_scope. Declare Scope monom_scope. Delimit Scope monom_scope with M. (* -------------------------------------------------------------------- *) Reserved Notation "{ 'cmonom' I }" (at level 0, I at level 2, format "{ 'cmonom' I }"). Reserved Notation "[ 'cmonom' E | i 'in' P ]" (at level 0, i at level 99). Reserved Notation "[ 'cmonom' E | i : P ]" (at level 0, i at level 99). Reserved Notation "{ 'fmonom' I }" (at level 0, I at level 2, format "{ 'fmonom' I }"). Reserved Notation "{ 'malg' G [ K ] }" (at level 0, K, G at level 2, format "{ 'malg' G [ K ] }"). Reserved Notation "{ 'malg' K }" (at level 0, K at level 2, format "{ 'malg' K }"). Reserved Notation "[ 'malg' g ]" (at level 0, g at level 2, format "[ 'malg' g ]"). Reserved Notation "[ 'malg' x 'in' aT => E ]" (at level 0, x ident, format "[ 'malg' x 'in' aT => E ]"). Reserved Notation "[ 'malg' x => E ]" (at level 0, x ident, format "[ 'malg' x => E ]"). Reserved Notation "{ 'mpoly' T [ n ] }" (at level 0, T, n at level 2, format "{ 'mpoly' T [ n ] }"). Reserved Notation "<< z *p k >>" (at level 0, format "<< z *p k >>"). Reserved Notation "<< k >>" (at level 0, format "<< k >>"). Reserved Notation "g @_ k" (at level 3, k at level 2, left associativity, format "g @_ k"). Reserved Notation "c %:MP" (at level 2, left associativity, format "c %:MP"). Reserved Notation "''X_{1..' n '}'" (at level 0, n at level 2). Reserved Notation "'U_(' n )" (at level 0, n at level 2, no associativity, format "'U_(' n )"). Reserved Notation "x ^[ f , g ]" (at level 2, left associativity, format "x ^[ f , g ]"). Reserved Notation "'{' 'mmorphism' M '->' S '}'" (at level 0, M at level 98, S at level 99, format "{ 'mmorphism' M -> S }"). (* -------------------------------------------------------------------- *) HB.mixin Record Choice_isMonomialDef V of Choice V := { one : V; mul : V -> V -> V; mulmA : associative mul; mul1m : left_id one mul; mulm1 : right_id one mul; unitm : forall x y, mul x y = one -> x = one /\ y = one }. HB.structure Definition MonomialDef := { V of Choice V & Choice_isMonomialDef V }. Module MonomialDefExports. Bind Scope monom_scope with MonomialDef.sort. Notation monomType := MonomialDef.type. End MonomialDefExports. Export MonomialDefExports. (* -------------------------------------------------------------------- *) Notation mone := one. Notation mmul := mul. Local Notation "1" := (@mone _) : monom_scope. Local Notation "*%M" := (@mmul _) : function_scope. Local Notation "x * y" := (mmul x y) : monom_scope. (* -------------------------------------------------------------------- *) HB.mixin Record MonomialDef_isConomialDef V of MonomialDef V := { mulmC : commutative (@mul V) }. HB.structure Definition ConomialDef := { V of MonomialDef V & MonomialDef_isConomialDef V }. Module ConomialDefExports. Bind Scope monom_scope with ConomialDef.sort. Notation conomType := ConomialDef.type. End ConomialDefExports. Export ConomialDefExports. (* -------------------------------------------------------------------- *) Section Monomial. Context (M : monomType). Local Open Scope monom_scope. #[export] HB.instance Definition _ := Monoid.isLaw.Build M 1 mmul mulmA mul1m mulm1. Lemma unitmP (x y : M) : reflect (x == 1 /\ y == 1) (x * y == 1). Proof. by apply: (iffP eqP)=> [/unitm[-> ->]|[/eqP-> /eqP->]] //; rewrite mulm1. Qed. End Monomial. #[export] HB.instance Definition _ (M : conomType) := Monoid.isComLaw.Build M mone mmul (@mulmA M) mulmC (@mul1m M). Module Exports. HB.reexport. End Exports. Export Exports. (* -------------------------------------------------------------------- *) Definition mmorphism (M : monomType) (S : ringType) (f : M -> S) := {morph f : x y / (x * y)%M >-> (x * y)%R} * (f 1%M = 1) : Prop. HB.mixin Record isMultiplicative (M : monomType) (S : ringType) (apply : M -> S) := { mmorphism_subproof : mmorphism apply; }. #[mathcomp(axiom="multiplicative")] HB.structure Definition MMorphism (M : monomType) (S : ringType) := {f of isMultiplicative M S f}. Module MMorphismExports. Notation "{ 'mmorphism' M -> S }" := (@MMorphism.type M S) : type_scope. #[deprecated(since="multinomials 2.2.0", note="Use MMorphism.clone instead.")] Notation "[ 'mmorphism' 'of' f 'as' g ]" := (MMorphism.clone _ _ f g) (at level 0, only parsing) : form_scope. #[deprecated(since="multinomials 2.2.0", note="Use MMorphism.clone instead.")] Notation "[ 'mmorphism' 'of' f ]" := (MMorphism.clone _ _ f _) (at level 0, only parsing) : form_scope. End MMorphismExports. Export MMorphismExports. (* -------------------------------------------------------------------- *) Section MMorphismTheory. Variables (M : monomType) (S : ringType) (f : {mmorphism M -> S}). Lemma mmorph1 : f 1%M = 1. Proof. exact: mmorphism_subproof.2. Qed. Lemma mmorphM : {morph f : x y / (x * y)%M >-> (x * y)%R}. Proof. exact: mmorphism_subproof.1. Qed. End MMorphismTheory. (* -------------------------------------------------------------------- *) Section MalgDef. Variable (K : choiceType) (G : zmodType). Record malg : predArgType := Malg { malg_val : {fsfun K -> G with 0} }. Fact malg_key : unit. Proof. by []. Qed. Definition malg_of_fsfun k := locked_with k Malg. Canonical malg_unlockable k := [unlockable fun malg_of_fsfun k]. HB.instance Definition _ := [isNew for @malg_val]. HB.instance Definition _ := [Choice of malg by <:]. End MalgDef. (* -------------------------------------------------------------------- *) Bind Scope ring_scope with malg. Notation "{ 'malg' G [ K ] }" := (@malg K G) : type_scope. Notation "{ 'malg' K }" := {malg int[K]} : type_scope. (* -------------------------------------------------------------------- *) Section MalgBaseOp. Context {K : choiceType} {G : zmodType}. Definition mcoeff (x : K) (g : {malg G[K]}) : G := malg_val g x. Definition mkmalg : {fsfun K -> G with 0} -> {malg G[K]} := @Malg K G. Definition mkmalgU (k : K) (x : G) := mkmalg [fsfun y => [fmap].[k <- x] y]. Definition msupp (g : {malg G[K]}) : {fset K} := finsupp (malg_val g). End MalgBaseOp. Arguments mcoeff {K G} x%monom_scope g%ring_scope. Arguments mkmalg {K G} _. Arguments mkmalgU {K G} k%monom_scope x%ring_scope. Arguments msupp {K G} g%ring_scope. (* -------------------------------------------------------------------- *) Notation "g @_ k" := (mcoeff k g). Notation "[ 'malg' g ]" := (mkmalg g) : ring_scope. Notation "[ 'malg' x 'in' aT => E ]" := (mkmalg [fsfun x in aT => E]) : ring_scope. Notation "[ 'malg' x => E ]" := (mkmalg [fsfun x => E]) : ring_scope. Notation "<< z *g k >>" := (mkmalgU k z) : ring_scope. Notation "<< k >>" := << 1 *g k >> : ring_scope. Notation malgC := (mkmalgU 1). Notation "@ 'malgC' K G" := (@mkmalgU K G 1) (at level 10, K at level 8, G at level 8, only parsing) : function_scope. Notation "c %:MP" := (malgC c) : ring_scope. (* -------------------------------------------------------------------- *) Section MalgTheory. Variable (K : choiceType) (G : zmodType). Lemma mkmalgK (g : {fsfun K -> G with 0}) : malg_val (mkmalg g) = g. Proof. by []. Qed. Lemma malgP (g1 g2 : {malg G[K]}) : (forall k, g1@_k = g2@_k) <-> g1 = g2. Proof. by case: g1 g2 => [g1] [g2]; split=> [h|->//]; congr Malg; apply/fsfunP/h. Qed. Lemma mcoeff_fnd (g : {fmap K -> G}) k : [malg x => g x]@_k = odflt 0 g.[?k]. Proof. exact/fsfun_ffun. Qed. Lemma mcoeffE (domf : {fset K}) (E : K -> G) k : [malg k in domf => E k]@_k = if k \in domf then E k else 0. Proof. exact/fsfun_fun. Qed. Lemma mcoeff_eq0 (g : {malg G[K]}) (k : K) : (g@_k == 0) = (k \notin msupp g). Proof. by rewrite memNfinsupp. Qed. Lemma mcoeff_neq0 (g : {malg G[K]}) (k : K) : (g@_k != 0) = (k \in msupp g). Proof. by rewrite mcoeff_eq0 negbK. Qed. Lemma mcoeff_outdom (g : {malg G[K]}) (k : K) : k \notin msupp g -> g@_k = 0. Proof. exact: fsfun_dflt. Qed. Variant msupp_spec (g : {malg G[K]}) (k : K) : bool -> G -> Type := | MsuppIn (_ : k \in msupp g) : msupp_spec g k true g@_k | MsuppOut (_ : k \notin msupp g) : msupp_spec g k false 0. Lemma msuppP (g : {malg G[K]}) (k : K) : msupp_spec g k (k \in msupp g) g@_k. Proof. by rewrite /mcoeff; case: finsuppP => h; constructor. Qed. End MalgTheory. (* -------------------------------------------------------------------- *) Section MalgZMod. Variable (K : choiceType) (G : zmodType). Implicit Types (g : {malg G[K]}) (k : K). Definition fgzero : {malg G[K]} := [malg x => [fmap] x]. Definition fgopp g := [malg k in msupp g => - g@_k]. Definition fgadd g1 g2 := [malg k in msupp g1 `|` msupp g2 => g1@_k + g2@_k]. Lemma fgzeroE k : fgzero@_k = 0. Proof. by rewrite mcoeff_fnd !(in_fsetE, not_fnd). Qed. Lemma fgoppE g k : (fgopp g)@_k = - g@_k. Proof. by rewrite mcoeffE; case: msuppP; rewrite ?oppr0. Qed. Lemma fgaddE g1 g2 k : (fgadd g1 g2)@_k = g1@_k + g2@_k. Proof. rewrite mcoeffE in_fsetE. by case: (msuppP g1); case: (msuppP g2); rewrite ?addr0. Qed. Lemma fgaddA : associative fgadd. Proof. by move=> x y z; apply/malgP=> k; rewrite !fgaddE addrA. Qed. Lemma fgaddC : commutative fgadd. Proof. by move=> x y; apply/malgP=> k; rewrite !fgaddE addrC. Qed. Lemma fgadd0g : left_id fgzero fgadd. Proof. by move=> x; apply/malgP=> k; rewrite fgaddE fgzeroE add0r. Qed. Lemma fgaddg0 : right_id fgzero fgadd. Proof. by move=> x; rewrite fgaddC fgadd0g. Qed. Lemma fgaddNg : left_inverse fgzero fgopp fgadd. Proof. by move=> x; apply/malgP=> k; rewrite !fgaddE fgzeroE fgoppE addNr. Qed. Lemma fgaddgN : right_inverse fgzero fgopp fgadd. Proof. by move=> x; rewrite fgaddC fgaddNg. Qed. HB.instance Definition _ := GRing.isZmodule.Build (malg K G) fgaddA fgaddC fgadd0g fgaddNg. HB.instance Definition _ := GRing.Zmodule.on {malg G[K]}. End MalgZMod. Section MAlgZModTheory. Context {K : choiceType} {G : zmodType}. Implicit Types (g : {malg G[K]}) (k : K) (x y : G). Local Notation mcoeff := (@mcoeff K G) (only parsing). Local Notation msupp := (@msupp K G). Local Notation mkmalgU := (@mkmalgU K G) (only parsing). Let fgE := (fgzeroE, fgoppE, fgaddE). (* -------------------------------------------------------------------- *) Lemma malgD_def g1 g2 : g1 + g2 = fgadd g1 g2. Proof. by []. Qed. (* -------------------------------------------------------------------- *) Lemma mcoeff_is_additive k: additive (mcoeff k). Proof. by move=> g1 g2 /=; rewrite fgaddE fgoppE. (* !fgE *) Qed. HB.instance Definition _ k := GRing.isAdditive.Build {malg G[K]} G (mcoeff k) (mcoeff_is_additive k). Lemma mcoeff0 k : 0@_k = 0 :> G . Proof. exact: raddf0. Qed. Lemma mcoeffN k : {morph mcoeff k: x / - x} . Proof. exact: raddfN. Qed. Lemma mcoeffD k : {morph mcoeff k: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mcoeffB k : {morph mcoeff k: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mcoeffMn k n : {morph mcoeff k: x / x *+ n} . Proof. exact: raddfMn. Qed. Lemma mcoeffMNn k n : {morph mcoeff k: x / x *- n} . Proof. exact: raddfMNn. Qed. Lemma mcoeffU k x k' : << x *g k >>@_k' = x *+ (k == k'). Proof. by rewrite mcoeff_fnd fnd_set fnd_fmap0; case: eqVneq. Qed. Lemma mcoeffUU k x : << x *g k >>@_k = x. Proof. by rewrite mcoeffU eqxx. Qed. Let mcoeffsE := (mcoeff0, mcoeffU, mcoeffB, mcoeffD, mcoeffN, mcoeffMn). (* -------------------------------------------------------------------- *) Lemma msupp0 : msupp 0 = fset0 :> {fset K}. Proof. apply/fsetP=> k; rewrite in_fset0; apply/negbTE. by rewrite -mcoeff_eq0 mcoeff0. Qed. Lemma msuppU k x : msupp << x *g k >> = if x == 0 then fset0 else [fset k]. Proof. apply/fsetP=> k'; rewrite -mcoeff_neq0 mcoeffU 2!fun_if !inE. by have [//|_] := eqVneq k k'; rewrite eqxx if_same. Qed. Lemma msuppU_le {k x} : msupp << x *g k >> `<=` [fset k]. Proof. by rewrite msuppU; case: eqP. Qed. Lemma msuppN g : msupp (-g) = msupp g. Proof. by apply/fsetP=> k; rewrite -!mcoeff_neq0 mcoeffN oppr_eq0. Qed. Lemma msuppD_le g1 g2 : msupp (g1 + g2) `<=` msupp g1 `|` msupp g2. Proof. apply/fsubsetP=> k; rewrite in_fsetU -mcoeff_neq0 mcoeffD. by case: (msuppP g1); case: (msuppP g2); rewrite //= addr0 eqxx. Qed. Lemma msuppB_le g1 g2 : msupp (g1 - g2) `<=` msupp g1 `|` msupp g2. Proof. by rewrite -[msupp g2]msuppN; apply/msuppD_le. Qed. Lemma msuppD g1 g2 : [disjoint msupp g1 & msupp g2] -> msupp (g1 + g2) = msupp g1 `|` msupp g2. Proof. move=> dj_g1g2; apply/fsetP=> k; move/fdisjointP/(_ k): dj_g1g2. rewrite in_fsetU -!mcoeff_neq0 mcoeffD negbK. have [->|] //= := eqVneq (g1@_k) 0; first by rewrite add0r. by move=> + /(_ isT) /eqP ->; rewrite addr0. Qed. Lemma msuppB g1 g2 : [disjoint msupp g1 & msupp g2] -> msupp (g1 - g2) = msupp g1 `|` msupp g2. Proof. by move=> dj_g1g2; rewrite msuppD msuppN. Qed. Lemma msuppMn_le g n : msupp (g *+ n) `<=` msupp g. Proof. apply/fsubsetP=> k; rewrite -!mcoeff_neq0 mcoeffMn. by apply/contra_neq => ->; rewrite mul0rn. Qed. Lemma msuppMNm_le g n : msupp (g *- n) `<=` msupp g. Proof. by rewrite msuppN msuppMn_le. Qed. (* -------------------------------------------------------------------- *) Lemma monalgU_is_additive k : additive (mkmalgU k). Proof. by move=> x1 x2 /=; apply/malgP=> k'; rewrite !mcoeffsE mulrnBl. Qed. HB.instance Definition _ k := GRing.isAdditive.Build G {malg G[K]} (mkmalgU k) (monalgU_is_additive k). Lemma monalgU0 k : << (0 : G) *g k >> = 0 . Proof. exact: raddf0. Qed. Lemma monalgUN k : {morph mkmalgU k: x / - x} . Proof. exact: raddfN. Qed. Lemma monalgUD k : {morph mkmalgU k: x y / x + y}. Proof. exact: raddfD. Qed. Lemma monalgUB k : {morph mkmalgU k: x y / x - y}. Proof. exact: raddfB. Qed. Lemma monalgUMn k n : {morph mkmalgU k: x / x *+ n} . Proof. exact: raddfMn. Qed. Lemma monalgUMNn k n : {morph mkmalgU k: x / x *- n} . Proof. exact: raddfMNn. Qed. Lemma monalgU_eq0 x k: (<< x *g k >> == 0) = (x == 0). Proof. apply/eqP/eqP => [/(congr1 (mcoeff k))|->]; last by rewrite monalgU0. by rewrite !mcoeffsE eqxx. Qed. Definition monalgUE := (monalgU0, monalgUB, monalgUD, monalgUN, monalgUMn). (* -------------------------------------------------------------------- *) Lemma monalgEw (g : {malg G[K]}) (domg : {fset K}) : msupp g `<=` domg -> g = \sum_(k <- domg) << g@_k *g k >>. Proof. move/fsubsetP=> le_gd; apply/malgP=> k; have [/le_gd kg|k_notin_g] := msuppP. rewrite raddf_sum (big_fsetD1 k) //= mcoeffUU big1_fset ?addr0 // => k'. by rewrite in_fsetD1 mcoeffU; case: eqP. rewrite raddf_sum /= big1_fset // => k' _ _. by rewrite mcoeffU; case: eqP k_notin_g => // <- /mcoeff_outdom ->. Qed. Lemma monalgE (g : {malg G[K]}) : g = \sum_(k <- msupp g) << g@_k *g k >>. Proof. exact/monalgEw. Qed. End MAlgZModTheory. (* -------------------------------------------------------------------- *) Section MalgMonomTheory. Context {K : monomType} {G : zmodType}. (* -------------------------------------------------------------------- *) Lemma msuppC (c : G) : msupp c%:MP = (if c == 0 then fset0 else [fset 1%M]) :> {fset K}. Proof. exact/msuppU. Qed. Lemma msuppC_le (c : G) : msupp c%:MP `<=` ([fset 1%M] : {fset K}). Proof. by rewrite msuppC; case: eqP=> _; rewrite ?fsubset_refl // fsub0set. Qed. Lemma mcoeffC (c : G) k : c%:MP@_k = c *+ (k == 1%M :> K). Proof. by rewrite mcoeffU eq_sym. Qed. Lemma mcoeffC0 (k : K) : 0%:MP@_k = 0 :> G. Proof. by rewrite mcoeffC mul0rn. Qed. Lemma msuppC0 : msupp (0 : G)%:MP = fset0 :> {fset K}. Proof. by rewrite msuppC eqxx. Qed. Lemma malgC0E : 0%:MP = 0 :> {malg G[K]}. Proof. by apply/malgP=> k; rewrite mcoeffC0 mcoeff0. Qed. Lemma malgCK : cancel malgC (@mcoeff K G 1%M). Proof. by move=> c; rewrite mcoeffC eqxx mulr1n. Qed. Lemma malgC_eq (c1 c2 : G) : (c1%:MP == c2%:MP :> {malg G[K]}) = (c1 == c2). Proof. by apply/eqP/eqP=> [|->//] /malgP/(_ 1%M); rewrite !mcoeffU eqxx. Qed. Lemma msupp_eq0 (g : {malg G[K]}) : (msupp g == fset0) = (g == 0). Proof. apply/eqP/eqP=> [/fsetP z_g|->]; last exact: msupp0. by apply/malgP=> i; rewrite mcoeff0 mcoeff_outdom // z_g. Qed. End MalgMonomTheory. (* -------------------------------------------------------------------- *) Section MAlgLMod. Context (K : choiceType) (R : ringType). Definition fgscale c g : {malg R[K]} := \sum_(k <- msupp g) << c * g@_k *g k >>. Local Notation "c *:g g" := (fgscale c g) (at level 40, left associativity). Lemma fgscaleE c g k : (c *:g g)@_k = c * g@_k. Proof. rewrite {2}[g]monalgE !raddf_sum mulr_sumr. by apply/eq_bigr=> /= i _; rewrite !mcoeffU mulrnAr. Qed. Lemma fgscaleA c1 c2 g : c1 *:g (c2 *:g g) = (c1 * c2) *:g g. Proof. by apply/malgP=> x; rewrite !fgscaleE mulrA. Qed. Lemma fgscale1r D: 1 *:g D = D. Proof. by apply/malgP=> k; rewrite !fgscaleE mul1r. Qed. Lemma fgscaleDr c g1 g2 : c *:g (g1 + g2) = c *:g g1 + c *:g g2. Proof. by apply/malgP=> k; rewrite !(mcoeffD, fgscaleE) mulrDr. Qed. Lemma fgscaleDl g c1 c2: (c1 + c2) *:g g = c1 *:g g + c2 *:g g. Proof. by apply/malgP=> x; rewrite !(mcoeffD, fgscaleE) mulrDl. Qed. HB.instance Definition _ := GRing.Zmodule_isLmodule.Build R (malg K R) fgscaleA fgscale1r fgscaleDr fgscaleDl. HB.instance Definition _ := GRing.Lmodule.on {malg R[K]}. End MAlgLMod. (* -------------------------------------------------------------------- *) Section MAlgLModTheory. Context {K : choiceType} {R : ringType}. Implicit Types (g : {malg R[K]}). Lemma malgZ_def c g : c *: g = fgscale c g. Proof. by []. Qed. (* -------------------------------------------------------------------- *) Lemma mcoeffZ c g k : (c *: g)@_k = c * g@_k. Proof. exact/fgscaleE. Qed. (* FIXME: make the production of a LRMorphism fail below *) (* HB.instance Definition _ m := *) (* GRing.isLinear.Build R [lmodType R of {malg R[K]}] R *%R (mcoeff m) *) (* (fun c g => mcoeffZ c g m). *) (* -------------------------------------------------------------------- *) Lemma msuppZ_le c g : msupp (c *: g) `<=` msupp g. Proof. apply/fsubsetP=> k; rewrite -!mcoeff_neq0 mcoeffZ. by apply/contraTneq=> ->; rewrite mulr0 negbK. Qed. End MAlgLModTheory. (* -------------------------------------------------------------------- *) Section MAlgLModTheoryIntegralDomain. Context {K : choiceType} {R : idomainType}. Implicit Types (g : {malg R[K]}). (* -------------------------------------------------------------------- *) Lemma msuppZ c g : msupp (c *: g) = if c == 0 then fset0 else msupp g. Proof. case: eqP=> [->|/eqP nz_c]; first by rewrite scale0r msupp0. by apply/fsetP=> k; rewrite -!mcoeff_neq0 mcoeffZ mulf_eq0 negb_or nz_c. Qed. End MAlgLModTheoryIntegralDomain. (* -------------------------------------------------------------------- *) Definition mcoeffsE := (@mcoeff0, @mcoeffUU, @mcoeffU, @mcoeffB, @mcoeffD, @mcoeffN, @mcoeffMn, @mcoeffZ). (* -------------------------------------------------------------------- *) Section MAlgRingType. Context (K : monomType) (R : ringType). Implicit Types (g : {malg R[K]}) (k l : K). Definition fgone : {malg R[K]} := << 1%M >>. Local Notation "g1 *M_[ k1 , k2 ] g2" := << g1@_k1%M * g2@_k2%M *g (k1 * k2)%M >> (at level 40, no associativity, format "g1 *M_[ k1 , k2 ] g2"). Local Notation "g1 *gM_[ k2 ] g2" := (\sum_(k1 <- msupp g1) g1 *M_[k1, k2] g2) (at level 40, no associativity, only parsing). Local Notation "g1 *Mg_[ k1 ] g2" := (\sum_(k2 <- msupp g2) g1 *M_[k1, k2] g2) (at level 40, no associativity, only parsing). Definition fgmul g1 g2 : {malg R[K]} := \sum_(k1 <- msupp g1) \sum_(k2 <- msupp g2) g1 *M_[k1, k2] g2. Lemma fgmull g1 g2 : fgmul g1 g2 = \sum_(k1 <- msupp g1) \sum_(k2 <- msupp g2) g1 *M_[k1, k2] g2. Proof. by []. Qed. Lemma fgmulr g1 g2 : fgmul g1 g2 = \sum_(k2 <- msupp g2) \sum_(k1 <- msupp g1) g1 *M_[k1, k2] g2. Proof. by rewrite fgmull exchange_big. Qed. (* big_fset_incl has (op : com_law idx) as first non automatic argument *) Lemma fgmullw (d1 d2 : {fset K}) g1 g2 : msupp g1 `<=` d1 -> msupp g2 `<=` d2 -> fgmul g1 g2 = \sum_(k1 <- d1) \sum_(k2 <- d2) g1 *M_[k1, k2] g2. Proof. move=> le_d1 le_d2; rewrite fgmull (big_fset_incl _ le_d1) /=. apply/eq_bigr=> k1 _; apply/big_fset_incl => // k _ /mcoeff_outdom ->. by rewrite mulr0 monalgU0. move=> k _ /mcoeff_outdom g1k. by rewrite big1 => // k' _; rewrite g1k mul0r monalgU0. Qed. Lemma fgmulrw (d1 d2 : {fset K}) g1 g2 : msupp g1 `<=` d1 -> msupp g2 `<=` d2 -> fgmul g1 g2 = \sum_(k2 <- d2) \sum_(k1 <- d1) g1 *M_[k1, k2] g2. Proof. by move=> le_d1 le_d2; rewrite (fgmullw le_d1 le_d2) exchange_big. Qed. Definition fgmullwl (d1 : {fset K}) {g1 g2} (le : msupp g1 `<=` d1) := @fgmullw _ _ g1 g2 le (fsubset_refl _). Definition fgmulrwl (d2 : {fset K}) {g1 g2} (le : msupp g2 `<=` d2) := @fgmulrw _ _ g1 g2 (fsubset_refl _) le. Lemma fgmul0g : left_zero 0 fgmul. Proof. by move=> g; rewrite fgmull msupp0 big_seq_fset0. Qed. Lemma fgmulg0 : right_zero 0 fgmul. Proof. by move=> g; rewrite fgmulr msupp0 big_seq_fset0. Qed. Lemma fgmulUg c k g : fgmul << c *g k >> g = \sum_(k' <- msupp g) << c * g@_k' *g k * k' >>. Proof. rewrite (fgmullw msuppU_le (fsubset_refl _)) big_seq_fset1. by apply/eq_bigr => k' _; rewrite mcoeffUU. Qed. Lemma fgmulgU c k g : fgmul g << c *g k >> = \sum_(k' <- msupp g) << g@_k' * c *g k' * k >>. Proof. rewrite (fgmulrw (fsubset_refl _) msuppU_le) big_seq_fset1. by apply/eq_bigr=> k' _; rewrite mcoeffUU. Qed. Lemma fgmulUU c1 c2 k1 k2 : fgmul << c1 *g k1 >> << c2 *g k2 >> = << c1 * c2 *g k1 * k2 >>. Proof. by rewrite (fgmulrw msuppU_le msuppU_le) !big_seq_fset1 !mcoeffUU. Qed. Lemma fgmulEl1 g1 g2 : fgmul g1 g2 = \sum_(k1 <- msupp g1) fgmul << g1@_k1 *g k1 >> g2. Proof. by apply/eq_bigr=> k _; rewrite fgmulUg. Qed. Lemma fgmulEr1 g1 g2 : fgmul g1 g2 = \sum_(k2 <- msupp g2) fgmul g1 << g2@_k2 *g k2 >>. Proof. by rewrite fgmulr; apply/eq_bigr=> k _; rewrite fgmulgU. Qed. Lemma fgmul1g : left_id fgone fgmul. Proof. move=> g; rewrite fgmulUg [RHS]monalgE. by apply/eq_bigr=> kg _; rewrite mul1r mul1m. Qed. Lemma fgmulg1 : right_id fgone fgmul. Proof. move=> g; rewrite fgmulgU [RHS]monalgE. by apply/eq_bigr=> k _; rewrite mulr1 mulm1. Qed. Lemma fgmulgDl : left_distributive fgmul +%R. Proof. move=> g1 g2 g; rewrite [in RHS](fgmullwl (fsubsetUl _ (msupp g2))). rewrite [in RHS](fgmullwl (fsubsetUr (msupp g1) _)) (fgmullwl (msuppD_le _ _)). rewrite -big_split /=; apply/eq_bigr=> k1 _. rewrite -big_split /=; apply/eq_bigr=> k2 _. by rewrite mcoeffD mulrDl monalgUD. Qed. Lemma fgmulgDr : right_distributive fgmul +%R. Proof. move=> g g1 g2; rewrite [in RHS](fgmulrwl (fsubsetUl _ (msupp g2))). rewrite [in RHS](fgmulrwl (fsubsetUr (msupp g1) _)) (fgmulrwl (msuppD_le _ _)). rewrite -big_split /=; apply/eq_bigr => k1 _. rewrite -big_split /=; apply/eq_bigr => k2 _. by rewrite mcoeffD mulrDr monalgUD. Qed. Lemma fgmulA : associative fgmul. Proof. move=> g1 g2 g3. rewrite [RHS](big_morph (fgmul^~ _) (fun _ _ => fgmulgDl _ _ _) (fgmul0g _)). rewrite fgmulEl1; apply/eq_bigr=> k1 _. rewrite [LHS](big_morph (fgmul _) (fun _ _ => fgmulgDr _ _ _) (fgmulg0 _)). rewrite [RHS](big_morph (fgmul^~ _) (fun _ _ => fgmulgDl _ _ _) (fgmul0g _)). apply/eq_bigr=> k2 _. rewrite [LHS](big_morph (fgmul _) (fun _ _ => fgmulgDr _ _ _) (fgmulg0 _)). by rewrite fgmulEr1; apply/eq_bigr=> k3 _; rewrite !fgmulUU mulrA mulmA. Qed. Lemma fgoner_eq0 : fgone != 0. Proof. by apply/eqP/malgP=> /(_ 1%M) /eqP; rewrite !mcoeffsE oner_eq0. Qed. HB.instance Definition _ := GRing.Zmodule_isRing.Build (malg K R) fgmulA fgmul1g fgmulg1 fgmulgDl fgmulgDr fgoner_eq0. HB.instance Definition _ := GRing.Ring.on {malg R[K]}. End MAlgRingType. (* -------------------------------------------------------------------- *) Section MAlgRingTheory. Context (K : monomType) (R : ringType). Implicit Types (g : {malg R[K]}) (k l : K). Lemma malgM_def g1 g2 : g1 * g2 = fgmul g1 g2. Proof. by []. Qed. Lemma mcoeffU1 k k' : (<< k >> : {malg R[K]})@_k' = (k == k')%:R. Proof. by rewrite mcoeffU. Qed. Lemma msuppU1 k : @msupp _ R << k >> = [fset k]. Proof. by rewrite msuppU oner_eq0. Qed. Lemma malgME g1 g2 : g1 * g2 = \sum_(k1 <- msupp g1) \sum_(k2 <- msupp g2) << g1@_k1 * g2@_k2 *g k1 * k2 >>. Proof. by []. Qed. Lemma malgMEw (d1 d2 : {fset K}) g1 g2 : msupp g1 `<=` d1 -> msupp g2 `<=` d2 -> g1 * g2 = \sum_(k1 <- d1) \sum_(k2 <- d2) << g1@_k1 * g2@_k2 *g k1 * k2 >>. Proof. exact/fgmullw. Qed. Lemma mcoeffMlw (d1 d2 : {fset K}) g1 g2 k : msupp g1 `<=` d1 -> msupp g2 `<=` d2 -> (g1 * g2)@_k = \sum_(k1 <- d1) \sum_(k2 <- d2) (g1@_k1 * g2@_k2) *+ (k1 * k2 == k)%M. Proof. move=> le1 le2; rewrite (malgMEw le1 le2) raddf_sum /=. apply/eq_bigr=> k1 _; rewrite raddf_sum /=; apply/eq_bigr=> k2 _. by rewrite mcoeffsE. Qed. Lemma mcoeffMrw (d1 d2 : {fset K}) g1 g2 k : msupp g1 `<=` d1 -> msupp g2 `<=` d2 -> (g1 * g2)@_k = \sum_(k2 <- d2) \sum_(k1 <- d1) (g1@_k1 * g2@_k2) *+ (k1 * k2 == k)%M. Proof. by move=> le1 le2; rewrite (mcoeffMlw _ le1 le2) exchange_big. Qed. Lemma mcoeffMl g1 g2 k : (g1 * g2)@_k = \sum_(k1 <- msupp g1) \sum_(k2 <- msupp g2) (g1@_k1 * g2@_k2) *+ (k1 * k2 == k)%M. Proof. exact: mcoeffMlw. Qed. Lemma mcoeffMr g1 g2 k : (g1 * g2)@_k = \sum_(k2 <- msupp g2) \sum_(k1 <- msupp g1) (g1@_k1 * g2@_k2) *+ (k1 * k2 == k)%M. Proof. exact: mcoeffMrw. Qed. Lemma mcoeff1 k : 1@_k = (k == 1%M)%:R :> R. Proof. by rewrite mcoeffC. Qed. Lemma mul_malgC c g : c%:MP * g = c *: g. Proof. by rewrite malgM_def malgZ_def fgmulUg; apply/eq_bigr=> /= k _; rewrite mul1m. Qed. Lemma mcoeffCM c g k : (c%:MP * g)@_k = c * g@_k :> R. Proof. by rewrite mul_malgC mcoeffZ. Qed. Lemma msuppM_le_finType g1 g2 k : k \in msupp (g1 * g2) -> exists (k1 : msupp g1) (k2 : msupp g2), k = (val k1 * val k2)%M. Proof. move=> k_in_g1Mg2; apply/(existsPP (fun _ => exists_eqP)). apply/contraLR: k_in_g1Mg2=> hk; rewrite -mcoeff_eq0. rewrite mcoeffMl big_seq big1 // => /= k1 Hk1. rewrite big_seq big1 // => k2 Hk2. case: eqP=> // kE; case/negP: hk. by apply/existsP; exists [` Hk1]; apply/existsP; exists [` Hk2]; rewrite kE. Qed. Lemma msuppM_le g1 g2 k : k \in msupp (g1 * g2) -> exists k1 k2, [/\ k1 \in msupp g1, k2 \in msupp g2 & k = (k1 * k2)%M]. Proof. move/msuppM_le_finType => [] [k1 Hk1] [] [k2 Hk2] /= Hk. by exists k1; exists k2. Qed. (* Alternative equivalent statement *) Lemma msuppM_incl g1 g2 : msupp (g1 * g2) `<=` [fset (k1 * k2)%M | k1 in msupp g1, k2 in msupp g2]. Proof. apply/fsubsetP => k /msuppM_le [k1 [k2 [k1g1 k2g2 ->]]]. by apply/imfset2P; exists k1; last exists k2. Qed. Lemma malgC_is_multiplicative : multiplicative (@malgC K R). Proof. by split=> // g1 g2; apply/malgP=> k; rewrite mcoeffCM !mcoeffC mulrnAr. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build R {malg R[K]} (@malgC K R) malgC_is_multiplicative. Lemma mpolyC1E : 1%:MP = 1 :> {malg R[K]}. Proof. exact: rmorph1. Qed. Lemma mpolyC_nat (n : nat) : (n%:R)%:MP = n%:R :> {malg R[K]}. Proof. by apply/malgP=> i; rewrite mcoeffC mcoeffMn mcoeffC mulrnAC. Qed. Lemma mpolyCM : {morph @malgC K R : p q / p * q}. Proof. exact: rmorphM. Qed. Lemma mcoeff1g_is_multiplicative : multiplicative (mcoeff 1%M : {malg R[K]} -> R). Proof. split=> [g1 g2|]; rewrite ?malgCK //; pose_big_fset K E. have E1: 1%M \in E by rewrite -fsub1set. rewrite (@malgMEw E E) // (big_fsetD1 1%M) //=. 2: by close. rewrite (big_fsetD1 1%M) //= mulm1 2!mcoeffD mcoeffUU. rewrite ![\sum_(i <- E `\ 1%M) _]big_seq. rewrite !raddf_sum !big1 ?addr0 //= => k; rewrite in_fsetD1 => /andP [ne1_k _]. rewrite raddf_sum big1 ?mcoeff0 //= => k'; rewrite mcoeffU. by case: eqP=> // /eqP /unitmP []; rewrite (negbTE ne1_k). by rewrite mcoeffU mul1m (negbTE ne1_k). Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {malg R[K]} R (@mcoeff K R 1%M) mcoeff1g_is_multiplicative. (* FIXME: building Linear instance here so as to not trigger the creation of a LRMorphism that fails on above command (but is built just below anyway) *) HB.instance Definition _ m := GRing.isScalable.Build R {malg R[K]} R *%R (mcoeff m) (fun c => (mcoeffZ c)^~ m). Lemma fgscaleAl c g1 g2 : c *: (g1 * g2) = (c *: g1) * g2. Proof. by rewrite -!mul_malgC mulrA. Qed. HB.instance Definition _ := GRing.Lmodule_isLalgebra.Build R (malg K R) fgscaleAl. HB.instance Definition _ := GRing.Lalgebra.on {malg R[K]}. End MAlgRingTheory. (* -------------------------------------------------------------------- *) Section MalgComRingType. Context (K : conomType) (R : comRingType). Lemma fgmulC : @commutative {malg R[K]} _ *%R. Proof. move=> g1 g2; apply/malgP=> k; rewrite mcoeffMl mcoeffMr. apply/eq_bigr=> /= k1 _; apply/eq_bigr=> /= k2 _. by rewrite mulrC [X in X==k]mulmC. Qed. HB.instance Definition _ := GRing.Ring_hasCommutativeMul.Build (malg K R) fgmulC. HB.instance Definition _ := GRing.Lalgebra_isComAlgebra.Build R (malg K R). HB.instance Definition _ := GRing.ComAlgebra.on {malg R[K]}. End MalgComRingType. (* -------------------------------------------------------------------- *) Section MalgMorphism. Section Defs. Context (K : choiceType) (G : zmodType) (S : ringType). Context (f : G -> S) (h : K -> S). Definition mmap g := \sum_(k <- msupp g) f g@_k * h k. Lemma mmapE g : mmap g = \sum_(k <- msupp g) f g@_k * h k. Proof. by []. Qed. End Defs. Local Notation "g ^[ f , h ]" := (mmap f h g). Section BaseTheory. Context (K : choiceType) (G : zmodType) (S : ringType). Context {f : {additive G -> S}} {h : K -> S}. Lemma mmapEw (d : {fset K}) g : msupp g `<=` d -> g^[f, h] = \sum_(k <- d) f g@_k * h k. Proof. move=> le; rewrite [LHS](big_fset_incl _ le) => //= x xd /mcoeff_outdom ->. by rewrite raddf0 mul0r. Qed. Lemma mmapU (c : G) (m : K) : mmap f h << c *g m >> = f c * h m. Proof. by rewrite (mmapEw msuppU_le) big_seq_fset1 mcoeffUU. Qed. End BaseTheory. Section Additive. Context (K : choiceType) (G : zmodType) (S : ringType). Context {f : {additive G -> S}} {h : K -> S}. Lemma mmap_is_additive : additive (mmap f h). Proof. move=> g1 g2 /=; pose_big_fset K E; rewrite 3?(mmapEw (d := E)) //. by rewrite -sumrB; apply/eq_bigr=> k _; rewrite !raddfB /= mulrBl. by close. Qed. HB.instance Definition _ := GRing.isAdditive.Build {malg G[K]} S (mmap f h) mmap_is_additive. Local Notation mmap := (mmap f h). Lemma mmap0 : mmap 0 = 0 . Proof. exact: raddf0. Qed. Lemma mmapN : {morph mmap: x / - x} . Proof. exact: raddfN. Qed. Lemma mmapD : {morph mmap: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mmapB : {morph mmap: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mmapMn n : {morph mmap: x / x *+ n} . Proof. exact: raddfMn. Qed. Lemma mmapMNn n : {morph mmap: x / x *- n} . Proof. exact: raddfMNn. Qed. End Additive. Section CommrMultiplicative. Context (K : monomType) (R : ringType) (S : ringType). Context {f : {rmorphism R -> S}} {h : {mmorphism K -> S}}. Implicit Types (g : {malg R[K]}). Lemma mmapZ c g : (c *: g)^[f,h] = f c * g^[f,h]. Proof. rewrite (mmapEw (msuppZ_le _ _)) mmapE big_distrr /=. by apply/eq_bigr=> k _; rewrite linearZ rmorphM /= mulrA. Qed. Lemma mmapC c : c%:MP^[f,h] = f c. Proof. by rewrite mmapU mmorph1 mulr1. Qed. Lemma mmap1 : 1^[f,h] = 1. Proof. by rewrite mmapC rmorph1. Qed. Hypothesis commr_f: forall g m m', GRing.comm (f g@_m) (h m'). Lemma commr_mmap_is_multiplicative: multiplicative (mmap f h). Proof. split => [g1 g2|]; last by rewrite mmap1. rewrite malgME raddf_sum mulr_suml /=; apply: eq_bigr=> i _. rewrite raddf_sum mulr_sumr /=; apply: eq_bigr=> j _. by rewrite mmapU /= rmorphM mmorphM -mulrA [X in _*X=_]mulrA commr_f !mulrA. Qed. End CommrMultiplicative. (* -------------------------------------------------------------------- *) Section Multiplicative. Context (K : monomType) (R : ringType) (S : comRingType). Context {f : {rmorphism R -> S}} {h : {mmorphism K -> S}}. Implicit Types (g : {malg R[K]}). Lemma mmap_is_multiplicative : multiplicative (mmap f h). Proof. by apply/commr_mmap_is_multiplicative=> g m m'; apply/mulrC. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {malg R[K]} S (mmap f h) mmap_is_multiplicative. End Multiplicative. (* -------------------------------------------------------------------- *) Section Linear. Context (K : monomType) (R : comRingType) {h : {mmorphism K -> R}}. Lemma mmap_is_linear : scalable_for *%R (mmap idfun h). Proof. by move=> /= c g; rewrite -mul_malgC rmorphM /= mmapC. Qed. HB.instance Definition _ := GRing.isScalable.Build R {malg R[K]} R *%R (mmap idfun h) mmap_is_linear. End Linear. End MalgMorphism. (* -------------------------------------------------------------------- *) Section MonalgOver. Section Def. Context {K : choiceType} {G : zmodType}. Definition monalgOver_pred (S : {pred G}) := fun g : {malg G[K]} => all (fun m => g@_m \in S) (msupp g). Definition monalgOver (S : {pred G}) := [qualify a g| monalgOver_pred S g]. End Def. Arguments monalgOver_pred _ _ _ _ /. (* -------------------------------------------------------------------- *) Section Theory. Context (K : choiceType) (G : zmodType). Local Notation monalgOver := (@monalgOver K G). Lemma monalgOverS (S1 S2 : {pred G}) : {subset S1 <= S2} -> {subset monalgOver S1 <= monalgOver S2}. Proof. move=> le_S1S2 g /allP /= S1g; apply/allP => /= x Hx. exact/le_S1S2/S1g. Qed. Lemma monalgOverU c k S : << c *g k >> \in monalgOver S = (c == 0) || (c \in S). Proof. rewrite qualifE /= msuppU; have [->|nz_c] //= := eqVneq c 0. apply/allP/idP => [h|h x]; last by rewrite in_fset1=> /eqP->; rewrite mcoeffUU. by move: (h k); rewrite mcoeffUU in_fset1 eqxx; apply. Qed. Lemma monalgOver0 S: 0 \is a monalgOver S. Proof. by rewrite qualifE /= msupp0; apply/allP. Qed. End Theory. (* -------------------------------------------------------------------- *) Section MonalgOverAdd. Context (K : choiceType) (G : zmodType) (S : addrClosed G). Implicit Types (g : {malg G[K]}). Local Notation monalgOver := (@monalgOver K G). Lemma monalgOverP {g} : reflect (forall m, g@_m \in S) (g \in monalgOver S). Proof. apply: (iffP allP)=> /= h k; last by rewrite h. by case: msuppP=> [kg|]; rewrite ?rpred0 // (h k). Qed. Lemma monalgOver_addr_closed : addr_closed (monalgOver S). Proof. split=> [|g1 g2 Sg1 Sg2]; rewrite ?monalgOver0 //. by apply/monalgOverP=> m; rewrite mcoeffD rpredD ?(monalgOverP _). Qed. HB.instance Definition _ := GRing.isAddClosed.Build _ (monalgOver_pred S) monalgOver_addr_closed. End MonalgOverAdd. (* -------------------------------------------------------------------- *) Section MonalgOverOpp. Context (K : choiceType) (G : zmodType) (zmodS : zmodClosed G). Local Notation monalgOver := (@monalgOver K G). Lemma monalgOver_oppr_closed : oppr_closed (monalgOver zmodS). Proof. move=> g Sg; apply/monalgOverP=> n; rewrite mcoeffN. by rewrite rpredN; apply/(monalgOverP zmodS). Qed. HB.instance Definition _ := GRing.isOppClosed.Build _ (monalgOver_pred zmodS) monalgOver_oppr_closed. End MonalgOverOpp. (* -------------------------------------------------------------------- *) Section MonalgOverSemiring. Context (K : monomType) (R : ringType) (S : semiringClosed R). Local Notation monalgOver := (@monalgOver K R). Lemma monalgOverC c : (c%:MP \in monalgOver S) = (c \in S). Proof. by rewrite monalgOverU; case: eqP=> // ->; rewrite rpred0. Qed. Lemma monalgOver1 : 1 \in monalgOver S. Proof. by rewrite monalgOverC rpred1. Qed. Lemma monalgOver_mulr_closed : mulr_closed (monalgOver S). Proof. split=> [|g1 g2 /monalgOverP Sg1 /monalgOverP sS2]. by rewrite monalgOver1. apply/monalgOverP=> m; rewrite mcoeffMl rpred_sum //=. move=> k1 _; rewrite rpred_sum // => k2 _. by case: eqP; rewrite ?mulr0n (rpred0, rpredM). Qed. HB.instance Definition _ := GRing.isMulClosed.Build _ (monalgOver_pred S) monalgOver_mulr_closed. Lemma monalgOverZ : {in S & monalgOver S, forall c g, c *: g \is a monalgOver S}. Proof. move=> c g Sc Sg; apply/monalgOverP=> k. by rewrite mcoeffZ rpredM //; apply/(monalgOverP S). Qed. Lemma rpred_meval : {in monalgOver S, forall g (v : K -> R), (forall x, v x \in S) -> mmap idfun v g \in S}. Proof. move=> g /monalgOverP Sg v Sv; rewrite mmapE rpred_sum //. by move=> /= k; rewrite rpredM. Qed. End MonalgOverSemiring. Section MonalgOverRing. Context (K : monomType) (R : ringType) (ringS : subringClosed R). HB.instance Definition _ := GRing.isMulClosed.Build _ (monalgOver_pred ringS) (monalgOver_mulr_closed K ringS). End MonalgOverRing. End MonalgOver. Arguments monalgOver_pred _ _ _ _ /. (* -------------------------------------------------------------------- *) HB.mixin Record isMeasure (M : monomType) (mf : M -> nat) := { mf0 : mf 1%M = 0%N; mfM : {morph mf : m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N}; mf_eq0I : forall m, mf m = 0%N -> m = 1%M }. #[short(type="measure")] HB.structure Definition Measure (M : monomType) := {mf of isMeasure M mf}. Notation "[ 'measure' 'of' f ]" := (Measure.clone _ f _) (at level 0, only parsing) : form_scope. (* -------------------------------------------------------------------- *) Section MMeasure. Context (M : monomType) (G : zmodType) (mf : measure M). Implicit Types (g : {malg G[M]}). Lemma mf_eq0 m : (mf m == 0%N) = (m == 1%M). Proof. by apply/eqP/eqP=> [|->]; rewrite ?mf0 // => /mf_eq0I. Qed. Definition mmeasure g := (\max_(m <- msupp g) (mf m).+1)%N. Lemma mmeasureE g : mmeasure g = (\max_(m <- msupp g) (mf m).+1)%N. Proof. by []. Qed. Lemma mmeasure0 : mmeasure 0 = 0%N. Proof. by rewrite mmeasureE msupp0 big_seq_fset0. Qed. Lemma mmeasure_mnm_lt g m : m \in msupp g -> (mf m < mmeasure g)%N. Proof. move=> km; rewrite mmeasureE (big_fsetD1 m) //=. by rewrite leq_max ltnS leqnn. Qed. Lemma mmeasure_mnm_ge g m : (mmeasure g <= mf m)%N -> m \notin msupp g. Proof. by apply/contraTN=> /mmeasure_mnm_lt; rewrite leqNgt ltnS. Qed. Lemma mmeasureC c : mmeasure c%:MP = (c != 0%R) :> nat. Proof. rewrite mmeasureE msuppC; case: (_ == 0)=> /=. by rewrite big_nil. by rewrite big_seq_fset1 mf0. Qed. Lemma mmeasureN g : mmeasure (-g) = mmeasure g. Proof. by rewrite mmeasureE msuppN. Qed. Lemma mmeasureD_le g1 g2 : (mmeasure (g1 + g2) <= maxn (mmeasure g1) (mmeasure g2))%N. Proof. rewrite {1}mmeasureE big_seq_fsetE /=. (* Going briefly through finType as lemmas about max apply only to them *) apply/bigmax_leqP=> [[i ki]] _ /=. have /fsubsetP /(_ i ki) := (msuppD_le g1 g2); rewrite in_fsetU. by rewrite leq_max; case/orP=> /mmeasure_mnm_lt->; rewrite ?orbT. Qed. Lemma mmeasure_sum (T : Type) (r : seq _) (F : T -> {malg G[M]}) (P : pred T) : (mmeasure (\sum_(i <- r | P i) F i) <= \max_(i <- r | P i) mmeasure (F i))%N. Proof. elim/big_rec2: _ => /= [|i k p _ le]; first by rewrite mmeasure0. apply: leq_trans (mmeasureD_le _ _) _; rewrite geq_max. by rewrite leq_maxl /= leq_max le orbC. Qed. Lemma mmeasure_eq0 g : (mmeasure g == 0%N) = (g == 0). Proof. apply/idP/eqP=> [z_g|->]; last by rewrite mmeasure0. apply/malgP=> k; rewrite mcoeff0; apply/contraTeq: z_g. rewrite mcoeff_neq0 => kg; rewrite mmeasureE. by rewrite (big_fsetD1 k) //= -lt0n leq_max. Qed. Lemma malgSpred g : g != 0 -> mmeasure g = (mmeasure g).-1.+1. Proof. by rewrite -mmeasure_eq0 -lt0n => /prednK. Qed. Lemma mmeasure_msupp0 g : (mmeasure g == 0%N) = (msupp g == fset0). Proof. by rewrite mmeasure_eq0 msupp_eq0. Qed. End MMeasure. (* -------------------------------------------------------------------- *) Section CmonomDef. Context (I : choiceType). Record cmonom : predArgType := CMonom { cmonom_val : {fsfun of _ : I => 0%N} }. Coercion cmonom_val : cmonom >-> fsfun. Fact cmonom_key : unit. Proof. by []. Qed. Definition cmonom_of_fsfun k := locked_with k CMonom. Canonical cmonom_unlockable k := [unlockable fun cmonom_of_fsfun k]. End CmonomDef. Notation "{ 'cmonom' I }" := (cmonom I) : type_scope. Notation "''X_{1..' n '}'" := (cmonom 'I_n) : type_scope. Notation "{ 'mpoly' R [ n ] }" := {malg R['X_{1..n}]} : type_scope. Notation mkcmonom := (cmonom_of_fsfun cmonom_key). Notation "[ 'cmonom' E | i 'in' P ]" := (mkcmonom [fsfun i in P%fset => E%N | 0%N]) : monom_scope. Notation "[ 'cmonom' E | i : P ]" := (mkcmonom [fsfun i : P%fset => E%N | 0%N]) : monom_scope. (* -------------------------------------------------------------------- *) Section CmonomCanonicals. Context (I : choiceType). HB.instance Definition _ := [isNew for @cmonom_val I]. HB.instance Definition _ := [Choice of cmonom I by <:]. (* -------------------------------------------------------------------- *) Implicit Types (m : cmonom I). Lemma cmE (f : {fsfun of _ : I => 0%N}) : mkcmonom f =1 CMonom f. Proof. by rewrite unlock. Qed. Lemma cmP m1 m2 : reflect (forall i, m1 i = m2 i) (m1 == m2). Proof. by apply: (iffP eqP) => [->//|eq]; apply/val_inj/fsfunP. Qed. Definition onecm : cmonom I := mkcmonom [fsfun of _ => 0%N]. Definition ucm (i : I) : cmonom I := [cmonom 1 | _ in fset1 i]%M. Definition mulcm m1 m2 : cmonom I := [cmonom m1 i + m2 i | i in finsupp m1 `|` finsupp m2]%M. Definition divcm m1 m2 : cmonom I := [cmonom m1 i - m2 i | i in finsupp m1]%M. Definition expcmn m n : cmonom I := iterop n mulcm m onecm. Lemma onecmE i : onecm i = 0%N. Proof. by rewrite cmE fsfun_ffun insubF. Qed. Lemma ucmE i j : ucm i j = (i == j) :> nat. Proof. by rewrite cmE fsfun_fun in_fsetE; case: eqVneq. Qed. Lemma mulcmE m1 m2 i : mulcm m1 m2 i = (m1 i + m2 i)%N. Proof. by rewrite cmE fsfun_fun in_fsetE; case: (finsuppP m1); case: (finsuppP m2). Qed. Lemma divcmE m1 m2 i : divcm m1 m2 i = (m1 i - m2 i)%N. Proof. by rewrite cmE fsfun_fun; case: finsuppP. Qed. Lemma mulcmA : associative mulcm. Proof. by move=> m1 m2 m3; apply/eqP/cmP=> i; rewrite !mulcmE addnA. Qed. Lemma mulcmC : commutative mulcm. Proof. by move=> m1 m2; apply/eqP/cmP=> i; rewrite !mulcmE addnC. Qed. Lemma mul0cm : left_id onecm mulcm. Proof. by move=> m; apply/eqP/cmP=> i; rewrite mulcmE onecmE add0n. Qed. Lemma mulcm0 : right_id onecm mulcm. Proof. by move=> m; apply/eqP/cmP=> i; rewrite mulcmE onecmE addn0. Qed. Lemma mulcm_eq0 m1 m2 : mulcm m1 m2 = onecm -> m1 = onecm /\ m2 = onecm. Proof. move: m1 m2; have gen m1 m2 : mulcm m1 m2 = onecm -> m1 = onecm. move/eqP/cmP=> h; apply/eqP/cmP=> i; move/eqP: (h i). by rewrite mulcmE onecmE addn_eq0 => /andP[] /eqP->. by move=> m1 m2 h; split; move: h; last rewrite mulcmC; apply/gen. Qed. HB.instance Definition _ := Choice_isMonomialDef.Build (cmonom I) mulcmA mul0cm mulcm0 mulcm_eq0. HB.instance Definition _ := MonomialDef_isConomialDef.Build (cmonom I) mulcmC. End CmonomCanonicals. (* -------------------------------------------------------------------- *) Definition mdeg {I : choiceType} (m : cmonom I) := (\sum_(k <- finsupp m) m k)%N. Definition mnmwgt {n} (m : cmonom 'I_n) := (\sum_i m i * i.+1)%N. (* -------------------------------------------------------------------- *) Section CmonomTheory. Context {I : choiceType}. Implicit Types (m : cmonom I) (i : I). Local Notation "'U_(' i )" := (@ucm I i) : monom_scope. Local Notation mdeg := (@mdeg I). Lemma cm1 i : (1%M : cmonom I) i = 0%N. Proof. exact/onecmE. Qed. Lemma cmU i j : U_(i)%M j = (i == j) :> nat. Proof. exact/ucmE. Qed. Lemma cmUU i : U_(i)%M i = 1%N. Proof. by rewrite cmU eqxx. Qed. Lemma cmM i m1 m2 : (m1 * m2)%M i = (m1 i + m2 i)%N. Proof. exact/mulcmE. Qed. Lemma cmE_eq0 m i : (m i == 0%N) = (i \notin finsupp m). Proof. by rewrite memNfinsupp. Qed. Lemma cmE_neq0 m i : (m i != 0%N) = (i \in finsupp m). Proof. by rewrite cmE_eq0 negbK. Qed. Variant mdom_spec m (i : I) : bool -> nat -> Type := | MdomIn (_ : i \in finsupp m) : mdom_spec m i true (m i) | MdomOut (_ : i \notin finsupp m) : mdom_spec m i false 0%N. Lemma mdomP m i : mdom_spec m i (i \in finsupp m) (m i). Proof. by case: finsuppP=> h; constructor. Qed. Lemma mdom1 : finsupp (1 : cmonom I)%M = fset0 :> {fset I}. Proof. by apply/fsetP=> i; rewrite in_fset0 -cmE_neq0 cm1 eqxx. Qed. Lemma mdomU i : finsupp U_(i)%M = [fset i]. Proof. by apply/fsetP=> j; rewrite -!cmE_neq0 cmU in_fset1 eqb0 negbK. Qed. Lemma mdomD m1 m2 : finsupp (m1 * m2)%M = finsupp m1 `|` finsupp m2. Proof. by apply/fsetP=> i; rewrite in_fsetU -!cmE_neq0 cmM addn_eq0 negb_and. Qed. Lemma mdegE m : mdeg m = (\sum_(i <- finsupp m) (m i))%N. Proof. by []. Qed. Lemma mdegEw m (d : {fset I}) : finsupp m `<=` d -> mdeg m = (\sum_(i <- d) (m i))%N. Proof. move=> le; rewrite mdegE (big_fset_incl _ le) //. by move=> i i_in_d; rewrite -cmE_neq0 negbK => /eqP. Qed. Lemma mdeg1 : mdeg 1%M = 0%N. Proof. by rewrite mdegE mdom1 big_seq_fset0. Qed. Lemma mdegU k : mdeg U_(k)%M = 1%N. Proof. by rewrite mdegE mdomU big_seq_fset1 cmUU. Qed. Lemma mdegM : {morph mdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }. Proof. move=> m1 m2 /=; rewrite mdegE mdomD. rewrite (mdegEw (fsubsetUl _ (finsupp m2))) (mdegEw (fsubsetUr (finsupp m1) _)). by rewrite -big_split /=; apply/eq_bigr=> /= i _; rewrite cmM. Qed. Lemma mdeg_prod (T : Type) r P (F : T -> cmonom I) : mdeg (\big[mmul/1%M]_(x <- r | P x) (F x)) = (\sum_(x <- r | P x) (mdeg (F x)))%N. Proof. exact/big_morph/mdeg1/mdegM. Qed. Lemma mdeg_eq0I m : mdeg m = 0%N -> m = 1%M. Proof. move=> h; apply/eqP/cmP=> i; move: h; rewrite mdegE cm1. by case: mdomP=> // ki /eqP; rewrite (big_fsetD1 i) //= addn_eq0 => /andP[/eqP]. Qed. (* -------------------------------------------------------------------- *) #[hnf] HB.instance Definition _ := isMeasure.Build (cmonom I) mdeg mdeg1 mdegM mdeg_eq0I. Lemma mdeg_eq0 m : (mdeg m == 0%N) = (m == 1%M). Proof. exact/mf_eq0. Qed. Lemma cmM_eq1 m1 m2 : (m1 * m2 == 1)%M = (m1 == 1%M) && (m2 == 1%M). Proof. by rewrite -!mdeg_eq0 mdegM addn_eq0. Qed. Lemma cm1_eq1 i : (U_(i) == 1)%M = false. Proof. by rewrite -mdeg_eq0 mdegU. Qed. End CmonomTheory. (* -------------------------------------------------------------------- *) Section MWeight. Context (n : nat). Implicit Types (m : 'X_{1..n}). Local Notation mnmwgt := (@mnmwgt n). Local Notation "'U_(' i )" := (@ucm 'I_n i). Lemma mnmwgtE m : mnmwgt m = (\sum_i m i * i.+1)%N. Proof. by []. Qed. Lemma mnmwgt1 : mnmwgt 1%M = 0%N. Proof. by rewrite mnmwgtE big1 // => /= i _; rewrite cm1. Qed. Lemma mnmwgtU i : mnmwgt U_(i) = i.+1. Proof. rewrite mnmwgtE (bigD1 i) //= cmUU mul1n big1 ?addn0 //. by move=> j ne_ij; rewrite cmU eq_sym (negbTE ne_ij). Qed. Lemma mnmwgtM : {morph mnmwgt: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N}. Proof. move=> m1 m2 /=; rewrite !mnmwgtE -big_split /=. by apply/eq_bigr=> i _; rewrite cmM mulnDl. Qed. Lemma mnmwgt_eq0I m : mnmwgt m = 0%N -> m = 1%M. Proof. move=> h; apply/eqP/cmP=> /= i; move: h; rewrite mnmwgtE cm1 => /eqP. rewrite sum_nat_eq0 => /forallP /(_ i) /implyP. by rewrite muln_eq0 orbF => z_mi; apply/eqP/z_mi. Qed. (* -------------------------------------------------------------------- *) #[hnf] HB.instance Definition _ := isMeasure.Build 'X_{1..n} mnmwgt mnmwgt1 mnmwgtM mnmwgt_eq0I. Lemma mnmwgt_eq0 m : (mnmwgt m == 0%N) = (m == 1%M). Proof. exact/mf_eq0. Qed. End MWeight. (* -------------------------------------------------------------------- *) Notation msize := (@mmeasure _ _ mdeg). Notation mweight := (@mmeasure _ _ mnmwgt). Section MSize. Context (I : choiceType) (G : zmodType). Implicit Types (m : cmonom I) (g : {malg G[cmonom I]}). Local Notation mdeg := (@mdeg I). Lemma msizeE g : msize g = (\max_(m <- msupp g) (mdeg m).+1)%N. Proof. exact/mmeasureE. Qed. Lemma msize_mdeg_lt g m : m \in msupp g -> (mdeg m < msize g)%N. Proof. exact/mmeasure_mnm_lt. Qed. Lemma msize_mdeg_ge g m : (msize g <= mdeg m)%N -> m \notin msupp g. Proof. exact/mmeasure_mnm_ge. Qed. Definition msize0 := @mmeasure0 _ G mdeg. Definition msizeC := @mmeasureC _ G mdeg. Definition msizeD_le := @mmeasureD_le _ G mdeg. Definition msize_sum := @mmeasure_sum _ G mdeg. Definition msizeN := @mmeasureN _ G mdeg. Definition msize_eq0 := @mmeasure_eq0 _ G mdeg. Definition msize_msupp0 := @mmeasure_msupp0 _ G mdeg. End MSize. (* -------------------------------------------------------------------- *) Section FmonomDef. Context (I : choiceType). Record fmonom : predArgType := FMonom { fmonom_val : seq I }. Coercion fmonom_val : fmonom >-> seq. Fact fmonom_key : unit. Proof. by []. Qed. Definition fmonom_of_seq k := locked_with k FMonom. Canonical fmonom_unlockable k := [unlockable fun fmonom_of_seq k]. End FmonomDef. Notation "{ 'fmonom' I }" := (fmonom I) : type_scope. Local Notation mkfmonom s := (fmonom_of_seq fmonom_key s). (* -------------------------------------------------------------------- *) Section FmonomCanonicals. Context (I : choiceType). HB.instance Definition _ := [isNew for @fmonom_val I]. HB.instance Definition _ := [Choice of fmonom I by <:]. (* -------------------------------------------------------------------- *) Implicit Types (m : fmonom I). Lemma fmE (s : seq I) : mkfmonom s = FMonom s. Proof. by rewrite unlock. Qed. Lemma fmP m1 m2 : (m1 == m2) = (m1 == m2 :> seq I). Proof. by rewrite val_eqE. Qed. Lemma fmK m : FMonom m = m. Proof. exact/innew_val. Qed. Definition fmone : fmonom I := mkfmonom [::]. Definition fmu i : fmonom I := mkfmonom [:: i]. Definition fmmul m1 m2 : fmonom I := mkfmonom (m1 ++ m2). Lemma fmoneE : fmone = FMonom [::]. Proof. by apply/eqP; rewrite fmP /fmone fmE. Qed. Lemma fmuE i : fmu i = FMonom [:: i]. Proof. by apply/eqP; rewrite fmP /fmu fmE. Qed. Lemma fmmulE m1 m2 : fmmul m1 m2 = FMonom (m1 ++ m2). Proof. by apply/eqP; rewrite fmP /fmmul fmE. Qed. Let fmE := (fmoneE, fmuE, fmmulE, fmE). Lemma fmmulA : associative fmmul. Proof. by move=> m1 m2 m3; rewrite !fmE catA. Qed. Lemma fmmul1m : left_id fmone fmmul. Proof. by move=> m; rewrite !fmE cat0s fmK. Qed. Lemma fmmulm1 : right_id fmone fmmul. Proof. by move=> m; rewrite !fmE cats0 fmK. Qed. Lemma fmmul_eq1 m1 m2 : fmmul m1 m2 = fmone -> m1 = fmone /\ m2 = fmone. Proof. by case: m1 m2 => [[|? ?]] [[|? ?]]; rewrite !fmE. Qed. HB.instance Definition _ := Choice_isMonomialDef.Build (fmonom I) fmmulA fmmul1m fmmulm1 fmmul_eq1. End FmonomCanonicals. (* -------------------------------------------------------------------- *) Definition fdeg (I : choiceType) (m : fmonom I) := size m. (* -------------------------------------------------------------------- *) Section FmonomTheory. Context {I : choiceType}. Implicit Types (m : fmonom I). Local Notation "'U_(' i )" := (@fmu I i). Local Notation fdeg := (@fdeg I). Lemma fm1 : (1%M : fmonom I) = [::] :> seq I. Proof. by rewrite /mone /one /= fmoneE. Qed. Lemma fmU i : U_(i) = [:: i] :> seq I. Proof. by rewrite fmuE. Qed. Lemma fmM m1 m2 : (m1 * m2)%M = (m1 ++ m2) :> seq I. Proof. by rewrite /mmul /mul /= fmmulE. Qed. Lemma fdegE m : fdeg m = size m. Proof. by []. Qed. Lemma fdeg1 : fdeg 1%M = 0%N. Proof. by rewrite fdegE fm1. Qed. Lemma fdegU k : fdeg U_(k) = 1%N. Proof. by rewrite fdegE fmU. Qed. Lemma fdegM : {morph fdeg: m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N }. Proof. by move=> m1 m2; rewrite !fdegE fmM size_cat. Qed. Lemma fdeg_prod (T : Type) r P (F : T -> fmonom I) : fdeg (\big[mmul/1%M]_(x <- r | P x) (F x)) = (\sum_(x <- r | P x) (fdeg (F x)))%N. Proof. by apply/big_morph; [apply/fdegM|apply/fdeg1]. Qed. Lemma fdeg_eq0I m : fdeg m = 0%N -> m = 1%M. Proof. rewrite fdegE => /size0nil z_m; apply/eqP. by rewrite -val_eqE /= z_m fm1. Qed. (* -------------------------------------------------------------------- *) #[hnf] HB.instance Definition _ := isMeasure.Build (fmonom I) fdeg fdeg1 fdegM fdeg_eq0I. Lemma fdeg_eq0 m : (fdeg m == 0%N) = (m == 1%M). Proof. exact/mf_eq0. Qed. Lemma fmM_eq1 m1 m2 : (m1 * m2 == 1)%M = (m1 == 1%M) && (m2 == 1%M). Proof. by rewrite -!fdeg_eq0 fdegM addn_eq0. Qed. Lemma fm1_eq1 i : (U_(i) == 1)%M = false. Proof. by rewrite -fdeg_eq0 fdegU. Qed. End FmonomTheory. multinomials-2.3.0/src/mpoly.v000066400000000000000000005406461472432761000163740ustar00rootroot00000000000000(* -------------------------------------------------------------------- * (c) Copyright 2014--2015 IMDEA Software Institute. * * You may distribute this file under the terms of the CeCILL-B license * -------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *) (* This file provides a library for multivariate polynomials over ring *) (* structures; it also provides an extended theory for polynomials *) (* whose coefficients range over commutative rings and integral domains. *) (* *) (* 'X_{1..n} == the type of monomials in n variables. m : 'X_{1..n} *) (* acts as a function from 'I_n to nat, returning the *) (* power of the i-th variable in m. Notations related *) (* to 'X_{1..n} lies in the multi_scope scope, *) (* delimited by %MM *) (* [multinom E i | i < n] *) (* == the monomial in n variables whose i-th power is E(i) *) (* mdeg m == the degree of the monomial m; i.e. *) (* mdeg m = \sum_(i < n) (m i) *) (* 'X_{1..n < k} == the finite type of monomials in n variables with *) (* degree bounded by k. *) (* (m1 <= m2)%MM == the point-wise partial order over monomials, i.e. *) (* (m1 <= m2)%MM <=> forall i, m1 i <= m2 i *) (* (m1 <= m2)%O == the total cpo (equipped with a cpoType) over *) (* monomials. This is the degrevlex monomial ordering. *) (* 0, 'U_i, m1 + m2, == 'X_{1..n} is equipped with a semi-group structure, *) (* m1 - m2, m *+ n, ... all operations being point-wise. The substraction *) (* is truncated when (m1 <= m2)%MM does not hold. *) (* mlcm m1 m2 == the monomial that is the least common multiple *) (* {mpoly R[n]} == the type of multivariate polynomials in n variables *) (* and with coefficients of type R represented as *) (* {free 'X_{1..n} / R}, i.e. as a formal sum over *) (* 'X_{1..n} and with coefficients in R. *) (* [mpoly D] == the multivariate polynomial constructed from a free *) (* sum in {freeg 'X_{1..n} / R} *) (* 0, 1, - p, p + q, == the usual ring operations: {mpoly R} has a canonical *) (* p * q, p ^+ n, ... ringType structure, which is commutative / integral *) (* when R is commutative / integral, respectively. *) (* {ipoly R[n]} == the type obtained by iterating the univariate *) (* polynomial type, with R as base ring. *) (* {ipoly R[n]}^p == copy of {ipoly R[n]} with a ring canonical structure *) (* mwiden p == the canonical injection (ring morphism) from *) (* {mpoly R[n]} to {mpoly R[n.+1]} *) (* mpolyC c, c%:MP == the constant multivariate polynomial c *) (* 'X_i == the variable i, for i : 'I_n *) (* 'X_[m] == the monomial m as a multivariate polynomial *) (* msupp p == the support of p, i.e. the m s.t. p@_m != 0 *) (* p@_m == the coefficient of 'X_[m] in p. *) (* msize p == 1 + the degree of p, or 0 if p = 0. *) (* mlead p == the leading monomial of p; this is the maximum *) (* monomial of p for the degrevlex monimial ordering. *) (* mlead p defaults to 0%MM when p is 0. *) (* mlast p == the smallest non-zero monomial of p for the *) (* degrevlex monimial ordering. *) (* mlast p defaults to 0%MM when p is 0. *) (* mleadc p == the coefficient of the highest monomial in p; *) (* this is a notation for p@_(mlead p). *) (* p \is a mpolyOver 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, where *) (* v is a n.-tuple R s.t. 'X_i evaluates to (tnth v i) *) (* p^`M() == formal derivative of p w.r.t the i-th variable *) (* p^`M(n, i) == formal n-derivative of p w.r.t the i-th variable *) (* p^`M[m] == formal parallel (m i)-derivative of p w.r.t the *) (* i-th variable, i ranging in {0..n.-1}. *) (* p \mPo lq == multivariate polynomial composition, where lq is a *) (* (n.-tuple {mpoly R[k]}) s.t. 'X_i is substituted by *) (* (tnth lq i). *) (* map_mpoly f p == the image of the polynomial by the function f (which *) (* is usually a ring morphism). *) (* p \is symmetric == p is a symmetric polynomial. *) (* 's_(n, k) == the k-th elementary symmetric polynomial with *) (* n indeterminates. We prove the fundamental lemma of *) (* symmetric polynomials. *) (* p \is d.-homog == p is a homogeneous polynomial of degree d. *) (* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------- *) From HB Require Import structures. 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 order fingroup perm ssralg zmodp poly ssrint. From mathcomp Require Import matrix vector. From mathcomp Require Import bigenough. Require Import ssrcomplements freeg. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.Theory GRing.Theory BigEnough. Local Open Scope ring_scope. Declare Scope mpoly_scope. Declare Scope multi_scope. Delimit Scope mpoly_scope with MP. Delimit Scope multi_scope with MM. Local Notation simpm := Monoid.simpm. Local Infix "@@" := (allpairs pair) (at level 60, right associativity). Local Notation widen := (widen_ord (leqnSn _)). Import Order.DefaultProdLexiOrder. Import Order.DefaultSeqLexiOrder. Import Order.DefaultTupleLexiOrder. (* -------------------------------------------------------------------- *) Reserved Notation "''X_{1..' n '}'" (at level 0, n at level 2). Reserved Notation "''X_{1..' n < b '}'" (at level 0, n, b at level 2). Reserved Notation "''X_{1..' n < b1 , b2 '}'" (at level 0, n, b1, b2 at level 2). Reserved Notation "[ 'multinom' s ]" (at level 0, format "[ 'multinom' s ]"). Reserved Notation "[ 'multinom' 'of' s ]" (at level 0, format "[ 'multinom' 'of' s ]"). Reserved Notation "[ 'multinom' F | i < n ]" (at level 0, i at level 0, format "[ '[hv' 'multinom' F '/' | i < n ] ']'"). Reserved Notation "'U_(' n )" (at level 0, n at level 2, no associativity, format "'U_(' n )"). Reserved Notation "{ 'mpoly' T [ n ] }" (at level 0, T, n at level 2, format "{ 'mpoly' T [ n ] }"). Reserved Notation "[ 'mpoly' D ]" (at level 0, D at level 2, format "[ 'mpoly' D ]"). Reserved Notation "{ 'ipoly' T [ n ] }" (at level 0, T, n at level 2, format "{ 'ipoly' T [ n ] }"). Reserved Notation "{ 'ipoly' T [ n ] }^p" (at level 0, T, n at level 2, format "{ 'ipoly' T [ n ] }^p"). Reserved Notation "''X_' i" (at level 8, i at level 2, format "''X_' i"). Reserved Notation "''X_[' i ]" (at level 8, i at level 2, format "''X_[' i ]"). Reserved Notation "''X_[' R , i ]" (at level 8, R, i at level 2, format "''X_[' R , i ]"). Reserved Notation "c %:MP" (at level 2, left associativity, format "c %:MP"). Reserved Notation "c %:MP_[ n ]" (at level 2, left associativity, n at level 50, format "c %:MP_[ n ]"). Reserved Notation "c %:IP" (at level 2, left associativity, format "c %:IP"). Reserved Notation "s @_ i" (at level 3, i at level 2, left associativity, format "s @_ i"). Reserved Notation "e .@[ x ]" (at level 2, left associativity, format "e .@[ x ]"). Reserved Notation "e .@[< x >]" (at level 2, left associativity, format "e .@[< x >]"). Reserved Notation "p \mPo q" (at level 50). Reserved Notation "x ^[ f ]" (at level 2, left associativity, format "x ^[ f ]"). Reserved Notation "x ^[ f , g ]" (at level 2, left associativity, format "x ^[ f , g ]"). Reserved Notation "p ^`M ( m )" (at level 8, format "p ^`M ( m )"). Reserved Notation "p ^`M ( m , n )" (at level 8, format "p ^`M ( m , n )"). Reserved Notation "p ^`M [ m ]" (at level 8, format "p ^`M [ m ]"). Reserved Notation "''s_' k" (at level 8, k at level 2, format "''s_' k"). Reserved Notation "''s_' ( n , k )" (at level 8, n, k at level 2, format "''s_' ( n , k )"). Reserved Notation "''s_' ( K , n , k )" (at level 8, n, k, K at level 2, format "''s_' ( K , n , k )"). Reserved Notation "+%MM" (at level 0). Reserved Notation "-%MM" (at level 0). (* -------------------------------------------------------------------- *) Section MultinomDef. Context (n : nat). Record multinom : predArgType := Multinom { multinom_val :> n.-tuple nat }. HB.instance Definition _ := [isNew for multinom_val]. Definition fun_of_multinom M (i : 'I_n) := tnth (multinom_val M) i. Coercion fun_of_multinom : multinom >-> Funclass. Lemma multinomE M : Multinom M =1 tnth M. Proof. by []. Qed. End MultinomDef. Notation "[ 'multinom' s ]" := (@Multinom _ s) : form_scope. Notation "[ 'multinom' 'of' s ]" := [multinom [tuple of s]] : form_scope. Notation "[ 'multinom' E | i < n ]" := [multinom [tuple E%N | i < n]] : form_scope. Notation "[ 'multinom' E | i < n ]" := [multinom [tuple E%N : nat | i < n]] (only parsing) : form_scope. (* -------------------------------------------------------------------- *) Notation "''X_{1..' n '}'" := (multinom n) : type_scope. HB.instance Definition _ n := [Countable of 'X_{1..n} by <:]. Bind Scope multi_scope with multinom. (* -------------------------------------------------------------------- *) Definition lem n (m1 m2 : 'X_{1..n}) := [forall i, m1%MM i <= m2%MM i]. Definition ltm n (m1 m2 : 'X_{1..n}) := (m1 != m2) && (lem m1 m2). (* -------------------------------------------------------------------- *) Section MultinomTheory. Context {n : nat}. Implicit Types (m : 'X_{1..n}). Lemma mnm_tnth m j : m j = tnth m j. Proof. by []. Qed. Lemma mnm_nth x0 m j : m j = nth x0 m j. Proof. by rewrite mnm_tnth (tnth_nth x0). Qed. Lemma mnmE E j : [multinom E i | i < n] j = E j. Proof. by rewrite multinomE tnth_mktuple. Qed. Lemma mnm_valK t : [multinom t] = t :> n.-tuple nat. Proof. by []. Qed. Lemma mnmP m1 m2 : (m1 = m2) <-> (m1 =1 m2). Proof. case: m1 m2 => [m1] [m2] /=; split => [->//|h]. by apply/val_inj/eq_from_tnth => i; rewrite -!multinomE. Qed. End MultinomTheory. (* -------------------------------------------------------------------- *) Section MultinomMonoid. Context {n : nat}. Implicit Types (m : 'X_{1..n}). Definition mnm0 := [multinom 0 | _ < n]. Definition mnm1 (c : 'I_n) := [multinom c == i | i < n]. Definition mnm_add m1 m2 := [multinom m1 i + m2 i | i < n]. Definition mnm_sub m1 m2 := [multinom m1 i - m2 i | i < n]. Definition mnm_muln m i := nosimpl iterop _ i mnm_add m mnm0. Local Notation "0" := mnm0 : multi_scope. Local Notation "'U_(' n )" := (mnm1 n) : multi_scope. Local Notation "m1 + m2" := (mnm_add m1 m2) : multi_scope. Local Notation "m1 - m2" := (mnm_sub m1 m2) : multi_scope. Local Notation "x *+ n" := (mnm_muln x n) : multi_scope. Local Notation "+%MM" := (@mnm_add) : function_scope. Local Notation "-%MM" := (@mnm_sub) : function_scope. Local Notation "m1 <= m2" := (lem m1 m2) : multi_scope. Local Notation "m1 < m2" := (ltm m1 m2) : multi_scope. Lemma mnm0E i : 0%MM i = 0%N. Proof. exact/mnmE. Qed. Lemma mnmDE i m1 m2 : (m1 + m2)%MM i = (m1 i + m2 i)%N. Proof. exact/mnmE. Qed. Lemma mnmBE i m1 m2 : (m1 - m2)%MM i = (m1 i - m2 i)%N. Proof. exact/mnmE. Qed. Lemma mnm_sumE (I : Type) i (r : seq I) P F : (\big[+%MM/0%MM]_(x <- r | P x) (F x)) i = (\sum_(x <- r | P x) (F x i))%N. Proof. by apply/(big_morph (fun m => m i)) => [x y|]; rewrite mnmE. Qed. (*-------------------------------------------------------------------- *) Lemma mnm_lepP {m1 m2} : reflect (forall i, m1 i <= m2 i) (m1 <= m2)%MM. Proof. exact: (iffP forallP). Qed. Lemma lepm_refl m : (m <= m)%MM. Proof. exact/mnm_lepP. Qed. Lemma lepm_trans m3 m1 m2 : (m1 <= m2 -> m2 <= m3 -> m1 <= m3)%MM. Proof. move=> h1 h2; apply/mnm_lepP => i. exact: leq_trans (mnm_lepP h1 i) (mnm_lepP h2 i). Qed. Lemma addmC : commutative +%MM. Proof. by move=> m1 m2; apply/mnmP=> i; rewrite !mnmE addnC. Qed. Lemma addmA : associative +%MM. Proof. by move=> m1 m2 m3; apply/mnmP=> i; rewrite !mnmE addnA. Qed. Lemma add0m : left_id 0%MM +%MM. Proof. by move=> m; apply/mnmP=> i; rewrite !mnmE add0n. Qed. Lemma addm0 : right_id 0%MM +%MM. Proof. by move=> m; rewrite addmC add0m. Qed. HB.instance Definition _ := Monoid.isComLaw.Build 'X_{1..n} 0%MM +%MM addmA addmC add0m. Lemma subm0 m : (m - 0)%MM = m. Proof. by apply/mnmP=> i; rewrite !mnmE subn0. Qed. Lemma sub0m m : (0 - m = 0)%MM. Proof. by apply/mnmP=> i; rewrite !mnmE sub0n. Qed. Lemma addmK m : cancel (+%MM^~ m) (-%MM^~ m). Proof. by move=> m' /=; apply/mnmP=> i; rewrite !mnmE addnK. Qed. Lemma addIm : left_injective +%MM. Proof. by move=> ? ? ? /(can_inj (@addmK _)). Qed. Lemma addmI : right_injective +%MM. Proof. by move=> m ? ?; rewrite ![(m + _)%MM]addmC => /addIm. Qed. Lemma eqm_add2l m n1 n2 : (m + n1 == m + n2)%MM = (n1 == n2). Proof. exact/inj_eq/addmI. Qed. Lemma eqm_add2r m n1 n2 : (n1 + m == n2 + m)%MM = (n1 == n2). Proof. exact: (inj_eq (@addIm _)). Qed. Lemma submK m m' : (m <= m')%MM -> (m' - m + m = m')%MM. Proof. by move/mnm_lepP=> h; apply/mnmP=> i; rewrite !mnmE subnK. Qed. Lemma addmBA m1 m2 m3 : (m3 <= m2)%MM -> (m1 + (m2 - m3))%MM = (m1 + m2 - m3)%MM. Proof. by move/mnm_lepP=> h; apply/mnmP=> i; rewrite !mnmE addnBA. Qed. Lemma submDA m1 m2 m3 : (m1 - m2 - m3)%MM = (m1 - (m2 + m3))%MM. Proof. by apply/mnmP=> i; rewrite !mnmE subnDA. Qed. Lemma submBA m1 m2 m3 : (m3 <= m2)%MM -> (m1 - (m2 - m3) = m1 + m3 - m2)%MM. Proof. by move/mnm_lepP=> h; apply/mnmP=> i; rewrite !mnmE subnBA. Qed. Lemma lem_subr m1 m2 : (m1 - m2 <= m1)%MM. Proof. by apply/mnm_lepP=> i; rewrite !mnmE leq_subr. Qed. Lemma lem_addr m1 m2 : (m1 <= m1 + m2)%MM. Proof. by apply/mnm_lepP=> i; rewrite mnmDE leq_addr. Qed. Lemma lem_addl m1 m2 : (m2 <= m1 + m2)%MM. Proof. by apply/mnm_lepP=> i; rewrite mnmDE leq_addl. Qed. (* -------------------------------------------------------------------- *) Lemma mulm0n m : (m *+ 0 = 0)%MM. Proof. by []. Qed. Lemma mulm1n m : (m *+ 1 = m)%MM. Proof. by []. Qed. Lemma mulmS m i : (m *+ i.+1 = m + m *+ i)%MM. Proof. by rewrite /mnm_muln !Monoid.iteropE iterS. Qed. Lemma mulmSr m i : (m *+ i.+1 = m *+ i + m)%MM. Proof. by rewrite mulmS addmC. Qed. Lemma mulmnE m k i : ((m *+ k) i)%MM = (m i * k)%N. Proof. elim: k => [|k ih]; first by rewrite muln0 mulm0n !mnmE. by rewrite mulmS mulnS mnmDE ih. Qed. Lemma mnm1E i j : U_(i)%MM j = (i == j). Proof. exact/mnmE. Qed. Lemma lep1mP i m : (U_(i) <= m)%MM = (m i != 0%N). Proof. apply/mnm_lepP/idP=> [/(_ i)|]; rewrite -lt0n; first by rewrite mnm1E eqxx. by move=> lt0_mi j; rewrite mnm1E; case: eqP=> // <-. Qed. End MultinomMonoid. (* -------------------------------------------------------------------- *) Notation "+%MM" := (@mnm_add _). Notation "-%MM" := (@mnm_sub _). Notation "0" := (@mnm0 _) : multi_scope. Notation "'U_(' n )" := (mnm1 n) : multi_scope. Notation "m1 + m2" := (mnm_add m1 m2) : multi_scope. Notation "m1 - m2" := (mnm_sub m1 m2) : multi_scope. Notation "x *+ n" := (mnm_muln x n) : multi_scope. Notation "m1 <= m2" := (lem m1 m2) : multi_scope. Notation "m1 < m2" := (ltm m1 m2) : multi_scope. Notation "\sum_ ( i <- r | P ) F" := (\big[+%MM/0%MM]_(i <- r | P%B) F%MM) : multi_scope. Notation "\sum_ ( i <- r ) F" := (\big[+%MM/0%MM]_(i <- r) F%MM) : multi_scope. Notation "\sum_ ( m <= i < n | P ) F" := (\big[+%MM/0%MM]_(m <= i < n | P%B) F%MM) : multi_scope. Notation "\sum_ ( m <= i < n ) F" := (\big[+%MM/0%MM]_(m <= i < n) F%MM) : multi_scope. Notation "\sum_ ( i | P ) F" := (\big[+%MM/0%MM]_(i | P%B) F%MM) : multi_scope. Notation "\sum_ i F" := (\big[+%MM/0%MM]_i F%MM) : multi_scope. Notation "\sum_ ( i : t | P ) F" := (\big[+%MM/0%MM]_(i : t | P%B) F%MM) (only parsing) : multi_scope. Notation "\sum_ ( i : t ) F" := (\big[+%MM/0%MM]_(i : t) F%MM) (only parsing) : multi_scope. Notation "\sum_ ( i < n | P ) F" := (\big[+%MM/0%MM]_(i < n | P%B) F%MM) : multi_scope. Notation "\sum_ ( i < n ) F" := (\big[+%MM/0%MM]_(i < n) F%MM) : multi_scope. Notation "\sum_ ( i 'in' A | P ) F" := (\big[+%MM/0%MM]_(i in A | P%B) F%MM) : multi_scope. Notation "\sum_ ( i 'in' A ) F" := (\big[+%MM/0%MM]_(i in A) F%MM) : multi_scope. (* -------------------------------------------------------------------- *) Lemma multinomUE_id n (m : 'X_{1..n}) : m = (\sum_i U_(i) *+ m i)%MM. Proof. apply/mnmP=> i; rewrite mnm_sumE (bigD1 i) //=. rewrite big1; first by rewrite addn0 mulmnE mnm1E eqxx mul1n. by move=> j ne_ji; rewrite mulmnE mnm1E (negbTE ne_ji). Qed. Lemma multinomUE n (s : 'S_n) (m : 'X_{1..n}) : m = (\sum_i U_(s i) *+ m (s i))%MM. Proof. rewrite (reindex s^-1)%g //=; last first. by exists s=> i _; rewrite (permK, permKV). by rewrite [LHS]multinomUE_id; apply/eq_bigr => i _; rewrite permKV. Qed. (* -------------------------------------------------------------------- *) Section MultinomDeg. Context {n : nat}. Implicit Types (m : 'X_{1..n}). Definition mdeg m := (\sum_(i <- m) i)%N. Lemma mdegE m : mdeg m = (\sum_i (m i))%N. Proof. exact: big_tuple. Qed. Lemma mdeg0 : mdeg 0%MM = 0%N. Proof. by rewrite mdegE big1 // => i; rewrite mnmE. Qed. Lemma mdeg1 i : mdeg U_(i) = 1%N. Proof. rewrite mdegE (bigD1 i) //= big1 => [|j]; first by rewrite mnmE eqxx addn0. by rewrite mnmE eq_sym => /negbTE ->. Qed. Lemma mdegD m1 m2 : mdeg (m1 + m2) = (mdeg m1 + mdeg m2)%N. Proof. by rewrite !mdegE -big_split; apply/eq_bigr => i _; rewrite mnmE. Qed. Lemma mdegB m1 m2 : mdeg (m1 - m2) <= mdeg m1. Proof. by rewrite !mdegE; apply/leq_sum => i _; rewrite mnmE leq_subr. Qed. Lemma mdegMn m k : mdeg (m *+ k) = (mdeg m * k)%N. Proof. by rewrite !mdegE big_distrl; apply/eq_bigr => i _; rewrite mulmnE. Qed. Lemma mdeg_sum (I : Type) (r : seq I) P F : mdeg (\sum_(x <- r | P x) F x) = (\sum_(x <- r | P x) mdeg (F x))%N. Proof. exact/big_morph/mdeg0/mdegD. Qed. Lemma mdeg_eq0 m : (mdeg m == 0%N) = (m == 0%MM). Proof. apply/idP/eqP=> [h|->]; last by rewrite mdeg0. apply/mnmP=> i; move: h; rewrite mdegE mnm0E. by rewrite (bigD1 i) //= addn_eq0 => /andP[/eqP-> _]. Qed. Lemma mnmD_eq0 m1 m2 : (m1 + m2 == 0)%MM = (m1 == 0%MM) && (m2 == 0%MM). Proof. by rewrite -!mdeg_eq0 mdegD addn_eq0. Qed. Lemma mnm1_eq0 i : (U_(i) == 0 :> 'X_{1..n})%MM = false. Proof. by rewrite -mdeg_eq0 mdeg1. Qed. Lemma eq_mnm1 (i j : 'I_n) : (U_(i)%MM == U_(j)%MM) = (i == j). Proof. by apply/eqP/eqP => [/mnmP /(_ j)|->//]; rewrite !mnm1E eqxx; case: eqP. Qed. Lemma mdeg_eq1 m : (mdeg m == 1%N) = [exists i : 'I_n, m == U_(i)%MM]. Proof. apply/eqP/idP=> [|/existsP[i /eqP ->]]; last by rewrite mdeg1. rewrite [m]multinomUE_id => Hmdeg. have: [exists i, m i != 0%N]. rewrite -negb_forall; apply/contra_eqN: Hmdeg => /forallP Hm0. by rewrite big1 ?mdeg0 //= => i _; rewrite (eqP (Hm0 i)). case/existsP => i Hi; apply/existsP; exists i; move: Hmdeg. rewrite (bigD1 i) //= mdegD mdegMn mdeg1 mul1n. case: (m i) Hi => [|[|]] //= _ [] /eqP; rewrite mdeg_eq0 => /eqP ->. by rewrite mulm1n addm0. Qed. Lemma mdeg1P m : reflect (exists i, m == U_(i)%MM) (mdeg m == 1%N). Proof. by rewrite mdeg_eq1; apply/existsP. Qed. End MultinomDeg. (* -------------------------------------------------------------------- *) Section MultinomOrder. Context {n : nat}. Implicit Types (m : 'X_{1..n}). Definition mnmc_le m1 m2 := (mdeg m1 :: m1 <= mdeg m2 :: m2)%O. Definition mnmc_lt m1 m2 := (mdeg m1 :: m1 < mdeg m2 :: m2)%O. Local Lemma lemc_refl : reflexive mnmc_le. Proof. by move=> m; apply/le_refl. Qed. Local Lemma lemc_anti : antisymmetric mnmc_le. Proof. by move=> m1 m2 /le_anti [_] /val_inj/val_inj. Qed. Local Lemma lemc_trans : transitive mnmc_le. Proof. by move=> m2 m1 m3; apply/le_trans. Qed. Lemma lemc_total : total mnmc_le. Proof. by move=> m1 m2; apply/le_total. Qed. Local Lemma ltmc_def m1 m2 : mnmc_lt m1 m2 = (m2 != m1) && mnmc_le m1 m2. Proof. apply/esym; rewrite andbC /mnmc_lt /mnmc_le lt_def lexi_cons eqseq_cons. by case: ltgtP; rewrite //= 1?andbC //; apply/contra_ltN => /eqP ->. Qed. HB.instance Definition _ := Order.isPOrder.Build Order.default_display 'X_{1..n} ltmc_def lemc_refl lemc_anti lemc_trans. Lemma leEmnm m1 m2 : (m1 <= m2)%O = (mdeg m1 :: val m1 <= mdeg m2 :: val m2)%O. Proof. by []. Qed. Lemma ltEmnm m m' : (m < m')%O = (mdeg m :: m < mdeg m' :: m')%O. Proof. by []. Qed. HB.instance Definition _ := Order.POrder_isTotal.Build Order.default_display 'X_{1..n} lemc_total. Lemma le0m m : (0%MM <= m)%O. Proof. rewrite leEmnm; have [/eqP|] := eqVneq (mdeg m) 0%N. by rewrite mdeg_eq0 => /eqP->; rewrite lexx. by rewrite -lt0n mdeg0 lexi_cons leEnat; case: ltngtP. Qed. HB.instance Definition _ := Order.hasBottom.Build Order.default_display 'X_{1..n} le0m. Lemma ltmcP m1 m2 : mdeg m1 = mdeg m2 -> reflect (exists2 i : 'I_n, forall (j : 'I_n), j < i -> m1 j = m2 j & m1 i < m2 i) (m1 < m2)%O. Proof. by move=> eq_mdeg; rewrite ltEmnm eq_mdeg eqhead_ltxiE; apply: ltxi_tuplePlt. Qed. Lemma lemc_mdeg m1 m2 : (m1 <= m2)%O -> mdeg m1 <= mdeg m2. Proof. by rewrite leEmnm lexi_cons leEnat; case: ltngtP. Qed. Lemma lt_mdeg_ltmc m1 m2 : mdeg m1 < mdeg m2 -> (m1 < m2)%O. Proof. by rewrite ltEmnm ltxi_cons leEnat; case: ltngtP. Qed. Lemma mdeg_max m1 m2 : mdeg (m1 `|` m2)%O = maxn (mdeg m1) (mdeg m2). Proof. have [/lemc_mdeg|Hgt] := leP; first by case: ltngtP. by apply/esym/maxn_idPl; apply/contra_lt_leq: Hgt => /lt_mdeg_ltmc /ltW. Qed. (* FIXME: introduce \max_ to replace \join_ ? This would require bOrderType. *) Lemma mdeg_bigmax (r : seq 'X_{1..n}) : mdeg (\join_(m <- r) m)%O = \max_(m <- r) mdeg m. Proof. elim: r => [|m r ih]; first by rewrite !big_nil mdeg0. by rewrite !big_cons mdeg_max ih. Qed. Lemma ltmc_add2r m m1 m2 : ((m + m1)%MM < (m + m2)%MM)%O = (m1 < m2)%O. Proof. case: (ltngtP (mdeg m1) (mdeg m2)) => [lt|lt|]. + by rewrite !lt_mdeg_ltmc // !mdegD ltn_add2l. + rewrite !ltNge !le_eqVlt !lt_mdeg_ltmc ?orbT //. by rewrite !mdegD ltn_add2l. move=> eq; have eqD: mdeg (m + m1) = mdeg (m + m2). by rewrite !mdegD (rwP eqP) eqn_add2l eq. apply/ltmcP/ltmcP => // {eq eqD} -[i eq lt]; exists i. + by move=> j /eq /eqP; rewrite !mnmDE (rwP eqP) eqn_add2l. + by move: lt; rewrite !mnmDE ltn_add2l. + by move=> j /eq /eqP; rewrite !mnmDE (rwP eqP) eqn_add2l. + by rewrite !mnmDE ltn_add2l. Qed. Lemma ltmc_add2l m1 m2 m : ((m1 + m)%MM < (m2 + m)%MM)%O = (m1 < m2)%O. Proof. by rewrite ![(_+m)%MM]addmC ltmc_add2r. Qed. Lemma lemc_add2r m m1 m2 : ((m + m1)%MM <= (m + m2)%MM)%O = (m1 <= m2)%O. Proof. by rewrite !le_eqVlt eqm_add2l ltmc_add2r. Qed. Lemma lemc_add2l m1 m2 m : ((m1 + m)%MM <= (m2 + m)%MM)%O = (m1 <= m2)%O. Proof. by rewrite ![(_+m)%MM]addmC lemc_add2r. Qed. Lemma lemc_addr m1 m2 : (m1 <= (m1 + m2)%MM)%O. Proof. by rewrite -{1}[m1]addm0 lemc_add2r le0x. Qed. Lemma lemc_addl m1 m2 : (m2 <= (m1 + m2)%MM)%O. Proof. by rewrite addmC lemc_addr. Qed. Lemma lemc_lt_add m1 m2 n1 n2 : (m1 <= n1 -> m2 < n2 -> (m1 + m2)%MM < (n1 + n2)%MM)%O. Proof. move=> le lt; apply/(le_lt_trans (y := n1 + m2)%MM). by rewrite lemc_add2l. by rewrite ltmc_add2r. Qed. Lemma ltmc_le_add m1 m2 n1 n2 : (m1 < n1 -> m2 <= n2 -> (m1 + m2)%MM < (n1 + n2)%MM)%O. Proof. move=> lt le; apply/(lt_le_trans (y := n1 + m2)%MM). by rewrite ltmc_add2l. by rewrite lemc_add2r. Qed. Lemma ltm_add m1 m2 n1 n2 : (m1 < n1 -> m2 < n2 -> (m1 + m2)%MM < (n1 + n2)%MM)%O. Proof. by move=> lt1 /ltW /(ltmc_le_add lt1). Qed. Lemma lem_add m1 m2 n1 n2 : (m1 <= n1 -> m2 <= n2 -> (m1 + m2)%MM <= (n1 + n2)%MM)%O. Proof. move=> le1 le2; apply/(le_trans (y := m1 + n2)%MM). by rewrite lemc_add2r. by rewrite lemc_add2l. Qed. Lemma lem_leo m1 m2 : (m1 <= m2)%MM -> (m1 <= m2)%O. Proof. by move=> ml; rewrite -(submK ml) -{1}[m1]add0m lem_add // le0x. Qed. (* -------------------------------------------------------------------- *) Section WF. Context (P : 'X_{1..n} -> Type). Lemma ltmwf : (forall m1, (forall m2, (m2 < m1)%O -> P m2) -> P m1) -> forall m, P m. Proof. pose tof m := [tuple of mdeg m :: m]. move=> ih m; move: {2}(tof _) (erefl (tof m))=> t. elim/(@ltxwf _ nat): t m=> //=; last first. move=> t wih m Em; apply/ih=> m' lt_m'm. by apply/(wih (tof m')); rewrite // -Em. move=> Q {}ih x; elim: x {-2}x (leqnn x). move=> x; rewrite leqn0=> /eqP->; apply/ih. by move=> y; rewrite ltEnat/= ltn0. move=> k wih l le_l_Sk; apply/ih=> y; rewrite ltEnat => lt_yl. by apply/wih; have := leq_trans lt_yl le_l_Sk; rewrite ltnS. Qed. End WF. Lemma ltom_wf : @well_founded 'X_{1..n} <%O. Proof. by apply: ltmwf=> m1 IH; apply: Acc_intro => m2 /IH. Qed. End MultinomOrder. (* -------------------------------------------------------------------- *) Section DegBoundMultinom. Context (n bound : nat). Record bmultinom := BMultinom { bmnm :> 'X_{1..n}; _ : mdeg bmnm < bound }. HB.instance Definition _ := [isSub for bmnm]. HB.instance Definition _ := [Countable of bmultinom by <:]. Lemma bmeqP (m1 m2 : bmultinom) : (m1 == m2) = (m1 == m2 :> 'X_{1..n}). Proof. by []. Qed. Lemma bmdeg (m : bmultinom) : mdeg m < bound. Proof. by case: m. Qed. Lemma bm0_proof : mdeg (0%MM : 'X_{1..n}) < bound.+1. Proof. by rewrite mdeg0. Qed. End DegBoundMultinom. Definition bm0 n b := BMultinom (bm0_proof n b). Arguments bm0 {n b}. Notation "''X_{1..' n < b '}'" := (bmultinom n b) : type_scope. Notation "''X_{1..' n < b1 , b2 '}'" := ('X_{1..n < b1} * 'X_{1..n < b2})%type : type_scope. (* -------------------------------------------------------------------- *) Section FinDegBound. Context (n b : nat). Definition bmnm_enum : seq 'X_{1..n < b} := let project (x : n.-tuple 'I_b) := [multinom of map val x] in pmap insub [seq (project x) | x <- enum {: n.-tuple 'I_b }]. Lemma bmnm_enumP : Finite.axiom bmnm_enum. Proof. case=> m lt_dm_b /=; rewrite count_uniq_mem; last first. rewrite (pmap_uniq (@insubK _ _ _)) 1?map_inj_uniq ?enum_uniq //. by move=> t1 t2 [] /(inj_map val_inj) /val_inj ->. apply/eqP; rewrite eqb1 mem_pmap_sub /=; apply/mapP. case: b m lt_dm_b=> // b' [m] /= lt_dm_Sb; exists [tuple of map inord m]. by rewrite mem_enum. apply/mnmP=> i; rewrite !multinomE !tnth_map inordK //. move: lt_dm_Sb; rewrite mdegE (bigD1 i) //= multinomE. by move=> /(leq_trans _) ->//; rewrite ltnS leq_addr. Qed. HB.instance Definition _ := isFinite.Build 'X_{1..n < b} bmnm_enumP. End FinDegBound. Section Mlcm. Context (n : nat). Implicit Types (m : 'X_{1..n}). Definition mlcm m1 m2 := [multinom maxn (m1 i) (m2 i) | i < n]. Lemma mlcmC : commutative mlcm. Proof. by move=> m1 m2; apply/mnmP=> i; rewrite /mlcm /= !mnmE maxnC. Qed. Lemma mlc0m : left_id 0%MM mlcm. Proof. by move=> m; apply/mnmP=> i; rewrite /mlcm /= !mnmE max0n. Qed. Lemma mlcm0 : right_id 0%MM mlcm. Proof. by move=> m; rewrite mlcmC mlc0m. Qed. Lemma mlcmE m1 m2 : mlcm m1 m2 = (m1 + (m2 - m1))%MM. Proof. by apply/mnmP=> i; rewrite /mlcm /= !mnmE maxnE. Qed. Lemma lem_mlcm m m1 m2 : (mlcm m1 m2 <= m)%MM = (m1 <= m)%MM && (m2 <= m)%MM. Proof. apply/forallP/andP => [H|[/forallP H1 /forallP H2] i]; first split. - by apply/forallP=> i; apply: leq_trans (H i); rewrite mnmE leq_maxl. - by apply/forallP=> i; apply: leq_trans (H i); rewrite mnmE leq_maxr. by rewrite mnmE geq_max H1 H2. Qed. Lemma lem_mlcml m1 m2 : (m1 <= mlcm m1 m2)%MM. Proof. by apply/forallP=> i; rewrite /mlcm /= !mnmE leq_maxl. Qed. Lemma lem_mlcmr m1 m2 : (m2 <= mlcm m1 m2)%MM. Proof. by apply/forallP=> i; rewrite /mlcm /= !mnmE leq_maxr. Qed. End Mlcm. (* -------------------------------------------------------------------- *) Section MPolyDef. Context (n : nat) (R : ringType). Inductive mpoly := MPoly of {freeg 'X_{1..n} / R}. Coercion mpoly_val p := let: MPoly D := p in D. HB.instance Definition _ := [isNew for mpoly_val]. HB.instance Definition _ := [Choice of mpoly by <:]. End MPolyDef. Bind Scope ring_scope with mpoly. Notation "{ 'mpoly' T [ n ] }" := (mpoly n T). Notation "[ 'mpoly' D ]" := (@MPoly _ _ D). (* -------------------------------------------------------------------- *) Section MPolyTheory. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (D : {freeg 'X_{1..n} / R}). Lemma mpoly_valK D : [mpoly D] = D :> {freeg _ / _}. Proof. by []. Qed. Lemma mpoly_eqP p q : (p = q) <-> (p = q :> {freeg _ / _}). Proof. split=> [->//|]; case: p q => [p] [q]. by rewrite !mpoly_valK=> ->. Qed. Definition mpolyC (c : R) : {mpoly R[n]} := [mpoly << c *g 0%MM >>]. Local Notation "c %:MP" := (mpolyC c) : ring_scope. Lemma mpolyC_eq (c1 c2 : R) : (c1%:MP == c2%:MP) = (c1 == c2). Proof. apply/eqP/eqP=> [|->//] /eqP /freeg_eqP /(_ 0%MM). by rewrite !coeffU eqxx !mulr1. Qed. Definition mcoeff (m : 'X_{1..n}) p : R := coeff m p. Lemma mcoeff_MPoly D m : mcoeff m (MPoly D) = coeff m D. Proof. by []. Qed. Local Notation "p @_ i" := (mcoeff i p) : ring_scope. Lemma mcoeffC c m : c%:MP@_m = c * (m == 0%MM)%:R. Proof. by rewrite mcoeff_MPoly coeffU eq_sym. Qed. Lemma mpolyCK : cancel mpolyC (mcoeff 0%MM). Proof. by move=> c; rewrite mcoeffC eqxx mulr1. Qed. Definition msupp p : seq 'X_{1..n} := nosimpl (dom p). Lemma msuppE p : msupp p = dom p :> seq _. Proof. by []. Qed. Lemma msupp_uniq p : uniq (msupp p). Proof. by rewrite msuppE uniq_dom. Qed. Lemma mcoeff_msupp p m : (m \in msupp p) = (p@_m != 0). Proof. by rewrite msuppE /mcoeff mem_dom. Qed. Lemma memN_msupp_eq0 p m : m \notin msupp p -> p@_m = 0. Proof. by rewrite !msuppE /mcoeff => /coeff_outdom. Qed. Lemma mcoeff_eq0 p m : (p@_m == 0) = (m \notin msupp p). Proof. by rewrite msuppE mem_dom /mcoeff negbK. Qed. Lemma msupp0 : msupp 0%:MP = [::]. Proof. by rewrite msuppE /= freegU0 dom0. Qed. Lemma msupp1 : msupp 1%:MP = [:: 0%MM]. Proof. by rewrite msuppE /= domU1. Qed. Lemma msuppC (c : R) : msupp c%:MP = if c == 0 then [::] else [:: 0%MM]. Proof. by have [->|nz_c] := eqVneq; [rewrite msupp0 | rewrite msuppE domU]. Qed. Lemma mpolyP p q : (forall m, mcoeff m p = mcoeff m q) <-> (p = q). Proof. by split=> [|->] // h; apply/mpoly_eqP/eqP/freeg_eqP/h. Qed. Lemma freeg_mpoly p: p = [mpoly \sum_(m <- msupp p) << p@_m *g m >>]. Proof. by case: p=> p; apply/mpoly_eqP; rewrite /= -{1}[p]freeg_sumE. Qed. End MPolyTheory. Notation "c %:MP" := (mpolyC _ c) : ring_scope. Notation "c %:MP_[ n ]" := (mpolyC n c) : ring_scope. Notation "p @_ i" := (mcoeff i p) : ring_scope. #[global] Hint Resolve msupp_uniq : core. (* -------------------------------------------------------------------- *) Section NVar0. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}). Lemma nvar0_mnmE : @all_equal_to 'X_{1..0} 0%MM. Proof. by move=> mon; apply/mnmP; case. Qed. Lemma nvar0_mpolyC (p : {mpoly R[0]}): p = (p@_0%MM)%:MP. Proof. by apply/mpolyP=> m; rewrite mcoeffC nvar0_mnmE eqxx mulr1. Qed. Lemma nvar0_mpolyC_eq p : n = 0%N -> p = (p@_0%MM)%:MP. Proof. by move=> z_p; move:p; rewrite z_p; apply/nvar0_mpolyC. Qed. End NVar0. (* -------------------------------------------------------------------- *) Section MPolyZMod. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}). Definition mpoly_opp p := [mpoly - mpoly_val p]. Definition mpoly_add p q := [mpoly mpoly_val p + mpoly_val q]. Lemma add_mpoly0 : left_id 0%:MP mpoly_add. Proof. by move=> p; apply/mpoly_eqP; rewrite !mpoly_valK freegU0 add0r. Qed. Lemma add_mpolyN : left_inverse 0%:MP mpoly_opp mpoly_add. Proof. by move=> p; apply/mpoly_eqP; rewrite !mpoly_valK freegU0 addrC subrr. Qed. Lemma add_mpolyC : commutative mpoly_add. Proof. by move=> p q; apply/mpoly_eqP; rewrite !mpoly_valK addrC. Qed. Lemma add_mpolyA : associative mpoly_add. Proof. by move=> p q r; apply/mpoly_eqP; rewrite !mpoly_valK addrA. Qed. HB.instance Definition _ := GRing.isZmodule.Build (mpoly n R) add_mpolyA add_mpolyC add_mpoly0 add_mpolyN. HB.instance Definition _ := GRing.Zmodule.on {mpoly R[n]}. Definition mpoly_scale c p := [mpoly c *: mpoly_val p]. Local Notation "c *:M p" := (mpoly_scale c p) (at level 40, left associativity). Lemma scale_mpolyA c1 c2 p : c1 *:M (c2 *:M p) = (c1 * c2) *:M p. Proof. by apply/mpoly_eqP; rewrite !mpoly_valK scalerA. Qed. Lemma scale_mpoly1m p : 1 *:M p = p. Proof. by apply/mpoly_eqP; rewrite !mpoly_valK scale1r. Qed. Lemma scale_mpolyDr c p1 p2 : c *:M (p1 + p2) = c *:M p1 + c *:M p2. Proof. by apply/mpoly_eqP; rewrite !mpoly_valK scalerDr. Qed. Lemma scale_mpolyDl p c1 c2 : (c1 + c2) *:M p = c1 *:M p + c2 *:M p. Proof. by apply/mpoly_eqP; rewrite !mpoly_valK scalerDl. Qed. HB.instance Definition _ := GRing.Zmodule_isLmodule.Build R (mpoly n R) scale_mpolyA scale_mpoly1m scale_mpolyDr scale_mpolyDl. HB.instance Definition _ := GRing.Lmodule.on {mpoly R[n]}. Local Notation mcoeff := (@mcoeff n R). Lemma mcoeff_is_additive m : additive (mcoeff m). Proof. by move=> p q /=; rewrite /mcoeff raddfB. Qed. HB.instance Definition _ m := GRing.isAdditive.Build {mpoly R[n]} R (mcoeff m) (mcoeff_is_additive m). Lemma mcoeff0 m : mcoeff m 0 = 0 . Proof. exact: raddf0. Qed. Lemma mcoeffN m : {morph mcoeff m: x / - x} . Proof. exact: raddfN. Qed. Lemma mcoeffD m : {morph mcoeff m: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mcoeffB m : {morph mcoeff m: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mcoeffMn m k : {morph mcoeff m: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma mcoeffMNn m k : {morph mcoeff m: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma mcoeffZ c p m : mcoeff m (c *: p) = c * (mcoeff m p). Proof. by rewrite /mcoeff coeffZ. Qed. HB.instance Definition _ m := GRing.isScalable.Build R {mpoly R[n]} R *%R (mcoeff m) (fun c => (mcoeffZ c)^~ m). Local Notation mpolyC := (@mpolyC n R). Lemma mpolyC_is_additive : additive mpolyC. Proof. by move=> p q; apply/mpoly_eqP; rewrite /= freegUB. Qed. HB.instance Definition _ := GRing.isAdditive.Build R {mpoly R[n]} mpolyC mpolyC_is_additive. Lemma mpolyC0 : mpolyC 0 = 0 . Proof. exact: raddf0. Qed. Lemma mpolyCN : {morph mpolyC: x / - x} . Proof. exact: raddfN. Qed. Lemma mpolyCD : {morph mpolyC: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mpolyCB : {morph mpolyC: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mpolyCMn k : {morph mpolyC: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma mpolyCMNn k : {morph mpolyC: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma msupp_eq0 p : (msupp p == [::]) = (p == 0). Proof. case: p=> p /=; rewrite msuppE /GRing.zero /= /mpolyC. by rewrite dom_eq0 freegU0 /=. Qed. Lemma msuppnil0 p : msupp p = [::] -> p = 0. Proof. by move/eqP; rewrite msupp_eq0 => /eqP. Qed. Lemma mpolyC_eq0 c : (c%:MP == 0 :> {mpoly R[n]}) = (c == 0). Proof. rewrite eqE /=; apply/idP/eqP=> [/freeg_eqP/(_ 0%MM)|->//]. by rewrite !coeffU eqxx !mulr1. Qed. End MPolyZMod. (* -------------------------------------------------------------------- *) HB.mixin Record isMeasure (n : nat) (mf : 'X_{1..n} -> nat) := { mf0 : mf 0%MM = 0%N; mfD : {morph mf : m1 m2 / (m1 + m2)%MM >-> (m1 + m2)%N}; }. #[short(type="measure")] HB.structure Definition Measure (n : nat) := {mf of isMeasure n mf}. #[deprecated(since="multinomials 2.2.0", note="Use Measure.clone instead.")] Notation "[ 'measure' 'of' f ]" := (Measure.clone _ f _) (at level 0, only parsing) : form_scope. (* -------------------------------------------------------------------- *) #[hnf] HB.instance Definition _ n := isMeasure.Build n mdeg mdeg0 mdegD. (* -------------------------------------------------------------------- *) Section MMeasure. Context (n : nat) (R : ringType) (mf : measure n). Implicit Types (m : 'X_{1..n}) (p q : {mpoly R[n]}). Lemma mfE m : mf m = (\sum_(i < n) (m i) * mf U_(i)%MM)%N. Proof. rewrite {1}(multinomUE_id m) (big_morph mf mfD mf0); apply/eq_bigr => i _. elim: (m i) => [// | d ih] /=; first by rewrite mul0n mulm0n mf0. by rewrite mulmS mulSn mfD ih. Qed. Definition mmeasure p := (\max_(m <- msupp p) (mf m).+1)%N. Lemma mmeasureE p : mmeasure p = (\max_(m <- msupp p) (mf m).+1)%N. Proof. by []. Qed. Lemma mmeasure0 : mmeasure 0 = 0%N. Proof. by rewrite /mmeasure msupp0 big_nil. Qed. Lemma mmeasure_mnm_lt p m : m \in msupp p -> mf m < mmeasure p. Proof. by move=> m_in_p; rewrite /mmeasure (bigD1_seq m) //= leq_max leqnn. Qed. Lemma mmeasure_mnm_ge p m : mmeasure p <= mf m -> m \notin msupp p. Proof. by apply/contra_leqN => /mmeasure_mnm_lt. Qed. End MMeasure. (* -------------------------------------------------------------------- *) Section MSuppZMod. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (D : {freeg 'X_{1..n} / R}). Lemma msuppN p : perm_eq (msupp (-p)) (msupp p). Proof. by apply/domN_perm_eq. Qed. Lemma msuppD_le p q : {subset msupp (p + q) <= msupp p ++ msupp q}. Proof. by move=> x /domD_subset. Qed. Lemma msuppB_le p q : {subset msupp (p - q) <= msupp p ++ msupp q}. Proof. by move=> x /msuppD_le; rewrite !mem_cat (perm_mem (msuppN _)). Qed. Lemma msuppD (p1 p2 : {mpoly R[n]}) : [predI (msupp p1) & (msupp p2)] =1 xpred0 -> perm_eq (msupp (p1 + p2)) (msupp p1 ++ msupp p2). Proof. by apply/domD_perm_eq. Qed. Lemma msupp_sum_le (T : Type) (F : T -> {mpoly R[n]}) P (r : seq T) : {subset msupp (\sum_(i <- r | P i) (F i)) <= flatten [seq msupp (F i) | i <- r & P i]}. Proof. elim: r => /= [|x r ih]; first by rewrite !big_nil msupp0. rewrite !big_cons; case: (P x)=> // m /msuppD_le. by rewrite !mem_cat => /orP [->//|] /ih ->; rewrite orbT. Qed. Lemma msupp_sum (T : eqType) (r : seq T) (P : pred T) (F : T -> {mpoly R[n]}) : uniq r -> {in r &, forall x y, x != y -> [predI (msupp (F x)) & (msupp (F y))] =1 xpred0} -> perm_eq (msupp (\sum_(i <- r | P i) F i)) (flatten [seq msupp (F i) | i <- r & P i]). Proof. elim: r => /= [|x r ih]; first by rewrite !big_nil msupp0. case/andP=> x_notin_r uq_r h; rewrite !big_cons /=. case: (P x); last apply/ih=> //; last first. by move=> y1 y2 y1_in_r y2_in_r; apply/h; rewrite 1?mem_behead. move/(_ uq_r): ih; rewrite -(perm_cat2l (msupp (F x))) => h'. rewrite -(permPr (h' _)); first apply/msuppD. move=> m /=; case: (boolP (m \in _))=> //= m_in_Fx. apply/negP=> /msupp_sum_le /flattenP[/= ms] /mapP[y]. rewrite mem_filter => /andP[_ y_in_r] ->. have /= := h x y _ _ _ m; rewrite m_in_Fx=> /= -> //. by rewrite mem_head. by rewrite mem_behead. by move/memPnC: x_notin_r => /(_ _ y_in_r). by move=> y1 y2 y1_in_r y2_in_r; apply/h; rewrite 1?mem_behead. Qed. End MSuppZMod. (* -------------------------------------------------------------------- *) Notation msize p := (@mmeasure _ _ mdeg p). (* -------------------------------------------------------------------- *) Section MWeight. Context {n : nat}. Implicit Types (m : 'X_{1..n}). Definition mnmwgt m := (\sum_i m i * i.+1)%N. Lemma mnmwgt0 : mnmwgt 0 = 0%N. Proof. by rewrite /mnmwgt big1 // => /= i _; rewrite mnm0E mul0n. Qed. Lemma mnmwgt1 i : mnmwgt U_(i) = i.+1. Proof. rewrite /mnmwgt (bigD1 i) //= mnm1E eqxx mul1n. rewrite big1 ?addn0 //= => j ne_ij; rewrite mnm1E. by rewrite eq_sym (negbTE ne_ij) mul0n. Qed. Lemma mnmwgtD m1 m2 : mnmwgt (m1 + m2) = (mnmwgt m1 + mnmwgt m2)%N. Proof. rewrite /mnmwgt -big_split /=; apply/eq_bigr=> i _. by rewrite mnmDE mulnDl. Qed. End MWeight. #[hnf] HB.instance Definition _ n := isMeasure.Build n mnmwgt mnmwgt0 mnmwgtD. (* -------------------------------------------------------------------- *) (* FIXME: removing Measure.clone below breaks the proof of mweight_XLS *) Notation mweight p := (@mmeasure _ _ (Measure.clone _ mnmwgt _) p). Section MSize. Context (n : nat) (R : ringType). Implicit Types (m : 'X_{1..n}) (p : {mpoly R[n]}). Lemma msizeE p : msize p = (\max_(m <- msupp p) (mdeg m).+1)%N. Proof. exact/mmeasureE. Qed. Definition msize0 := mmeasure0 R (@mdeg n). Lemma msize_mdeg_lt p m : m \in msupp p -> mdeg m < msize p. Proof. exact/mmeasure_mnm_lt. Qed. Lemma msize_mdeg_ge p m : msize p <= mdeg m -> m \notin msupp p. Proof. exact/mmeasure_mnm_ge. Qed. End MSize. (* -------------------------------------------------------------------- *) Section MMeasureZMod. Context (n : nat) (R : ringType) (mf : measure n). Implicit Types (c : R) (m : 'X_{1..n}) (p q : {mpoly R[n]}). Local Notation mmeasure := (@mmeasure n R mf). Lemma mmeasureC c : mmeasure c%:MP = (c != 0%R) :> nat. Proof. rewrite mmeasureE msuppC; case: (_ == 0)=> /=. by rewrite big_nil. by rewrite big_seq1 mf0. Qed. Lemma mmeasureD_le p q : mmeasure (p + q) <= maxn (mmeasure p) (mmeasure q). Proof. rewrite {1}mmeasureE big_tnth; apply/bigmax_leqP=> /= i _. set m := tnth _ _; have: m \in msupp (p + q) by apply/mem_tnth. move/msuppD_le; rewrite leq_max mem_cat. by case/orP=> /mmeasure_mnm_lt->; rewrite !simpm. Qed. Lemma mmeasure_sum (T : Type) (r : seq _) (F : T -> {mpoly R[n]}) (P : pred T) : mmeasure (\sum_(i <- r | P i) F i) <= \max_(i <- r | P i) mmeasure (F i). Proof. elim/big_rec2: _ => /= [|i k p _ le]; first by rewrite mmeasure0. apply/(leq_trans (mmeasureD_le _ _)); rewrite geq_max. by rewrite leq_maxl /= leq_max le orbC. Qed. Lemma mmeasureN p : mmeasure (-p) = mmeasure p. Proof. by rewrite mmeasureE (perm_big _ (msuppN _)). Qed. Lemma mmeasure_poly_eq0 p : (mmeasure p == 0%N) = (p == 0). Proof. apply/idP/eqP=> [z_p|->]; last by rewrite mmeasure0. apply/mpoly_eqP; move: z_p; rewrite mmeasureE. rewrite {2}[p]freeg_mpoly; case: (msupp p). by rewrite !big_nil /= freegU0. by move=> m q; rewrite !big_cons -leqn0 geq_max. Qed. Lemma mpolySpred p : p != 0 -> mmeasure p = (mmeasure p).-1.+1. Proof. by rewrite -mmeasure_poly_eq0 -lt0n => /prednK. Qed. Lemma mmeasure_msupp0 p : (mmeasure p == 0%N) = (msupp p == [::]). Proof. rewrite mmeasureE; case: (msupp _) => [|m s]. by rewrite big_nil !eqxx. rewrite big_cons /= -[_::_==_]/false; apply/negbTE. by rewrite -lt0n leq_max. Qed. End MMeasureZMod. (* -------------------------------------------------------------------- *) Definition msizeC n R := @mmeasureC n R mdeg. Definition msizeD_le n R := @mmeasureD_le n R mdeg. Definition msize_sum n R := @mmeasure_sum n R mdeg. Definition msizeN n R := @mmeasureN n R mdeg. Definition msize_poly_eq0 n R := @mmeasure_poly_eq0 n R mdeg. Definition msize_msupp0 n R := @mmeasure_msupp0 n R mdeg. (* -------------------------------------------------------------------- *) Definition polyn (R : ringType) := fix polyn n := if n is p.+1 then {poly (polyn p)} else R. Definition ipoly (T : Type) : Type := T. Notation "{ 'ipoly' T [ n ] }" := (polyn T n). Notation "{ 'ipoly' T [ n ] }^p" := (ipoly {ipoly T[n]}). Section IPoly. Context (R : ringType) (n : nat). HB.instance Definition _ := GRing.Ring.on {ipoly R[n]}^p. End IPoly. (* -------------------------------------------------------------------- *) Section Inject. Context (R : ringType). Fixpoint inject n m (p : {ipoly R[n]}) : {ipoly R[m + n]} := if m is m'.+1 return {ipoly R[m + n]} then (inject m' p)%:P else p. Lemma inject_inj n m : injective (@inject n m). Proof. by elim: m=> [|m ih] p q //= /polyC_inj /ih. Qed. Lemma inject_is_additive n m : additive (@inject n m). Proof. elim: m => [|m ih] //=; rewrite -/(_ \o _). pose iaM := GRing.isAdditive.Build _ _ _ ih. pose iA : GRing.Additive.type _ _ := HB.pack (@inject n m) iaM. have ->: inject m = iA by []. exact: raddfB. Qed. HB.instance Definition _ n m := GRing.isAdditive.Build {ipoly R[n]} {ipoly R[m+n]} (@inject n m) (@inject_is_additive n m). Lemma inject_is_multiplicative n m : multiplicative (@inject n m). Proof. elim: m => [|m ih] //=; rewrite -/(_ \o _). pose imM := GRing.isMultiplicative.Build _ _ _ ih. pose iM : GRing.RMorphism.type _ _ := HB.pack (@inject n m) imM. have ->: inject m = iM by []. exact: (rmorphM _, rmorph1 _). Qed. HB.instance Definition _ n m := GRing.isMultiplicative.Build {ipoly R[n]} {ipoly R[m+n]} (@inject n m) (@inject_is_multiplicative n m). Definition inject_cast n m k E : {ipoly R[n]} -> {ipoly R[k]} := ecast k (_ -> {ipoly R[k]}) E (@inject n m). Lemma inject_cast_inj n m k E : injective (@inject_cast n m k E). Proof. by case: k / E; apply/inject_inj. Qed. Lemma inject_cast_is_additive n m k E : additive (@inject_cast n m k E). Proof. case: k /E; exact: raddfB. Qed. Lemma inject_cast_is_multiplicative n m k E : multiplicative (@inject_cast n m k E). Proof. case: k / E; exact: (rmorphM _, rmorph1 _). Qed. HB.instance Definition _ n m k e := GRing.isAdditive.Build {ipoly R[n]} {ipoly R[k]} (@inject_cast n m k e) (inject_cast_is_additive e). HB.instance Definition _ n m k e := GRing.isMultiplicative.Build {ipoly R[n]} {ipoly R[k]} (@inject_cast n m k e) (inject_cast_is_multiplicative e). Lemma inject1_proof n (i : 'I_n.+1) : (n - i + i = n)%N. Proof. by rewrite subnK // -ltnS. Qed. Definition inject1 n (i : 'I_n.+1) (p : {ipoly R[i]}) : {ipoly R[n]} := inject_cast (inject1_proof i) p. Local Notation "c %:IP" := (inject_cast (inject1_proof ord0) c). Section IScale. Context (n : nat). Lemma iscaleA (c1 c2 : R) (p : {ipoly R[n]}) : c1%:IP * (c2%:IP * p) = (c1 * c2)%:IP * p. Proof. by rewrite mulrA rmorphM /=. Qed. Lemma iscale1r (p : {ipoly R[n]}) : 1%:IP * p = p. Proof. by rewrite rmorph1 mul1r. Qed. Lemma iscaleDr (c : R) (p q : {ipoly R[n]}) : c%:IP * (p + q) = c%:IP * p + c%:IP * q. Proof. by rewrite mulrDr. Qed. Lemma iscaleDl (p : {ipoly R[n]}) (c1 c2 : R) : (c1 + c2)%:IP * p = c1%:IP * p + c2%:IP * p. Proof. by rewrite raddfD /= mulrDl. Qed. Definition iscale (c : R) (p : {ipoly R[n]}) := c%:IP * p. HB.instance Definition _ := GRing.Zmodule_isLmodule.Build R {ipoly R[n]}^p iscaleA iscale1r iscaleDr iscaleDl. End IScale. Definition injectX n (m : 'X_{1..n}) : {ipoly R[n]} := \prod_(i < n) (@inject1 _ (rshift 1 i) 'X)^+(m i). Definition minject n (p : {mpoly R[n]}) : {ipoly R[n]} := fglift (@injectX n : _ -> {ipoly R[n]}^p) p. End Inject. (* -------------------------------------------------------------------- *) Section MPolyRing. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (m : 'X_{1..n}). Local Notation "`| p |" := (msize p) : ring_scope. Local Notation "!| m |" := (mdeg m) (format "!| m |"): ring_scope. Local Notation "p *M_[ m ] q" := << (p@_m.1)%MM * (q@_m.2)%MM *g (m.1 + m.2)%MM >> (at level 40, no associativity, format "p *M_[ m ] q"). Definition mpoly_mul p q : {mpoly R[n]} := [mpoly \sum_(m <- msupp p @@ msupp q) p *M_[m] q]. Local Notation "p *M q" := (mpoly_mul p q) (at level 40, left associativity, format "p *M q"). Lemma mul_poly1_eq0L p q (m : 'X_{1..n} * 'X_{1..n}) : m.1 \notin msupp p -> p *M_[m] q = 0. Proof. by move/memN_msupp_eq0=> ->; rewrite mul0r freegU0. Qed. Lemma mul_poly1_eq0R p q (m : 'X_{1..n} * 'X_{1..n}) : m.2 \notin msupp q -> p *M_[m] q = 0. Proof. by move/memN_msupp_eq0=> ->; rewrite mulr0 freegU0. Qed. Lemma mpoly_mulwE p q kp kq : msize p <= kp -> msize q <= kq -> p *M q = [mpoly \sum_(m : 'X_{1..n < kp, kq}) p *M_[m] q]. Proof. pose Ip : subFinType _ := 'X_{1..n < kp}. pose Iq : subFinType _ := 'X_{1..n < kq}. move=> lep leq; apply/mpoly_eqP/esym=> /=. rewrite big_allpairs/= big_pairA. rewrite (big_mksub Ip) ?msupp_uniq //=; first last. by move=> x /msize_mdeg_lt /leq_trans; apply. rewrite [X in _ = X]big_rmcond /=; last first. move=> i /memN_msupp_eq0 ->; rewrite big1=> //. by move=> j _; rewrite mul0r freegU0. apply/eq_bigr=> i _; rewrite (big_mksub Iq) /=; first last. by move=> x /msize_mdeg_lt /leq_trans; apply. by rewrite msupp_uniq. rewrite [X in _ = X]big_rmcond //= => j /memN_msupp_eq0 ->. by rewrite mulr0 freegU0. Qed. Arguments mpoly_mulwE [p q]. Lemma mpoly_mul_revwE p q kp kq : msize p <= kp -> msize q <= kq -> p *M q = [mpoly \sum_(m : 'X_{1..n < kq, kp}) p *M_[(m.2, m.1)] q]. Proof. by move=> lep leq; rewrite big_pairA exchange_big pair_bigA -mpoly_mulwE. Qed. Arguments mpoly_mul_revwE [p q]. Lemma mcoeff_poly_mul p q m k : !|m| < k -> (p *M q)@_m = \sum_(k : 'X_{1..n < k, k} | m == (k.1 + k.2)%MM) p@_k.1 * q@_k.2. Proof. pose_big_enough i; first rewrite (mpoly_mulwE i i) // => lt_mk. rewrite mcoeff_MPoly raddf_sum /=; have lt_mi: k < i by []. apply/esym; rewrite big_cond_mulrn !big_pairA /=. pose Ik : subFinType _ := 'X_{1..n < k}. pose Ii : subFinType _ := 'X_{1..n < i}. pose F i j := (p@_i * q@_j) *+ (m == (i + j))%MM. pose G i := \sum_(j : 'X_{1..n < k}) (F i j). rewrite (big_sub_widen Ik Ii xpredT G) /=; last first. by move=> x /leq_trans; apply. rewrite big_rmcond /=; last first. case=> /= j _; rewrite -leqNgt => /(leq_trans lt_mk) h. rewrite {}/G {}/F big1 // => /= l _. case: eqP h => [{1}->|]; last by rewrite mulr0n. by rewrite mdegD ltnNge leq_addr. apply/eq_bigr=> j _; rewrite {}/G. rewrite (big_sub_widen Ik Ii xpredT (F _)) /=; last first. by move=> x /leq_trans; apply. rewrite big_rmcond => //=; last first. move=> l; rewrite -leqNgt => /(leq_trans lt_mk) h. rewrite {}/F; case: eqP h; rewrite ?mulr0n //. by move=> ->; rewrite mdegD ltnNge leq_addl. by apply/eq_bigr=> l _; rewrite {}/F coeffU eq_sym mulr_natr. by close. Qed. Lemma mcoeff_poly_mul_rev p q m k : !|m| < k -> (p *M q)@_m = \sum_(k : 'X_{1..n < k, k} | m == (k.1 + k.2)%MM) p@_k.2 * q@_k.1. Proof. move=> /mcoeff_poly_mul ->; rewrite big_cond_mulrn. rewrite big_pairA /= exchange_big pair_bigA /=. by rewrite /= -big_cond_mulrn; apply/eq_big=> // i /=; rewrite addmC. Qed. Lemma mcoeff_poly_mul_lin p q m k : !|m| < k -> (p *M q)@_m = \sum_(k : 'X_{1..n < k} | (k <= m)%MM) p@_k * q@_(m-k). Proof. move=> lt_m_k; rewrite (mcoeff_poly_mul _ _ (k := k)) //. pose P (k1 k2 : 'X_{1..n < k}) := m == (k1 + k2)%MM. pose Q (k : 'X_{1..n < k}) := (k <= m)%MM. pose F (k1 k2 : 'X_{1..n}) := p@_k1 * q@_k2. rewrite -(pair_big_dep xpredT P F) (bigID Q) /= addrC. (rewrite big1 ?add0r {}/P {}/Q; first apply/eq_bigr)=> /= h1. + move=> le_h1_m; have pr: !|m - h1| < k. by rewrite (leq_ltn_trans _ lt_m_k) // mdegB. rewrite (big_pred1 (BMultinom pr)) //= => h2 /=. rewrite bmeqP /=; apply/eqP/eqP=> ->. * by rewrite addmC addmK. * by rewrite addmC submK //; apply/mnm_lepP. + rewrite negb_forall => /existsP /= [i Nle]. rewrite big_pred0 //= => h2; apply/negbTE/eqP. move/mnmP/(_ i); rewrite mnmDE=> eq; move: Nle. by rewrite eq leq_addr. Qed. Arguments mcoeff_poly_mul_lin [p q m]. Local Notation mcoeff_pml := mcoeff_poly_mul_lin. Lemma mcoeff_poly_mul_lin_rev p q m k : !|m| < k -> (p *M q)@_m = \sum_(k : 'X_{1..n < k} | (k <= m)%MM) p@_(m-k) * q@_k. Proof. move=> /[dup] /mcoeff_pml -> lt. have pr (h : 'X_{1..n}) : !|m - h| < k by exact: leq_ltn_trans (mdegB _ _) _. pose F (k : 'X_{1..n < k}) := BMultinom (pr k). have inv_F (h : 'X_{1..n}): (h <= m)%MM -> (m - (m - h))%MM = h. by move=> le_hm; rewrite submBA // addmC addmK. rewrite (reindex_onto F F) //=; last first. by move=> h /inv_F eqh; apply/eqP; rewrite eqE /= eqh. apply/esym/eq_big => [h /=|h /inv_F -> //]; apply/esym; rewrite lem_subr eqE /=. by apply/eqP/idP => [<-|/inv_F //]; apply/mnm_lepP=> i; rewrite !mnmBE leq_subr. Qed. Arguments mcoeff_poly_mul_lin_rev [p q m]. Local Notation mcoeff_pmlr := mcoeff_poly_mul_lin_rev. Lemma poly_mulA : associative mpoly_mul. Proof. move=> p q r; apply/mpolyP=> mi; pose_big_enough b. rewrite (mcoeff_pml b) // (mcoeff_pmlr b) //. 2: by close. have h m: !|mi - m| < b by exact/(leq_ltn_trans (mdegB mi m)). pose coef3 mj mk := p@_mj * (q@_(mi - mj - mk)%MM * r@_mk). transitivity (\sum_(mj : 'X_{1..n < b} | (mj <= mi)%MM) \sum_(mk : 'X_{1..n < b} | (mk <= mi - mj)%MM) coef3 mj mk). by apply/eq_bigr=> /= mj _; rewrite (mcoeff_pmlr b) 1?big_distrr. pose P (mj : 'X_{1..n < b}) := (mj <= mi)%MM. rewrite (exchange_big_dep P) //= {}/P; last first. by move=> mj mk _ /lepm_trans; apply; apply/lem_subr. apply/eq_bigr=> /= mk /mnm_lepP le_mk_mi. transitivity (\sum_(mj : 'X_{1..n < b} | (mj <= mi - mk)%MM) coef3 mj mk). + apply/eq_bigl=> m /=. apply/idP/idP => [/andP[/mnm_lepP le1 /mnm_lepP le2]|le1]. * apply/mnm_lepP => i; rewrite mnmBE /leq subnBA // addnC -subnBA //. by rewrite -mnmBE; apply/le2. * have le2: (m <= mi)%MM by rewrite (lepm_trans le1) ?lem_subr. rewrite le2; apply/mnm_lepP=> i; rewrite mnmBE /leq. move/mnm_lepP: le2 => le2; rewrite subnBA // addnC. by rewrite -subnBA //; move/mnm_lepP/(_ i): le1; rewrite mnmBE. rewrite (mcoeff_pml b) /coef3 1?big_distrl //=. by apply/eq_bigr=> mj le_mj_miBk; rewrite !mulrA !submDA addmC. Qed. Lemma poly_mul1m : left_id 1%:MP mpoly_mul. Proof. move=> p; apply/mpoly_eqP/esym; rewrite /mpoly_mul /=. rewrite msupp1 big_allpairs big_seq1 {1}[p]freeg_mpoly /=. by apply: eq_bigr => i _; rewrite mpolyCK !simpm. Qed. Lemma poly_mulm1 : right_id 1%:MP mpoly_mul. Proof. move=> p; apply/mpoly_eqP/esym; rewrite /mpoly_mul /=. rewrite msupp1 big_allpairs exchange_big big_seq1 {1}[p]freeg_mpoly /=. by apply: eq_bigr=> i _; rewrite mpolyCK !simpm. Qed. Lemma poly_mulDl : left_distributive mpoly_mul +%R. Proof. move=> p q r; pose_big_enough i. rewrite !(mpoly_mulwE i (msize r)) //=. apply/mpoly_eqP=> /=; rewrite -big_split /=; apply: eq_bigr. by case=> [[i1 /= _] [i2 /= _]] _; rewrite freegUD -mulrDl -mcoeffD. by close. Qed. Lemma poly_mulDr : right_distributive mpoly_mul +%R. Proof. move=> p q r; pose_big_enough i. rewrite !(mpoly_mulwE (msize p) i) //=. apply/mpoly_eqP=> /=; rewrite -big_split /=; apply: eq_bigr. by case=> [[i1 /= _] [i2 /= _]] _; rewrite freegUD -mulrDr -mcoeffD. by close. Qed. Lemma poly_oner_neq0 : 1%:MP != 0 :> {mpoly R[n]}. Proof. by rewrite mpolyC_eq oner_eq0. Qed. HB.instance Definition _ := GRing.Zmodule_isRing.Build (mpoly n R) poly_mulA poly_mul1m poly_mulm1 poly_mulDl poly_mulDr poly_oner_neq0. HB.instance Definition _ := GRing.Ring.on {mpoly R[n]}. Lemma mcoeff1 m : 1@_m = (m == 0%MM)%:R. Proof. by rewrite mcoeffC mul1r. Qed. Lemma mcoeffM p q m : (p * q)@_m = \sum_(k : 'X_{1..n < !|m|.+1, !|m|.+1} | m == (k.1 + k.2)%MM) (p@_k.1 * q@_k.2). Proof. exact: mcoeff_poly_mul. Qed. Lemma mcoeffMr p q m : (p * q)@_m = \sum_(k : 'X_{1..n < !|m|.+1, !|m|.+1} | m == (k.1 + k.2)%MM) (p@_k.2 * q@_k.1). Proof. rewrite mcoeffM big_cond_mulrn big_pairA/=. rewrite exchange_big pair_bigA /= -big_cond_mulrn. by apply: eq_bigl=> k /=; rewrite addmC. Qed. Lemma msuppM_le p q : {subset msupp (p * q) <= [seq (m1 + m2)%MM | m1 <- msupp p, m2 <- msupp q]}. Proof. move=> m; rewrite -[_ \in _]negbK -mcoeff_eq0 mcoeffM=> nz_s. apply/memPn=> /= h; move: nz_s; rewrite big1 ?eqxx //=. case=> m1 m2 /=; pose m'1 : 'X_{1..n} := m1; pose m'2 : 'X_{1..n} := m2. move/eqP=> mE; case: (boolP (m'1 \in msupp p)); last first. by move/memN_msupp_eq0=> ->; rewrite mul0r. case: (boolP (m'2 \in msupp q)); last first. by move/memN_msupp_eq0=> ->; rewrite mulr0. rewrite {}/m'1 {}/m'2=> m2_in_q m1_in_p; absurd false=> //. move: (h m); rewrite eqxx; apply; apply/allpairsP=> /=. exists (m1 : 'X_{1..n}, m2 : 'X_{1..n}) => /=. by rewrite m1_in_p m2_in_q /=. Qed. Lemma mul_mpolyC c p : c%:MP * p = c *: p. Proof. have [->|nz_c] := eqVneq c 0; first by rewrite scale0r mul0r. apply/mpoly_eqP=> /=; rewrite big_allpairs msuppC (negbTE nz_c) big_seq1. by apply: eq_bigr => i _; rewrite mpolyCK !simpm. Qed. Lemma mcoeffCM c p m : (c%:MP * p)@_m = c * p@_m. Proof. by rewrite mul_mpolyC mcoeffZ. Qed. Lemma msuppZ_le (c : R) p : {subset msupp (c *: p) <= msupp p}. Proof. move=> /= m; rewrite !mcoeff_msupp -mul_mpolyC. rewrite mcoeffCM; have [->|//] := eqVneq p@_m 0. by rewrite mulr0 eqxx. Qed. Lemma mpolyC_is_multiplicative : multiplicative (mpolyC n (R := R)). Proof. split=> // p q; apply/mpolyP=> m. by rewrite mcoeffCM !mcoeffC mulrA. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build R {mpoly R[n]} (@mpolyC n R) mpolyC_is_multiplicative. Lemma mpolyC1 : mpolyC n 1 = 1. Proof. exact: rmorph1. Qed. Lemma msize1_polyC p : msize p <= 1 -> p = (p@_0)%:MP. Proof. move=> le_p_1; apply/mpolyP=> m; rewrite mcoeffC. case: (m =P 0%MM)=> [->|/eqP]; first by rewrite mulr1. rewrite mulr0 -mdeg_eq0 => nz_m; rewrite memN_msupp_eq0 //. by apply/msize_mdeg_ge; rewrite 1?(@leq_trans 1) // lt0n. Qed. Lemma msize_poly1P p : reflect (exists2 c, c != 0 & p = c%:MP) (msize p == 1%N). Proof. apply: (iffP eqP)=> [pC|[c nz_c ->]]; last by rewrite msizeC nz_c. have def_p: p = (p@_0)%:MP by rewrite -msize1_polyC ?pC. by exists p@_0; rewrite // -(mpolyC_eq0 n) -def_p -msize_poly_eq0 pC. Qed. Lemma mpolyC_nat (k : nat) : (k%:R)%:MP = k%:R :> {mpoly R[n]}. Proof. apply/mpolyP=> i; rewrite mcoeffC mcoeffMn mcoeffC. by rewrite mul1r commr_nat mulr_natr. Qed. Lemma mpolyCM : {morph mpolyC n (R := _): p q / p * q}. Proof. exact: rmorphM. Qed. Lemma mmeasure1 mf : mmeasure mf 1 = 1%N. Proof. by rewrite mmeasureC oner_eq0. Qed. Lemma msize1 : msize 1 = 1%N. Proof. exact/mmeasure1. Qed. Lemma mmeasureZ_le mf (p : {mpoly R[n]}) c : mmeasure mf (c *: p) <= mmeasure mf p. Proof. rewrite {1}mmeasureE big_tnth; apply/bigmax_leqP=> /= i _. set m := tnth _ _; have: m \in msupp (c *: p) by apply/mem_tnth. by move/msuppZ_le=> /mmeasure_mnm_lt->. Qed. Lemma mpoly_scaleAl c p q : c *: (p * q) = (c *: p) * q. Proof. by rewrite -!mul_mpolyC mulrA. Qed. HB.instance Definition _ := GRing.Lmodule_isLalgebra.Build R (mpoly n R) mpoly_scaleAl. HB.instance Definition _ := GRing.Lalgebra.on {mpoly R[n]}. Lemma alg_mpolyC c : c%:A = c%:MP :> {mpoly R[n]}. Proof. by rewrite -mul_mpolyC mulr1. Qed. Lemma mcoeff0_is_multiplicative : multiplicative (mcoeff 0%MM : {mpoly R[n]} -> R). Proof. split=> [p q|]; rewrite ?mpolyCK //. rewrite (mcoeff_poly_mul _ _ (k := 1)) ?mdeg0 //. rewrite (bigD1 (bm0, bm0)) ?simpm //=; last first. rewrite [X in _+X]big1 ?addr0 // => i /andP [] h. rewrite eqE /= !bmeqP /=; move/eqP/esym/(congr1 mdeg): h. rewrite mdegD [X in _=X]mdeg0 => /eqP; rewrite addn_eq0. by rewrite !mdeg_eq0=> /andP [/eqP->/eqP->]; rewrite !eqxx. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n]} R (mcoeff 0) mcoeff0_is_multiplicative. End MPolyRing. (* -------------------------------------------------------------------- *) Section MPolyVar. Context (n : nat) (R : ringType). Definition mpolyX_def (m : 'X_{1..n}) : {mpoly R[n]} := [mpoly << m >>]. Fact mpolyX_key : unit. Proof. by []. Qed. Definition mpolyX m : {mpoly R[n]} := locked_with mpolyX_key (mpolyX_def m). Canonical mpolyX_unlockable m := [unlockable of (mpolyX m)]. Definition mX (k : 'I_n) : 'X_{1..n} := nosimpl [multinom (i == k : nat) | i < n]. End MPolyVar. Notation "'X_[ R , m ]" := (@mpolyX _ R m). Notation "'X_[ m ]" := (@mpolyX _ _ m). Notation "'X_ i" := (@mpolyX _ _ U_(i)). (* -------------------------------------------------------------------- *) Section MPolyVarTheory. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (m : 'X_{1..n}). Local Notation "'X_[ m ]" := (@mpolyX n R m). Lemma msuppX m : msupp 'X_[m] = [:: m]. Proof. by rewrite unlock /msupp domU1. Qed. Lemma mem_msuppXP m m' : reflect (m = m') (m' \in msupp 'X_[m]). Proof. by rewrite msuppX mem_seq1; apply: (iffP eqP). Qed. Lemma mcoeffX m k : 'X_[m]@_k = (m == k)%:R. Proof. by rewrite unlock /mpolyX_def mcoeff_MPoly coeffU mul1r. Qed. Lemma mcoeffXU (i j : 'I_n) : ('X_i : {mpoly R[n]})@_U_(j) = (i == j)%:R. Proof. by rewrite mcoeffX eq_mnm1. Qed. Lemma mmeasureX mf m : mmeasure mf 'X_[R, m] = (mf m).+1. Proof. by rewrite mmeasureE msuppX big_seq1. Qed. Lemma msizeX m : msize 'X_[R, m] = (mdeg m).+1. Proof. exact/mmeasureX. Qed. Lemma msupp_rem (p : {mpoly R[n]}) m : perm_eq (msupp (p - p@_m *: 'X_[m])) (rem m (msupp p)). Proof. case: (boolP (m \in msupp p)) => h. apply/uniq_perm; rewrite ?rem_uniq //. move=> m'; rewrite mem_rem_uniq // inE /=. rewrite !mcoeff_msupp mcoeffB mcoeffZ mcoeffX. case: (eqVneq m' m) => [->|] /=. by rewrite mulr1 subrr eqxx. by rewrite mulr0 subr0. have/rem_id -> := h; move: h. rewrite mcoeff_msupp negbK=> /eqP ->. by rewrite scale0r subr0. Qed. Lemma mpolyX0 : 'X_[0] = 1. Proof. by apply/mpolyP=> m; rewrite mcoeffX mcoeffC mul1r eq_sym. Qed. Lemma mpolyXD m1 m2 : 'X_[m1 + m2] = 'X_[m1] * 'X_[m2] :> {mpoly R[n]}. Proof. apply/mpoly_eqP; rewrite /GRing.mul /= !msuppX big_seq1 /=. by rewrite !mcoeffX !eqxx !simpm unlock /=. Qed. Lemma mpolyX_prod s P : \prod_(i <- s | P i) 'X_[i] = 'X_[\sum_(i <- s | P i) i]. Proof. elim: s => [|i s ih]; first by rewrite !big_nil mpolyX0. by rewrite !big_cons; case: (P i); rewrite ?mpolyXD ih. Qed. Lemma mpolyXn m i : 'X_[m] ^+ i = 'X_[m *+ i]. Proof. elim: i=> [|i ih]; first by rewrite expr0 mulm0n mpolyX0. by rewrite mulmS mpolyXD -ih exprS. Qed. Lemma mprodXnE {I} F P (m : I -> nat) (r : seq _) : \prod_(i <- r | P i) 'X_[R, F i] ^+ m i = 'X_[\sum_(i <- r | P i) (F i *+ m i)]. Proof. elim/big_rec2: _ => /= [|i m' p Pi ->]. by rewrite mpolyX0. by rewrite ?(mpolyXD, mpolyXn). Qed. Lemma mprodXE {I} (F : I -> 'X_{1..n}) P (r : seq _) : \prod_(i <- r | P i) 'X_[R, F i] = 'X_[\sum_(i <- r | P i) F i]. Proof. rewrite (eq_bigr (fun i => 'X_[R, F i] ^+ 1)) => [|i _]. by rewrite mprodXnE. by rewrite expr1. Qed. Lemma mpolyXE (s : 'S_n) m : 'X_[m] = \prod_(i < n) 'X_(s i) ^+ m (s i). Proof. rewrite {1}[m](multinomUE s) -mprodXE. by apply/eq_bigr=> i _; rewrite mpolyXn. Qed. Lemma mpolyXE_id m : 'X_[m] = \prod_(i < n) 'X_i ^+ m i. Proof. by rewrite (mpolyXE 1); apply/eq_bigr=> /= i _; rewrite perm1. Qed. Lemma mcoeffXn m i k : ('X_[m] ^+ i)@_k = ((m *+ i)%MM == k)%:R. Proof. by rewrite mpolyXn mcoeffX. Qed. Lemma mpolyE p : p = \sum_(m <- msupp p) (p@_m *: 'X_[m]). Proof. apply/mpolyP=> m; rewrite {1}[p]freeg_mpoly /= mcoeff_MPoly. rewrite !raddf_sum /=; apply/eq_bigr=> i _. by rewrite -mul_mpolyC mcoeffCM mcoeffX coeffU. Qed. Lemma mpolywE k p : msize p <= k -> p = \sum_(m : 'X_{1..n < k}) (p@_m *: 'X_[m]). Proof. move=> lt_pk; pose I : subFinType _ := 'X_{1..n < k}. rewrite {1}[p]mpolyE (big_mksub I) //=; first last. by move=> x /msize_mdeg_lt /leq_trans; apply. by rewrite msupp_uniq. by rewrite big_rmcond //= => i; move/memN_msupp_eq0 ->; rewrite scale0r. Qed. Lemma mpolyME p q : p * q = \sum_(m <- msupp p @@ msupp q) (p@_m.1 * q@_m.2) *: 'X_[m.1 + m.2]. Proof. apply/mpolyP=> m; rewrite {1}/GRing.mul /= mcoeff_MPoly. rewrite !raddf_sum; apply/eq_bigr=> i _ /=. by rewrite coeffU -mul_mpolyC mcoeffCM mcoeffX. Qed. Lemma mpolywME p q k : msize p <= k -> msize q <= k -> p * q = \sum_(m : 'X_{1..n < k, k}) (p@_m.1 * q@_m.2) *: 'X_[m.1 + m.2]. Proof. move=> ltpk ltqk; rewrite mpolyME; pose I : subFinType _ := 'X_{1..n < k}. rewrite big_allpairs (big_mksub I) /=; last first. by move=> m /msize_mdeg_lt /leq_trans; apply. by rewrite msupp_uniq. rewrite big_rmcond /= => [|i]; last first. by move/memN_msupp_eq0=> ->; rewrite big1 // => j _; rewrite mul0r scale0r. rewrite big_pairA /=; apply/eq_bigr=> i _; rewrite (big_mksub I)/=; last first. - by move=> m /msize_mdeg_lt /leq_trans; apply. - by rewrite msupp_uniq. rewrite big_rmcond /= => [//|j]. by move/memN_msupp_eq0=> ->; rewrite mulr0 scale0r. Qed. Lemma commr_mpolyX m p : GRing.comm p 'X_[m]. Proof. apply/mpolyP=> k; rewrite mcoeffM mcoeffMr. by apply/eq_bigr=> /= i _; rewrite !mcoeffX GRing.commr_nat. Qed. Lemma mcoeffMX p m k : (p * 'X_[m])@_(m + k) = p@_k. Proof. rewrite commr_mpolyX mpolyME msuppX big_allpairs. rewrite big_seq1 [X in _=X@__]mpolyE !raddf_sum /=. by apply/eq_bigr=> i _; rewrite !mcoeffZ !mcoeffX eqxx mul1r eqm_add2l. Qed. Lemma msuppMX p m : perm_eq (msupp (p * 'X_[m])) [seq (m + m')%MM | m' <- msupp p]. Proof. apply/uniq_perm=> //; first rewrite map_inj_uniq //. by move=> m1 m2 /=; rewrite ![(m + _)%MM]addmC; apply: addIm. move=> m'; apply/idP/idP; last first. case/mapP=> mp mp_in_p ->; rewrite mcoeff_msupp. by rewrite mcoeffMX -mcoeff_msupp. move/msuppM_le; rewrite msuppX => /allpairsP [[p1 p2]] /=. rewrite mem_seq1; case=> p1_in_p /eqP <- ->. by apply/mapP; exists p1; last rewrite addmC. Qed. Lemma msuppMCX c m : c != 0 -> msupp (c *: 'X_[m]) = [:: m]. Proof. move=> nz_c; rewrite -mul_mpolyC; apply/perm_small_eq=> //. by rewrite (permPl (msuppMX _ _)) msuppC (negbTE nz_c) /= addm0. Qed. Lemma msupp_sumX (r : seq 'X_{1..n}) (f : 'X_{1..n} -> R) : uniq r -> {in r, forall m, f m != 0} -> perm_eq (msupp (\sum_(m <- r) (f m) *: 'X_[m])) r. Proof. move=> uq_r h; set F := fun m => (f m *: 'X_[m] : {mpoly R[n]}). have msFm m: m \in r -> msupp (f m *: 'X_[m]) = [:: m]. by move=> m_in_r; rewrite msuppMCX // h. rewrite (permPl (msupp_sum xpredT _ _)) //. move/eq_in_map: msFm; rewrite filter_predT=> ->. set s := flatten _; have ->: s = r => //. by rewrite {}/s; elim: {uq_r h} r=> //= m r ->. move=> m1 m2 /h nz_fm1 /h nz_fm2 nz_m1m2 m /=. rewrite !msuppMCX // !mem_seq1; case: eqP=> //= ->. by rewrite (negbTE nz_m1m2). Qed. Lemma mcoeff_mpoly (E : 'X_{1..n} -> R) m k : mdeg m < k -> (\sum_(m : 'X_{1..n < k}) (E m *: 'X_[m]))@_m = E m. Proof. move=> lt_mk; rewrite raddf_sum (bigD1 (Sub m lt_mk)) //=. rewrite big1 ?addr0; last first. case=> i /= lt_ik; rewrite eqE /= => ne_im. by rewrite mcoeffZ mcoeffX (negbTE ne_im) mulr0. by rewrite mcoeffZ mcoeffX eqxx mulr1. Qed. Lemma MPoly_is_linear: linear (@MPoly n R). Proof. by move=> c p q; apply/mpoly_eqP. Qed. HB.instance Definition _ := GRing.isLinear.Build R {freeg 'X_{1.. n} / R} {mpoly R[n]} _ (@MPoly n R) MPoly_is_linear. Lemma MPolyU c m : MPoly << c *g m >> = c *: 'X_[m]. Proof. apply/mpolyP=> k; rewrite mcoeff_MPoly. by rewrite mcoeffZ mcoeffX coeffU. Qed. Lemma mpolyrect (P : {mpoly R[n]} -> Type) : P 0 -> (forall c m p, m \notin msupp p -> c != 0 -> P p -> P (c *: 'X_[m] + p)) -> forall p, P p. Proof. move=> h0 hS [p] /=; elim/freeg_rect_dom0: p => [|c q m mdom nz_c /hS h]. by rewrite raddf0. by rewrite raddfD /= MPolyU; apply: h. Qed. Lemma mpolyind (P : {mpoly R[n]} -> Prop) : P 0 -> (forall c m p, m \notin msupp p -> c != 0 -> P p -> P (c *: 'X_[m] + p)) -> forall p, P p. Proof. exact: mpolyrect. Qed. End MPolyVarTheory. (* -------------------------------------------------------------------- *) Section MPolyLead. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}). Definition mlead p : 'X_{1..n} := (\join_(m <- msupp p) m)%O. Lemma mleadC (c : R) : mlead c%:MP = 0%MM. Proof. rewrite /mlead msuppC; case: eqP=> _. by rewrite big_nil. by rewrite big_seq1. Qed. Lemma mlead0 : mlead 0 = 0%MM. Proof. by rewrite mleadC. Qed. Lemma mlead1 : mlead 1 = 0%MM. Proof. by rewrite mleadC. Qed. Lemma mleadXm m : mlead 'X_[m] = m. Proof. by rewrite /mlead msuppX big_seq1. Qed. Lemma mlead_supp p : p != 0 -> mlead p \in msupp p. Proof. rewrite -msupp_eq0 /mlead => nz_p; case: bigjoinP => //; first exact: le_total. by case: (msupp p) nz_p. Qed. Lemma mlead_deg p : p != 0 -> (mdeg (mlead p)).+1 = msize p. Proof. move=> /mlead_supp lc_in_p; rewrite /mlead msizeE mdeg_bigmax. have: msupp p != [::] by case: (msupp p) lc_in_p. elim: (msupp p)=> [|m [|m' r] ih] // _; first by rewrite !big_seq1. by rewrite big_cons -maxnSS {}ih // !big_cons. Qed. Lemma msupp_le_mlead p m : m \in msupp p -> (m <= mlead p)%O. Proof. by move=> mp; apply/joins_sup_seq. Qed. Lemma mleadN p : mlead (-p) = mlead p. Proof. have [->|nz_p] := eqVneq p 0; first by rewrite oppr0. by rewrite /mlead (perm_big _ (msuppN p)). Qed. Lemma mleadD_le p q : (mlead (p + q) <= mlead p `|` mlead q)%O. Proof. have [->|] := eqVneq (p+q) 0; first by rewrite mlead0 le0x. move/mlead_supp/msuppD_le; rewrite mem_cat => /orP[]. + by move/msupp_le_mlead=> h; apply/(le_trans h)/leUl. + by move/msupp_le_mlead=> h; apply/(le_trans h)/leUr. Qed. Lemma mleadB_le p q : (mlead (p - q) <= mlead p `|` mlead q)%O. Proof. by rewrite -(mleadN q); apply/mleadD_le. Qed. Lemma mleadc_eq0 p : (p@_(mlead p) == 0) = (p == 0). Proof. apply/idP/idP => [|/eqP->]; last by rewrite mcoeff0. by case: (p =P 0) => // /eqP /mlead_supp; rewrite mcoeff_eq0 => ->. Qed. Lemma mcoeff_gt_mlead p m : (mlead p < m)%O -> p@_m = 0. Proof. move=> lt_lcp_m; apply/eqP; rewrite mcoeff_eq0; apply/negP. by move/msupp_le_mlead; rewrite leNgt lt_lcp_m. Qed. Lemma mleadDr (p1 p2 : {mpoly R[n]}) : (mlead p1 < mlead p2)%O -> mlead (p1 + p2) = mlead p2. Proof. move=> lt_p1p2. apply/le_anti. move/ltW/join_r: (lt_p1p2) (mleadD_le p1 p2) => -> -> /=. rewrite leNgt; apply/negP=> /mcoeff_gt_mlead. rewrite mcoeffD mcoeff_gt_mlead // add0r => /eqP. rewrite mleadc_eq0=> /eqP z_p2; move: lt_p1p2. by rewrite z_p2 mlead0 ltx0. Qed. Lemma mleadDl (p1 p2 : {mpoly R[n]}) : (mlead p2 < mlead p1)%O -> mlead (p1 + p2) = mlead p1. Proof. by move/mleadDr; rewrite addrC => ->. Qed. Lemma mleadD (p1 p2 : {mpoly R[n]}) : mlead p1 != mlead p2 -> mlead (p1 + p2) = (mlead p1 `|` mlead p2)%O. Proof. by case: ltgtP => [/mleadDr ->|/mleadDl ->|->] //; rewrite eqxx. Qed. Lemma mlead_sum_le {T} (r : seq T) P F : (mlead (\sum_(p <- r | P p) F p) <= \join_(p <- r | P p) mlead (F p))%O. Proof. elim/big_rec2: _ => /= [|x m p Px le]; first by rewrite mlead0. by apply/(le_trans (mleadD_le _ _))/leU2. Qed. Lemma mlead_sum {T} (r : seq T) P F : uniq [seq mlead (F x) | x <- r & P x] -> mlead (\sum_(p <- r | P p) F p) = (\join_(p <- r | P p) mlead (F p))%O. Proof. elim: r=> [|p r ih]; first by rewrite !big_nil mlead0. rewrite !big_cons /=; case: (P p)=> //= /andP[Fp_ml uq_ml]. pose Q i := P (nth p r i); rewrite !(big_nth p) -!(big_filter _ Q). set itg := [seq _ <- _ | _]; have [/size0nil->|nz_szr] := eqVneq (size itg) 0%N. by rewrite !big_nil joinx0 addr0. move: {ih}(ih uq_ml); rewrite !(big_nth p) -!(big_filter _ Q) -/itg. move=> ih; rewrite mleadD ih //. case: bigjoinP; [exact: le_total | by rewrite /nilp; case: eqP nz_szr |]. move=> /= x; rewrite mem_filter => /andP[Px]. rewrite mem_iota add0n subn0 => /andP[_ lt_x_szr]. apply/contra: Fp_ml=> /eqP-> {Q itg uq_ml nz_szr ih}. elim: r x Px lt_x_szr=> [|y r ih] [|x] //=. by move=> -> /=; rewrite mem_head. rewrite ltnS=> Px lt_x_szr; case: (P y)=> /=. by rewrite 1?mem_behead //=; apply/ih. by apply/ih. Qed. Lemma mleadM_le p q : (mlead (p * q) <= (mlead p + mlead q)%MM)%O. Proof. have [->|] := eqVneq (p * q) 0; first by rewrite mlead0 le0x. move/mlead_supp/msuppM_le/allpairsP => [[m1 m2] /=] [m1_in_p m2_in_q ->]. by apply/lem_add; apply/msupp_le_mlead. Qed. Lemma mlead_prod_le T (r : seq T) (P : pred T) F : (mlead (\prod_(p <- r | P p) F p) <= (\sum_(p <- r | P p) mlead (F p))%MM)%O. Proof. elim/big_rec2: _ => /= [|x m p Px ih]; first by rewrite mlead1. by apply/(le_trans (mleadM_le (F x) p)); apply/lem_add. Qed. Notation mleadc p := (p@_(mlead p)). Lemma mleadcC (c : R) : mleadc c%:MP_[n] = c. Proof. by rewrite mleadC mcoeffC eqxx mulr1. Qed. Lemma mleadc0 : mleadc (0 : {mpoly R[n]}) = 0. Proof. by rewrite mleadcC. Qed. Lemma mleadc1 : mleadc (1 : {mpoly R[n]}) = 1. Proof. by rewrite mleadcC. Qed. Lemma mleadcM p q : (p * q)@_(mlead p + mlead q) = mleadc p * mleadc q. Proof. have [->|nz_p] := eqVneq p 0; first by rewrite mleadc0 !mul0r mcoeff0. have [->|nz_q] := eqVneq q 0; first by rewrite mleadc0 !mulr0 mcoeff0. rewrite mpolyME (bigD1_seq (mlead p, mlead q)) /=; first last. + by rewrite allpairs_uniq => // -[? ?] []. + by rewrite allpairs_f// !mlead_supp. rewrite mcoeffD mcoeffZ mcoeffX eqxx mulr1. rewrite big_seq_cond raddf_sum /= big1 ?addr0 //. case=> m1 m2; rewrite in_allpairs//= -andbA; case/and3P. move=> m1_in_p m2_in_q ne_m_lc; rewrite mcoeffZ mcoeffX. move/msupp_le_mlead: m1_in_p; move/msupp_le_mlead: m2_in_q. rewrite le_eqVlt => /predU1P[m2E|]; last first. by move=> lt /lemc_lt_add /(_ lt) /lt_eqF ->; rewrite mulr0. move: ne_m_lc; rewrite m2E xpair_eqE eqxx andbT. rewrite le_eqVlt=> /negbTE -> /=; rewrite eqm_add2r. by move/lt_eqF=> ->; rewrite mulr0. Qed. Lemma mleadcMW p q (mp mq : 'X_{1..n}) : (mlead p <= mp)%O -> (mlead q <= mq)%O -> (p * q)@_(mp + mq)%MM = p@_mp * q@_mq. Proof. case: (boolP ((mlead p < mp) || (mlead q < mq)))%O; last first. by case: ltgtP => // <-; case: ltgtP => // <- _ _ _; apply: mleadcM. move=> lt_lm lep leq; have lt_lmD: ((mlead p + mlead q)%MM < (mp + mq)%MM)%O. by case/orP: lt_lm=> lt; [apply/ltmc_le_add | apply/lemc_lt_add]. move/(le_lt_trans (mleadM_le p q))/mcoeff_gt_mlead: lt_lmD. by case/orP: lt_lm=> /mcoeff_gt_mlead ->; rewrite ?(mul0r, mulr0). Qed. Lemma mleadc_prod T (r : seq T) (P : pred T) (F : T -> {mpoly R[n]}) : (\prod_(p <- r | P p) F p)@_(\sum_(p <- r | P p) mlead (F p))%MM = \prod_(p <- r | P p) mleadc (F p). Proof. elim: r => [|p r ih]; first by rewrite !big_nil mcoeff1 eqxx. rewrite !big_cons; case: (P p); rewrite // mleadcMW //. by rewrite ih. by apply/mlead_prod_le. Qed. Lemma mleadcZ c p : (c *: p)@_(mlead p) = c * mleadc p. Proof. by rewrite mcoeffZ. Qed. Lemma mleadM_proper p q : mleadc p * mleadc q != 0 -> mlead (p * q) = (mlead p + mlead q)%MM. Proof. move: (mleadM_le p q); rewrite le_eqVlt => /predU1P[->//|]. rewrite -mleadcM mcoeff_eq0 negbK => ltm /msupp_le_mlead lem. by move: (lt_le_trans ltm lem); rewrite ltxx. Qed. Lemma mleadcM_proper p q : mleadc p * mleadc q != 0 -> mleadc (p * q) = mleadc p * mleadc q. Proof. by move/mleadM_proper=> ->; rewrite mleadcM. Qed. Lemma lreg_mleadc p : GRing.lreg (mleadc p) -> GRing.lreg p. Proof. move/mulrI_eq0=> reg_p; apply/mulrI0_lreg=> q /eqP. apply/contraTeq => nz_q; rewrite -mleadc_eq0. by rewrite mleadcM_proper reg_p mleadc_eq0. Qed. Section MLeadProd. Context (T : eqType) (r : seq T) (P : pred T) (F : T -> {mpoly R[n]}). Lemma mlead_prod_proper : (forall x, x \in r -> P x -> GRing.lreg (mleadc (F x))) -> mlead (\prod_(p <- r | P p) F p) = (\sum_(p <- r | P p) mlead (F p))%MM. Proof. pose Q (s : seq T) := forall x, x \in s -> P x -> GRing.lreg (mleadc (F x)). rewrite -/(Q r); elim: r => [|x s ih] h; first by rewrite !big_nil mleadC. have lreg_s: Q s. by move=> y y_in_s; apply: (h y); rewrite mem_behead. rewrite !big_cons; case: (boolP (P x))=> Px; last exact/ih. have lreg_x := (h x (mem_head _ _) Px). rewrite mleadM_proper; first by rewrite ih. by rewrite mulrI_eq0 ?ih // mleadc_prod; apply/lreg_neq0/lreg_prod. Qed. Lemma mleadc_prod_proper : (forall x, x \in r -> P x -> GRing.lreg (mleadc (F x))) -> mleadc (\prod_(p <- r | P p) F p) = \prod_(p <- r | P p) mleadc (F p). Proof. by move/mlead_prod_proper=> ->; rewrite mleadc_prod. Qed. End MLeadProd. Lemma mleadX_le p k : (mlead (p ^+ k) <= (mlead p *+ k)%MM)%O. Proof. rewrite -[k](card_ord k) -prodr_const /mnm_muln. by rewrite Monoid.iteropE -big_const; apply/mlead_prod_le. Qed. Lemma mleadcX p k : (p ^+ k)@_(mlead p *+ k) = (mleadc p) ^+ k. Proof. rewrite -[k](card_ord k) -prodr_const /mnm_muln. by rewrite Monoid.iteropE -big_const mleadc_prod prodr_const. Qed. Lemma mleadX_proper p k : GRing.lreg (mleadc p) -> mlead (p ^+ k) = (mlead p *+ k)%MM. Proof. move=> h; rewrite -[k](card_ord k) -prodr_const. rewrite /mnm_muln Monoid.iteropE -big_const. by apply/mlead_prod_proper=> /= i _ _. Qed. Lemma mleadcX_proper p k : GRing.lreg (mleadc p) -> mleadc (p ^+ k) = mleadc p ^+ k. Proof. move=> h; rewrite -[k](card_ord k) -!prodr_const. by apply/mleadc_prod_proper=> /= i _ _. Qed. Lemma msizeM_le (p q : {mpoly R[n]}) : msize (p * q) <= (msize p + msize q).+1. Proof. have [->|nz_p ] := eqVneq p 0; first by rewrite mul0r msize0. have [->|nz_q ] := eqVneq q 0; first by rewrite mulr0 msize0. have [->|nz_pq] := eqVneq (p * q) 0; first by rewrite msize0. rewrite -!mlead_deg // !(addSn, addnS) 2?ltnW // !ltnS. by have /lemc_mdeg := mleadM_le p q; rewrite mdegD. Qed. Lemma msizeM_proper p q : mleadc p * mleadc q != 0 -> msize (p * q) = (msize p + msize q).-1. Proof. have [->|nz_p ] := eqVneq p 0; first by rewrite mleadc0 mul0r eqxx. have [->|nz_q ] := eqVneq q 0; first by rewrite mleadc0 mulr0 eqxx. move=> h; rewrite -?[msize p]mlead_deg -?[msize q]mlead_deg //. rewrite !(addSn, addnS) -mdegD /= -mleadM_proper //. rewrite mlead_deg //; apply/negP; pose m := (mlead p + mlead q)%MM. move/eqP/(congr1 (mcoeff m)); rewrite mleadcM mcoeff0. by move/eqP; rewrite (negbTE h). Qed. Lemma mleadZ_le c p : (mlead (c *: p) <= mlead p)%O. Proof. have [->|] := eqVneq (c *: p) 0; first by rewrite mlead0 le0x. by move/mlead_supp/msuppZ_le/msupp_le_mlead. Qed. Lemma mleadZ_proper c p : c * mleadc p != 0 -> mlead (c *: p) = mlead p. Proof. move: (mleadZ_le c p); rewrite le_eqVlt => /predU1P[->//|]. rewrite -mleadcZ mcoeff_eq0 negbK => ltm /msupp_le_mlead lem. by move: (lt_le_trans ltm lem); rewrite ltxx. Qed. Lemma ltm_mleadD p (q := p - p@_(mlead p) *: 'X_[mlead p]) : p != 0 -> q != 0 -> (mlead q < mlead p)%O. Proof. move=> Zp Zq; have: mlead q \in (rem (mlead p) (msupp p)). by rewrite -(perm_mem (msupp_rem p _)) // mlead_supp. rewrite (rem_filter _ (msupp_uniq p)) mem_filter /= => /andP[h]. suff: (mlead q <= mlead p)%O by rewrite le_eqVlt (negPf h). apply: le_trans (mleadB_le _ _) _; rewrite leUx lexx /=. by rewrite (le_trans (mleadZ_le _ _)) // mleadXm. Qed. Lemma msizeZ_le p c : msize (c *: p) <= msize p. Proof. exact: mmeasureZ_le. Qed. Lemma msizeZ_proper (p : {mpoly R[n]}) c : c * mleadc p != 0 -> msize (c *: p) = msize p. Proof. have [->|nz_p] := eqVneq p 0; first by rewrite mleadc0 mulr0 eqxx. have [->|nz_c] := eqVneq c 0; first by rewrite mul0r eqxx. move=> h; rewrite -[msize p]mlead_deg // -(mleadZ_proper h). rewrite mlead_deg //; pose m := (mlead p); apply/negP. move/eqP/(congr1 (mcoeff m)); rewrite mcoeffZ mcoeff0. by move/eqP; rewrite (negbTE h). Qed. Lemma mleadrect (P : {mpoly R[n]} -> Type) : (forall p, (forall q, (mlead q < mlead p)%O -> P q) -> P p) -> forall p, P p. Proof. move=> ih p; move: {2}(mlead p) (lexx (mlead p))=> m. elim/(ltmwf (n := n)): m p=> m1 wih p lt_pm1; apply/ih=> q lt_pq. by apply/(wih (mlead q)); first exact: lt_le_trans lt_pq _. Qed. End MPolyLead. Notation mleadc p := (p@_(mlead p)). (* -------------------------------------------------------------------- *) Section MPolyLast. Context {R : ringType} {n : nat}. Definition mlast (p : {mpoly R[n]}) : 'X_{1..n} := head 0%MM (sort <=%O (msupp p)). Lemma mlast0 : mlast 0 = 0%MM. Proof. by rewrite /mlast msupp0. Qed. Lemma mlast_supp p : p != 0 -> mlast p \in msupp p. Proof. rewrite -msupp_eq0 /mlast; move: (msupp p) => s nz_s. rewrite -(perm_mem (permEl (perm_sort <=%O%O _))). by rewrite -nth0 mem_nth // size_sort lt0n size_eq0. Qed. Lemma mlast_lemc m p : m \in msupp p -> (mlast p <= m)%O. Proof. rewrite /mlast -nth0; set s := sort _ _. have: perm_eq s (msupp p) by apply/permEl/perm_sort. have: sorted <=%O%O s by apply/sort_sorted/le_total. case: s => /= [_|m' s srt_s]; first rewrite perm_sym. by move/perm_small_eq=> -> //. move/perm_mem => <-; rewrite in_cons => /predU1P[->//|]. elim: s m' srt_s => //= m'' s ih m' /andP[le_mm' /ih {}ih]. by rewrite in_cons => /predU1P[->//|/ih /(le_trans le_mm')]. Qed. Lemma mlastE (p : {mpoly R[n]}) (m : 'X_{1..n}) : m \in msupp p -> (forall m' : 'X_{1..n}, m' \in msupp p -> (m <= m')%O) -> mlast p = m. Proof. move=> mp le; apply/le_anti; rewrite mlast_lemc //=. by apply/le; rewrite mlast_supp // -msupp_eq0; case: msupp mp. Qed. Lemma mcoeff_lt_mlast p m : (m < mlast p)%O -> p@_m = 0. Proof. move=> le; case/boolP: (m \in msupp p). by move/mlast_lemc/(lt_le_trans le); rewrite ltxx. by rewrite mcoeff_msupp negbK => /eqP. Qed. End MPolyLast. (* -------------------------------------------------------------------- *) Section MPoly0. Context (R : ringType). Lemma mpolyKC : cancel (@mcoeff 0 R 0%MM) (@mpolyC 0 R). Proof. move=> p; apply/mpolyP=> m; rewrite mcoeffC. case: (m =P 0%MM)=> [->|/eqP]; first by rewrite mulr1. by apply/contraNeq=> _; apply/eqP/mnmP; case. Qed. End MPoly0. (* -------------------------------------------------------------------- *) Section MPolyDeriv. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (m : 'X_{1..n}). Definition mderiv (i : 'I_n) p := \sum_(m <- msupp p) ((m i)%:R * p@_m) *: 'X_[m - U_(i)]. Local Notation "p ^`M ( i )" := (mderiv i p). Lemma mderivwE i p k : msize p <= k -> p^`M(i) = \sum_(m : 'X_{1..n < k}) ((m i)%:R * p@_m) *: 'X_[m - U_(i)]. Proof. pose I : subFinType _ := 'X_{1..n < k}. move=> le_pk; rewrite /mderiv (big_mksub I) /=; first last. by move=> x /msize_mdeg_lt/leq_trans/(_ le_pk). by rewrite msupp_uniq. rewrite big_rmcond //= => j /memN_msupp_eq0 ->. by rewrite mulr0 scale0r. Qed. Arguments mderivwE [i p]. Lemma mcoeff_deriv i m p : p^`M(i)@_m = p@_(m + U_(i)) *+ (m i).+1. Proof. pose_big_enough j; first rewrite {2}[p](mpolywE (k := j)) //. rewrite !(mderivwE j) // !raddf_sum -sumrMnl; apply/eq_bigr. move=> /= [k /= _] _; rewrite !mcoeffZ !mcoeffX. case: (k =P m + U_(i))%MM=> [{1 3}->|]. by rewrite mnmDE mnm1E eqxx addn1 addmK eqxx !simpm mulr_natl. rewrite !simpm mul0rn; have [->|nz_mi] := (eqVneq (k i) 0%N). by rewrite !simpm. case: eqP=> [{1}<-|]; rewrite ?simpm //. rewrite submK //; apply/mnm_lepP => l; rewrite mnm1E. by case: (i =P l) nz_mi=> // ->; rewrite -lt0n. by close. Qed. Lemma mderiv_is_linear i : linear (mderiv i). Proof. move=> c p q; pose_big_enough j; first rewrite !(mderivwE j) //. rewrite scaler_sumr -big_split /=; apply/eq_bigr=> k _. rewrite !scalerA -scalerDl; congr (_ *: _). by rewrite mcoeffD mcoeffZ mulrDr !mulrA commr_nat. by close. Qed. HB.instance Definition _ i := GRing.isLinear.Build R {mpoly R[n]} {mpoly R[n]} _ (mderiv i) (mderiv_is_linear i). Lemma mderiv0 i : mderiv i 0 = 0. Proof. exact: raddf0. Qed. Lemma mderivC i c : mderiv i c%:MP = 0. Proof. apply/mpolyP=> m; rewrite mcoeff0 mcoeff_deriv mcoeffC. by rewrite mnmD_eq0 mnm1_eq0 andbF mulr0 mul0rn. Qed. Lemma mderivX i m : mderiv i 'X_[m] = (m i)%:R *: 'X_[m - U_(i)]. Proof. by rewrite /mderiv msuppX big_seq1 mcoeffX eqxx mulr1. Qed. Lemma commr_mderivX i m p : GRing.comm p ('X_[m])^`M(i). Proof. rewrite /GRing.comm mderivX -mul_mpolyC mpolyC_nat. by rewrite -{1}commr_nat mulrA commr_nat commr_mpolyX mulrA. Qed. Lemma mderivN i : {morph mderiv i: x / - x}. Proof. exact: raddfN. Qed. Lemma mderivD i : {morph mderiv i: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mderivB i : {morph mderiv i: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mderivMn i k : {morph mderiv i: x / x *+ k}. Proof. exact: raddfMn. Qed. Lemma mderivMNn i k : {morph mderiv i: x / x *- k}. Proof. exact: raddfMNn. Qed. Lemma mderivZ i c p : (c *: p)^`M(i) = c *: p^`M(i). Proof. by rewrite linearZ. Qed. Lemma mderiv_mulC i c p : (c%:MP * p)^`M(i) = c%:MP * p^`M(i). Proof. by rewrite !mul_mpolyC mderivZ. Qed. Lemma mderivM i p q : (p * q)^`M(i) = (p^`M(i) * q) + (p * q^`M(i)). Proof. elim/mpolyind: p; first by rewrite !(mul0r, add0r, mderiv0). move=> c m p _ _ ih; rewrite !(mulrDl, mderivD) -addrA. rewrite [X in _=_+X]addrCA -ih addrA => {ih}; congr (_ + _). rewrite -!scalerAl !mderivZ -scalerAl -scalerDr; congr (_ *: _). pose_big_enough k; rewrite 1?[q](mpolywE (k := k)) //; try by close. do! rewrite mulr_sumr ?raddf_sum /=; rewrite -big_split /=. apply/eq_bigr=> h _; rewrite -!commr_mpolyX -scalerAl -mpolyXD. rewrite !mderivZ -commr_mderivX -!scalerAl -scalerDr; congr (_ *: _). rewrite !mderivX -!commr_mpolyX -!scalerAl -!mpolyXD mnmDE. have [z_mi|ne_mi] := eqVneq (m i) 0%N. rewrite z_mi addn0 scale0r add0r; congr (_ *: 'X_[_]). apply/mnmP=> j; rewrite !(mnmBE, mnmDE, mnm1E). by case: eqP => /= [<-|]; rewrite ?subn0 // z_mi !addn0. apply/esym; rewrite addmC addmBA; last by rewrite lep1mP. have [z_hi|ne_hi] := eqVneq (h i) 0%N. by rewrite z_hi add0n scale0r addr0. rewrite addrC addmC addmBA; last by rewrite lep1mP. by rewrite addmC -scalerDl natrD. Qed. Lemma mderiv_comm i j p : p^`M(i)^`M(j) = p^`M(j)^`M(i). Proof. (* FIXME: f_equal *) pose_big_enough k; first pose mderivE := (mderivwE k). rewrite ![p^`M(_)]mderivE // !raddf_sum /=; apply/eq_bigr. move=> l _; rewrite !mderivZ !mderivX !scalerA. rewrite !submDA addmC -!commr_nat -!mulrA -!natrM. f_equal; congr (_ * _%:R); rewrite !mnmBE !mnm1E. by case: eqVneq => [->|_] //=; rewrite !subn0 mulnC. by close. Qed. Lemma mderiv_perm (s1 s2 : seq 'I_n) p : perm_eq s1 s2 -> foldr mderiv p s1 = foldr mderiv p s2. Proof. pose M q s := foldr mderiv q s; rewrite -!/(M _ _). have h (s : seq 'I_n) (x : 'I_n) q: x \in s -> M q s = M q (x :: rem x s). + elim: s=> [|y s ih] //; rewrite in_cons /=. by case: eqVneq => [->|ne_xy {}/ih ->] //=; rewrite mderiv_comm. elim: s1 s2 => [|x s1 ih] s2. by rewrite perm_sym=> /perm_small_eq=> ->. move=> peq_xDs1_s2; have x_in_s2: x \in s2. by rewrite -(perm_mem peq_xDs1_s2) mem_head. have /h ->/= := x_in_s2; rewrite -ih // -(perm_cons x). by rewrite (permPl peq_xDs1_s2) perm_to_rem. Qed. Definition mderivm m p : {mpoly R[n]} := foldr (fun i => iter (m i) (mderiv i)) p (enum 'I_n). Local Notation "p ^`M [ m ]" := (mderivm m p). Lemma mderivm_foldr m p : let s := flatten [seq nseq (m i) i | i <- enum 'I_n] in p^`M[m] = foldr mderiv p s. Proof. rewrite /mderivm; elim: (enum _)=> //= i s ih. by rewrite foldr_cat; elim: (m i)=> //= k ->. Qed. Lemma mderivm0m p : p^`M[0] = p. Proof. rewrite mderivm_foldr (eq_map (_ : _ =1 fun=> [::])); first by elim: (enum _). by move=> i /=; rewrite mnm0E. Qed. Lemma mderivmDm m1 m2 p : p^`M[m1 + m2] = p^`M[m1]^`M[m2]. Proof. rewrite !mderivm_foldr -foldr_cat; apply/mderiv_perm. apply/seq.permP => /= a; rewrite count_cat !count_flatten. rewrite !sumnE !big_map -big_split /=; apply/eq_bigr=> i _. by rewrite mnmDE nseqD count_cat addnC. Qed. Lemma mderiv_summ (T : Type) (r : seq T) (P : pred T) F p : p^`M[\sum_(x <- r | P x) (F x)] = foldr mderivm p [seq F x | x <- r & P x]. Proof. elim: r => //= [|x s ih]; first by rewrite big_nil mderivm0m. by rewrite big_cons; case: (P x); rewrite //= addmC mderivmDm ih. Qed. Lemma mderivmU1m i p : p^`M[U_(i)] = p^`M(i). Proof. rewrite mderivm_foldr (@mderiv_perm _ [:: i]) //. apply/seq.permP=> /= a; rewrite addn0 count_flatten sumnE !big_map. rewrite -/(index_enum _) (bigD1 i) //=. rewrite mnm1E eqxx /= big1 ?addn0 // => j ne_ji. by rewrite mnm1E eq_sym (negbTE ne_ji). Qed. Lemma mderivm_is_linear m : linear (mderivm m). Proof. move=> c p q; rewrite /mderivm; elim: (enum _)=> //= i s ih. by elim: (m i) => //= {ih}k ->; rewrite mderivD mderivZ. Qed. HB.instance Definition _ m := GRing.isLinear.Build R {mpoly R[n]} {mpoly R[n]} _ (mderivm m) (mderivm_is_linear m). Lemma mderivmN m : {morph mderivm m: x / - x}. Proof. exact: raddfN. Qed. Lemma mderivmD m : {morph mderivm m: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mderivmB m : {morph mderivm m: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mderivmMn m k : {morph mderivm m: x / x *+ k}. Proof. exact: raddfMn. Qed. Lemma mderivmMNn m k : {morph mderivm m: x / x *- k}. Proof. exact: raddfMNn. Qed. Lemma mderivmZ m c p : (c *: p)^`M[m] = c *: p^`M[m]. Proof. by rewrite linearZ. Qed. Lemma mderivm_mulC m c p : (c%:MP * p)^`M[m] = c%:MP * p^`M[m]. Proof. by rewrite !mul_mpolyC mderivmZ. Qed. Local Notation "p ^`M ( i , n )" := (mderivm (U_(i) *+ n) p). Lemma mderivn0 i p : p^`M(i, 0) = p. Proof. by rewrite mulm0n mderivm0m. Qed. Lemma nderivn1 i p : p^`M(i, 1) = p^`M(i). Proof. by rewrite mulm1n mderivmU1m. Qed. Lemma mderivSn i k p : p^`M(i, k.+1) = p^`M(i)^`M(i, k). Proof. by rewrite mulmS mderivmDm mderivmU1m. Qed. Lemma mderivnS i k p : p^`M(i, k.+1) = p^`M(i, k)^`M(i). Proof. by rewrite mulmS addmC mderivmDm mderivmU1m. Qed. Lemma mderivn_iter i k p : p^`M(i, k) = iter k (mderiv i) p. Proof. by elim: k => /= [|k ih]; rewrite ?mderivn0 // mderivnS ih. Qed. Lemma mderivmX m1 m2 : ('X_[m1])^`M[m2] = (\prod_(i < n) (m1 i)^_(m2 i))%:R *: 'X_[m1-m2]. Proof. rewrite [m2]multinomUE_id mderiv_summ filter_predT /index_enum -enumT /=. elim: (enum _) (enum_uniq 'I_n) => /= [|i s ih /andP [i_notin_s uq_s]]. by move=> _; rewrite !big_nil scale1r subm0. pose F j := (m1 j) ^_ (m2 j); rewrite ih // mderivmZ. rewrite big_seq [X in X%:R](eq_bigr F) -?big_seq; last first. move=> j j_in_s; rewrite (bigD1_seq j) //=. rewrite mnmDE mnm_sumE mulmnE mnm1E eqxx mul1n. rewrite big1 ?addn0 // => j' ne_j'j; rewrite mulmnE. by rewrite mnm1E (negbTE ne_j'j). rewrite big_cons mulnC natrM -scalerA; apply/esym. rewrite 2![X in X%:R*:(_*:_)](big_seq, eq_bigr F); last first. move=> j j_in_s; rewrite big_cons mnmDE mnm_sumE. rewrite (bigD1_seq j) //= big1 ?addn0 => [|j' ne_j'j]. rewrite !mulmnE !mnm1E eqxx mul1n; move/memPn: i_notin_s. by rewrite eq_sym => /(_ j j_in_s) /negbTE ->. by rewrite mulmnE mnm1E (negbTE ne_j'j). rewrite -big_seq; congr (_ *: _); rewrite !big_cons. rewrite mnmDE mnm_sumE big_seq big1 ?addn0; last first. move=> /= j j_in_s; rewrite mulmnE mnm1E; move/memPn: i_notin_s. by move/(_ j j_in_s)=> /negbTE->. rewrite mulmnE mnm1E eqxx mul1n; elim: (m2 i)=> /= [|k ihk]. by rewrite ffactn0 scale1r mulm0n add0m mderivm0m. rewrite mderivnS -ihk mderivZ mderivX scalerA -natrM. rewrite submDA Monoid.mulmAC /= mulmSr; congr (_%:R *: 'X_[_]). rewrite mnmBE mnmDE mnm_sumE big_seq big1; last first. move=> /= j j_in_s; rewrite mulmnE mnm1E; move: i_notin_s. by move/memPn/(_ j j_in_s)=> /negbTE->. by rewrite addn0 mulmnE mnm1E eqxx mul1n ffactnSr. Qed. Lemma mderivmE m p : p^`M[m] = \sum_(m' <- msupp p) (p@_m' * (\prod_(i < n) (m' i)^_(m i))%:R *: 'X_[m'-m]). Proof. rewrite {1}[p]mpolyE raddf_sum /=; apply/eq_bigr=> m' _. by rewrite mderivmZ -scalerA -mderivmX. Qed. Lemma mderivmwE k m p : msize p <= k -> p^`M[m] = \sum_(m' : 'X_{1..n < k}) (p@_m' * (\prod_(i < n) (m' i)^_(m i))%:R *: 'X_[m'-m]). Proof. move=> lt_pk; pose P (m : 'X_{1..n < k}) := (val m) \in msupp p. rewrite (bigID P) {}/P /= addrC big1 ?add0r; last first. by move=> m' /memN_msupp_eq0=> ->; rewrite mul0r scale0r. rewrite mderivmE (big_mksub 'X_{1..n < k}) //=; first exact/msupp_uniq. by move=> m' /msize_mdeg_lt /leq_trans; apply. Qed. Lemma mderivnE i k p : p^`M(i, k) = \sum_(m <- msupp p) (((m i)^_k)%:R * p@_m) *: 'X_[m - U_(i) *+ k]. Proof. rewrite mderivmE; apply/eq_bigr=> /= m _. rewrite -commr_nat (bigD1 i) //= big1 ?muln1. by rewrite mulmnE mnm1E eqxx mul1n. by move=> j ne_ji; rewrite mulmnE mnm1E eq_sym (negbTE ne_ji). Qed. Lemma mderivnX i k m : 'X_[m]^`M(i, k) = ((m i)^_k)%:R *: 'X_[m - U_(i) *+ k]. Proof. by rewrite mderivnE msuppX big_seq1 mcoeffX eqxx mulr1. Qed. Lemma mcoeff_mderivm m p m' : (p^`M[m])@_m' = p@_(m + m') *+ (\prod_(i < n) ((m + m')%MM i)^_(m i)). Proof. pose_big_enough i; first rewrite (@mderivmwE i) //. have lt_mDm'_i: mdeg (m + m') < i by []. rewrite (bigD1 (Sub (m + m')%MM lt_mDm'_i)) //=. rewrite mcoeffD raddf_sum /= [X in _+X]big1; last first. case=> j lt_ji; rewrite eqE /= => ne_j_mDm'. rewrite mcoeffZ mcoeffX; case: eqP; rewrite ?mulr0 //=. move=> eq_m'_jBm; move: ne_j_mDm'; rewrite -eq_m'_jBm. case: (boolP (m <= j))%MM => [/addmBA->|]. by rewrite [(m + j)%MM]addmC /= addmK eqxx. rewrite negb_forall; case/existsP=> /= k Nle_mj. by rewrite (bigD1 k) //= ffact_small ?simpm // ltnNge. rewrite addr0 mcoeffZ mcoeffX {3}[(m + m')%MM]addmC addmK. by rewrite eqxx mulr1 mulr_natr. by close. Qed. Lemma mcoeff_mderiv i p m : (p^`M(i))@_m = p@_(m + U_(i)) *+ (m i).+1. Proof. rewrite -mderivmU1m mcoeff_mderivm addmC /=. rewrite (bigD1 i) //= mnmDE !mnm1E eqxx addn1 ffactn1. rewrite (eq_bigr (fun _ => 1%N)) ?prod_nat_const /=. by rewrite exp1n muln1. move=> j ne_ji; rewrite mnmDE mnm1E eq_sym. by rewrite (negbTE ne_ji) ffactn0. Qed. End MPolyDeriv. Notation "p ^`M ( i )" := (mderiv i p). Notation "p ^`M [ m ]" := (mderivm m p). Notation "p ^`M ( i , n )" := (mderivm (U_(i) *+ n) p). (* -------------------------------------------------------------------- *) Section MPolyMorphism. Context (n : nat) (R S : ringType). Implicit Types (p q r : {mpoly R[n]}) (m : 'X_{1..n}). Section Defs. Context (f : R -> S) (h : 'I_n -> S). Definition mmap1 m := \prod_(i < n) (h i)^+(m i). Definition mmap p := \sum_(m <- msupp p) (f p@_m) * (mmap1 m). End Defs. Lemma mmap11 h : mmap1 h 0%MM = 1. Proof. by rewrite /mmap1 big1 // => /= i _; rewrite mnm0E expr0. Qed. Lemma mmap1U h i : mmap1 h U_(i) = h i. Proof. pose inj j := insubd i j; rewrite /mmap1. pose F j := h (inj j) ^+ U_(i)%MM (inj j). have FE j: j < n -> F j = (h (inj j)) ^+ (i == j :> nat). move=> lt_jn; rewrite /F /inj /insubd insubT /=. by rewrite mnm1E -val_eqE. rewrite (eq_bigr (F \o val)) //; last first. by move=> j _ /=; rewrite FE // mnm1E /inj /insubd valK. have ->: n = (i.+1 + (n - i.+1))%N by rewrite subnKC. rewrite big_split_ord /= [X in _*X]big1 ?mulr1; last first. case=> j /= lt_nBSi _; rewrite FE -?ltn_subRL //. case: (_ =P _); last by rewrite expr0. by rewrite addSnnS -{1}[val i]addn0 /= => /addnI. rewrite big_ord_recr /= big1 ?mul1r; last first. case=> j /= lt_ji _; rewrite FE; last first. by rewrite (@leq_trans i) // ltnW. by rewrite eq_sym (ltn_eqF lt_ji) expr0. by rewrite FE // eqxx expr1 /inj /insubd valK. Qed. Lemma commr_mmap1_M h m1 m2 : (forall i x, GRing.comm x (h i)) -> mmap1 h (m1 + m2) = (mmap1 h m1) * (mmap1 h m2). Proof. move=> comm; pose F (i : 'I_n) := (h i ^+ m1 i) * (h i ^+ m2 i). rewrite /mmap1 (eq_bigr F) => [|i _]; last first. by rewrite mnmDE exprD. rewrite {}/F; elim/big_rec3: _; first by rewrite mulr1. move=> i y1 y2 y3 _ ->; rewrite -!mulrA; congr (_ * _). have commn k j x: GRing.comm x ((h j)^+k) by apply/commrX. by rewrite -commn -mulrA commn. Qed. Local Notation "m ^[ h ]" := (mmap1 h m). Local Notation "p ^[ f , h ]" := (mmap f h p). Section Additive. Context (h : 'I_n -> S) (f : {additive R -> S}). Lemma mmapE p i : msize p <= i -> p^[f,h] = \sum_(m : 'X_{1..n < i}) (f p@_m) * m^[h]. Proof. move=> le_pi; set I : subFinType _ := 'X_{1..n < i}. rewrite /mmap (big_mksub I) ?msupp_uniq //=; first last. by move=> x /msize_mdeg_lt /leq_trans; apply. rewrite big_rmcond //= => j /memN_msupp_eq0 ->. by rewrite raddf0 mul0r. Qed. Arguments mmapE [p]. Lemma mmap_is_additive : additive (mmap f h). Proof. move=> p q /=; pose_big_enough i. rewrite !(mmapE i) // -sumrB; apply/eq_bigr. by case=> /= [m _] _; rewrite !raddfB /= mulrDl mulNr. by close. Qed. HB.instance Definition _ := GRing.isAdditive.Build {mpoly R[n]} S (mmap f h) mmap_is_additive. Local Notation mmap := (mmap f h). Lemma mmap0 : mmap 0 = 0 . Proof. exact: raddf0. Qed. Lemma mmapN : {morph mmap: x / - x} . Proof. exact: raddfN. Qed. Lemma mmapD : {morph mmap: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mmapB : {morph mmap: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mmapMn k : {morph mmap: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma mmapMNn k : {morph mmap: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma mmapC c : mmap c%:MP = f c. Proof. have [->|nz_c] := eqVneq c 0; first by rewrite mmap0 raddf0. rewrite /mmap msuppC (negbTE nz_c) big_seq1 mmap11 mulr1. by rewrite mcoeffC eqxx mulr1. Qed. End Additive. Arguments mmapE [h f p]. Section Multiplicative. Context (h : 'I_n -> S) (f : {rmorphism R -> S}). Lemma mmapX m : ('X_[m])^[f,h] = m^[h]. Proof. by rewrite /mmap msuppX big_seq1 mcoeffX eqxx rmorph1 mul1r. Qed. Lemma mmapZ c p : (c *: p)^[f,h] = (f c) * p^[f,h]. Proof. pose_big_enough i. rewrite !(mmapE i) // mulr_sumr; apply/eq_bigr. by move=> j _; rewrite mcoeffZ mulrA -rmorphM. by close. Qed. Hypothesis commr_h: forall i x, GRing.comm x (h i). Hypothesis commr_f: forall p m m', GRing.comm (f p@_m) (m'^[h]). Lemma commr_mmap_is_multiplicative: multiplicative (mmap f h). Proof. split=> //= [p q|]; last first. by rewrite /mmap msupp1 big_seq1 mpolyCK rmorph1 mul1r mmap11. pose_big_enough i. rewrite (mpolywME (k := i)) // raddf_sum /= !(mmapE i) //. rewrite big_distrlr /= pair_bigA; apply/eq_bigr=> /=. case=> j1 j2 _ /=; rewrite mmapZ mmapX; apply/esym. rewrite [f q@__ * _]commr_f mulrA -[X in X*_]mulrA. by rewrite -commr_mmap1_M // -mulrA -commr_f !mulrA rmorphM. by close. Qed. End Multiplicative. End MPolyMorphism. Arguments mmapE [n R S h f p]. (* -------------------------------------------------------------------- *) Lemma mmap1_eq n (R : ringType) (f1 f2 : 'I_n -> R) m : f1 =1 f2 -> mmap1 f1 m = mmap1 f2 m. Proof. move=> eq_f; rewrite /mmap1; apply/eq_bigr. by move=> /= i _; rewrite eq_f. Qed. Lemma mmap1_id n (R : ringType) m : mmap1 (fun i => 'X_i) m = 'X_[m] :> {mpoly R[n]}. Proof. by rewrite mpolyXE_id. Qed. (* -------------------------------------------------------------------- *) Section MPolyMorphismComm. Context (n : nat) (R : ringType) (S : comRingType). Context (h : 'I_n -> S) (f : {rmorphism R -> S}). Implicit Types (p q r : {mpoly R[n]}). Lemma mmap_is_multiplicative : multiplicative (mmap f h). Proof. apply/commr_mmap_is_multiplicative. + by move=> i x; apply/mulrC. + by move=> p m m'; apply/mulrC. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n]} S (mmap f h) mmap_is_multiplicative. End MPolyMorphismComm. (* -------------------------------------------------------------------- *) Section MPolyComRing. Context (n : nat) (R : comRingType). Implicit Types (p q r : {mpoly R[n]}). Lemma mpoly_mulC p q : p * q = q * p. Proof. apply/mpolyP=> /= m; rewrite mcoeffM mcoeffMr. by apply: eq_bigr=> /= i _; rewrite mulrC. Qed. HB.instance Definition _ := GRing.Ring_hasCommutativeMul.Build (mpoly n R) mpoly_mulC. HB.instance Definition _ := GRing.ComRing.on {mpoly R[n]}. #[hnf] HB.instance Definition _ := GRing.Lalgebra_isComAlgebra.Build R {mpoly R[n]}. #[hnf] HB.instance Definition _ := GRing.Lalgebra_isComAlgebra.Build R (mpoly n R). End MPolyComRing. (* -------------------------------------------------------------------- *) Section MPolyComp. Context (n : nat) (R : ringType) (k : nat). Implicit Types (p q : {mpoly R[n]}) (lp lq : n.-tuple {mpoly R[k]}). Definition comp_mpoly lq p : {mpoly R[k]} := mmap (@mpolyC _ R) (tnth lq) p. Local Notation "p \mPo lq" := (comp_mpoly lq p). Lemma comp_mpolyE p lq : p \mPo lq = \sum_(m <- msupp p) p@_m *: \prod_(i < n) (tnth lq i)^+(m i). Proof. by apply/eq_bigr=> m _; rewrite -mul_mpolyC. Qed. Lemma comp_mpolywE p lq w : msize p <= w -> p \mPo lq = \sum_(m : 'X_{1..n < w}) (p@_m *: \prod_(i < n) (tnth lq i)^+(m i)). Proof. move=> le_szp_w; rewrite /comp_mpoly (mmapE w) //=. by apply/eq_bigr=> m _; rewrite mul_mpolyC. Qed. Lemma comp_mpoly_is_additive lq : additive (comp_mpoly lq). Proof. by move=> p q; rewrite /comp_mpoly -mmapB. Qed. HB.instance Definition _ lq := GRing.isAdditive.Build {mpoly R[n]} {mpoly R[k]} (comp_mpoly lq) (comp_mpoly_is_additive lq). Lemma comp_mpoly0 lq : 0 \mPo lq = 0 . Proof. exact: raddf0. Qed. Lemma comp_mpolyN lq : {morph comp_mpoly lq: x / - x} . Proof. exact: raddfN. Qed. Lemma comp_mpolyD lq : {morph comp_mpoly lq: x y / x + y}. Proof. exact: raddfD. Qed. Lemma comp_mpolyB lq : {morph comp_mpoly lq: x y / x - y}. Proof. exact: raddfB. Qed. Lemma comp_mpolyMn lq l : {morph comp_mpoly lq: x / x *+ l} . Proof. exact: raddfMn. Qed. Lemma comp_mpolyMNn lq l : {morph comp_mpoly lq: x / x *- l} . Proof. exact: raddfMNn. Qed. Lemma comp_mpoly_is_linear lq : scalable (comp_mpoly lq). Proof. by move=> c p; rewrite /comp_mpoly mmapZ mul_mpolyC. Qed. HB.instance Definition _ lq := GRing.isScalable.Build R {mpoly R[n]} {mpoly R[k]} _ (comp_mpoly lq) (comp_mpoly_is_linear lq). Lemma comp_mpoly1 lq : 1 \mPo lq = 1. Proof. by rewrite /comp_mpoly -mpolyC1 mmapC. Qed. Lemma comp_mpolyC c lq : c%:MP \mPo lq = c%:MP. Proof. by rewrite [LHS]mmapC. Qed. Lemma comp_mpolyZ c p lq : (c *: p) \mPo lq = c *: (p \mPo lq). Proof. exact/linearZ. Qed. Lemma comp_mpolyXU i lq : 'X_i \mPo lq = lq`_i. Proof. by rewrite /comp_mpoly mmapX mmap1U -tnth_nth. Qed. Lemma comp_mpolyX m lq : 'X_[m] \mPo lq = \prod_(i < n) (tnth lq i)^+(m i). Proof. by rewrite [LHS]mmapX. Qed. Lemma comp_mpolyEX p lq : p \mPo lq = \sum_(m <- msupp p) (p@_m *: ('X_[m] \mPo lq)). Proof. by apply/eq_bigr=> m _; rewrite mul_mpolyC comp_mpolyX. Qed. End MPolyComp. Notation "p \mPo lq" := (@comp_mpoly _ _ _ lq p). Section MPolyCompComm. Context (n : nat) (R : comRingType) (k : nat) (lp : n.-tuple {mpoly R[k]}). Lemma comp_mpoly_is_multiplicative : multiplicative (comp_mpoly lp). Proof. exact: mmap_is_multiplicative. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n]} {mpoly R[k]} (comp_mpoly lp) comp_mpoly_is_multiplicative. End MPolyCompComm. (* -------------------------------------------------------------------- *) Section MPolyCompHomo. Context (n : nat) (R : ringType). Implicit Types (p q : {mpoly R[n]}). Lemma comp_mpoly_id p : p \mPo [tuple 'X_i | i < n] = p. Proof. rewrite [p]mpolyE raddf_sum /=; apply/eq_bigr. move=> m _; rewrite comp_mpolyZ; congr (_ *: _). rewrite /comp_mpoly mmapX -mmap1_id; apply/mmap1_eq. by move=> /= i; rewrite tnth_map tnth_ord_tuple. Qed. End MPolyCompHomo. (* -------------------------------------------------------------------- *) Section MEval. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (v : 'I_n -> R). Definition meval v p := mmap idfun v p. Lemma mevalE v p : meval v p = \sum_(m <- msupp p) p@_m * \prod_i v i ^+ m i. Proof. by []. Qed. Lemma meval_is_additive v : additive (meval v). Proof. exact/mmap_is_additive. Qed. HB.instance Definition _ v := GRing.isAdditive.Build {mpoly R[n]} R (meval v) (meval_is_additive v). Lemma meval0 v : meval v 0 = 0 . Proof. exact: raddf0. Qed. Lemma mevalN v : {morph meval v: x / - x} . Proof. exact: raddfN. Qed. Lemma mevalD v : {morph meval v: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mevalB v : {morph meval v: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mevalMn v k : {morph meval v: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma mevalMNn v k : {morph meval v: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma mevalC v c : meval v c%:MP = c. Proof. by rewrite [LHS]mmapC. Qed. Lemma meval1 v : meval v 1 = 1. Proof. exact/mevalC. Qed. Lemma mevalXU v i : meval v 'X_i = v i. Proof. by rewrite [LHS]mmapX mmap1U. Qed. Lemma mevalX v m : meval v 'X_[m] = \prod_(i < n) (v i) ^+ (m i). Proof. by rewrite [LHS]mmapX. Qed. Lemma meval_is_scalable v : scalable_for *%R (meval v). Proof. by move=> /= c p; rewrite [LHS]mmapZ. Qed. Lemma mevalZ v c p : meval v (c *: p) = c * (meval v p). Proof. exact: meval_is_scalable. Qed. Lemma meval_eq v1 v2 p : v1 =1 v2 -> meval v1 p = meval v2 p. Proof. move=> eq_v; rewrite !mevalE; apply/eq_bigr=> i _. by congr *%R; apply/eq_bigr=> j _; rewrite eq_v. Qed. End MEval. Notation "p .@[ v ]" := (@meval _ _ v p). Notation "p .@[< v >]" := (@meval _ _ (nth v) p). (* -------------------------------------------------------------------- *) Section MEvalCom. Context (n k : nat) (R : comRingType). Implicit Types (p q r : {mpoly R[n]}) (v : 'I_n -> R). Lemma meval_is_lrmorphism v : scalable_for *%R (meval v). Proof. by move=> /= c p; rewrite /meval mmapZ /=. Qed. HB.instance Definition _ v := GRing.RMorphism.copy (meval v) (meval v). HB.instance Definition _ v := GRing.isScalable.Build R {mpoly R[n]} R *%R (meval v) (meval_is_lrmorphism v). Lemma mevalM v : {morph meval v: x y / x * y}. Proof. exact: rmorphM. Qed. End MEvalCom. (* -------------------------------------------------------------------- *) Section MEvalComp. Context (n k : nat) (R : comRingType) (v : 'I_n -> R) (p : {mpoly R[k]}). Context (lq : k.-tuple {mpoly R[n]}). Lemma comp_mpoly_meval : (p \mPo lq).@[v] = p.@[fun i => (tnth lq i).@[v]]. Proof. rewrite comp_mpolyEX [X in _ = X.@[_]](mpolyE p) !raddf_sum /=. apply/eq_bigr => m _; rewrite !mevalZ; congr *%R. rewrite comp_mpolyX rmorph_prod /= mevalX. by apply/eq_bigr=> i _; rewrite rmorphXn. Qed. End MEvalComp. (* -------------------------------------------------------------------- *) Section MPolyMap. Context (n : nat) (R S : ringType). Implicit Types (p q r : {mpoly R[n]}). Definition map_mpoly (f : R -> S) p : {mpoly S[n]} := mmap ((@mpolyC n _) \o f) (fun i => 'X_i) p. Section Additive. Context (f : {additive R -> S}). Local Notation "p ^f" := (map_mpoly f p). Lemma map_mpoly_is_additive : additive (map_mpoly f). Proof. exact/mmap_is_additive. Qed. HB.instance Definition _ := GRing.isAdditive.Build {mpoly R[n]} {mpoly S[n]} (map_mpoly f) map_mpoly_is_additive. Lemma map_mpolyC c : map_mpoly f c%:MP_[n] = (f c)%:MP_[n]. Proof. by rewrite [LHS]mmapC. Qed. Lemma map_mpolyE p k : msize p <= k -> p^f = \sum_(m : 'X_{1..n < k}) (f p@_m) *: 'X_[m]. Proof. rewrite /map_mpoly; move/mmapE=> -> /=; apply/eq_bigr. by move=> i _; rewrite mmap1_id mul_mpolyC. Qed. Arguments map_mpolyE [p]. Lemma mcoeff_map_mpoly m p : p^f@_m = f p@_m. Proof. pose_big_enough i; first rewrite (map_mpolyE i) //. by rewrite (mcoeff_mpoly (fun m => (f p@_m))). by close. Qed. End Additive. Section Multiplicative. Context (f : {rmorphism R -> S}). Local Notation "p ^f" := (map_mpoly f p). Lemma map_mpoly_is_multiplicative : multiplicative (map_mpoly f). Proof. apply/commr_mmap_is_multiplicative => /=. + by move=> i x; apply/commr_mpolyX. + by move=> p m m'; rewrite mmap1_id; apply/commr_mpolyX. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n]} {mpoly S[n]} (map_mpoly f) map_mpoly_is_multiplicative. Lemma map_mpolyX (m : 'X_{1..n}) : map_mpoly f 'X_[m] = 'X_[m]. Proof. by rewrite /map_mpoly mmapX mmap1_id. Qed. Lemma map_mpolyZ (c : R) (p : {mpoly R[n]}) : map_mpoly f (c *: p) = (f c) *: (map_mpoly f p). Proof. by rewrite /map_mpoly mmapZ /= mul_mpolyC. Qed. Lemma msupp_map_mpoly p : injective f -> perm_eq (msupp (map_mpoly f p)) (msupp p). Proof. move=> inj_f; apply/uniq_perm; rewrite ?msupp_uniq //=. by move=> m; rewrite !mcoeff_msupp mcoeff_map_mpoly raddf_eq0. Qed. End Multiplicative. End MPolyMap. (* -------------------------------------------------------------------- *) Section MPolyMapComp. Context (n k : nat) (R S : ringType) (f : {rmorphism R -> S}). Context (lq : n.-tuple {mpoly R[k]}) (p : {mpoly R[n]}). Local Notation "p ^f" := (map_mpoly f p). Lemma map_mpoly_comp : injective f -> (p \mPo lq)^f = (p^f) \mPo [tuple of [seq map_mpoly f q | q <- lq]]. Proof. move=> inj_f; apply/mpolyP=> m; rewrite mcoeff_map_mpoly. rewrite !raddf_sum (perm_big _ (msupp_map_mpoly _ inj_f)) /=. apply/eq_bigr=> m' _; rewrite mcoeff_map_mpoly !mcoeffCM rmorphM /=. congr *%R; rewrite /mmap1 -mcoeff_map_mpoly rmorph_prod /=. by congr _@__; apply/eq_bigr=> i /=; rewrite tnth_map rmorphXn. Qed. End MPolyMapComp. (* -------------------------------------------------------------------- *) Section MPolyOver. Context (n : nat) (R : ringType). Definition mpolyOver_pred (S : {pred R}) := fun p : {mpoly R[n]} => all (mem S) [seq p@_m | m <- msupp p]. Arguments mpolyOver_pred _ _ /. Definition mpolyOver (S : {pred R}) := [qualify a p | mpolyOver_pred S p]. Lemma mpolyOverS (S1 S2 : {pred R}) : {subset S1 <= S2} -> {subset mpolyOver S1 <= mpolyOver S2}. Proof. move=> sS12 p /(all_nthP 0)S1p. by apply/(all_nthP 0)=> i /S1p; apply: sS12. Qed. Lemma mpolyOver0 S: 0 \is a mpolyOver S. Proof. by rewrite qualifE /= msupp0. Qed. Lemma mpolyOver_mpoly (S : {pred R}) E : (forall m : 'X_{1..n}, m \in dom E -> coeff m E \in S) -> [mpoly E] \is a mpolyOver S. Proof. move=> S_E; apply/(all_nthP 0)=> i; rewrite size_map /= => lt. by rewrite (nth_map 0%MM) // mcoeff_MPoly S_E ?mem_nth. Qed. Section MPolyOverAdd. Variable S : addrClosed R. Lemma mpolyOverP {p} : reflect (forall m, p@_m \in S) (p \in mpolyOver S). Proof. case: p=> E; rewrite qualifE /=; apply: (iffP allP); last first. by move=> h x /mapP /= [m m_in_E] ->; apply/h. move=> h m; case: (boolP (m \in msupp (MPoly E))). by move=> m_in_E; apply/h/map_f. by rewrite -mcoeff_eq0 => /eqP->; rewrite rpred0. Qed. Lemma mpolyOverC c : (c%:MP \in mpolyOver S) = (c \in S). Proof. rewrite qualifE /= msuppC; case: eqP=> [->|] //=; by rewrite ?rpred0 // andbT mcoeffC eqxx mulr1. Qed. Lemma mpolyOver_addr_closed : addr_closed (mpolyOver S). Proof. split=> [|p q Sp Sq]; first exact: mpolyOver0. by apply/mpolyOverP=> i; rewrite mcoeffD rpredD ?(mpolyOverP _). Qed. HB.instance Definition _ := GRing.isAddClosed.Build {mpoly R[n]} (mpolyOver_pred S) mpolyOver_addr_closed. End MPolyOverAdd. Lemma mpolyOverNr (addS : zmodClosed R) : oppr_closed (mpolyOver addS). Proof. by move=> p /mpolyOverP Sp; apply/mpolyOverP=> i; rewrite mcoeffN rpredN. Qed. HB.instance Definition _ (addS : zmodClosed R) := GRing.isOppClosed.Build {mpoly R[n]} (mpolyOver_pred addS) (@mpolyOverNr addS). Section MPolyOverSemiring. Variable S : semiringClosed R. Lemma mpolyOver_mulr_closed : mulr_closed (mpolyOver S). Proof. split=> [|p q /mpolyOverP Sp /mpolyOverP Sq]. by rewrite mpolyOverC rpred1. apply/mpolyOverP=> i; rewrite mcoeffM rpred_sum //. by move=> j _; apply: rpredM. Qed. HB.instance Definition _ := GRing.isMulClosed.Build {mpoly R[n]} (mpolyOver_pred S) mpolyOver_mulr_closed. Lemma mpolyOverZ : {in S & mpolyOver S, forall c p, c *: p \is a mpolyOver S}. Proof. move=> c p Sc /mpolyOverP Sp; apply/mpolyOverP=> i. by rewrite mcoeffZ rpredM ?Sp. Qed. Lemma mpolyOverX m : 'X_[m] \in mpolyOver S. Proof. by rewrite qualifE /= msuppX /= mcoeffX eqxx rpred1. Qed. Lemma rpred_mhorner : {in mpolyOver S, forall p (v : 'I_n -> R), [forall i : 'I_n, v i \in S] -> p.@[v] \in S}. Proof. move=> p /mpolyOverP Sp v Sv; rewrite mevalE rpred_sum // => m _. rewrite rpredM // rpred_prod //= => /= i _. by rewrite rpredX //; move/forallP: Sv; apply; apply/mem_tnth. Qed. End MPolyOverSemiring. Section MPolyOverRing. Variable S : subringClosed R. HB.instance Definition _ := GRing.isMulClosed.Build {mpoly R[n]} (mpolyOver_pred S) (mpolyOver_mulr_closed S). Lemma mpolyOverXaddC m c : ('X_[m] + c%:MP \in mpolyOver S) = (c \in S). Proof. by rewrite rpredDl ?mpolyOverX ?mpolyOverC. Qed. End MPolyOverRing. End MPolyOver. Arguments mpolyOver_pred _ _ _ _ /. (* -------------------------------------------------------------------- *) Section MPolyIdomain. Context (n : nat) (R : idomainType). Implicit Types (p q r : {mpoly R[n]}). Lemma mleadM p q : p != 0 -> q != 0 -> mlead (p * q) = (mlead p + mlead q)%MM. Proof. move=> nz_p nz_q; rewrite mleadM_proper //. by rewrite mulf_neq0 // mleadc_eq0. Qed. Lemma mlead_prod (T : eqType) (r : seq T) (P : pred T) (F : T -> {mpoly R[n]}) : (forall x, x \in r -> P x -> F x != 0) -> mlead (\prod_(p <- r | P p) F p) = (\sum_(p <- r | P p) mlead (F p))%MM. Proof. move=> nz_Fr; rewrite mlead_prod_proper // => x x_in_r Px. apply/lregP; rewrite mleadc_eq0; exact/nz_Fr. Qed. Lemma mleadX p k : p != 0 -> mlead (p ^+ k) = (mlead p *+ k)%MM. Proof. by move=> nz_p; rewrite mleadX_proper //; apply/lregP; rewrite mleadc_eq0. Qed. Lemma mleadZ c p : c != 0 -> mlead (c *: p) = mlead p. Proof. move=> nz_c; have [->|nz_p] := eqVneq p 0; first by rewrite scaler0. by rewrite mleadZ_proper // mulf_neq0 // mleadc_eq0. Qed. Lemma mleadcZE a p : mleadc (a *: p) = a * mleadc p. Proof. have [->|Za] := eqVneq a 0; last by rewrite mleadZ // mcoeffZ. by rewrite scale0r mleadc0 mul0r. Qed. Lemma msizeM p q : p != 0 -> q != 0 -> msize (p * q) = (msize p + msize q).-1. Proof. by move=> nz_p nz_q; rewrite msizeM_proper ?mulf_neq0 // mleadc_eq0. Qed. Lemma msuppZ c p : c != 0 -> perm_eq (msupp (c *: p)) (msupp p). Proof. move=> nz_c; apply/uniq_perm=> // m. by rewrite !mcoeff_msupp mcoeffZ mulf_eq0 (negbTE nz_c). Qed. Lemma mscalerI a p : (a *: p == 0) = (a == 0) || (p == 0). Proof. have [/eqP->| /(msuppZ p)/perm_size] := boolP (a == 0). by rewrite scale0r eqxx. by rewrite -!msupp_eq0; case: msupp => [|a1 l1]; case: msupp. Qed. Lemma mmeasureZ c p mf : c != 0 -> mmeasure mf (c *: p) = mmeasure mf p. Proof. by move=> nz_c; rewrite !mmeasureE; apply/perm_big/msuppZ. Qed. Lemma msizeZ c p : c != 0 -> msize (c *: p) = msize p. Proof. exact/mmeasureZ. Qed. Lemma mpoly_idomainAxiom p q : p * q = 0 -> (p == 0) || (q == 0). Proof. apply: contra_eqT => /norP[nz_p nz_q]; rewrite -msize_poly_eq0 msizeM //. by rewrite (mpolySpred _ nz_p) (mpolySpred _ nz_q) addnS. Qed. Definition mpoly_unit : pred {mpoly R[n]} := fun p => (p == (p@_0)%:MP) && (p@_0 \in GRing.unit). Definition mpoly_inv p := if p \in mpoly_unit then (p@_0)^-1%:MP else p. Lemma mpoly_mulVp : {in mpoly_unit, left_inverse 1 mpoly_inv *%R}. Proof. move=> p Up; rewrite /mpoly_inv Up; case/andP: Up. by move/eqP=> {3}->; rewrite -mpolyCM => /mulVr ->. Qed. Lemma mpoly_intro_unit p q : q * p = 1 -> p \in mpoly_unit. Proof. move=> qp1; apply/andP; split; last first. apply/unitrP; exists q@_0. by rewrite 2!mulrC -rmorphM qp1 rmorph1. apply/eqP/msize1_polyC; have: msize (q * p) == 1%N. by rewrite qp1 msize1. have [-> | nz_p] := eqVneq p 0; first by rewrite mulr0 msize0. have [-> | nz_q] := eqVneq q 0; first by rewrite mul0r msize0. rewrite msizeM // (mpolySpred _ nz_p) (mpolySpred _ nz_q). by rewrite addnS addSn !eqSS addn_eq0 => /andP[] _ /eqP->. Qed. Lemma mpoly_inv_out : {in [predC mpoly_unit], mpoly_inv =1 id}. Proof. by rewrite /mpoly_inv => p /negbTE /= ->. Qed. HB.instance Definition _ := GRing.ComRing_hasMulInverse.Build (mpoly n R) mpoly_mulVp mpoly_intro_unit mpoly_inv_out. HB.instance Definition _ := GRing.ComUnitRing.on {mpoly R[n]}. #[hnf] HB.instance Definition _ := GRing.ComUnitRing_isIntegral.Build (mpoly n R) mpoly_idomainAxiom. #[hnf] HB.instance Definition _ := GRing.IntegralDomain.on {mpoly R[n]}. End MPolyIdomain. (* -------------------------------------------------------------------- *) Section MWeightTheory. Context (n : nat) (R : ringType). Implicit Types (m : 'X_{1..n}) (p : {mpoly R[n]}). Lemma leq_mdeg_mnmwgt m : mdeg m <= mnmwgt m. Proof. rewrite /mnmwgt mdegE leq_sum //= => i _; exact: leq_pmulr. Qed. Lemma leq_msize_meight p : msize p <= mweight p. Proof. rewrite !mmeasureE; elim: (msupp p)=> [|m r ih]. by rewrite !big_nil. rewrite !big_cons geq_max !leq_max !ltnS. by rewrite leq_mdeg_mnmwgt /= ih orbT. Qed. End MWeightTheory. (* -------------------------------------------------------------------- *) Section MPerm. Context (n : nat) (R : ringType). Implicit Types (m : 'X_{1..n}). Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Lemma mperm_inj (s : 'S_n) : injective (fun m => m#s). Proof. move=> m1 m2 /= /mnmP h; apply/mnmP=> i. by move: (h (s^-1 i)%g); rewrite !mnmE permKV. Qed. Lemma mperm1 m : m#(1 : 'S_n)%g = m. Proof. by apply/mnmP=> i; rewrite mnmE perm1. Qed. Lemma mpermM m (s1 s2 : 'S_n) : m#(s1 * s2)%g = m#s2#s1. Proof. by apply/mnmP=> i; rewrite !mnmE permM. Qed. Lemma mpermKV (s : 'S_n) : cancel (fun m => m#s) (fun m => m#(s^-1))%g. Proof. by move=> m /=; apply/mnmP=> i; rewrite !mnmE permKV. Qed. Lemma mpermK (s : 'S_n) : cancel (fun m => m#(s^-1))%g (fun m => m#s). Proof. by move=> m /=; apply/mnmP=> i; rewrite !mnmE permK. Qed. Lemma mdeg_mperm m (s : 'S_n) : mdeg (m#s) = mdeg m. Proof. rewrite !mdegE (reindex_inj (h := s^-1))%g /=; last exact/perm_inj. by apply/eq_bigr=> j _; rewrite !mnmE permKV. Qed. End MPerm. (* -------------------------------------------------------------------- *) Section MPolySym. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}). Definition msym (s : 'S_n) p : {mpoly R[n]} := mmap (@mpolyC n R) (fun i => 'X_(s i)) p. Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Lemma msymE p (s : 'S_n) k : msize p <= k -> msym s p = \sum_(m : 'X_{1..n < k}) (p@_m *: 'X_[m#(s^-1)%g]). Proof. move=> lt_pk; rewrite /msym (mmapE k) //=; apply/eq_bigr. move=> m' _; rewrite mul_mpolyC; congr (_ *: _). rewrite /mmap1 mprodXnE [X in _=X]mpolyXE_id mprodXnE. rewrite [X in _='X_[X]](reindex (fun i : 'I_n => s i)) /=. congr 'X_[_]; apply/eq_bigr=> i _; congr (_ *+ _)%MM. by rewrite mnmE /= permK. by exists (s^-1)%g=> i _; rewrite (permK, permKV). Qed. Arguments msymE [p]. Lemma mcoeff_sym p (s : 'S_n) m : (msym s p)@_m = p@_(m#s). Proof. pose_big_enough i; first rewrite (msymE s i) //. apply/esym; rewrite {1}[p](mpolywE (k := i)) //. rewrite !raddf_sum /=; apply/eq_bigr=> j _. rewrite !mcoeffZ !mcoeffX; congr (_ * _). have bijF: bijective (fun (m : 'X_{1..n}) => m#(s^-1)%g). exists (fun (m : 'X_{1..n}) => m#s) => m'. + by apply/mnmP=> k; rewrite !mnmE permK. + by apply/mnmP=> k; rewrite !mnmE permKV. rewrite -(bij_eq bijF); have ->//: m#s#(s^-1)%g = m. by apply/mnmP=> k; rewrite !mnmE /= permKV. by close. Qed. Lemma msymX m s : msym s 'X_[m] = 'X_[m#(s^-1)%g]. Proof. apply/mpolyP=> m'; rewrite mcoeff_sym !mcoeffX. congr (_ : bool)%:R; apply/eqP/eqP=> [->|<-]. + by apply/mnmP=> i; rewrite !mnmE permKV. + by apply/mnmP=> i; rewrite !mnmE permK. Qed. Lemma msym_is_additive s: additive (msym s). Proof. exact/mmap_is_additive. Qed. HB.instance Definition _ s := GRing.isAdditive.Build {mpoly R[n]} {mpoly R[n]} (msym s) (msym_is_additive s). Lemma msym0 s : msym s 0 = 0 . Proof. exact: raddf0. Qed. Lemma msymN s : {morph msym s: x / - x} . Proof. exact: raddfN. Qed. Lemma msymD s : {morph msym s: x y / x + y}. Proof. exact: raddfD. Qed. Lemma msymB s : {morph msym s: x y / x - y}. Proof. exact: raddfB. Qed. Lemma msymMn s k : {morph msym s: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma msymMNn s k : {morph msym s: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma msym_is_multiplicative s : multiplicative (msym s). Proof. apply/commr_mmap_is_multiplicative => [i x|p m1 m2]; first exact/commr_mpolyX. rewrite /= /mmap1; elim/big_rec: _ => [|i q _]; first exact/commr1. exact/commrM/commrX/commr_mpolyX. Qed. HB.instance Definition _ s := GRing.isMultiplicative.Build {mpoly R[n]} {mpoly R[n]} (msym s) (msym_is_multiplicative s). Lemma msym1 s : msym s 1 = 1. Proof. exact: rmorph1. Qed. Lemma msymM s : {morph msym s: x y / x * y}. Proof. exact: rmorphM. Qed. Lemma msymZ c p s : msym s (c *: p) = c *: (msym s p). Proof. pose_big_enough i; first rewrite !(msymE s i) //. rewrite scaler_sumr; apply/eq_bigr => j _. by rewrite mcoeffZ scalerA. by close. Qed. HB.instance Definition _ s := GRing.isScalable.Build R {mpoly R[n]} {mpoly R[n]} *:%R (msym s) (fun c => (msymZ c)^~ s). Definition symmetric_pred : pred {mpoly R[n]} := fun p => [forall s, msym s p == p]. Arguments symmetric_pred _ /. Definition symmetric : qualifier 0 {mpoly R[n]} := [qualify p | symmetric_pred p]. Lemma issymP p : reflect (forall s, msym s p = p) (p \is symmetric). Proof. apply: (iffP forallP)=> /= h s; last by rewrite h. by rewrite (eqP (h s)). Qed. Lemma sym_zmod : zmod_closed symmetric. Proof. split=> [|p q /issymP sp /issymP sq]; apply/issymP=> s. by rewrite msym0. by rewrite msymB sp sq. Qed. HB.instance Definition _ := GRing.isZmodClosed.Build {mpoly R[n]} symmetric_pred sym_zmod. Lemma sym_mulr_closed : mulr_closed symmetric. Proof. split=> [|p q /issymP sp /issymP sq]; apply/issymP=> s. by rewrite msym1. by rewrite msymM sp sq. Qed. HB.instance Definition _ := GRing.isMulClosed.Build {mpoly R[n]} symmetric_pred sym_mulr_closed. Lemma sym_submod_closed : submod_closed symmetric. Proof. split=> [|c p q /issymP sp /issymP sq]; apply/issymP=> s. by rewrite msym0. by rewrite msymD msymZ sp sq. Qed. HB.instance Definition _ := GRing.isSubmodClosed.Build R {mpoly R[n]} symmetric_pred sym_submod_closed. Lemma issym_msupp p (s : 'S_n) (m : 'X_{1..n}) : p \is symmetric -> (m#s \in msupp p) = (m \in msupp p). Proof. by rewrite !mcoeff_msupp -mcoeff_sym => /issymP ->. Qed. Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Lemma msym_coeff (p : {mpoly R[n]}) (m : 'X_{1..n}) (s : 'S_n) : p \is symmetric -> p@_(m#s) = p@_m. Proof. move/issymP=> /(_ s^-1)%g {1}<-; rewrite mcoeff_sym. by congr (_@__); apply/mnmP=> i /=; rewrite !mnmE permKV. Qed. Lemma msym1m p : msym 1 p = p. Proof. by apply/mpolyP=> m; rewrite mcoeff_sym mperm1. Qed. Lemma msymMm p (s1 s2 : 'S_n) : msym (s1 * s2)%g p = msym s2 (msym s1 p). Proof. by apply/mpolyP=> m; rewrite !mcoeff_sym mpermM. Qed. Lemma inj_msym (s : 'S_n) : injective (msym s). Proof. move=> p q; move/(congr1 (msym s^-1)%g). by rewrite -!msymMm mulgV !msym1m. Qed. Lemma mlead_msym_sorted (p : {mpoly R[n]}) : p \is symmetric -> forall (i j : 'I_n), i <= j -> (mlead p) j <= (mlead p) i. Proof. move=> sym_p i j le_ij; have [->|nz_p] := eqVneq p 0. by rewrite mlead0 !mnm0E. set m := mlead p; case: leqP=> // h. pose s := tperm i j; pose ms := m#s; have: (m < ms)%O. apply/ltmcP; first by rewrite mdeg_mperm. exists i=> [k lt_ki|]; last by rewrite mnmE tpermL. rewrite mnmE tpermD // neq_ltn orbC ?lt_ki //. by move/leq_trans: lt_ki => /(_ _ le_ij) ->. have: ms \in msupp p by rewrite issym_msupp // mlead_supp. by move/msupp_le_mlead; rewrite leNgt => /negbTE=> ->. Qed. End MPolySym. Arguments inj_msym {n R}. Arguments symmetric_pred _ _ _ /. Arguments symmetric {n R}. (* -------------------------------------------------------------------- *) Section MPolySymComp. Context (n : nat) (R : ringType). Lemma mcomp_sym k (p : {mpoly R[n]}) (t : n.-tuple {mpoly R[k]}) : (forall i : 'I_n, t`_i \is symmetric) -> p \mPo t \is symmetric. Proof. move=> sym_t; pose_big_enough l. rewrite (comp_mpolywE _ (w := l)) //. 2: by close. apply/rpred_sum=> m _; apply/rpredZ/rpred_prod=> i _. by rewrite (tnth_nth 0); apply/rpredX/sym_t. Qed. End MPolySymComp. (* -------------------------------------------------------------------- *) Section MPolySymCompCom. Context (n : nat) (R : comRingType). Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Lemma msym_mPo (s : 'S_n) (p : {mpoly R[n]}) k (T : n.-tuple {mpoly R[k]}) : (msym s p) \mPo T = p \mPo [tuple tnth T (s i) | i < n]. Proof. pose_big_enough l; [rewrite !(comp_mpolywE _ (w := l)) // | by close]. have FP (m : 'X_{1..n < l}) : mdeg (m#s) < l by rewrite mdeg_mperm bmdeg. pose F (m : 'X_{1..n < l}) := BMultinom (FP m). have inj_F: injective F. by move=> m1 m2 /(congr1 val) /mperm_inj /val_inj. rewrite [RHS](reindex_inj inj_F); apply/eq_bigr=> m _ /=. rewrite mcoeff_sym (reindex_inj (@perm_inj _ s)) /=; congr (_ *: _). by apply/eq_bigr=> i _; rewrite mnmE tnth_mktuple. Qed. Lemma msym_comp_poly k (p : {mpoly R[n]}) (t : n.-tuple {mpoly R[k]}) : p \is symmetric -> (forall s : 'S_k, perm_eq t [tuple (msym s t`_i) | i < n]) -> p \mPo t \is symmetric. Proof. move=> sym_p sym_t; apply/issymP=> s; pose_big_enough l. rewrite (comp_mpolywE _ (w := l)) //. 2: by close. case/tuple_permP: (sym_t s^-1)%g => s' tE. pose F (m : 'X_{1..n < l}) := insubd m [multinom m (s' i) | i < n]. have FE m: F m = [multinom m (s' i) | i < n] :> 'X_{1..n}. by rewrite insubdK // -topredE /= mdeg_mperm ?bmdeg. rewrite raddf_sum {1}(reindex_inj (h := F)) /=; last first. move=> m1 m2 /(congr1 (@bmnm _ _)); rewrite !FE. by move/mperm_inj=> /val_inj. apply/eq_bigr=> m _; rewrite linearZ /= FE msym_coeff //. rewrite rmorph_prod /= (reindex_inj (perm_inj (s := s'^-1))) /=. congr (_ *: _); apply/eq_bigr=> i _; rewrite rmorphXn /=. rewrite mnmE permKV (tnth_nth 0) {1}tE -!tnth_nth. rewrite !tnth_map !tnth_ord_tuple permKV -msymMm. by rewrite mulVg msym1m -tnth_nth. Qed. End MPolySymCompCom. (* -------------------------------------------------------------------- *) Section MPolySymUnit. Context (n : nat) (R : idomainType). Implicit Types (p q r : {mpoly R[n]}). Lemma msymMK (p q : {mpoly R[n]}) : p != 0 -> p \is symmetric -> p * q \is symmetric -> q \is symmetric. Proof. move=> nz_p /issymP sym_p /issymP sym_pq; apply/issymP => s. by move/(_ s): sym_pq; rewrite msymM sym_p => /(mulfI nz_p). Qed. Lemma sym_divring : divring_closed (symmetric (n := n) (R := R)). Proof. split; try solve [apply/rpred1 | apply/rpredB]. move=> p q sym_p sym_q /=; case: (boolP (q \isn't a GRing.unit)). by move/invr_out=> ->; apply/rpredM. rewrite negbK=> inv_q; apply/(msymMK _ sym_q). by apply/contraTneq: inv_q=> ->; rewrite unitr0. by rewrite mulrCA divrr // mulr1. Qed. HB.instance Definition _ := GRing.isDivringClosed.Build {mpoly R[n]} (@symmetric_pred n R) sym_divring. End MPolySymUnit. (* -------------------------------------------------------------------- *) Section MElemPolySym. Context (n : nat) (R : ringType). Implicit Types (p q r : {mpoly R[n]}) (h : {set 'I_n}). Definition mesym (k : nat) : {mpoly R[n]} := \sum_(h : {set 'I_n} | #|h| == k) \prod_(i in h) 'X_i. Local Notation "''s_' k" := (@mesym k). Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Definition mesym1 (h : {set 'I_n}) := [multinom i \in h | i < n]. Lemma mesym1_set0 : mesym1 set0 = 0%MM. Proof. by apply/mnmP=> i; rewrite mnmE mnm0E in_set0. Qed. Lemma mesym1_set1 i : mesym1 [set i] = U_(i)%MM. Proof. by apply/mnmP=> j; rewrite mnmE in_set1 mnmE eq_sym. Qed. Lemma mesym1_setT : mesym1 setT = (\sum_(i < n) U_(i))%MM. Proof. apply/mnmP=> i; rewrite mnmE mnm_sumE in_setT /=. rewrite (bigD1 i) //= mnmE eqxx big1 ?addn0 //. by move=> j; rewrite mnmE => /negbTE->. Qed. Lemma mesymE k : 's_k = \sum_(h : {set 'I_n} | #|h| == k) 'X_[mesym1 h]. Proof. apply/eq_bigr=> /= h _; rewrite mprodXE; congr 'X_[_]. apply/mnmP=> i; rewrite mnmE mnm_sumE big_mkcond /=. rewrite (bigD1 i) //= mnmE eqxx /= big1 ?addn0 // => j ne_ji. by case: (_ \in _); rewrite // mnmE (negbTE ne_ji). Qed. Lemma mdeg_mesym1 h : mdeg (mesym1 h) = #|h|. Proof. rewrite mdegE (bigID (mem h)) /= addnC big1 ?add0n; last first. by move=> i i_notin_h; rewrite mnmE (negbTE i_notin_h). rewrite (eq_bigr (fun _ => 1%N)) ?sum1_card //. by move=> i i_in_h; rewrite mnmE i_in_h. Qed. Lemma inj_mesym1 : injective mesym1. Proof. move=> h1 h2 /mnmP eqh; apply/setP=> /= i. by have := eqh i; rewrite !mnmE; do! case: (_ \in _). Qed. Local Hint Resolve inj_mesym1 : core. Lemma msupp_mesym k : perm_eq (msupp 's_k) [seq mesym1 h | h : {set 'I_n} <- enum {set 'I_n} & #|h| == k]. Proof. rewrite mesymE; apply/(perm_trans (msupp_sum _ _ _))=> /=. + by rewrite /index_enum -enumT enum_uniq. + move=> h1 h2 _ _ ne_h1h2 m /=; rewrite !msuppX !mem_seq1. apply/negbTE/negP=> /andP[/eqP->] /eqP /inj_mesym1. by move/eqP; rewrite (negbTE ne_h1h2). rewrite /index_enum -enumT /= (eq_map (fun h => msuppX _ (mesym1 h))). by rewrite (map_comp (cons^~ [::])) flatten_seq1. Qed. Lemma msupp_mesymP (k : nat) m : (m \in msupp 's_k) = [exists h : {set 'I_n}, (#|h| == k) && (m == mesym1 h)]. Proof. rewrite (perm_mem (msupp_mesym _)); apply/idP/existsP=> /=. + case/mapP=> /= h; rewrite mem_filter=> /andP[/eqP<- _ ->]. by exists h; rewrite !eqxx. + case=> h /andP[/eqP<- /eqP->]; apply/mapP; exists h=> //. by rewrite mem_filter eqxx /= mem_enum. Qed. Definition mechar k (m : 'X_{1..n}) := (mdeg m == k) && [forall i, m i <= 1%N]. Lemma mecharP k m : mechar k m = [exists h : {set 'I_n}, (m == mesym1 h) && (#|h| == k)]. Proof. apply/idP/existsP=> /=; last first. case=> h /andP[/eqP-> /eqP<-]; rewrite /mechar. rewrite mdeg_mesym1 eqxx /=; apply/forallP=> /= i. by rewrite mnmE leq_b1. case/andP=> /eqP<- /forallP /= mE; exists [set i | m i != 0%N]. apply/andP; split; [apply/eqP/mnmP=> i|apply/eqP]. by rewrite mnmE inE; have := mE i; case: (m i)=> [|[|]]. rewrite mdegE (bigID (fun i => m i == 0%N)) /=. rewrite big1 ?add0n; last by move=> i /eqP->. rewrite (eq_bigr (fun _ => 1%N)) ?sum1_card ?cardsE //. by move=> i; have := mE i; case: (m i) => [|[|]]. Qed. Lemma mcoeff_mesym (k : nat) m : ('s_k)@_m = (mechar k m)%:R. Proof. rewrite mecharP; case: (altP existsP) => /= [[h /andP[/eqP-> /eqP<-]]|]. rewrite mesymE raddf_sum (bigD1 h) //= mcoeffX eqxx big1 ?addr0 //. move=> h' /andP[_ ne_h]; rewrite mcoeffX -[0]/0%:R. by congr _%:R; apply/eqP; rewrite eqb0 inj_eq. rewrite negb_exists=> /forallP /= ne. rewrite mesymE raddf_sum big1 //= => h cardh; have := ne h. by rewrite cardh andbT mcoeffX; case: eqVneq. Qed. Lemma mem_msupp_mesym k m : m \in msupp 's_k = mechar k m. Proof. rewrite mcoeff_msupp mcoeff_mesym. by case: (mechar _ _); rewrite ?eqxx // oner_eq0. Qed. Lemma mperm_mechar k (m : 'X_{1..n}) (s : 'S_n) : mechar k (m#s) = mechar k m. Proof. rewrite /mechar mdeg_mperm; congr (_ && _). apply/forallP/forallP=> //=. + by move=> h i; move/(_ (s^-1 i))%g: h; rewrite mnmE permKV. + by move=> h i; rewrite mnmE; apply/h. Qed. Lemma mesym_sym k : 's_k \is symmetric. Proof. apply/issymP=> s; apply/mpolyP=> m. by rewrite mcoeff_sym !mcoeff_mesym mperm_mechar. Qed. Lemma mem_mesym1_mesym h : mesym1 h \in msupp 's_#|h|. Proof. rewrite mem_msupp_mesym mecharP; apply/existsP. by exists h; rewrite !eqxx. Qed. Lemma mesym0E : 's_0 = 1. Proof. rewrite mesymE (bigD1 set0) ?cards0 //= mesym1_set0 mpolyX0. by rewrite big1 ?addr0 // => i /andP[/eqP/cards0_eq->]; rewrite eqxx. Qed. Lemma mesym1E : 's_1 = \sum_(i < n) 'X_i. Proof. rewrite mesymE -big_set /=; set S := [set _ | _]. have ->: S = [set [set i] | i : 'I_n]. apply/eqP; rewrite eqEcard (card_imset _ set1_inj). rewrite card_draws /= !card_ord bin1 leqnn andbT. apply/subsetP=> /= s; rewrite inE => /cards1P /= [i {s}->]. by apply/imsetP; exists i. rewrite big_imset /=; last by move=> i1 i2 _ _; apply/set1_inj. by apply/eq_bigr=> i _; rewrite mesym1_set1. Qed. Lemma mesymnnE : 's_n = \prod_(i < n) 'X_i. Proof. rewrite mesymE (bigD1 setT) ?cardsT ?card_ord //=. rewrite [X in _+X]big1 ?addr0; last first. move=> i /andP []; rewrite eqEcard => /eqP ->. by rewrite subsetT cardsT card_ord leqnn. by rewrite mprodXE mesym1_setT. Qed. Lemma mesym_geqnE i : i > n -> mesym i = 0. Proof. rewrite /mesym => Hn; apply: big1 => s /eqP Hs; exfalso. by have:= subset_leq_card (subsetT s); rewrite Hs cardsT card_ord leqNgt Hn. Qed. Definition mesymlmnm k : {set 'I_n} := [set i : 'I_n | i < k]. Definition mesymlm k : 'X_{1..n} := mesym1 (mesymlmnm k). Let card_mesymlmnm k (le_kn : k <= n) : #|mesymlmnm k| = k. Proof. rewrite -sum1dep_card -(big_ord_widen _ (fun _ => 1%N)) //=. by rewrite sum1_card card_ord. Qed. Let mesymlmE k : mesymlm k = [multinom (i < k : nat) | i < n]. Proof. by apply/mnmP=> i; rewrite !mnmE in_set. Qed. Let mesymlm_max (h : {set 'I_n}) : #|h| <= n -> (mesym1 h <= mesymlm #|h|)%O. Proof. (* FIXME: far too convoluted *) move=> le_Ch_n; pose P := [exists i : 'I_n, (i < #|h|) && (i \notin h)]. case: (boolP P)=> [/existsP[/= i /andP[lt_ih i_notin_h]]|hNP]; last first. suff ->: h = mesymlmnm #|h|; first by rewrite card_mesymlmnm. move: hNP; rewrite negb_exists => /forallP /= {P} hNP. have eq1: forall i : 'I_n, i < #|h| -> i \in h. move=> i lt_i_Ch; move: (hNP i); rewrite negb_and. by rewrite lt_i_Ch /= negbK. have eq2: forall i : 'I_n, i >= #|h| -> i \notin h. move=> i le_Ch_i; apply/negP=> i_in_h; move: (leqnn #|h|). rewrite -{1}sum1_card; pose P (j : 'I_n) := j < #|h|. rewrite (bigID P) big_andbC (eq_bigl P) {}/P /=; last first. move=> j /=; apply/andb_idr=> lt_j_Ch; have := hNP j. by rewrite lt_j_Ch /= negbK. rewrite -(big_ord_widen _ (fun _ => 1%N)) // sum1_card card_ord. rewrite -[X in _<=X]addn0 leq_add2l leqn0; apply/eqP. by rewrite (bigD1 i) // -leqNgt le_Ch_i andbT. apply/setP=> i; rewrite in_set; case: (leqP #|h| i). by move/eq2/negbTE. by move/eq1. pose i0 : 'I_n := [arg min_(j < i | j \notin h) j]. apply/ltW/ltmcP; first by rewrite !mdeg_mesym1 card_mesymlmnm. exists i0; rewrite {}/i0; case: arg_minnP => //=. + move=> i0 i0_notin_h i0_min j lt_j_i0; rewrite !mnmE in_set. rewrite (@ltn_trans i) // 1?(@leq_trans i0) // ?i0_min //. by case: (boolP (j \in h))=> // /i0_min; rewrite leqNgt lt_j_i0. + move=> i0 i0_notin_h i0_min; rewrite !mnmE in_set. by rewrite (negbTE i0_notin_h) lt0n // (@leq_ltn_trans i) // i0_min. Qed. Lemma mesym_neq0 k (le_kn : k <= n) : 's_k != 0 :> {mpoly R[n]}. Proof. apply/eqP=> z_sk; pose h : {set 'I_n} := mesymlmnm k. have := mem_mesym1_mesym h; rewrite card_mesymlmnm //. by rewrite mcoeff_msupp z_sk mcoeff0 eqxx. Qed. Lemma mlead_mesym k (le_kn : k <= n) : mlead 's_k = [multinom (i < k : nat) | i < n]. Proof. rewrite -mesymlmE /mlead (bigD1_seq (mesymlm k)) //=; last first. rewrite mem_msupp_mesym mecharP; apply/existsP. by exists (mesymlmnm k); rewrite card_mesymlmnm ?eqxx. apply/join_l/joinsP_seq=> /= {}m. rewrite msupp_mesymP => /existsP[/=]. move=> h /andP[/eqP Chk /eqP->] _; rewrite -Chk. by apply/mesymlm_max; rewrite Chk. Qed. Lemma mleadc_mesym k (le_kn : k <= n) : mleadc 's_k = 1. Proof. rewrite mcoeff_mesym; case: (boolP (mechar _ _))=> //=. by rewrite -mem_msupp_mesym mlead_supp // mesym_neq0. Qed. Definition tmono (n : nat) (h : seq 'I_n) := sorted ltn (map val h). Lemma uniq_tmono (h : seq 'I_n) : tmono h -> uniq h. Proof. rewrite /tmono => /sorted_uniq; rewrite (map_inj_uniq val_inj). by apply; [apply/ltn_trans | move=> ?; rewrite /ltn /= ltnn]. Qed. Lemma eq_tmono (h1 h2 : seq 'I_n) : tmono h1 -> tmono h2 -> h1 =i h2 -> h1 = h2. Proof. move=> tm1 tm2 h; apply/(inj_map val_inj). apply/(irr_sorted_eq (leT := ltn)) => //. exact/ltn_trans. by move=> ?; rewrite /ltn /= ltnn. move=> m; apply/mapP/mapP; case=> /= x; by rewrite (h, =^~ h)=> {}h ->; exists x. Qed. Lemma mesym_tupleE (k : nat) : 's_k = \sum_(h : k.-tuple 'I_n | tmono h) \prod_(i <- h) 'X_i. Proof. have tval_tcast T k1 k2 (eq : k1 = k2) (x : k1.-tuple T) : tval (tcast eq x) = tval x. + by rewrite /tcast; case: k2 / eq. pose t2s (t : k.-tuple 'I_n) := [set x | x \in t]. rewrite /mesym -[X in X=_]big_set -[X in _=X]big_set /=. set E := [set t2s x | x in [pred t | tmono (tval t)]]. have h: E = [set i : {set 'I_n} | #|i| == k]. apply/setP=> /= h; rewrite inE; apply/imsetP/idP=> /=. + case=> t; rewrite inE => tmono_t -> /=; rewrite /t2s. rewrite cardsE /= -[X in _==X](size_tuple t). by apply/eqP/card_uniqP/uniq_tmono. + move/eqP=> eq_sz; exists (tcast eq_sz [tuple of (enum h)]). * rewrite inE /tmono tval_tcast /=; pose I := enum 'I_n. apply/(subseq_sorted _ (s2 := [seq val i | i <- I])). exact/ltn_trans. by apply/map_subseq; rewrite /enum_mem -enumT; apply/filter_subseq. by rewrite val_enum_ord iota_ltn_sorted. * by apply/setP=> i; rewrite !(inE, memtE) tval_tcast mem_enum. rewrite -h {h}/E big_imset 1?big_set /=; last first. move=> t1 t2; rewrite !inE => tmono_t1 tmono_t2 /setP eq. by apply/val_inj/eq_tmono => // i; move: (eq i); rewrite !inE. apply/eq_big=> // i; rewrite inE 1?big_set /=. case: i => i sz_i /= tmono_i; rewrite (eq_bigl (mem i)) //=. by rewrite !mprodXE big_uniq //; apply/uniq_tmono. Qed. End MElemPolySym. Local Notation "''s_' ( K , n , k )" := (@mesym n K k). Local Notation "''s_' ( n , k )" := (@mesym n _ k). (* -------------------------------------------------------------------- *) Section MWiden. Context (n : nat) (R : ringType). Definition mwiden (p : {mpoly R[n]}) : {mpoly R[n.+1]} := mmap (@mpolyC _ _) (fun i => 'X_(widen i)) p. Definition mnmwiden (m : 'X_{1..n}) : 'X_{1..n.+1} := [multinom of rcons m 0%N]. Lemma mnmwiden_ordmax m : (mnmwiden m) ord_max = 0%N. Proof. rewrite multinomE (tnth_nth 0%N) nth_rcons /=. by rewrite size_tuple ltnn eqxx. Qed. Lemma mnmwiden_widen m (i : 'I_n) : (mnmwiden m) (widen i) = m i. Proof. case: m=> m; rewrite !(mnm_nth 0%N) nth_rcons. by rewrite size_tuple /=; case: i => i /= ->. Qed. Lemma mnmwiden0 : mnmwiden 0 = 0%MM. Proof. apply/mnmP=> i; rewrite mnmE (mnm_nth 0%N) nth_rcons. case: ssrnat.ltnP; last by rewrite ?if_same. rewrite size_tuple=> lt_in; pose oi := Ordinal lt_in. by rewrite (nth_map oi) //; rewrite size_tuple. Qed. Lemma mnmwidenD m1 m2 : mnmwiden (m1 + m2) = (mnmwiden m1 + mnmwiden m2)%MM. Proof. apply/mnmP=> i; rewrite mnmDE !multinomE !(tnth_nth 0%N) /=. rewrite !nth_rcons size_map size_enum_ord !size_tuple !if_same. case h: (i < n); last by rewrite addn0. rewrite (nth_map (Ordinal h)) ?size_enum_ord //. by rewrite !(mnm_nth 0%N) /= !nth_enum_ord. Qed. Lemma mnmwiden_sum (I : Type) (r : seq I) P F : mnmwiden (\sum_(x <- r | P x) (F x)) = (\sum_(x <- r | P x) (mnmwiden (F x)))%MM. Proof. exact/big_morph/mnmwiden0/mnmwidenD. Qed. Lemma mnmwiden1 i : (mnmwiden U_(i) = U_(widen i))%MM. Proof. apply/mnmP; case=> j /= lt; rewrite /mnmwiden !mnmE; apply/esym. rewrite eqE multinomE /tnth /=; move: (tnth_default _ _) => x. rewrite nth_rcons size_map size_enum_ord; move: lt. rewrite ltnS leq_eqVlt => /predU1P[->|lt]. by apply/eqP; rewrite ltnn eqxx eqb0 ltn_eqF. rewrite lt (nth_map i) ?size_enum_ord //. by apply/esym; rewrite eqE /= nth_enum_ord. Qed. Lemma inj_mnmwiden : injective mnmwiden. Proof. move=> m1 m2 /mnmP h; apply/mnmP=> i; move: (h (widen i)). by rewrite !mnmwiden_widen. Qed. Lemma mwiden_is_additive : additive mwiden. Proof. exact/mmap_is_additive. Qed. Lemma mwiden0 : mwiden 0 = 0 . Proof. exact: raddf0. Qed. Lemma mwidenN : {morph mwiden: x / - x} . Proof. exact: raddfN. Qed. Lemma mwidenD : {morph mwiden: x y / x + y}. Proof. exact: raddfD. Qed. Lemma mwidenB : {morph mwiden: x y / x - y}. Proof. exact: raddfB. Qed. Lemma mwidenMn k : {morph mwiden: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma mwidenMNn k : {morph mwiden: x / x *- k} . Proof. exact: raddfMNn. Qed. HB.instance Definition _ := GRing.isAdditive.Build {mpoly R[n]} {mpoly R[n.+1]} mwiden mwiden_is_additive. Lemma mwiden_is_multiplicative : multiplicative mwiden. Proof. apply/commr_mmap_is_multiplicative=> [i p|p m m']; first exact/commr_mpolyX. rewrite /= /mmap1; elim/big_rec: _ => /= [|i q _]; first exact/commr1. exact/commrM/commrX/commr_mpolyX. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n]} {mpoly R[n.+1]} mwiden mwiden_is_multiplicative. Lemma mwiden1 : mwiden 1 = 1. Proof. exact: rmorph1. Qed. Lemma mwidenM : {morph mwiden: x y / x * y}. Proof. exact: rmorphM. Qed. Lemma mwidenC c : mwiden c%:MP = c%:MP. Proof. by rewrite /mwiden mmapC. Qed. Lemma mwidenN1 : mwiden (-1) = -1. Proof. by rewrite raddfN /= mwidenC. Qed. Lemma mwidenX m : mwiden 'X_[m] = 'X_[mnmwiden m]. Proof. rewrite /mwiden mmapX /mmap1 /= (mpolyXE _ 1); apply/esym. rewrite (eq_bigr (fun i => 'X_i ^+ (mnmwiden m i))); last first. by move=> i _; rewrite perm1. rewrite big_ord_recr /= mnmwiden_ordmax expr0 mulr1. by apply/eq_bigr=> i _; rewrite mnmwiden_widen. Qed. Lemma mwidenZ c p : mwiden (c *: p) = c *: mwiden p. Proof. by rewrite /mwiden mmapZ /= mul_mpolyC. Qed. Lemma mwidenE (p : {mpoly R[n]}) (k : nat) : msize p <= k -> mwiden p = \sum_(m : 'X_{1..n < k}) (p@_m *: 'X_[mnmwiden m]). Proof. move=> h; rewrite {1}[p](mpolywE (k := k)) //. rewrite raddf_sum /=; apply/eq_bigr=> m _. by rewrite mwidenZ mwidenX. Qed. Lemma mwiden_mnmwiden p m : (mwiden p)@_(mnmwiden m) = p@_m. Proof. rewrite (mwidenE (k := msize p)) // raddf_sum /=. rewrite [X in _=X@__](mpolywE (k := msize p)) //. rewrite raddf_sum /=; apply/eq_bigr=> i _. by rewrite !mcoeffZ !mcoeffX inj_eq //; apply/inj_mnmwiden. Qed. Lemma inj_mwiden : injective mwiden. Proof. move=> m1 m2 /mpolyP h; apply/mpolyP=> m. by move: (h (mnmwiden m)); rewrite !mwiden_mnmwiden. Qed. Definition mpwiden (p : {poly {mpoly R[n]}}) : {poly {mpoly R[n.+1]}} := map_poly mwiden p. Lemma mpwiden_is_additive : additive mpwiden. Proof. exact: map_poly_is_additive. Qed. HB.instance Definition _ := GRing.isAdditive.Build {poly {mpoly R[n]}} {poly {mpoly R[n.+1]}} mpwiden mpwiden_is_additive. Lemma mpwiden_is_multiplicative : multiplicative mpwiden. Proof. exact: map_poly_is_multiplicative. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {poly {mpoly R[n]}} {poly {mpoly R[n.+1]}} mpwiden mpwiden_is_multiplicative. Lemma mpwidenX : mpwiden 'X = 'X. Proof. by rewrite /mpwiden map_polyX. Qed. Lemma mpwidenC c : mpwiden c%:P = (mwiden c)%:P. Proof. by rewrite /mpwiden map_polyC. Qed. Lemma mpwidenZ c p : mpwiden (c *: p) = mwiden c *: (mpwiden p). Proof. by rewrite /mpwiden map_polyZ. Qed. End MWiden. (* -------------------------------------------------------------------- *) Section MPolyUni. Context (n : nat) (R : ringType). Implicit Types (p q : {mpoly R[n.+1]}). Let X (i : 'I_n.+1) : {poly {mpoly R[n]}} := match split (cast_ord (esym (addn1 n)) i) with | inl j => ('X_j)%:P | inr _ => 'X end. Definition muni (p : {mpoly R[n.+1]}) : {poly {mpoly R[n]}} := nosimpl (mmap (polyC \o @mpolyC _ _) X p). Let XE m : mmap1 X m = 'X_[[multinom (m (widen i)) | i < n]] *: 'X^(m ord_max). Proof. have X1: X ord_max = 'X. rewrite /X; case: splitP=> //; case=> j lt_jn /eqP /=. by have := lt_jn; rewrite ltn_neqAle eq_sym=> /andP[/negbTE->]. have X2 i: X (widen i) = ('X_i)%:P. rewrite /X; case: splitP=> [j eq|j]. by congr ('X__)%:P; apply/val_inj=> /=; rewrite -eq. by rewrite ord1 /= addn0 => /eqP /=; rewrite ltn_eqF. rewrite /mmap1 big_ord_recr /= X1 -mul_polyC. rewrite mpolyXE_id rmorph_prod /=; congr (_ * _). by apply/eq_bigr=> i _; rewrite X2 rmorphXn /= mnmE. Qed. Lemma muniE p : muni p = \sum_(m <- msupp p) p@_m *: 'X_[[multinom (m (widen i)) | i < n]] *: 'X^(m ord_max). Proof. apply/eq_bigr=> m _; rewrite XE /= -!mul_polyC. by rewrite mulrA -polyCM mul_mpolyC. Qed. Definition mmulti (p : {poly {mpoly R[n]}}) : {mpoly R[n.+1]} := \sum_(i < size p) ((mwiden p`_i) * ('X_ord_max) ^+ i). Lemma muni_is_additive : additive muni. Proof. exact/mmap_is_additive. Qed. HB.instance Definition _ := GRing.isAdditive.Build {mpoly R[n.+1]} {poly {mpoly R[n]}} muni muni_is_additive. Lemma muni0 : muni 0 = 0 . Proof. exact: raddf0. Qed. Lemma muniN : {morph muni: x / - x} . Proof. exact: raddfN. Qed. Lemma muniD : {morph muni: x y / x + y}. Proof. exact: raddfD. Qed. Lemma muniB : {morph muni: x y / x - y}. Proof. exact: raddfB. Qed. Lemma muniMn k : {morph muni: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma muniMNn k : {morph muni: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma muni_is_multiplicative : multiplicative muni. Proof. apply/commr_mmap_is_multiplicative=> /= [i p|p m1 m2]. rewrite /X; case: splitP=> j _; last exact/commr_polyX. by apply/polyP=> k; rewrite coefCM coefMC; apply/commr_mpolyX. apply/polyP=> k; rewrite coefCM coefMC XE coefZ coefXn. case: eqP; rewrite ?(mulr0, mul0r, mulr1, mul1r) //= => _. exact/commr_mpolyX. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build {mpoly R[n.+1]} {poly {mpoly R[n]}} muni muni_is_multiplicative. Lemma muni1 : muni 1 = 1. Proof. exact: rmorph1. Qed. Lemma muniM : {morph muni: x y / x * y}. Proof. exact: rmorphM. Qed. Lemma muniC c : muni c%:MP = (c%:MP)%:P. Proof. by rewrite /muni mmapC. Qed. Lemma muniN1 : muni (-1) = -1. Proof. by rewrite raddfN /= muniC. Qed. Lemma muniZ c p : muni (c *: p) = c%:MP *: muni p. Proof. by rewrite /muni mmapZ /= mul_polyC. Qed. End MPolyUni. (* -------------------------------------------------------------------- *) Section MESymViete. Local Notation mw := mwiden. Local Notation mpw := mpwiden. Local Notation swiden h := [set widen x | x in h : {set 'I__}] (only parsing). Local Notation S1 n k := [set swiden h | h in {set 'I_n} & #|h| == k.+1] (only parsing). Local Notation S2 n k := [set ord_max |: swiden h | h in {set 'I_n} & #|h| == k] (only parsing). Let inj_widen n : injective (widen : 'I_n -> _). Proof. by move=> x y /eqP; rewrite eqE /= val_eqE => /eqP. Qed. Local Hint Resolve inj_widen : core. Let inj_swiden n : injective (fun h : {set 'I_n} => swiden h). Proof. have h m (x : 'I_n): (widen x \in swiden m) = (x \in m). apply/imsetP/idP=> /= [[y y_in_m /inj_widen ->//]|]. by move=> x_in_m; exists x. move=> m1 m2 /= /setP eq; apply/setP=> /= x. by have := eq (widen x); rewrite !h. Qed. Local Hint Resolve inj_swiden : core. Let inj_mDswiden n : injective (fun h : {set 'I_n} => ord_max |: swiden h). Proof. move=> h1 h2 /= /setP eq; apply/inj_swiden. apply/setP => /= x; have {eq} := (eq x). rewrite !inE; case: eqP=> [-> _|//]. have E (h : {set 'I_n}): ord_max \in swiden h = false. apply/negP; case/imsetP=> /= y _ /eqP. by rewrite eqE /= eq_sym ltn_eqF. by rewrite !E. Qed. Let disjoint_S n k : [disjoint (S1 n k) & (S2 n k)]. Proof. rewrite -setI_eq0; apply/eqP/setP=> /= x. rewrite !in_set; apply/negP=> /andP[]. case/imsetP=> /= h1 _ -> /imsetP /= [h2 _]. move/setP/(_ ord_max); rewrite in_set in_set1 eqxx /=. case/imsetP=> /= {h1 h2} m _ /eqP. by rewrite eqE /= eq_sym ltn_eqF. Qed. Let union_S n k : [set h in {set 'I_n.+1} | #|h| == k.+1] = S1 n k :|: S2 n k. Proof. apply/eqP; rewrite eq_sym eqEcard; apply/andP; split. rewrite subUset; apply/andP; split. apply/subsetP=> h /imsetP /= [m]; rewrite inE. by move=> eq ->; rewrite inE card_imset //=. apply/subsetP=> h /imsetP /= [m]; rewrite inE. move=> eq->; rewrite inE cardsU1 card_imset //=. rewrite -[k.+1]add1n (eqP eq) eqn_add2r eqb1. apply/negP=> /imsetP [/=] x _ /eqP. by rewrite eqE /= eq_sym ltn_eqF. have := disjoint_S n k; rewrite -leq_card_setU=> /eqP->. rewrite !card_imset //= ?card_draws /=; try exact/inj_swiden; try exact/inj_mDswiden. (* remove the line above once requiring Coq >= 8.17 *) by rewrite !card_ord binS. Qed. Lemma mesymSS (R : ringType) n k : 's_(n.+1, k.+1) = mw 's_(n, k.+1) + mw 's_(n, k) * 'X_(ord_max) :> {mpoly R[n.+1]}. Proof. rewrite /mesym -big_set /= union_S big_set. rewrite bigU ?disjoint_S //=; congr (_ + _). + rewrite big_imset /=; last by move=> ?? _ _; apply/inj_swiden. rewrite big_set /= raddf_sum /=; apply/eq_bigr=> h _. rewrite !mprodXE mwidenX; congr 'X_[_]; apply/mnmP=> j. rewrite mnmwiden_sum !mnm_sumE big_imset //=; last first. by move=> ?? _ _; apply/inj_widen. by apply/eq_bigr=> i _; rewrite mnmwiden1. + rewrite big_imset /=; last by move=> t1 t2 _ _; apply/inj_mDswiden. rewrite big_set /= raddf_sum /= mulr_suml; apply/eq_bigr=> h _. rewrite !mprodXE mwidenX -mpolyXD; congr 'X_[_]. rewrite (big_setD1 ord_max) /= ?in_setU1 ?eqxx //=. rewrite addmC setU1K //= ?mnmwiden_sum ?big_imset /=. by congr (_ + _)%MM; apply/eq_bigr=> i _; rewrite mnmwiden1. by move=> ?? _ _; apply/inj_widen. apply/negP; case/imsetP=> /= x _ /eqP. by rewrite eqE /= eq_sym ltn_eqF. Qed. Lemma Viete : forall n, \prod_(i < n ) ('X - ('X_i)%:P) = \sum_ (k < n.+1) (-1)^+k *: ('s_(n, k) *: 'X^(n-k)) :> {poly {mpoly int[n]}}. Proof. elim => [|n ih]. by rewrite !big_ord0 big_ord1 mesym0E expr0 !scale1r. pose F n k : {poly {mpoly int[n]}} := (-1)^+k *: ('s_(n, k) *: 'X^(n-k)). have Fn0 l: F l 0%N = 'X^l. by rewrite /F expr0 mesym0E !scale1r subn0. have Fnn l: F l l = (-1)^+l *: \prod_(i < l) ('X_i)%:P. by rewrite /F mesymnnE subnn expr0 alg_polyC rmorph_prod. rewrite big_ord_recr /=; set p := (\prod_(_ < _) _). have {p}->: p = mpw (\prod_(i < n) ('X - ('X_i)%:P)). rewrite /mpwiden rmorph_prod /=; apply/eq_bigr. move=> /= i _; rewrite raddfB /= map_polyX map_polyC /=. by rewrite mwidenX mnmwiden1. rewrite {}ih (eq_bigr (F n.+1 \o val)) //; apply/esym. rewrite (eq_bigr (F n \o val)) // -!(big_mkord xpredT). rewrite raddf_sum /= mulrBr !mulr_suml. rewrite big_nat_recl 1?[X in X-_]big_nat_recl //. rewrite -!addrA !Fn0; congr (_ + _). by rewrite rmorphXn /= mpwidenX exprSr. rewrite big_nat_recr 1?[X in _-X]big_nat_recr //=. rewrite opprD !addrA; congr (_ + _); last first. rewrite !Fnn !mpwidenZ !rmorphXn /= mwidenN1. rewrite exprS mulN1r scaleNr -scalerAl; congr (- (_ *: _)). rewrite big_ord_recr rmorph_prod /=; congr (_ * _). by apply/eq_bigr=> i _; rewrite mpwidenC mwidenX mnmwiden1. rewrite -sumrB !big_seq; apply/eq_bigr => i /=. rewrite mem_index_iota => /andP [_ lt_in]; rewrite {Fn0 Fnn}/F. rewrite subSS mesymSS !mpwidenZ !rmorphXn /= !mwidenN1 !mpwidenX. rewrite exprS mulN1r !scaleNr mulNr -opprD; congr (-_). rewrite -!scalerAl -scalerDr; congr (_ *: _). rewrite -exprSr -subSn // subSS scalerDl; congr (_ + _). by rewrite -!mul_polyC !mulrA mulrAC polyCM. Qed. Lemma mroots_coeff (R : idomainType) n (cs : n.-tuple R) (k : 'I_n.+1) : (\prod_(c <- cs) ('X - c%:P))`_(n - k) = (-1)^+k * 's_(n, k).@[tnth cs]. Proof. pose P := (\prod_(i < n) ('X - ('X_i)%:P) : {poly {mpoly int[n]}}). pose f := mmap intr (tnth cs): {mpoly int[n]} -> R. pose F := fun i => 'X - (tnth cs i)%:P. move: (Viete n) => /(congr1 (map_poly f)). rewrite rmorph_prod /= (eq_bigr F); last first. move=> i _; rewrite raddfB /= map_polyX map_polyC /=. by rewrite mmapX mmap1U. rewrite big_tuple => ->; rewrite raddf_sum coef_sum /=. rewrite (bigD1 k) //= big1 ?addr0; last first. case=> i /= lt_iSk; rewrite eqE /= => ne_ik. rewrite !map_polyZ /= map_polyXn !coefZ coefXn. rewrite -(eqn_add2r i) subnK // addnC. rewrite -(eqn_add2r k) -addnA subnK 1?addnC; last first. by move: (ltn_ord k); rewrite ltnS. by rewrite eqn_add2l (negbTE ne_ik) !mulr0. rewrite !map_polyZ !rmorphXn /= raddfN /= mmapC !coefZ /=. congr (_ * _); rewrite map_polyX coefXn eqxx mulr1. rewrite /mesym; rewrite !raddf_sum /=; apply/eq_bigr. move=> i _; rewrite !rmorph_prod /=; apply/eq_bigr. by move=> j _; rewrite mmapX mmap1U mevalXU. Qed. Lemma mroots_sum (R : idomainType) (n : nat) (cs : n.+1.-tuple R) : \sum_(c <- cs) c = - (\prod_(c <- cs) ('X - c%:P))`_n. Proof. move: (mroots_coeff cs) => /(_ 1); rewrite subSS subn0=> ->. rewrite expr1 mulN1r opprK mesym1E raddf_sum /=. by rewrite big_tuple; apply/eq_bigr=> /= i _; rewrite mevalXU. Qed. End MESymViete. (* -------------------------------------------------------------------- *) Section MESymFundamental. Context (n : nat) (R : comRingType). Implicit Types (m : 'X_{1..n}). Local Notation "m # s" := [multinom m (s i) | i < n] (at level 40, left associativity, format "m # s"). Local Notation S := [tuple 's_(R, n, i.+1) | i < n]. Let mlead_XS m : mlead ('X_[R, m] \mPo S) = [multinom \sum_(j : 'I_n | i <= j) (m j) | i < n]. Proof. rewrite comp_mpolyX mlead_prod_proper=> /=; last first. move=> i _ _; rewrite tnth_map tnth_ord_tuple. rewrite mleadX_proper /= ?mleadc_mesym //; last exact/lreg1. by rewrite mleadcX ?mleadc_mesym //; apply/lregX/lreg1. pose F (i : 'I_n) := [multinom (j <= i) * (m i) | j < n]. rewrite (eq_bigr F) {}/F=> [|i _]; last first. rewrite tnth_map tnth_ord_tuple mleadX_proper. rewrite mlead_mesym //; apply/mnmP=> j. by rewrite mulmnE !mnmE mulnC ltnS. by rewrite mleadc_mesym //; apply/lreg1. apply/mnmP=> i; apply/esym; rewrite mnm_sumE mnmE big_mkcond /=. apply/eq_bigr=> j _; rewrite mnmE; case: leqP=> _. by rewrite mul1n. by rewrite mul0n. Qed. Let mleadc_XS l : mleadc ('X_[l] \mPo S) = 1. Proof. rewrite comp_mpolyX mlead_prod_proper ?mleadc_prod; last first. move=> /= i _ _; rewrite tnth_map tnth_ord_tuple. rewrite mleadX_proper // ?mleadcX ?mleadc_mesym //. exact/lregX/lreg1. exact/lreg1. rewrite (eq_bigr (fun _ => 1)) /=; last first. move=> i _; rewrite tnth_map tnth_ord_tuple. rewrite mleadX_proper ?mleadcX ?mleadc_mesym //. by rewrite expr1n. exact/lreg1. by rewrite prodr_const expr1n. Qed. Let free_XS : injective (fun m => mlead ('X_[R, m] \mPo S)). Proof. move=> m1 m2; apply: contra_eq. move=> ne_m1m2; apply/negP=> /eqP eqXS. pose F m i := (\sum_(j : 'I_n | i <= j) (m j))%N. have {eqXS} eqF i: F m1 i = F m2 i. case: (ssrnat.ltnP i n)=> [lt_in|le_ni]; last first. rewrite /F !big1 //= => j /(leq_trans le_ni); by rewrite leqNgt ltn_ord. by move/mnmP/(_ (Ordinal lt_in)): eqXS; rewrite !mlead_XS !mnmE. apply/negP: ne_m1m2; rewrite negbK; apply/eqP/mnmP=> i. rewrite -[i in m1 i]rev_ordK -[i in m2 i]rev_ordK. pose G m i := nth 0%N m (n-i.+1); rewrite !(mnm_nth 0%N) /=. apply/(@psumn_eq n (G m1) (G m2)); rewrite ?subnSK ?leq_subr //. move=> j le_jn; have Geq m: (\sum_(i < n | i < j) G m i = F m (n-j))%N. rewrite (reindex_inj rev_ord_inj) /= /F; apply/eq_big=> l /=. + by rewrite subnSK // !leq_subLR addnC. + by move=> _; rewrite /G subnS subKn //= (mnm_nth 0%N). by rewrite !Geq. Qed. Let mlead_XLS (m : 'X_{1..n}) : let c i := nth 0%N m i in let F i := (c i - c i.+1)%N in (forall i j : 'I_n, i <= j -> m j <= m i) -> mlead ('X_[R, F#val] \mPo S) = m. Proof. move=> c F srt_m; rewrite mlead_XS; apply/mnmP=> i. rewrite mnmE; rewrite (eq_bigr (F \o val)); last first. by move=> /= j _; rewrite mnmE. rewrite -big_mkord (big_cat_nat _ (n := i)) // 1?ltnW //=. rewrite big_nat_cond big_pred0 ?add0n; last first. by move=> j /=; rewrite ltnNge andNb. rewrite big_nat_cond (eq_bigl (fun j => i <= j < n)); last first. by move=> j /=; apply/andb_idr=> /andP[]. rewrite -big_nat; rewrite sumn_range 1?ltnW //. rewrite /c [X in (_-X)%N]nth_default ?size_tuple //. by rewrite subn0 (mnm_nth 0%N). move=> j1 j2; rewrite ltnS=> /andP[le_j1j2]. rewrite leq_eqVlt ltn_subRL => /predU1P[->|]. by rewrite subnK ?[i <= _]ltnW // /c nth_default // size_tuple. rewrite addnC=> lt_j2Di_n; have lt_j1Di_n: j1 + i < n. by apply/(@leq_ltn_trans (j2+i)); rewrite // leq_add2r. have /= := srt_m (Ordinal lt_j1Di_n) (Ordinal lt_j2Di_n). by rewrite !(mnm_nth 0%N) /=; apply; rewrite leq_add2r. Qed. Let mweight_XLS (m : 'X_{1..n}) : let c i := nth 0%N m i in let F i := (c i - c i.+1)%N in (forall i j : 'I_n, i <= j -> m j <= m i) -> mweight 'X_[R, F#val] = (mdeg m).+1. Proof. move=> c F srt_m; rewrite mmeasureX /mnmwgt /=; congr _.+1. rewrite (eq_bigr (fun i : 'I_n => (F i) * i.+1))%N; last first. by move=> i _; rewrite mnmE. rewrite mdegE sumn_wgt_range; last first. move=> i j /andP[le_ij]; rewrite ltnS leq_eqVlt => /predU1P[->|]. by rewrite {1}/c nth_default // size_tuple. move=> lt_jn; have lt_in: i < n by exact: leq_ltn_trans le_ij _. have /(_ le_ij) := srt_m (Ordinal lt_in) (Ordinal lt_jn). by rewrite /fun_of_multinom !(tnth_nth 0%N). rewrite {2}/c nth_default ?size_tuple // muln0 subn0. by apply/eq_bigr=> /= i _; rewrite /fun_of_multinom (tnth_nth 0%N). Qed. Definition symf1 (p : {mpoly R[n]}) : {mpoly R[n]} * {mpoly R[n]} := if p == 0 then (0, 0) else let m := mlead p in let c := nth 0%N m in let F := fun i => (c i - c i.+1)%N in (p@_m *: 'X_[F#val], p - p@_m *: ('X_[F#val] \mPo S)). Fixpoint symfn (k : nat) (p : {mpoly R[n]}) := if k is k'.+1 then let (t1, p) := symf1 p in let (t2, p) := symfn k' p in (t1 + t2, p) else symf1 p. Lemma symf1E0 : symf1 0 = (0, 0). Proof. by rewrite /symf1 eqxx. Qed. Lemma symfnE0 k : symfn k 0 = (0, 0). Proof. by elim: k => /= [|k ih]; rewrite symf1E0 //= ih addr0. Qed. Lemma symf1P (p : {mpoly R[n]}) : p \is symmetric -> [&& ((symf1 p).2 == 0) || (mlead (symf1 p).2 < mlead p)%O , (symf1 p).2 \is symmetric & p == (symf1 p).1 \mPo S + (symf1 p).2]. Proof. rewrite /symf1; case: (eqVneq p 0) => [->|nz_p sym_p] /=. by rewrite comp_mpoly0 addr0 eqxx andbT. rewrite addrCA comp_mpolyZ subrr addr0 eqxx andbT rpredB //; last first. by apply/rpredZ/mcomp_sym => i; rewrite -tnth_nth tnth_map; apply/mesym_sym. case: eqVneq; rewrite //= andbT. have := mlead_XLS (mlead_msym_sorted sym_p). set c := nth 0%N (mlead p); pose F i := (c i - c i.+1)%N. rewrite -/(F#val) => mE. set q : {mpoly R[n]} := p@_(mlead p) *: (_ \mPo _). rewrite lt_neqAle andbC /= => nz_pBq. have := mleadB_le p q; rewrite mleadZ_proper; last first. by rewrite mE mulrC mulrI_eq0 ?mleadc_eq0 // -mE mleadc_XS; apply/lreg1. rewrite mE joinxx => -> /=; apply/contraTneq: nz_pBq. rewrite -mleadc_eq0 => ->; rewrite /q mcoeffB mcoeffZ -{3}mE. by rewrite mleadc_XS mulr1 subrr eqxx. Qed. Lemma symfnP k (p : {mpoly R[n]}) : p \is symmetric -> [&& ((symfn k p).2 == 0) || (mlead (symfn k p).2 < mlead p)%O , (symfn k p).2 \is symmetric & p == (symfn k p).1 \mPo S + (symfn k p).2]. Proof. elim: k p=> [|k ih] p sym_p /=; first exact/symf1P. have E T U (z : T * U) : z = (z.1, z.2) by case: z. rewrite [symf1 p]E [symfn _ _]E /= => {E}. case/and3P: (symf1P sym_p); case/orP=> [/eqP-> _ /eqP pE|]. by rewrite symfnE0 /= eqxx rpred0 /= {1}pE !simpm. move=> le_q1_p /ih /and3P[]; case/orP=> [/eqP-> _|]. move=> /eqP q1E /eqP pE; rewrite eqxx rpred0 /=. by rewrite {1}pE {1}q1E !simpm /= addr0 raddfD. move=> le_q2_q1 -> /eqP q1E /eqP pE. rewrite (lt_trans le_q2_q1) ?orbT //= {1}pE {1}q1E. by rewrite addrA raddfD. Qed. Lemma symfnS (p : {mpoly R[n]}) : { n : nat | p \is symmetric -> (symfn n p).2 = 0 }. Proof. have: p \is symmetric -> { n : nat | (symfn n p).2 = 0 }. elim/mleadrect: p => p ih sym_p; case/and3P: (symf1P sym_p). case: ((symf1 p).2 =P 0)=> /= [z_q1|nz_q1]; first by exists 0%N. move=> le_q1 /ih -/(_ le_q1) [k z_q2] /eqP pE. exists k.+1=> /=; have E T U (z : T * U): z = (z.1, z.2) by case: z. by rewrite [symf1 _]E [symfn _ _]E z_q2. by case: (p \is symmetric)=> [[]// k eq|_]; [exists k | exists 0%N]. Qed. Definition symf (p : {mpoly R[n]}) := nosimpl (symfn (tag (symfnS p)) p).1. Lemma symfP (p : {mpoly R[n]}) : p \is symmetric -> p = symf p \mPo S. Proof. move=> sym_p; rewrite /symf; set k := tag _. case/and3P: (symfnP k sym_p)=> /= _ _ /eqP {1}->. by rewrite {}/k; case: symfnS=> /= k -> //; rewrite !simpm. Qed. (* -------------------------------------------------------------------- *) Lemma symf1_wgle (p : {mpoly R[n]}) : p \is symmetric -> mweight (symf1 p).1 <= msize p. Proof. move=> sym_p; rewrite /symf1; case: (p =P 0). by rewrite mmeasure0. move=> /eqP nz_p; set X := 'X_[_] => /=. rewrite (@leq_trans (mweight X)) ?mmeasureZ_le //. rewrite -?mlead_deg ?mleadc_eq0 // mweight_XLS //. exact/mlead_msym_sorted. Qed. Lemma symfn_wgle k (p : {mpoly R[n]}) : p \is symmetric -> mweight (symfn k p).1 <= msize p. Proof. elim: k p => [|k ih] p sym_p /=; first exact/symf1_wgle. have E T U (z : T * U): z = (z.1, z.2) by case: z. rewrite [symf1 p]E [symfn _ _]E /= => {E}. case/and3P: (symf1P sym_p); case/orP=> [/eqP-> _ /eqP pE|]. by rewrite symfnE0 /= addr0; apply/symf1_wgle. move=> le_q1_p sym_q2 /eqP pE. rewrite (leq_trans (mmeasureD_le _ _ _)) //. rewrite geq_max symf1_wgle //= (leq_trans (ih _ _)) //. have [->|nz_p] := eqVneq p 0; first by rewrite symf1E0 msize0. have [->|nz_f1p] := eqVneq (symf1 p).2 0; first by rewrite msize0. by rewrite -!mlead_deg // ltnS lemc_mdeg // ltW. Qed. (* -------------------------------------------------------------------- *) Lemma sym_fundamental (p : {mpoly R[n]}) : p \is symmetric -> { t | t \mPo S = p /\ mweight t <= msize p}. Proof. by exists (symf p); rewrite {2}[p]symfP ?symfn_wgle. Qed. (* -------------------------------------------------------------------- *) Local Notation XS m := ('X_[R, m] \mPo S) (only parsing). Lemma msym_fundamental_un0 (t : {mpoly R[n]}) : t \mPo S = 0 -> t = 0. Proof. set S := S; move/eqP; apply/contraTeq=> nz_t; rewrite -mleadc_eq0. have h m: m \in msupp t -> mlead (t@_m *: (XS m)) = mlead (XS m). move=> m_in_t; rewrite mleadZ_proper // mleadc_XS. by rewrite mulr1 mcoeff_eq0 m_in_t. rewrite comp_mpolyEX mlead_sum ?filter_predT; last first. rewrite (iffLR (eq_in_map _ _ _) h) -/S. apply/(@uniqP _ 0%MM) => i j; rewrite size_map. move=> lti ltj; rewrite !(nth_map 0%MM) // => /free_XS. exact: (can_in_inj (nthK _ _)). rewrite big_seq (eq_bigr _ h) -big_seq. case: (eq_bigjoin (fun m => mlead (XS m)) _ (r := msupp t)). exact/le_total. by rewrite msupp_eq0. move=> /= m m_in_t /eqP/esym; rewrite -/S=> lmm. rewrite -lmm raddf_sum /= (bigD1_seq m) //= mcoeffZ. rewrite mleadc_XS mulr1 big_seq_cond big1. by rewrite addr0 mcoeff_eq0 m_in_t. move=> /= m' /andP[m'_in_t ne_m'm]; rewrite mcoeffZ. rewrite [X in _*X]mcoeff_gt_mlead ?mulr0 //. rewrite lt_neqAle (contra_neq (@free_XS _ _)) //= lmm. exact: (joins_sup_seq (fun m => mlead (XS m))). Qed. Lemma msym_fundamental_un (t1 t2 : {mpoly R[n]}) : t1 \mPo S = t2 \mPo S -> t1 = t2. Proof. move/eqP; rewrite -subr_eq0 -raddfB /= => /eqP. by move/msym_fundamental_un0/eqP; rewrite subr_eq0=> /eqP. Qed. End MESymFundamental. (* -------------------------------------------------------------------- *) Definition ishomog1_pred {n} {R : ringType} (d : nat) (mf : measure n) : pred {mpoly R[n]} := fun p => all [pred m | mf m == d] (msupp p). Arguments ishomog1_pred _ _ _ _ _ /. Definition ishomog1 {n} {R : ringType} (d : nat) (mf : measure n) : qualifier 0 {mpoly R[n]} := [qualify p | ishomog1_pred d mf p]. (* -------------------------------------------------------------------- *) Definition ishomog_pred {n} {R : ringType} mf : pred {mpoly R[n]} := fun p => p \is ishomog1 (@mmeasure _ _ mf p).-1 mf. Arguments ishomog_pred _ _ _ _ /. Definition ishomog {n} {R : ringType} mf : qualifier 0 {mpoly R[n]} := [qualify p | ishomog_pred mf p]. (* -------------------------------------------------------------------- *) Section MPolyHomogTheory. Context (n : nat) (R : ringType) (mf : measure n). Implicit Types (p q : {mpoly R[n]}). Local Notation "d .-homog" := (@ishomog1 _ _ d mf) (at level 1, format "d .-homog") : form_scope. Local Notation homog := (@ishomog _ _ mf). Local Notation "[ 'in' R [ n ] , d .-homog ]" := (@ishomog1 n R d mf) (at level 0, R, n at level 2, d at level 0, format "[ 'in' R [ n ] , d .-homog ]") : form_scope. Lemma dhomogE d p: (p \is d.-homog) = all [pred m | mf m == d] (msupp p). Proof. by []. Qed. Lemma dhomogP d p: reflect {in msupp p, forall m, mf m = d} (p \is d.-homog). Proof. by apply/(iffP allP)=> /= h m /h => [/eqP|->]. Qed. Lemma dhomog_mf d p: p \is d.-homog -> {in msupp p, forall m, mf m = d}. Proof. by move/dhomogP. Qed. Lemma dhomog_nemf_coeff d p m: p \is d.-homog -> mf m != d -> p@_m = 0. Proof. move/dhomogP=> hg_p; apply/contraTeq; rewrite -mcoeff_msupp. by move/hg_p=> ->; rewrite negbK. Qed. Lemma dhomog1 : (1 : {mpoly R[n]}) \is 0.-homog. Proof. by apply/dhomogP; rewrite msupp1=> m; rewrite inE=> /eqP ->; exact: mf0. Qed. Lemma dhomog_uniq p d e : p != 0 -> p \is d.-homog -> p \is e.-homog -> d = e. Proof. by move=> nz_p /dhomogP /(_ _ (mlead_supp nz_p)) <- /dhomogP/(_ _ (mlead_supp nz_p)). Qed. Lemma dhomog_submod_closed d : submod_closed [in R[n], d.-homog]. Proof. split=> [|c p q]; first by rewrite dhomogE msupp0. move=> /dhomogP hg_p /dhomogP hg_q; apply/dhomogP=> m. move/msuppD_le; rewrite mem_cat; case/orP=> [/msuppZ_le|]. by move/hg_p. by move/hg_q. Qed. HB.instance Definition _ d := GRing.isSubmodClosed.Build R {mpoly R[n]} (ishomog1_pred d mf) (dhomog_submod_closed d). Lemma dhomog0 d: 0 \is [in R[n], d.-homog]. Proof. exact/rpred0. Qed. Lemma dhomogX d m: ('X_[m] \is [in R[n], d.-homog]) = (mf m == d). Proof. by rewrite dhomogE msuppX /= andbT. Qed. Lemma dhomogD d: {in d.-homog &, forall p q, p + q \is d.-homog}. Proof. exact/rpredD. Qed. Lemma dhomogN d: {mono -%R: p / p \in [in R[n], d.-homog]}. Proof. exact/rpredN. Qed. Lemma dhomogZ d c p: p \in d.-homog -> (c *: p) \in d.-homog. Proof. exact/rpredZ. Qed. Local Notation mfsize p := (@mmeasure _ _ mf p). Lemma homog_msize p : (p \is homog) = (p \is (mfsize p).-1.-homog). Proof. by []. Qed. Lemma dhomog_msize d p : p \is d.-homog -> p \is (mfsize p).-1.-homog. Proof. rewrite mmeasureE => /dhomogP h; apply/dhomogP => m m_in_p. rewrite h // big_seq (eq_bigr (fun _ => d.+1)); last by move=> i /h ->. rewrite -big_seq (perm_big _ (perm_to_rem m_in_p)) big_cons /=. elim: (rem _ _)=> [|x s ih]; first by rewrite big_nil maxn0. by rewrite big_cons maxnA maxnn -ih. Qed. Lemma homogE d p : p \is d.-homog -> p \is homog. Proof. by move/dhomog_msize. Qed. Lemma homogP p : reflect (exists d, p \is d.-homog) (p \is homog). Proof. by apply: (iffP idP)=> [h|[d /dhomog_msize]] //; exists (mfsize p).-1. Qed. Lemma dhomogM d p e q : p \is d.-homog -> q \is e.-homog -> p * q \is (d + e).-homog. Proof. move=> /dhomogP homp /dhomogP homq; apply/dhomogP=> m. case/msuppM_le/allpairsP=> /= -[m1 m2] [/=]. by move=> /homp <- /homq <- ->; apply/mfD. Qed. Lemma dhomogMn d p k : p \is d.-homog -> p ^+ k \is (d * k).-homog. Proof. elim: k => [| k ihk] homp; first by rewrite muln0; apply/dhomog1. by rewrite exprS /= mulnS; apply/dhomogM/ihk. Qed. Lemma homog_prod (s : seq {mpoly R[n]}) : all (fun p => p \is homog) s -> \prod_(p <- s) p \is homog. Proof. move=> homs; apply/homogP; elim: s homs => [_ | p s ihs] /=. by exists 0%N; rewrite big_nil; apply/dhomog1. case/andP=> /homogP [dp p_hdp] {}/ihs [d ih]. by exists (dp + d)%N; rewrite big_cons; apply/dhomogM. Qed. Lemma dhomog_prod {l} (dt : l.-tuple nat) (mt : l.-tuple {mpoly R[n]}) : (forall i : 'I_l, tnth mt i \is (tnth dt i).-homog) -> \prod_(i <- mt) i \is (\sum_(i <- dt) i).-homog. Proof. elim: l dt mt => [| l ihl] dt mt hom. by rewrite tuple0 big_nil tuple0 big_nil dhomog1. case/tupleP: dt hom => d dt; case/tupleP: mt => p mt /= hom. rewrite !big_cons; apply/dhomogM. by move: (hom ord0); rewrite (tnth_nth 0) (tnth_nth 0%N). apply/ihl => i; have:= hom (inord i.+1). by rewrite !(tnth_nth 0) ?(tnth_nth 0%N) !inordK ?ltnS. Qed. End MPolyHomogTheory. Notation "[ 'in' R [ n ] , d .-homog 'for' mf ]" := (@ishomog1 n R d mf) (at level 0, R, n at level 2, d at level 0, format "[ 'in' R [ n ] , d .-homog 'for' mf ]") : form_scope. Notation "[ 'in' R [ n ] , d .-homog ]" := [in R[n], d.-homog for mdeg] (at level 0, R, n at level 2, d at level 0) : form_scope. Notation "d .-homog 'for' mf" := (@ishomog1 _ _ d mf) (at level 1, format "d .-homog 'for' mf") : form_scope. Notation "d .-homog" := (d .-homog for mdeg) (at level 1, format "d .-homog") : form_scope. Notation "'homog' mf" := (@ishomog _ _ mf) (at level 1, format "'homog' mf") : form_scope. (* -------------------------------------------------------------------- *) Section HomogNVar0. Context (n : nat) (R : ringType). Lemma nvar0_homog (mf : measure 0%N) (p : {mpoly R[0]}) : p \is 0.-homog for mf. Proof. by apply/dhomogP; case=> t; rewrite tuple0 mfE big_ord0. Qed. Lemma nvar0_homog_eq (mf : measure n) (p : {mpoly R[n]}) : n = 0%N -> p \is 0.-homog for mf. Proof. by move=> z_n; move: mf p; rewrite z_n; apply/nvar0_homog. Qed. End HomogNVar0. (* -------------------------------------------------------------------- *) Section ProjHomog. Context (n : nat) (R : ringType) (mf : measure n). Implicit Types (p q r : {mpoly R[n]}) (m : 'X_{1..n}). Local Notation mfsize p := (@mmeasure _ _ mf p). Section Def. Variable (d : nat). Definition pihomog p : {mpoly R[n]} := \sum_(m <- msupp p | mf m == d) p@_m *: 'X_[m]. Lemma pihomogE p : pihomog p = \sum_(m <- msupp p | mf m == d) p@_m *: 'X_[m]. Proof. by []. Qed. Lemma pihomogwE k p : msize p <= k -> pihomog p = \sum_(m : 'X_{1..n < k} | mf m == d) p@_m *: 'X_[m]. Proof. move=> lt_pk; pose I : subFinType _ := 'X_{1..n < k}. rewrite pihomogE (big_mksub_cond I) //=; first last. + by move=> x /msize_mdeg_lt /leq_trans /(_ lt_pk) ->. + by rewrite msupp_uniq. rewrite -big_filter_cond big_rmcond ?big_filter //=. by move=> m /memN_msupp_eq0 ->; rewrite scale0r. Qed. Lemma pihomogX m : pihomog 'X_[m] = if mf m == d then 'X_[m] else 0. Proof. by rewrite pihomogE msuppX big_mkcond /= big_seq1 mcoeffX eqxx scale1r. Qed. Lemma pihomog_is_linear : linear pihomog. Proof. move=> c p q /=; pose_big_enough l. rewrite (pihomogwE _ (k := l)) //. rewrite (pihomogwE _ (k := l) (p := p)) //. rewrite (pihomogwE _ (k := l) (p := q)) //. rewrite scaler_sumr -big_split /=; apply: eq_bigr => m _. by rewrite linearP /= scalerDl scalerA. by close. Qed. HB.instance Definition _ := GRing.isLinear.Build R {mpoly R[n]} {mpoly R[n]} _ pihomog pihomog_is_linear. Lemma pihomog0 : pihomog 0 = 0 . Proof. exact: raddf0. Qed. Lemma pihomogN : {morph pihomog: x / - x} . Proof. exact: raddfN. Qed. Lemma pihomogD : {morph pihomog: x y / x + y}. Proof. exact: raddfD. Qed. Lemma pihomogB : {morph pihomog: x y / x - y}. Proof. exact: raddfB. Qed. Lemma pihomogMn k : {morph pihomog: x / x *+ k} . Proof. exact: raddfMn. Qed. Lemma pihomogMNn k : {morph pihomog: x / x *- k} . Proof. exact: raddfMNn. Qed. Lemma pihomog_dE p : p \is d.-homog for mf -> pihomog p = p. Proof. move/dhomogP => hom_p; rewrite pihomogE big_seq_cond. rewrite (eq_bigl [pred m | m \in msupp p]); last first. by move=> m /=; rewrite andb_idr // => /hom_p ->. by rewrite -big_seq -mpolyE. Qed. Lemma pihomogP p : pihomog p \is d.-homog for mf. Proof. apply/rpred_sum=> m /eqP eqd_mfm; apply/rpredZ. by apply/dhomogP => m0 /mem_msuppXP <-. Qed. Lemma pihomog_id p : pihomog (pihomog p) = pihomog p. Proof. by rewrite pihomog_dE; last exact: pihomogP. Qed. Lemma homog_piE p : p \is d.-homog for mf = (pihomog p == p). Proof. apply: (sameP idP); apply: (iffP idP); last by move /pihomog_dE ->. by move=> /eqP <-; apply/pihomogP. Qed. End Def. Lemma pihomog_ne0 d b p : d != b -> p \is d.-homog for mf -> pihomog b p = 0. Proof. move=> ne /dhomogP hom; rewrite pihomogE big_seq_cond. by apply/big_pred0 => m; apply/contraNF: ne=> /andP[/hom->]. Qed. Lemma pihomog_partitionE k p : mfsize p <= k -> p = \sum_(d < k) pihomog d p. Proof. move=> h; rewrite (exchange_big_dep predT) //= {1}[p]mpolyE. apply/eq_bigr => m _; rewrite -scaler_sumr. case: (ssrnat.leqP k (mf m)) => [|lt_mk]. move/(leq_trans h)/mmeasure_mnm_ge/memN_msupp_eq0. by move=> ->; by rewrite !scale0r. rewrite (eq_bigl (fun i : 'I_k => i == Ordinal lt_mk)). by rewrite big_pred1_eq. by move=> i /=; rewrite eq_sym. Qed. End ProjHomog. (* -------------------------------------------------------------------- *) Section MPolyHomogType. Context (n : nat) (R : ringType) (d : nat). Record dhomog := DHomog { mpoly_of_dhomog :> {mpoly R[n]}; _ : mpoly_of_dhomog \is d.-homog }. HB.instance Definition _ := [isSub for @mpoly_of_dhomog]. HB.instance Definition _ := [Choice of dhomog by <:]. HB.instance Definition _ := [SubChoice_isSubLmodule of dhomog by <:]. Lemma mpoly_of_dhomog_is_linear: linear mpoly_of_dhomog. Proof. by []. Qed. HB.instance Definition _ := GRing.isLinear.Build R dhomog {mpoly R[n]} _ mpoly_of_dhomog mpoly_of_dhomog_is_linear. End MPolyHomogType. Lemma dhomog_is_dhomog n (R : ringType) d (p : dhomog n R d) : val p \is d.-homog. Proof. by case: p. Qed. #[global] Hint Extern 0 (is_true (_ \is _.-homog)) => (by apply/dhomog_is_dhomog) : core. Definition indhomog n (R : ringType) d : {mpoly R[n]} -> dhomog n R d := fun p => insubd (0 : dhomog n R d) p. Notation "[ ''dhomog_' d p ]" := (@indhomog _ _ d p) (at level 8, d, p at level 2, format "[ ''dhomog_' d p ]"). (* -------------------------------------------------------------------- *) Section MPolyHomogVec. Local Notation isorted s := (sorted leq [seq val i | i <- s]). Definition basis n d : {set (d.-tuple 'I_n)} := [set t in {: d.-tuple 'I_n } | isorted t]. Definition s2m n (m : seq 'I_n) := [multinom count_mem i m | i < n]. Definition m2s n (m : 'X_{1..n}) := flatten [seq nseq (m i) i | i <- enum 'I_n]. Lemma inj_s2m n d: {in basis n d &, injective (@s2m n \o val)}. Proof. move=> t1 t2; rewrite !inE=> srt_t1 srt_t2 eq_tm. apply/val_inj/(inj_map val_inj). apply/(sorted_eq leq_trans anti_leq srt_t1 srt_t2). apply/perm_map/allP=> /= i _; move/mnmP/(_ i): eq_tm. by rewrite !mnmE => ->. Qed. Lemma srt_m2s n (m : 'X_{1..n}): isorted (m2s m). Proof. have h (T : eqType) (leT : rel T) (s : seq T) (F : T -> nat) x: reflexive leT -> transitive leT -> path leT x s -> path leT x (flatten [seq nseq (F x) x | x <- s]). * move=> leTxx leT_tr; elim: s x => //= y s ih x /andP[le_xy pt_ys]. case: (F y)=> /= [|k]; first apply/ih. rewrite path_min_sorted; do ?apply: (introT allP). exact/(path_sorted (x := y)). move=> z z_in_s /=; apply/(leT_tr y)=> //. by move/order_path_min: pt_ys => /(_ leT_tr) /allP /(_ _ z_in_s). rewrite le_xy /= cat_path; apply/andP; split. by elim: k=> //= k ->; rewrite leTxx. by have ->: last y (nseq k y) = y; [elim: k | apply/ih]. case: n m=> [|n] m. case: m => t /=; rewrite /m2s; have ->//: enum 'I_0 = [::]. by apply/size0nil; rewrite size_enum_ord. apply/(path_sorted (x := val (0 : 'I_n.+1))). pose P := [rel i j : 'I_n.+1 | i <= j]. rewrite (map_path (e' := P) (b := xpred0)) //=; last first. by apply/hasP; case. apply/h; try solve [exact/leqnn | exact/leq_trans]. rewrite -(map_path (h := val) (e := leq) (b := xpred0)) //. rewrite val_enum_ord /= path_min_sorted ?iota_sorted//; do ?exact: (introT allP). by apply/hasP; case. Qed. Lemma size_m2s n (m : 'X_{1..n}): size (m2s m) = mdeg m. Proof. rewrite /m2s size_flatten /shape -map_comp /=. rewrite (eq_map (_ : _ =1 m)); first by rewrite mdegE sumnE !big_map. by move=> i /=; rewrite size_nseq. Qed. Lemma s2mK n (m : 'X_{1..n}): s2m (m2s m) = m. Proof. apply/mnmP=> i; rewrite mnmE /m2s /=. rewrite count_flatten sumnE !big_map (bigD1 i) //=. rewrite -sum1_count /= big_nseq_cond eqxx iter_succn. rewrite add0n big1 ?addn0 // => j ne_ji; apply/count_memPn. by apply/negP=> /nseqP [/esym/eqP]; rewrite (negbTE ne_ji). Qed. Local Notation sbasis n d := [seq s2m t | t : d.-tuple 'I_n <- enum (basis n d)]. Lemma basis_cover n d (m : 'X_{1..n}): (mdeg m == d) = (m \in sbasis n d). Proof. apply/eqP/idP=> [eq_szm_d|]. apply/mapP; have /eqP := size_m2s m; rewrite -eq_szm_d => sz_tm. exists (Tuple sz_tm); first by rewrite mem_enum inE /= srt_m2s. by rewrite s2mK. case/mapP=> /= t _ ->; pose F i := count_mem i t. rewrite mdegE (eq_bigr F) {}/F; last first. by move=> /= i _; rewrite mnmE. transitivity (\sum_i \sum_(j <- t | j == i) 1)%N. by apply: eq_bigr => i _; rewrite -big_filter sum1_size size_filter. rewrite (exchange_big_dep predT)//=. transitivity (\sum_(j <- t) 1)%N; last by rewrite sum1_size size_tuple. by apply: eq_bigr => i _; rewrite (eq_bigl _ _ (eq_sym _)) big_pred1_eq. Qed. Lemma size_basis n d: size (sbasis n.+1 d) = 'C(d + n, d). Proof. by rewrite size_map -cardE; apply/card_sorted_tuples. Qed. Lemma uniq_basis n d: uniq (sbasis n d). Proof. rewrite map_inj_in_uniq ?enum_uniq // => t1 t2. by rewrite !mem_enum; apply/inj_s2m. Qed. (* -------------------------------------------------------------------- *) Context (n : nat) (R : ringType) (d : nat). Lemma dhomog_vecaxiom: vector_axiom 'C(d + n, d) (dhomog n.+1 R d). Proof. pose b := sbasis n.+1 d. pose t := [tuple of nseq d (0 : 'I_n.+1)]. pose M := fun i => nth 0%MM b i. pose f (p : dhomog n.+1 R d) := \row_(i < 'C(d + n, d)) p@_(nth 0%MM b i). exists f => /= [c p q|]. by apply/matrixP=> i j; rewrite !mxE /= mcoeffD mcoeffZ. pose g (r : 'rV[R]_('C(d + n, d))) : {mpoly R[_]} := \sum_(i < 'C(d + n, d)) (r 0 i) *: 'X_[M i]. have dhg r: g r \is d.-homog. rewrite rpred_sum //= => i _; apply/rpredZ. rewrite dhomogX basis_cover /M (nth_map t); last first. by rewrite -cardE card_sorted_tuples. by apply/map_f/mem_nth; rewrite -cardE card_sorted_tuples. exists (fun r => DHomog (dhg r)); last first. move=> r; rewrite /g /f /=; apply/matrixP=> i j. rewrite mxE ord1 raddf_sum /= -/(M _) (bigD1 j) //=. rewrite mcoeffZ mcoeffX eqxx mulr1 big1 ?addr0 //. move=> k ne_kj; rewrite mcoeffZ mcoeffX /M. rewrite nth_uniq ?size_basis ?uniq_basis //. by rewrite (inj_eq (val_inj)) (negbTE ne_kj) mulr0. move=> p; apply/val_inj/mpolyP=> m /=; rewrite /g /f. pose P := fun (p : {mpoly R[n.+1]}) m => p@_m *: 'X_[m]. rewrite (eq_bigr (P p \o M \o val)) /P /=; last first. by move=> /= i _; rewrite mxE. rewrite -(big_map (M \o val) xpredT (P p)) {}/P /M /=. rewrite /index_enum -enumT /= map_comp val_enum_ord. set r := map _ _; have {r}->: r = b; rewrite ?raddf_sum /=. apply/(@eq_from_nth _ 0%MM). by rewrite size_map size_iota size_basis. rewrite size_map size_iota=> i lt_i_C. by rewrite (nth_map 0%N) ?size_iota // nth_iota. case: (mdeg m =P d)=> /eqP; rewrite basis_cover -/b. move=> m_in_b; rewrite (bigD1_seq m) ?uniq_basis //=. rewrite mcoeffZ mcoeffX eqxx mulr1 big1 ?addr0 // => m' ne. by rewrite mcoeffZ mcoeffX (negbTE ne) mulr0. move=> m_notin_b; rewrite big_seq big1 /=. apply/esym/(@dhomog_nemf_coeff _ _ mdeg d). exact/dhomog_is_dhomog. by rewrite basis_cover. move=> m'; apply/contraTeq; rewrite mcoeffZ mcoeffX. by case: (m' =P m)=> [->|_]; last rewrite mulr0 eqxx. Qed. #[hnf] HB.instance Definition _ := Lmodule_hasFinDim.Build R (dhomog n.+1 R d) dhomog_vecaxiom. End MPolyHomogVec. (* -------------------------------------------------------------------- *) Section MSymHomog. Context (n : nat) (R : comRingType). Implicit Types (p q r : {mpoly R[n]}). Lemma msym_pihomog d p (s : 'S_n) : msym s (pihomog mdeg d p) = pihomog mdeg d (msym s p). Proof. rewrite (mpolyE p) ![_ (\sum_(m <- msupp p) _)]linear_sum /=. rewrite [msym s _]linear_sum linear_sum /=. apply: eq_bigr => m _; rewrite !linearZ /=; congr (_ *: _). rewrite msymX !pihomogX /=. have -> : mdeg [multinom m ((s^-1)%g i) | i < n] = mdeg m. by apply/perm_big/tuple_permP; exists (s^-1)%g. by case: (mdeg m == d); rewrite ?msym0 ?msymX. Qed. Lemma pihomog_sym d p : p \is symmetric -> pihomog mdeg d p \is symmetric. Proof. by move=> /issymP Hp; apply/issymP => s; rewrite msym_pihomog Hp. Qed. End MSymHomog. (* -------------------------------------------------------------------- *) Section MESymFundamentalHomog. Context (n : nat) (R : comRingType). Local Notation S := [tuple mesym n R i.+1 | i < n]. Lemma dhomog_mesym d : mesym n R d \is d.-homog. Proof. apply/dhomogP => m; rewrite msupp_mesymP => /existsP [/= s]. by case/andP=> /eqP<- {d} /eqP -> {m}; exact/mdeg_mesym1. Qed. Lemma dhomog_XS (m : 'X_{1..n}) : 'X_[m] \mPo S \is (mnmwgt m).-homog. Proof. pose dt := [tuple (i.+1 * m i)%N | i < n]. pose mt := [tuple (mesym n R i.+1) ^+ m i | i < n]. rewrite [X in X \is _](_ : _ = \prod_(i <- mt) i); last first. rewrite comp_mpolyX (eq_bigr (tnth mt)) ?big_tuple //. by move=> i _ /=; rewrite !tnth_mktuple. rewrite [X in X.-homog](_ : _ = (\sum_(i <- dt) i)%N); last first. rewrite /mnmwgt big_tuple (eq_bigr (tnth dt)) //. by move=> i _ /=; rewrite !tnth_mktuple mulnC. apply/dhomog_prod => i; rewrite !tnth_mktuple => {mt dt}. exact/dhomogMn/dhomog_mesym. Qed. Lemma pihomog_mPo p d : pihomog mdeg d (p \mPo S) = pihomog mnmwgt d p \mPo S. Proof. elim/mpolyind: p; first by rewrite !linear0. move=> c m p msupp cn0 ihp; rewrite !linearP /= {}ihp. congr (c *: _ + _); case: (eqVneq (mnmwgt m) d) => wgtm. + have /eqP := wgtm; rewrite -(dhomogX R) => /pihomog_dE ->. by have := dhomog_XS m; rewrite wgtm => /pihomog_dE ->. rewrite (pihomog_ne0 wgtm (dhomog_XS m)). by rewrite (pihomog_ne0 wgtm) ?linear0 // dhomogX. Qed. Lemma mwmwgt_homogE (p : {mpoly R[n]}) d : (p \is d.-homog for mnmwgt) = (p \mPo S \is d.-homog). Proof. by rewrite !homog_piE pihomog_mPo; apply/eqP/eqP=> [->|/msym_fundamental_un ->]. Qed. Lemma sym_fundamental_homog (p : {mpoly R[n]}) (d : nat) : p \is symmetric -> p \is d.-homog -> { t | t \mPo S = p /\ t \is d.-homog for mnmwgt }. Proof. move/sym_fundamental => [t [tSp _]] homp. exists (pihomog mnmwgt d t); split. + by rewrite -pihomog_mPo tSp pihomog_dE. + exact: pihomogP. Qed. End MESymFundamentalHomog. multinomials-2.3.0/src/ssrcomplements.v000066400000000000000000000270051472432761000202770ustar00rootroot00000000000000(* -------------------------------------------------------------------- * (c) Copyright 2014--2015 IMDEA Software Institute. * * You may distribute this file under the terms of the CeCILL-B license * -------------------------------------------------------------------- *) (* -------------------------------------------------------------------- *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path. From mathcomp Require Import choice fintype tuple finfun bigop finset order. From mathcomp Require Import ssralg. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.Theory GRing.Theory. (* -------------------------------------------------------------------- *) (* Compatibility layer for Order.disp_t introduced in MathComp 2.3 *) (* TODO: remove when we drop the support for MathComp 2.2 *) Module Order. Import Order. Definition disp_t : Set. Proof. exact: disp_t || exact: unit. Defined. Definition default_display : disp_t. Proof. exact: tt || exact: Disp tt tt. Defined. End Order. (* -------------------------------------------------------------------- *) Lemma lreg_prod (T : eqType) (R : ringType) (r : seq T) (P : pred T) (F : T -> R): (forall x, x \in r -> P x -> GRing.lreg (F x)) -> GRing.lreg (\prod_(x <- r | P x) F x). Proof. elim: r => [|x r ih] h; first by rewrite !big_nil; apply/lreg1. rewrite big_cons; set X := (\prod_(_ <- _ | _) _)%R. have lreg_X: GRing.lreg X by apply/ih=> y ? /h; apply; rewrite mem_behead. by case: ifP => // Px; apply/lregM/lreg_X/h/Px/mem_head. Qed. (* -------------------------------------------------------------------- *) Lemma sumn_range (k1 k2 : nat) (c : nat -> nat): k1 <= k2 -> (forall i j, i <= j < (k2 - k1).+1 -> c (j + k1) <= c (i + k1)) -> \sum_(k1 <= i < k2) (c i - c i.+1) = c k1 - c k2. Proof. rewrite leq_eqVlt => /predU1P[<- h|]; first by rewrite big_geq // subnn. rewrite -subn_gt0=> gt0_k2Bk1 h; rewrite -{1}[k1]add0n big_addn. case k1Bk2E: (k2 - k1) gt0_k2Bk1 h => [|n] // _ h. rewrite big_nat sumnB -?big_nat; last first. move=> i /andP[_]; rewrite ltnS -addSn => le_in. by apply/h; rewrite leqnSn /= !ltnS. rewrite big_nat_recl ?big_nat_recr //= subnDA addnK. rewrite add0n -addSn -k1Bk2E subnK // leqNgt; apply/negP. by move/ltnW; rewrite -subn_eq0 k1Bk2E. Qed. Lemma sum0n_range (k : nat) (c : nat -> nat): (forall i j, i <= j < k.+1 -> c j <= c i) -> \sum_(0 <= i < k) (c i - c i.+1) = c 0 - c k. Proof. move=> h; apply/sumn_range; rewrite ?subn0=> // i j le. by rewrite !addn0; apply/h. Qed. (* -------------------------------------------------------------------- *) Lemma sumn_wgt_range (k : nat) (c : nat -> nat): (forall i j, i <= j < k.+1 -> c j <= c i) -> \sum_(i < k) (c i - c i.+1) * i.+1 = \sum_(i < k) c i - k * c k. Proof. pose F i := c i * i.+1 - c i.+1 * i.+1. rewrite (eq_bigr (F \o val)) /=; first last. by move=> i _; rewrite mulnBl. rewrite [k * _]mulnC; elim: k=> [|k ih] h. by rewrite !big_ord0 muln0 subn0. rewrite !big_ord_recr /= ih; last first. by move=> i j /andP[le_ij lt_jSk]; rewrite h // le_ij leqW. rewrite {ih}/F addnBA ?leq_mul //; last by apply/h; rewrite leqnn ltnW. congr subn; rewrite addnC addnBA 1?addnC -?addnBA. + by rewrite -mulnBr subSnn muln1. + by rewrite leq_mul. elim: k h => [|k ih] h; first by rewrite muln0. rewrite big_ord_recr //= mulnS addnC leq_add //; last first. by apply/h; rewrite !ltnS !leqnSn. apply/leq_trans/ih; first by apply/leq_mul/leqnn/h; rewrite !ltnS leqnSn. by move=> i j /andP[le_ij lt_jSSk]; apply/h; rewrite le_ij !ltnS ltnW. Qed. (* -------------------------------------------------------------------- *) Lemma psumn_eq k (F1 F2 : nat -> nat): (forall j, j <= k -> \sum_(i < k | i < j) F1 i = \sum_(i < k | i < j) F2 i) -> forall j, j < k -> F1 j = F2 j. Proof. pose rw := (big_ord_narrow, big_ord_recr). move=> h j; elim: j {-2}j (leqnn j)=> [|j ih] l. rewrite leqn0=> /eqP-> lt; have := h 1 lt. by rewrite !rw !big_ord0 /= !add0n=> ->. rewrite leq_eqVlt ltnS => /predU1P[->|]; last by apply/ih. move: {-2}j.+1 (leqnn j.+1)=> x le_xSj lt; have := h _ lt. rewrite !rw /=; set S1 := bigop _ _ _; set S2 := bigop _ _ _. suff <-: S1 = S2 by move/addnI. apply/eq_bigr=> /=. case=> /= i lt_ix _; apply/ih; last by apply/(ltn_trans lt_ix). by rewrite -ltnS; apply/(leq_trans lt_ix). Qed. (* -------------------------------------------------------------------- *) Section BigMkSub. Context {S : Type}. Context {idx : S}. Context {op : Monoid.com_law idx}. Context {T : choiceType}. Context {sT : pred T}. Context {rT : pred T}. Context (I : subFinType sT). Context (J : subFinType rT). Lemma big_mksub_cond {P : pred T} {F : T -> S} (r : seq T): uniq r -> (forall x, x \in r -> P x -> sT x) -> \big[op/idx]_(x <- r | P x) (F x) = \big[op/idx]_(x : I | P (val x) && (val x \in r)) (F (val x)). Proof. move=> uniq_r h; rewrite -big_filter; apply/esym. pose Q x := P x && (x \in r); rewrite -(big_map val Q). rewrite -big_filter; apply/perm_big/uniq_perm; try rewrite filter_uniq // (map_inj_uniq val_inj). by rewrite /index_enum -enumT enum_uniq. move=> x; rewrite !mem_filter {}/Q; apply/andb_idr. rewrite andbC; case/andP=> /h {}h /h sT_x. apply/mapP; exists (Sub x sT_x). by rewrite /index_enum -enumT mem_enum. by rewrite SubK. Qed. Lemma big_mksub {F : T -> S} (r : seq T): uniq r -> (forall x, x \in r -> sT x) -> \big[op/idx]_(x <- r) F x = \big[op/idx]_(x : I | val x \in r) F (val x). Proof. by move=> uniq_r h; apply/big_mksub_cond=> // x /h. Qed. Lemma big_sub_widen {P : pred T} {F : T -> S}: (forall x, sT x -> rT x) -> \big[op/idx]_(x : I | P (val x)) (F (val x)) = \big[op/idx]_(x : J | P (val x) && sT (val x)) (F (val x)). Proof. move=> h; pose Q := [pred x | P x && sT x]. rewrite -big_map -(big_map val Q F). rewrite -big_filter -[X in _=X]big_filter; apply/perm_big. apply/uniq_perm; rewrite ?(filter_uniq, map_inj_uniq val_inj) //; try by rewrite /index_enum -enumT enum_uniq. move=> x; rewrite !mem_filter {}/Q inE -andbA; congr (_ && _). apply/idP/andP; last first. by case=> sTx _; apply/mapP; exists (Sub x sTx); rewrite ?SubK. case/mapP=> y _ ->; split; first by apply valP. apply/mapP; exists (Sub (val y) (h _ (valP y))). by rewrite /index_enum -enumT mem_enum. by rewrite SubK. Qed. Lemma eq_big_widen {P : pred T} {F : T -> S}: (forall x, sT x -> rT x) -> (forall x, ~~ sT x -> F x = idx) -> \big[op/idx]_(x : I | P (val x)) (F (val x)) = \big[op/idx]_(x : J | P (val x)) (F (val x)). Proof. move=> h1 h2; rewrite big_sub_widen //; apply/esym. rewrite (bigID (sT \o val)) [X in op _ X]big1 ?Monoid.simpm //. by move=> j /andP [_ /h2]. Qed. End BigMkSub. Arguments big_sub_widen [S idx op T sT rT]. Arguments big_sub_widen [S idx op T sT rT]. (* add to mathcomp *) Lemma prod_inj A B : injective (uncurry (@pair A B)). Proof. by move=> [? ?] [? ?]. Qed. #[global] Hint Resolve prod_inj : core. (* add to mathcomp *) Lemma in_allpairs (S T R : eqType) (f : S -> T -> R) (s : seq S) (t : seq T) x y : injective (uncurry f) -> f x y \in [seq f x0 y0 | x0 <- s, y0 <- t] = (x \in s) && (y \in t). Proof. move=> f_inj; apply/allpairsP/andP => [|[]]; last by exists (x, y). by case=> -[/= x' y'] [x's y't] /(f_inj (x, y) (x',y')) [-> ->]. Qed. (* -------------------------------------------------------------------- *) Section BigOpPair. Variables I J : finType. Variables R : Type. Variable idx : R. Variable op : Monoid.com_law idx. Lemma big_pair_dep (P : pred I) (Q : pred (I * J)) (F : I * J -> R) : \big[op/idx]_(p | P p.1 && Q p) F p = \big[op/idx]_(i | P i) \big[op/idx]_(j | Q (i, j)) F (i, j). Proof. by rewrite pair_big_dep; apply: eq_big => -[]. Qed. Lemma big_pair (P : pred I) (Q : pred J) (F : I * J -> R) : \big[op/idx]_(p | P p.1 && Q p.2) F p = \big[op/idx]_(i | P i) \big[op/idx]_(j | Q j) F (i, j). Proof. exact: big_pair_dep. Qed. Lemma big_pairA (F : I * J -> R): \big[op/idx]_p F p = \big[op/idx]_i \big[op/idx]_j F (i, j). Proof. exact: (big_pair_dep xpredT xpredT). Qed. End BigOpPair. (* -------------------------------------------------------------------- *) Section BigOpMulrn. Variable I : Type. Variable R : ringType. Variable F : I -> R. Variable P : pred I. Lemma big_cond_mulrn r: (\sum_(i <- r | P i) F i = \sum_(i <- r) F i *+ P i)%R. Proof. by rewrite big_mkcond; apply: eq_bigr => i; rewrite mulrb. Qed. End BigOpMulrn. (* -------------------------------------------------------------------- *) Lemma tval_tcast (T : Type) (n m : nat) (e : n = m) (t : n.-tuple T): tval (tcast e t) = tval t. Proof. by case: m / e. Qed. (* -------------------------------------------------------------------- *) Local Open Scope order_scope. Lemma lePseqprod d d' (T : porderType d) (s1 s2 : seqprod_with d' T) : reflect ((size s1 <= size s2)%N /\ (forall x i, i < size s1 -> nth x s1 i <= nth x s2 i)) (s1 <= s2). Proof. elim: s1 s2 => [|x s1 IHs] [|y s2] //=; try by constructor; try case. rewrite ltnS leEseq; apply: (iffP idP) => [/andP[lexy /IHs [-> Hs12]]|[? Hs12]]. by split => // ? [] //= i /Hs12. by rewrite (Hs12 x 0%N) //=; apply/IHs; split => // ? i; apply: (Hs12 _ i.+1). Qed. (* -------------------------------------------------------------------- *) Section LatticeMisc. Context {T : eqType} {disp : Order.disp_t} {U : bDistrLatticeType disp}. Context (P : pred T) (F : T -> U). Implicit Type (r : seq T). (* FIXME: introducing bOrderType improves the statement of the lemmas below. *) Hypothesis letot : @total U <=%O. Variant bigjoin_spec r : U -> Type := | BigJoinEmpty : nilp r -> bigjoin_spec r \bot%O | BigJoinNonempty i : i \in r -> bigjoin_spec r (F i). Lemma bigjoinP r : bigjoin_spec r (\join_(i <- r) F i). Proof. elim: r => [|i r]; first by rewrite big_nil; constructor. rewrite big_cons; case=> [|j jr]. by case: r => // _; rewrite joinx0; constructor; rewrite mem_head. by case: lcomparableP (letot (F i) (F j)) => //= _ _; constructor; rewrite ?mem_head // in_cons jr orbT. Qed. Lemma eq_bigjoin r : r != [::] -> {x : T | x \in r & (\join_(i <- r) F i)%O == F x}. Proof. by case: r => // x r _; case: bigjoinP => // y y_in_r; exists y. Qed. Variant bigjoin_cond_spec r : U -> Type := | BigJoinCondEmpty : all (xpredC P) r -> bigjoin_cond_spec r \bot%O | BigJoinCondNonempty i : i \in r -> P i -> bigjoin_cond_spec r (F i). Lemma bigjoinPcond r : bigjoin_cond_spec r (\join_(i <- r | P i) F i). Proof. rewrite -big_filter; case: bigjoinP => [nilPr|i]. by constructor; rewrite all_predC has_filter negbK; case: filter nilPr. by rewrite mem_filter => /andP[? ?]; constructor. Qed. End LatticeMisc. (* -------------------------------------------------------------------- *) Section WF. Context {disp : Order.disp_t} {T : porderType disp}. Hypothesis wf: forall (P : T -> Type), (forall x, (forall y, y < x -> P y) -> P x) -> forall x, P x. Section WFTuple. Context {n : nat} (P : n.-tuple T -> Type). Implicit Types t : n.-tuplelexi T. Hypothesis ih: forall t1, (forall t2, t2 < t1 -> P t2) -> P t1. Lemma ltxwf t : P t. Proof. elim: n P ih t => [|k wih] Pn kih t; last have [a {}t] := tupleP t. by rewrite tuple0; apply/kih=> t2; rewrite tuple0. elim/wf: a t => a iha t; elim/wih: t => t iht. apply/kih => t'; have [a' {}t'] := tupleP t'; rewrite [_ < _]ltxi_cons. by case: (comparableP a a') => //= [/iha/(_ t')|<- /iht]. Qed. End WFTuple. End WF. multinomials-2.3.0/src/xfinmap.v000066400000000000000000000024301472432761000166560ustar00rootroot00000000000000(* -------------------------------------------------------------------- *) From mathcomp Require Import ssreflect ssrbool ssrnat eqtype ssrfun. From mathcomp Require Import choice seq path finset finfun fintype bigop. From mathcomp Require Import bigenough. From mathcomp Require Export finmap. (* -------------------------------------------------------------------- *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope fset. (* -------------------------------------------------------------------- *) Module BigEnoughFSet. Export BigEnough. Definition big_rel_fsubset_class K : big_rel_class_of (@fsubset K). Proof. exists fsubset (fun G => \big[fsetU/fset0]_(g <- G) g)=> [|g s|g1 g2 j] //. by rewrite big_cons fsubsetUl. by rewrite big_cons => h; rewrite fsubsetU // h orbT. Qed. Canonical big_enough_fset K := BigRelOf (big_rel_fsubset_class K). Ltac fset_big_enough_trans := match goal with | [leq : is_true (?A `<=` ?B) |- is_true (?X `<=` ?B)] => apply: fsubset_trans leq; big_enough; olddone end. Ltac done := do [fset_big_enough_trans|BigEnough.done]. Ltac pose_big_fset K i := evar (i : {fset K}); suff : closed i; first do [move=> _; instantiate (1 := bigger_than (@fsubset K) _) in (value of i)]. End BigEnoughFSet.